produce.hs (1520B)
1 module Produce where 2 3 import Lustre 4 import Data.String.Utils 5 import Text.Show.Pretty 6 7 parenthesize x = "(" ++ x ++ ")" 8 produceList = join ", " 9 produceListP names = (if length names > 1 then parenthesize else id) $ 10 produceList names 11 produceArgs names = parenthesize $ produceList names 12 produceArgsB names = produceList names ++ (if null names then "" else " : bool") 13 produceArgsPB = parenthesize . produceArgsB 14 15 produceMultiple f xs = foldl (++) "" $ map f xs 16 produceBinop o = case o of 17 Lustre.Or -> " or " 18 Lustre.And -> " and " 19 Lustre.Fby -> " -> " 20 produceUnop o = case o of 21 Lustre.Not -> " not " 22 Lustre.Pre -> " pre " 23 produceExpr e = case e of 24 Lustre.False -> "false" 25 Lustre.True -> "true" 26 Lustre.Var name -> name 27 Lustre.Binop o e1 e2 -> 28 parenthesize (produceExpr e1) ++ produceBinop o ++ 29 parenthesize (produceExpr e2) 30 Lustre.Unop o e -> 31 produceUnop o ++ parenthesize (produceExpr e) 32 Lustre.Call x ys -> x ++ produceArgs ys 33 produceDecl (Decl lvalues expr) = 34 produceListP lvalues ++ " = " ++ produceExpr expr ++ ";\n" 35 produceDecls = produceMultiple produceDecl 36 37 produceNode (Node name comment i o lvars decls) = 38 unlines (map (\x -> "-- "++x) $ lines $ ppShow comment) 39 ++ "node " ++ name ++ produceArgsPB i 40 ++ " returns " ++ produceArgsPB o ++ ";\n" 41 ++ if null lvars then "" else "var " ++ produceArgsB lvars ++ ";\n" 42 ++ "let\n" 43 ++ produceDecls decls 44 ++ "tel\n" 45 46 produceNodes :: Show a => [Node a] -> String 47 produceNodes nodes = join "\n\n" $ map produceNode nodes 48