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 instance toString FunDecl where
  30     toString fd = concat $ print fd
  31
  32 printStatements :: [Stmt] Int -> [String]
  33 printStatements [] i = []
  34 printStatements [s:ss] i = (case s of
  35         (IfStmt b thens elses) = indent i ["if (":print b] ++ [")"] ++
  36                 printCodeBlock thens i ++
  37                 indent i ["else ":printCodeBlock elses i] ++ ["\n"]
  38         (WhileStmt b dos) = indent i ["while (":print b] ++
  39                 [")":printCodeBlock dos i]
  40         (AssStmt vardef val) =
  41                 indent i $ print vardef ++ ["=":print val] ++ [";\n"]
  42         (FunStmt ident args fs) = indent i $ printFunCall ident args fs ++ [";\n"]
  43         (ReturnStmt me) = indent i ["return ":maybe [""] print me] ++ [";\n"]
  44         ) ++ printStatements ss i
  45         where
  46                 printCodeBlock :: [Stmt] Int -> [String]
  47                 printCodeBlock [] _ = ["{}\n"]
  48                 printCodeBlock [x] i = ["\n":printStatements [x] (i+1)]
  49                 printCodeBlock x i =
  50                         ["{\n":printStatements x (i+1)] ++ indent i ["}\n"]
  51
  52                 indent :: Int [String] -> [String]
  53                 indent i rest = replicate i "\t" ++ rest
  54
  55 instance print VarDecl where
  56         print (VarDecl _ t i e) = maybe ["var"] print t ++ [" ":i:"=":print e] ++ [";"]
  57 instance toString VarDecl where
  58     toString v = concat (print v)
  59
  60 instance toString Type where
  61         toString t = concat $ print t
  62
  63 instance print Type where
  64         print (TupleType (t1, t2)) = ["(":print t1] ++ [",":print t2] ++ [")"]
  65         print (ListType t) = ["[":print t] ++ ["]"]
  66         print (IdType s) = print s
  67         print IntType = print "Int"
  68         print BoolType = print "Bool"
  69         print CharType = print "Char"
  70     print VoidType = print "Void"
  71     print (FuncType t) = ["(-> ":print t] ++ [")"]
  72     print (t1 ->> t2) = ["(":print t1 ++ [" -> ":print t2]] ++ [")"]
  73
  74 instance print String where
  75         print s = [s]
  76
  77 instance print FieldSelector where
  78         print FieldHd = print "hd"
  79         print FieldTl = print "tl"
  80         print FieldSnd = print "snd"
  81         print FieldFst = print "fst"
  82 instance toString FieldSelector  where
  83     toString fs = concat $ print fs
  84
  85 instance print VarDef where
  86         print (VarDef i fs) = printersperse "." [i:printersperse "" fs]
  87
  88 instance toString Op2 where
  89         toString o = case o of
  90                 BiPlus = "+"; BiMinus = "-"; BiTimes = "*"; BiDivide = "/"
  91                 BiMod = "%"; BiEquals = "=="; BiLesser = "<"; BiGreater = ">"
  92                 BiLesserEq = "<="; BiGreaterEq = ">="; BiUnEqual = "!=";
  93                 BiAnd = "&&"; BiOr = "||"; BiCons = ":"
  94
  95 instance toString Op1 where
  96     toString UnNegation = "!"
  97     toString UnMinus = "-"
  98
  99 instance print Expr where
 100         print (VarExpr _ vd) = print vd
 101         print (Op2Expr _ e1 o e2) = ["(":print e1] ++
 102                 [" ",toString o, " ":print e2] ++ [")"]
 103         print (Op1Expr _ o e) = ["(",case o of
 104                 UnNegation = "!"; UnMinus = "-"
 105                 :print e] ++ [")"]
 106         print (IntExpr _ i) = [toString i]
 107         print (CharExpr _ c) = ["\'", case c of
 108                 '\b' = "\\b"; '\f' = "\\f"; '\n' = "\\n"
 109                 '\r' = "\\r"; '\t' = "\\t"; '\v' = "\\v"
 110                 c = if (c == toChar 7) "\\a" (toString c)
 111                 ,"\'"]
 112         print (BoolExpr _ b) = [toString b]
 113         print (FunExpr _ id as fs) = printFunCall id as fs
 114         print (EmptyListExpr _) = ["[]"]
 115         print (TupleExpr _ (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"]
 116     print (LambdaExpr _ args e) = ["\\":args] ++ ["->": print e]
 117 instance toString Expr where
 118     toString e = concat $ print e
 119
 120 printSelectors :: [FieldSelector] -> [String]
 121 printSelectors fs = ["."] ++ printersperse "." fs
 122
 123 printFunCall :: String [Expr] [FieldSelector] -> [String]
 124 printFunCall s args fs = [s, "(":printersperse "," args] ++ [")"] ++
 125         printSelectors fs
 126
 127 derive gEq Op2
 128 instance == Op2 where (==) o1 o2 = gEq{|*|} o1 o2
 129
 130 instance zero Pos where
 131         zero = {line=0, col=0}
 132
 133 derive gEq Op1
 134 instance == Op1 where (==) o1 o2 = gEq{|*|} o1 o2
 135 instance < Op2 where (<) o1 o2 = toString o1 < toString o2
 136 instance < Op1 where (<) o1 o2 = toString o1 < toString o2
 137
 138 derive gEq Type
 139 instance == Type where (==) t1 t2 = gEq{|*|} t1 t2