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 fs) = indent i $ printFunCall ident args fs ++ [";\n"]
  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 instance toString VarDecl where
  55     toString v = concat (print v)
  56
  57 instance toString Type where
  58         toString t = concat $ print t
  59
  60 instance print Type where
  61         print (TupleType (t1, t2)) = ["(":print t1] ++ [",":print t2] ++ [")"]
  62         print (ListType t) = ["[":print t] ++ ["]"]
  63         print (IdType s) = print s
  64         print IntType = print "Int"
  65         print BoolType = print "Bool"
  66         print CharType = print "Char"
  67     print VoidType = print "Void"
  68     print (FuncType t) = ["(-> ":print t] ++ [")"]
  69     print (t1 ->> t2) = ["(":print t1 ++ [" -> ":print t2]] ++ [")"]
  70
  71 instance print String where
  72         print s = [s]
  73
  74 instance print FieldSelector where
  75         print FieldHd = print "hd"
  76         print FieldTl = print "tl"
  77         print FieldSnd = print "snd"
  78         print FieldFst = print "fst"
  79 instance toString FieldSelector  where
  80     toString fs = concat $ print fs
  81
  82 instance print VarDef where
  83         print (VarDef i fs) = printersperse "." [i:printersperse "" fs]
  84
  85 instance toString Op2 where
  86         toString o = case o of
  87                 BiPlus = "+"; BiMinus = "-"; BiTimes = "*"; BiDivide = "/"
  88                 BiMod = "%"; BiEquals = "=="; BiLesser = "<"; BiGreater = ">"
  89                 BiLesserEq = "<="; BiGreaterEq = ">="; BiUnEqual = "!=";
  90                 BiAnd = "&&"; BiOr = "||"; BiCons = ":"
  91
  92 instance toString Op1 where
  93     toString UnNegation = "!"
  94     toString UnMinus = "-"
  95
  96 instance print Expr where
  97         print (VarExpr _ vd) = print vd
  98         print (Op2Expr _ e1 o e2) = ["(":print e1] ++
  99                 [" ",toString o, " ":print e2] ++ [")"]
 100         print (Op1Expr _ o e) = ["(",case o of
 101                 UnNegation = "!"; UnMinus = "-"
 102                 :print e] ++ [")"]
 103         print (IntExpr _ i) = [toString i]
 104         print (CharExpr _ c) = ["\'", case c of
 105                 '\b' = "\\b"; '\f' = "\\f"; '\n' = "\\n"
 106                 '\r' = "\\r"; '\t' = "\\t"; '\v' = "\\v"
 107                 c = if (c == toChar 7) "\\a" (toString c)
 108                 ,"\'"]
 109         print (BoolExpr _ b) = [toString b]
 110         print (FunExpr _ id as fs) = printFunCall id as fs
 111         print (EmptyListExpr _) = ["[]"]
 112         print (TupleExpr _ (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"]
 113 instance toString Expr where
 114     toString e = concat $ print e
 115
 116 printSelectors :: [FieldSelector] -> [String]
 117 printSelectors fs = printersperse "." fs
 118
 119 printFunCall :: String [Expr] [FieldSelector] -> [String]
 120 printFunCall s args fs = [s, "(":printersperse "," args] ++ [")"] ++
 121         printSelectors fs
 122
 123 derive gEq Op2
 124 instance == Op2 where (==) o1 o2 = gEq{|*|} o1 o2
 125
 126 instance zero Pos where
 127         zero = {line=0, col=0}
 128
 129 derive gEq Op1
 130 instance == Op1 where (==) o1 o2 = gEq{|*|} o1 o2
 131 instance < Op2 where (<) o1 o2 = toString o1 < toString o2
 132 instance < Op1 where (<) o1 o2 = toString o1 < toString o2
 133
 134 derive gEq Type
 135 instance == Type where (==) t1 t2 = gEq{|*|} t1 t2