cleanup

diff --git a/ast.dcl b/ast.dcl
index 6987c5b..c8f4c35 100644 (file)
--- a/ast.dcl
+++ b/ast.dcl
@@ -1,9 +1,9 @@
 definition module ast
 
-from Data.Either import :: Either
 from StdOverloaded import class toString
 
 :: Function = Function [Char] [[Char]] Expression
+
 :: Expression
        = Lit Value
        | Var [Char]

diff --git a/ast.icl b/ast.icl
index 2714a0c..acad3d2 100644 (file)
--- a/ast.icl
+++ b/ast.icl
@@ -9,18 +9,19 @@ instance toString Function 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 (Builtin v as) = concat ["'", toString v, "'", join " " (map toString as)]
+       toString (Let i a b r) = concat [toString i, " ", join " " (map toString a), " = ", toString b, "\n", toString r]
        toString _ = abort "toString Expression not implemented"
 
 instance toString Value where
        toString (Int i) = toString i
        toString (Bool b) = toString b
-       toString (Func a as _) = "Function arity " +++ toString a +++ " curried " +++ join "," (map toString as)
+       toString (Func a as _) = concat ["Function arity ", toString a, " curried ", join "," (map toString as)]
 
 instance toString Type where
        toString (TVar a) = toString a
        toString TInt = "Int"
        toString TBool = "Bool"
-       toString (TFun a b) = "(" +++ toString a +++ ") ->" +++ toString b
+       toString (TFun a b) = concat ["(", toString a, ") ->", toString b]

diff --git a/main.icl b/main.icl
index 30f7d9f..e533a4e 100644 (file)
--- a/main.icl
+++ b/main.icl
@@ -3,8 +3,6 @@ module main
 import StdEnv
 import Data.Either
 import Data.Functor
-import Data.Func
-import Text
 import Control.Monad => qualified join
 import System.GetOpt
 import System.CommandLine
@@ -23,15 +21,9 @@ chars f
        = ([c:cs], f)
 
 :: Mode = MHelp | MLex | MParse | MType | MInterpret | MGen
-:: Result
-       = Lex [Token]
-       | Parse String
-       | Type Expression
-       | Interpret Value
-       | Gen [String]
 
-options :: [OptDescr (Mode->Mode)]
-options =
+opts :: [OptDescr (Mode -> Mode)]
+opts =
        [ Option ['?'] ["help"]      (NoArg (const MHelp))      "Display this message"
        , Option ['l'] ["lex"]       (NoArg (const MLex))       "Up to and including lexing"
        , Option ['p'] ["parse"]     (NoArg (const MParse))     "Up to and including parse"
@@ -40,19 +32,20 @@ options =
        , Option ['g'] ["gen"]       (NoArg (const MGen))       "Up to and including generation"
        ]
 
-Start :: *World -> Either [String] Result
+Start :: *World -> Either [String] [String]
 Start w
        # ([argv0:args], w) = getCommandLine w
-       # (mode, positionals, errs) = getOpt Permute options args
+       # (mode, positionals, errs) = getOpt Permute opts args
        # mode = foldl (o) id mode MInterpret
        | not (errs =: []) = Left [e +++ "\n"\\e<-errs]
        | not (positionals =: []) = Left ["Positional arguments not allowed"]
        # (io, w) = stdio w
        # (cs, io) = chars io
+       # (_, w) = fclose io w
        = case mode of
-               MHelp = Left [usageInfo ("Usage: " +++ argv0 +++ " [options]\n") options]
-               MLex = Lex <$> lex cs
-               MParse = Parse <$> join "\n" <$> map toString <$> (lex cs >>= parse)
-               MType = Type <$> (lex cs >>= parse >>= check)
-               MInterpret = Interpret <$> (lex cs >>= parse >>= check >>= int)
-               MGen = Gen <$> (lex cs >>= parse >>= check >>= gen)
+               MHelp = Left [usageInfo ("Usage: " +++ argv0 +++ " [opts]\n") opts]
+               MLex = map (\x->toString x +++ "\n") <$> lex cs
+               MParse = map (\x->toString x +++ "\n") <$> (lex cs >>= parse)
+               MType = (\x->[toString x]) <$> (lex cs >>= parse >>= check)
+               MInterpret = (\x->[toString x]) <$> (lex cs >>= parse >>= check >>= int)
+               MGen = lex cs >>= parse >>= check >>= gen

diff --git a/parse.dcl b/parse.dcl
index 07121fd..6ee56d6 100644 (file)
--- a/parse.dcl
+++ b/parse.dcl
@@ -1,8 +1,10 @@
 definition module parse
 
+from StdOverloaded import class toString
 from Data.Either import :: Either
 from ast import :: Function
 
 :: Token
+instance toString Token
 lex :: [Char] -> Either [String] [Token]
 parse :: [Token] -> Either [String] [Function]

diff --git a/parse.icl b/parse.icl
index 99f0246..6a9ab29 100644 (file)
--- a/parse.icl
+++ b/parse.icl
@@ -9,7 +9,7 @@ import Data.GenEq
 import Data.Functor
 import Data.Func
 import Data.List
-import Data.Tuple
+import Text.GenPrint
 import StdEnv
 
 import ast
@@ -19,6 +19,8 @@ import ast
 
 :: Token = TTEq | TTSemiColon | TTLambda | TTDot | TTBrackOpen | TTBrackClose | TTBool Bool | TTInt Int | TTOp [Char] | TTIdent [Char]
 derive gEq Token
+instance toString Token where toString t = printToString t
+derive gPrint Token
 lex :: [Char] -> Either [String] [Token]
 lex [] = pure []
 lex [';':ts] = TTSemiColon <:> lex ts
@@ -88,7 +90,7 @@ where
 
        pFunction :: Parser ([Char], [[Char]], [Token])
        pFunction
-               =   tuple3
+               =   (\x y z->(x, y, z))
                <$> (pFunId <|> pId)
                <*> many pId
                <*  pToken TTEq