kesterel2lustre

compile Kernel Esterel to Lustre
git clone https://a3nm.net/git/kesterel2lustre/
Log | Files | Refs | README

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