AST.icl

   1 implementation module AST
   2
   3 import StdEnv
   4
   5 from Data.List import map, intercalate, replicate, flatten, isEmpty
   6 from Data.Func import $
   7 from Text import class Text(concat), instance Text String
   8 from Data.Maybe import :: Maybe, maybe
   9 import GenEq
  10
  11 instance toString Pos where
  12         toString {line,col} = concat [toString line, ":", toString col, " "]
  13
  14 instance toString AST where
  15         toString (AST f) = concat ["\n":printersperse "\n" f]
  16
  17 class print a :: a -> [String]
  18
  19 printersperse :: String [a] -> [String] | print a
  20 printersperse i j = intercalate [i] (map print j)
  21
  22 instance print FunDecl where
  23         print (FunDecl _ i as t vs ss) =
  24                 ["\n", i, " (":printersperse "," as] ++
  25                 [")"] ++ maybe [] (\tt->[" :: ":print tt]) t ++
  26                 ["{\n\t":printersperse "\n\t" vs] ++
  27                 ["\n":printStatements ss 1] ++ ["}\n"]
  28
  29 printStatements :: [Stmt] Int -> [String]
  30 printStatements [] i = []
  31 printStatements [s:ss] i = (case s of
  32         (IfStmt b thens elses) = indent i ["if (":print b] ++ [")"] ++
  33                 printCodeBlock thens i ++
  34                 indent i ["else ":printCodeBlock elses i] ++ ["\n"]
  35         (WhileStmt b dos) = indent i ["while (":print b] ++
  36                 [")":printCodeBlock dos i]
  37         (AssStmt vardef val) =
  38                 indent i $ print vardef ++ ["=":print val] ++ [";\n"]
  39         (FunStmt ident args) = indent i $ printFunCall ident args
  40         (ReturnStmt me) = indent i ["return ":maybe [""] print me] ++ [";\n"]
  41         ) ++ printStatements ss i
  42         where
  43                 printCodeBlock :: [Stmt] Int -> [String]
  44                 printCodeBlock [] _ = ["{}\n"]
  45                 printCodeBlock [x] i = ["\n":printStatements [x] (i+1)]
  46                 printCodeBlock x i =
  47                         ["{\n":printStatements x (i+1)] ++ indent i ["}\n"]
  48
  49                 indent :: Int [String] -> [String]
  50                 indent i rest = replicate i "\t" ++ rest
  51
  52 instance print VarDecl where
  53         print (VarDecl _ t i e) = maybe ["var"] print t ++ [" ":i:"=":print e] ++ [";"]
  54
  55 instance toString Type where
  56         toString t = concat $ print t
  57
  58 instance print Type where
  59         print (TupleType (t1, t2)) = ["(":print t1] ++ [",":print t2] ++ [")"]
  60         print (ListType t) = ["[":print t] ++ ["]"]
  61         print (IdType s) = print s
  62         print IntType = print "Int"
  63         print BoolType = print "Bool"
  64         print CharType = print "Char"
  65     print VoidType = print "Void"
  66     print (t1 ->> t2) = ["(":print t1 ++ [" -> ":print t2]] ++ [")"]
  67
  68 instance print String where
  69         print s = [s]
  70
  71 instance print FieldSelector where
  72         print FieldHd = print "hd"
  73         print FieldTl = print "tl"
  74         print FieldSnd = print "snd"
  75         print FieldFst = print "fst"
  76
  77 instance print VarDef where
  78         print (VarDef i fs) = printersperse "." [i:printersperse "" fs]
  79
  80 instance toString Op2 where
  81         toString o = case o of
  82                 BiPlus = "+"; BiMinus = "-"; BiTimes = "*"; BiDivide = "/"
  83                 BiMod = "%"; BiEquals = "=="; BiLesser = "<"; BiGreater = ">"
  84                 BiLesserEq = "<="; BiGreaterEq = ">="; BiUnEqual = "!=";
  85                 BiAnd = "&&"; BiOr = "||"; BiCons = ":"
  86
  87 instance print Expr where
  88         print (VarExpr _ vd) = print vd
  89         print (Op2Expr _ e1 o e2) = ["(":print e1] ++
  90                 [" ",toString o, " ":print e2] ++ [")"]
  91         print (Op1Expr _ o e) = ["(",case o of
  92                 UnNegation = "!"; UnMinus = "-"
  93                 :print e] ++ [")"]
  94         print (IntExpr _ i) = [toString i]
  95         print (CharExpr _ c) = ["\'", case c of
  96                 '\b' = "\\b"; '\f' = "\\f"; '\n' = "\\n"
  97                 '\r' = "\\r"; '\t' = "\\t"; '\v' = "\\v"
  98                 c = if (c == toChar 7) "\\a" (toString c)
  99                 ,"\'"]
 100         print (BoolExpr _ b) = [toString b]
 101         print (FunExpr _ id as fs) = printFunCall id as ++ printSelectors fs
 102         print (EmptyListExpr _) = ["[]"]
 103         print (TupleExpr _ (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"]
 104
 105 printSelectors :: [FieldSelector] -> [String]
 106 printSelectors x = case x of [] = [""]; _ = [".":printersperse "." x]
 107
 108 printFunCall :: String [Expr] -> [String]
 109 printFunCall s args = [s, "(":printersperse "," args] ++ [")"]
 110
 111 derive gEq Op2
 112 instance == Op2 where (==) o1 o2 = gEq{|*|} o1 o2