From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 4 Mar 2019 15:20:44 +0000 (+0100)
Subject: cleanup
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=f2b4f22f5ad88a0884e10ae1da3c0bd7acd2695c;p=minfp.git

cleanup
---

diff --git a/ast.dcl b/ast.dcl
index 6987c5b..c8f4c35 100644
--- 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
--- 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
--- 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
--- 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
--- 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