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 v f) = concat (
  16                 ["\n":printersperse "\n" v] ++
  17                 ["\n":printersperse "\n" f])
  18
  19 class print a :: a -> [String]
  20
  21 printersperse :: String [a] -> [String] | print a
  22 printersperse i j = intercalate [i] (map print j)
  23
  24 instance print FunDecl where
  25         print (FunDecl _ i as t vs ss) =
  26                 ["\n", i, " (":printersperse "," as] ++
  27                 [")"] ++ maybe [] (\tt->[" :: ":print tt]) t ++
  28                 ["{\n\t":printersperse "\n\t" vs] ++
  29                 ["\n":printStatements ss 1] ++ ["}\n"]
  30
  31 printStatements :: [Stmt] Int -> [String]
  32 printStatements [] i = []
  33 printStatements [s:ss] i = (case s of
  34         (IfStmt b thens elses) = indent i ["if (":print b] ++ [")"] ++
  35                 printCodeBlock thens i ++
  36                 indent i ["else ":printCodeBlock elses i] ++ ["\n"]
  37         (WhileStmt b dos) = indent i ["while (":print b] ++
  38                 [")":printCodeBlock dos i]
  39         (AssStmt vardef val) =
  40                 indent i $ print vardef ++ ["=":print val] ++ [";\n"]
  41         (FunStmt fc) = indent i $ print fc ++ [";\n"]
  42         (ReturnStmt me) = indent i ["return ":maybe [""] print me] ++ [";\n"]
  43         ) ++ printStatements ss i
  44         where
  45                 printCodeBlock :: [Stmt] Int -> [String]
  46                 printCodeBlock [] _ = ["{}\n"]
  47                 printCodeBlock [x] i = ["\n":printStatements [x] (i+1)]
  48                 printCodeBlock x i =
  49                         ["{\n":printStatements x (i+1)] ++ indent i ["}\n"]
  50
  51                 indent :: Int [String] -> [String]
  52                 indent i rest = replicate i "\t" ++ rest
  53
  54 instance print VarDecl where
  55         print (VarDecl _ t i e) = print t ++ [" ":i:"=":print e] ++ [";"]
  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 VarType = print "var"
  68     print VoidType = print "Void"
  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
  80 instance toString FieldSelector where
  81     toString fs = concat $ print fs
  82
  83 instance print VarDef where
  84         print (VarDef i fs) = printersperse "." [i:flatten $ map print fs]
  85
  86 instance print FunCall where
  87         print (FunCall i args) = [i,"(":printersperse "," args] ++ [")"]
  88
  89 instance toString Op2 where
  90         toString o = case o of
  91                 BiPlus = "+"; BiMinus = "-"; BiTimes = "*"; BiDivide = "/"
  92                 BiMod = "%"; BiEquals = "=="; BiLesser = "<"; BiGreater = ">"
  93                 BiLesserEq = "<="; BiGreaterEq = ">="; BiUnEqual = "!=";
  94                 BiAnd = "&&"; BiOr = "||"; BiCons = ":"
  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 _ fc) = print fc
 111         print (EmptyListExpr _) = ["[]"]
 112         print (TupleExpr _ (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"]
 113
 114 derive gEq Op2
 115 instance == Op2 where (==) o1 o2 = gEq{|*|} o1 o2