externalized ast

diff --git a/AST.dcl b/AST.dcl
new file mode 100644 (file)
index 0000000..340aec6
--- /dev/null
+++ b/AST.dcl
@@ -0,0 +1,43 @@
+definition module AST
+
+from Data.Maybe import :: Maybe
+from StdOverloaded import class toString
+
+:: Pos = {line :: Int, col :: Int}
+
+:: AST = AST [VarDecl] [FunDecl]
+:: VarDecl = VarDecl Type String Expr
+:: Type 
+       = TupleType (Type, Type)
+       | ListType Type
+       | IdType String
+       | IntType 
+       | BoolType
+       | CharType
+       | VarType
+:: Expr 
+       = VarExpr VarDef
+       | Op2Expr Expr Op2 Expr
+       | Op1Expr Op1 Expr
+       | IntExpr Int
+       | CharExpr Char
+       | BoolExpr Bool
+       | FunExpr FunCall
+       | EmptyListExpr
+       | TupleExpr (Expr, Expr)
+:: VarDef = VarDef String [FieldSelector]
+:: FieldSelector = FieldHd | FieldTl | FieldFst | FieldSnd
+:: Op1 = UnNegation | UnMinus
+:: Op2 = BiPlus | BiMinus | BiTimes | BiDivide | BiMod | BiEquals | BiLesser |
+       BiGreater | BiLesserEq | BiGreaterEq | BiUnEqual | BiAnd | BiOr | BiCons
+:: FunDecl = FunDecl String [String] (Maybe FunType) [VarDecl] [Stmt]
+:: FunType = FunType [Type] (Maybe Type)
+:: FunCall = FunCall String [Expr]
+:: Stmt 
+       = IfStmt Expr [Stmt] [Stmt]
+       | WhileStmt Expr [Stmt]
+       | AssStmt VarDef Expr
+       | FunStmt FunCall
+       | ReturnStmt (Maybe Expr)
+
+instance toString AST

diff --git a/AST.icl b/AST.icl
new file mode 100644 (file)
index 0000000..6023056
--- /dev/null
+++ b/AST.icl
@@ -0,0 +1,101 @@
+implementation module AST
+
+import StdEnv
+
+from Data.List import map, intercalate, replicate, flatten, isEmpty
+from Data.Func import $
+from Text import class Text(concat), instance Text String
+from Data.Maybe import :: Maybe, maybe
+
+instance toString AST where
+       toString (AST v f) = concat (
+               ["\n":printersperse "\n" v] ++
+               ["\n":printersperse "\n" f])
+
+class print a :: a -> [String]
+
+printersperse :: String [a] -> [String] | print a
+printersperse i j = intercalate [i] (map print j)
+
+instance print FunDecl where
+       print (FunDecl i as t vs ss) =
+               ["\n", i, " (":printersperse "," as] ++
+               [")"] ++ maybe [] (\tt->[" :: ":print tt]) t ++
+               ["{\n\t":printersperse "\n\t" vs] ++
+               ["\n":printStatements ss 1] ++ ["}\n"]
+
+printStatements :: [Stmt] Int -> [String]
+printStatements [] i = []
+printStatements [s:ss] i = (case s of
+       (IfStmt b thens elses) = indent i ["if (":print b] ++ [")"] ++
+               printCodeBlock thens i ++
+               indent i ["else ":printCodeBlock elses i] ++ ["\n"]
+       (WhileStmt b dos) = indent i ["while (":print b] ++
+               [")":printCodeBlock dos i]
+       (AssStmt vardef val) =
+               indent i $ print vardef ++ ["=":print val] ++ [";\n"]
+       (FunStmt fc) = indent i $ print fc ++ [";\n"]
+       (ReturnStmt me) = indent i ["return ":maybe [""] print me] ++ [";\n"]
+       ) ++ printStatements ss i
+       where
+               printCodeBlock :: [Stmt] Int -> [String]
+               printCodeBlock [] _ = ["{}\n"]
+               printCodeBlock [x] i = ["\n":printStatements [x] (i+1)]
+               printCodeBlock x i =
+                       ["{\n":printStatements x (i+1)] ++ indent i ["}\n"]
+
+               indent :: Int [String] -> [String]
+               indent i rest = replicate i "\t" ++ rest
+
+instance print FunType where
+       print (FunType at rt) = printersperse " " at ++
+               [if (isEmpty at) "" "->":maybe ["Void"] print rt]
+
+instance print VarDecl where
+       print (VarDecl t i e) = print t ++ [" ":i:"=":print e] ++ [";"]
+
+instance print Type where
+       print (TupleType (t1, t2)) = ["(":print t1] ++ [",":print t2] ++ [")"]
+       print (ListType t) = ["[":print t] ++ ["]"]
+       print (IdType s) = print s
+       print IntType = print "Int"
+       print BoolType = print "Bool"
+       print CharType = print "Char"
+       print VarType = print "var"
+
+instance print String where
+       print s = [s]
+
+instance print FieldSelector where
+       print FieldHd = print "hd"
+       print FieldTl = print "tl"
+       print FieldSnd = print "snd"
+       print FieldFst = print "fst"
+
+instance print VarDef where
+       print (VarDef i fs) = printersperse "." [i:flatten $ map print fs]
+
+instance print FunCall where
+       print (FunCall i args) = [i,"(":printersperse "," args] ++ [")"]
+
+instance print Expr where
+       print (VarExpr vd) = print vd
+       print (Op2Expr e1 o e2) = ["(":print e1] ++ [" ",case o of
+               BiPlus = "+"; BiMinus = "-"; BiTimes = "*"; BiDivide = "/"
+               BiMod = "%"; BiEquals = "="; BiLesser = "<"; BiGreater = ">"
+               BiLesserEq = "<="; BiGreaterEq = ">="; BiUnEqual = "!=";
+               BiAnd = "&&"; BiOr = "||"; BiCons = ":"
+               ," ":print e2] ++ [")"]
+       print (Op1Expr o e) = ["(",case o of
+               UnNegation = "!"; UnMinus = "-"
+               :print e] ++ [")"]
+       print (IntExpr i) = [toString i]
+       print (CharExpr c) = ["\'", case c of
+               '\b' = "\\b"; '\f' = "\\f"; '\n' = "\\n"
+               '\r' = "\\r"; '\t' = "\\t"; '\v' = "\\v"
+               c = if (c == toChar 7) "\\a" (toString c)
+               ,"\'"]
+       print (BoolExpr b) = [toString b]
+       print (FunExpr fc) = print fc
+       print EmptyListExpr = ["[]"]
+       print (TupleExpr (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"]

diff --git a/lex.dcl b/lex.dcl
index e78d495..a6cf7c6 100644 (file)
--- a/lex.dcl
+++ b/lex.dcl
@@ -3,10 +3,9 @@ definition module lex
 from Data.Either import :: Either
 from yard import :: Error
 
-:: Token = {
-       line :: Int,
-       column :: Int,
-       token :: TokenValue}
+from AST import :: Pos
+
+:: Token :== (Pos, TokenValue)
 :: TokenValue
        //Value tokens
        = IdentToken String // Identifier

diff --git a/lex.icl b/lex.icl
index 21a29e9..e3fb2c1 100644 (file)
--- a/lex.icl
+++ b/lex.icl
@@ -9,6 +9,7 @@ import StdChar
 import StdString
 
 import yard
+from AST import :: Pos(..)
 
 :: LexItem
        = LexToken Int TokenValue
@@ -30,7 +31,7 @@ lexProgram line column = lexToken >>= \t->case t of
        (LexItemError e) = fail <?>
                PositionalError line column ("LexerError: " +++ e)
        (LexToken c t) = lexProgram line (column+c)
-               >>= \rest->pure [{line=line, column=column, token=t}:rest]
+               >>= \rest->pure [({line=line,col=column}, t):rest]
 
 lexToken :: Parser Char LexItem
 lexToken =

diff --git a/parse.dcl b/parse.dcl
index 281c804..c5d2724 100644 (file)
--- a/parse.dcl
+++ b/parse.dcl
@@ -5,44 +5,8 @@ from Data.Maybe import :: Maybe
 from StdString import class toString
 
 import lex
+from AST import :: AST
 
 :: ParserOutput :== Either Error AST
 
-:: AST = AST [VarDecl] [FunDecl]
-:: VarDecl = VarDecl Type String Expr
-:: Type 
-       = TupleType (Type, Type)
-       | ListType Type
-       | IdType String
-       | IntType 
-       | BoolType
-       | CharType
-       | VarType
-:: Expr 
-       = VarExpr VarDef
-       | Op2Expr Expr Op2 Expr
-       | Op1Expr Op1 Expr
-       | IntExpr Int
-       | CharExpr Char
-       | BoolExpr Bool
-       | FunExpr FunCall
-       | EmptyListExpr
-       | TupleExpr (Expr, Expr)
-:: VarDef = VarDef String [FieldSelector]
-:: FieldSelector = FieldHd | FieldTl | FieldFst | FieldSnd
-:: Op1 = UnNegation | UnMinus
-:: Op2 = BiPlus | BiMinus | BiTimes | BiDivide | BiMod | BiEquals | BiLesser |
-       BiGreater | BiLesserEq | BiGreaterEq | BiUnEqual | BiAnd | BiOr | BiCons
-:: FunDecl = FunDecl String [String] (Maybe FunType) [VarDecl] [Stmt]
-:: FunType = FunType [Type] (Maybe Type)
-:: FunCall = FunCall String [Expr]
-:: Stmt 
-       = IfStmt Expr [Stmt] [Stmt]
-       | WhileStmt Expr [Stmt]
-       | AssStmt VarDef Expr
-       | FunStmt FunCall
-       | ReturnStmt (Maybe Expr)
-
-instance toString AST
-
 parser :: LexerOutput -> ParserOutput

diff --git a/parse.icl b/parse.icl
index 120935f..24b860b 100644 (file)
--- a/parse.icl
+++ b/parse.icl
@@ -15,6 +15,7 @@ import GenPrint
 
 import yard
 import lex
+import AST
 
 parser :: LexerOutput -> ParserOutput
 parser (Left e) = Left e
@@ -163,7 +164,7 @@ parseTuple p = satTok BraceOpenToken *>
        <* satTok BraceCloseToken
 
 trans2 :: TokenValue (TokenValue -> a) -> Parser Token a
-trans2 t f = liftM (\{token}->f token) $ satTok t
+trans2 t f = liftM (\(_,token)->f token) $ satTok t
 
 trans1 :: TokenValue a -> Parser Token a
 trans1 t r = trans2 t $ const r
@@ -171,8 +172,8 @@ trans1 t r = trans2 t $ const r
 derive gPrint TokenValue
 derive gEq TokenValue
 satTok :: TokenValue -> Parser Token Token
-satTok t = top >>= \tok=:{line,column,token} -> if (eq t token)
-       (pure tok) (fail <?> PositionalError line column
+satTok t = top >>= \tok=:({line,col},token) -> if (eq t token)
+       (pure tok) (fail <?> PositionalError line col
                ("ParseError: Unexpected token: " +++ printToString token))
        where
                eq (IdentToken _)  (IdentToken _) = True
@@ -187,96 +188,3 @@ parseSepList sep p =
 
 parseIdent :: Parser Token String
 parseIdent = trans2 (IdentToken "") (\(IdentToken e).toString e)
-
-instance toString AST where
-       toString (AST v f) = concat (
-               ["\n":printersperse "\n" v] ++
-               ["\n":printersperse "\n" f])
-
-class print a :: a -> [String]
-
-printersperse :: String [a] -> [String] | print a
-printersperse i j = intercalate [i] (map print j)
-
-instance print FunDecl where
-       print (FunDecl i as t vs ss) =
-               ["\n", i, " (":printersperse "," as] ++
-               [")"] ++ maybe [] (\tt->[" :: ":print tt]) t ++
-               ["{\n\t":printersperse "\n\t" vs] ++
-               ["\n":printStatements ss 1] ++ ["}\n"]
-
-printStatements :: [Stmt] Int -> [String]
-printStatements [] i = []
-printStatements [s:ss] i = (case s of
-       (IfStmt b thens elses) = indent i ["if (":print b] ++ [")"] ++
-               printCodeBlock thens i ++
-               indent i ["else ":printCodeBlock elses i] ++ ["\n"]
-       (WhileStmt b dos) = indent i ["while (":print b] ++
-               [")":printCodeBlock dos i]
-       (AssStmt vardef val) =
-               indent i $ print vardef ++ ["=":print val] ++ [";\n"]
-       (FunStmt fc) = indent i $ print fc ++ [";\n"]
-       (ReturnStmt me) = indent i ["return ":maybe [""] print me] ++ [";\n"]
-       ) ++ printStatements ss i
-       where
-               printCodeBlock :: [Stmt] Int -> [String]
-               printCodeBlock [] _ = ["{}\n"]
-               printCodeBlock [x] i = ["\n":printStatements [x] (i+1)]
-               printCodeBlock x i =
-                       ["{\n":printStatements x (i+1)] ++ indent i ["}\n"]
-
-               indent :: Int [String] -> [String]
-               indent i rest = replicate i "\t" ++ rest
-
-instance print FunType where
-       print (FunType at rt) = printersperse " " at ++
-               [if (isEmpty at) "" "->":maybe ["Void"] print rt]
-
-instance print VarDecl where
-       print (VarDecl t i e) = print t ++ [" ":i:"=":print e] ++ [";"]
-
-instance print Type where
-       print (TupleType (t1, t2)) = ["(":print t1] ++ [",":print t2] ++ [")"]
-       print (ListType t) = ["[":print t] ++ ["]"]
-       print (IdType s) = print s
-       print IntType = print "Int"
-       print BoolType = print "Bool"
-       print CharType = print "Char"
-       print VarType = print "var"
-
-instance print String where
-       print s = [s]
-
-instance print FieldSelector where
-       print FieldHd = print "hd"
-       print FieldTl = print "tl"
-       print FieldSnd = print "snd"
-       print FieldFst = print "fst"
-
-instance print VarDef where
-       print (VarDef i fs) = printersperse "." [i:flatten $ map print fs]
-
-instance print FunCall where
-       print (FunCall i args) = [i,"(":printersperse "," args] ++ [")"]
-
-instance print Expr where
-       print (VarExpr vd) = print vd
-       print (Op2Expr e1 o e2) = ["(":print e1] ++ [" ",case o of
-               BiPlus = "+"; BiMinus = "-"; BiTimes = "*"; BiDivide = "/"
-               BiMod = "%"; BiEquals = "="; BiLesser = "<"; BiGreater = ">"
-               BiLesserEq = "<="; BiGreaterEq = ">="; BiUnEqual = "!=";
-               BiAnd = "&&"; BiOr = "||"; BiCons = ":"
-               ," ":print e2] ++ [")"]
-       print (Op1Expr o e) = ["(",case o of
-               UnNegation = "!"; UnMinus = "-"
-               :print e] ++ [")"]
-       print (IntExpr i) = [toString i]
-       print (CharExpr c) = ["\'", case c of
-               '\b' = "\\b"; '\f' = "\\f"; '\n' = "\\n"
-               '\r' = "\\r"; '\t' = "\\t"; '\v' = "\\v"
-               c = if (c == toChar 7) "\\a" (toString c)
-               ,"\'"]
-       print (BoolExpr b) = [toString b]
-       print (FunExpr fc) = print fc
-       print EmptyListExpr = ["[]"]
-       print (TupleExpr (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"]

diff --git a/spl.icl b/spl.icl
index 63b1487..893d699 100644 (file)
--- a/spl.icl
+++ b/spl.icl
@@ -16,6 +16,7 @@ from Text import class Text(concat), instance Text String
 
 import parse
 import lex
+import AST
 from yard import :: Error, instance toString Error
 
 :: Opts = {
@@ -68,8 +69,8 @@ Start w
                        printTokens :: [Token] -> String
                        printTokens ts = concat $ flatten $ map pt ts
                                where
-                                       pt {line,column,token} = [toString line, ":", 
-                                               toString column, ": ", printToString token, "\n"]
+                                       pt ({line,col},token) = [toString line, ":", 
+                                               toString col, ": ", printToString token, "\n"]
 
 parseArgs :: *World -> (Opts, *World)
 parseArgs w

diff --git a/spl.prj b/spl.prj
index da6268b..1f2a0a9 100644 (file)
--- a/spl.prj
+++ b/spl.prj
@@ -56,6 +56,20 @@ MainModule
                ReuseUniqueNodes:       True
                Fusion: False
 OtherModules
+       Module
+               Name:   AST
+               Dir:    {Project}
+               Compiler
+                       NeverMemoryProfile:     False
+                       NeverTimeProfile:       False
+                       StrictnessAnalysis:     True
+                       ListTypes:      StrictExportTypes
+                       ListAttributes: True
+                       Warnings:       True
+                       Verbose:        True
+                       ReadableABC:    False
+                       ReuseUniqueNodes:       True
+                       Fusion: False
        Module
                Name:   lex
                Dir:    {Project}