checker update
[minfp.git] / main.icl
index 229b12d..386ee77 100644 (file)
--- a/main.icl
+++ b/main.icl
@@ -3,11 +3,51 @@ module main
 import StdEnv
 import Data.Either
 import Data.Functor
+import Data.Func
 import Control.Monad
+import System.GetOpt
+import System.CommandLine
 
 import parse
 import ast
 import check
 import int
 
-Start = parse ['ap f x = f x; fac i = if (eq i 0) 1 (mul i (fac (sub i 1))); start = ap fac 5;'] >>= check >>= int
+chars :: *File -> ([Char], *File)
+chars f
+       # (ok,c,f) = freadc f
+       | not ok = ([], f)
+       # (cs,f) = chars f
+       = ([c:cs], f)
+
+:: Mode = MHelp | MLex | MParse | MType | MInterpret
+:: Result
+       = Lex [Token]
+       | Parse AST
+       | Type (Type, AST)
+       | Interpret Value
+
+options :: [OptDescr (Mode->Mode)]
+options =
+       [ 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"
+       , Option ['t'] ["type"]      (NoArg (const MType))      "Up to and including typing"
+       , Option ['i'] ["interpret"] (NoArg (const MInterpret)) "Up to and including interpretation"
+       ]
+
+Start :: *World -> Either [String] Result
+Start w
+       # ([argv0:args], w) = getCommandLine w
+       # (mode, positionals, errs) = getOpt Permute options 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
+       = case mode of
+               MHelp = Left [usageInfo ("Usage: " +++ argv0 +++ " [options]\n") options]
+               MLex = Lex <$> lex cs
+               MParse = Parse <$> (lex cs >>= parse)
+               MType = Type <$> (lex cs >>= parse >>= check)
+               MInterpret = Interpret <$> (lex cs >>= parse >>= check >>= int o snd)