strictness, ci

[minfp.git] / ast.icl

diff --git a/ast.icl b/ast.icl
index cee14de..20d2ca3 100644 (file)
--- a/ast.icl
+++ b/ast.icl
@@ -1,28 +1,36 @@
 implementation module ast
 
 import StdEnv
+import Data.Either
 import Text
+import int
 
-instance toString AST
-where
-       toString (AST f) = join "\n" (map toString f)
-
-instance toString Function
-where
+instance toString Function where
        toString (Function i a e) = concat [toString i, " ", join " " (map toString a), " = ", toString e]
 
-instance toString Expression
-where
+instance toString Expression where
        toString (Lit v) = toString v
        toString (Var s) = toString s
-       toString (App l r) = "(" +++ toString l +++ " " +++ toString r +++ ")"
-       toString (Lambda a e) = "(\\" +++ toString a +++ "." +++ toString e +++ ")"
-       toString (Builtin v as) = "'" +++ toString v +++ "'" +++ join " " (map toString as)
+       toString (App l r) = concat ["(", toString l, " ", toString r, ")"]
+       toString (Lambda a e) = concat ["(\\", toString a, ". ", toString e, ")"]
+       toString (Let ns r) = concat
+               [ "let ", concat [concat ["\t", toString n, " = ", toString v, "\n"]\\(n, v)<-ns]
+               , "in\n", toString r]
        toString _ = abort "toString Expression not implemented"
 
-instance toString Value
-where
+instance toString Value where
        toString (Int i) = toString i
        toString (Bool b) = toString b
-       toString (Char b) = "'" +++ toString b +++ "'"
-       toString (Func a as _) = "Function arity " +++ toString a +++ " curried " +++ join "," (map toString as)
+       toString (Lambda` v a) = toString (Lambda v a)
+       toString (Builtin a) = "builtin"
+
+instance toString Type where
+       toString (TVar a) = toString a
+       toString TInt = "Int"
+       toString TBool = "Bool"
+       toString (TApp a b) = concat ["(", toString a, " ", toString b, ")"]
+       toString (a --> b) = concat ["(", toString a, " -> ", toString b, ")"]
+
+instance toString TypeDef where
+       toString (TypeDef name args def) = join " " ["::",toString name:map toString args]
+               +++ " = " +++ join " | " [join " " [toString c:map toString d]\\(c, d)<-def]