make work temporarily
authorMart Lubbers <mart@martlubbers.net>
Thu, 14 Mar 2019 13:17:47 +0000 (14:17 +0100)
committerMart Lubbers <mart@martlubbers.net>
Thu, 14 Mar 2019 13:17:47 +0000 (14:17 +0100)
check.icl
main.icl

index 2cc76ac..2832d53 100644 (file)
--- a/check.icl
+++ b/check.icl
@@ -129,19 +129,20 @@ infer env (Lambda x b)
 //     =              infer env e1
 //     >>= \(s1, t1)->infer ('Data.Map'.put x (generalize (apply s1 env) t1) env) e2
 //     >>= \(s2, t2)->pure (s1 oo s2, t2)
-//infer env (Let [(x, e1)] e2)
-//     =              fresh
-//     >>= \tv->      let env` = 'Data.Map'.put x (Forall [] tv) env
-//                    in infer env` e1
-//     >>= \(s1,t1)-> unify t1 tv
-//     >>= \t->infer ('Data.Map'.put x (generalize (apply s1 env`) t1) env`) e2
-//     >>= \(s2, t2)->pure (s1 oo s2, t2)
-infer env (Let xs e2)
-       # (ns, bs) = unzip xs
-       =              sequence [fresh\\_<-ns]
-       >>= \tvs->     let env` = foldr (uncurry putenv) env (zip2 ns tvs)
-                      in unzip <$> sequence (map infer env`) bs
-       >>= \(ss,ts)-> unify t1 tv
+infer env (Let [(x, e1)] e2)
+       =              fresh
+       >>= \tv->      let env` = 'Data.Map'.put x (Forall [] tv) env
+                      in infer env` e1
+       >>= \(s1,t1)-> unify t1 tv
+       >>= \t->infer ('Data.Map'.put x (generalize (apply s1 env`) t1) env`) e2
+       >>= \(s2, t2)->pure (s1 oo s2, t2)
+//infer env (Let xs e2)
+//     # (ns, bs) = unzip xs
+//     =              sequence [fresh\\_<-ns]
+//     >>= \tvs->     let env` = foldr (uncurry putenv) env (zip2 ns tvs)
+//                    in  unzip <$> sequence (map infer env`) bs
+//     >>= \(ss,ts)-> let s = foldr (oo) newMap ss
+//                    in  //unify t1 tv
 //     >>= \t->infer ('Data.Map'.put x (generalize (apply s1 env`) t1) env`) e2
 //     >>= \(s2, t2)->pure (s1 oo s2, t2)
 where
index 136c0e1..6b181af 100644 (file)
--- a/main.icl
+++ b/main.icl
@@ -32,14 +32,17 @@ opts =
        , Option ['g'] ["gen"]       (NoArg (const MGen))       "Up to and including generation"
        ]
 
+exit :: Int [String] *File *World -> *World
+exit i e f w = snd (fclose (foldr fwrites f e) (setReturnCode i w))
+
 Start :: *World -> *World
 Start w
+       # (io, w) = stdio w
        # ([argv0:args], w) = getCommandLine w
        # (mode, positionals, errs) = getOpt Permute opts args
        # mode = foldl (o) id mode MInterpret
-//     | not (errs =: []) = Left [e +++ "\n"\\e<-errs]
-//     | not (positionals =: []) = die ["Positional arguments not allowed"] w
-       # (io, w) = stdio w
+       | not (errs =: []) = exit 1 [e +++ "\n"\\e<-errs] io w
+       | not (positionals =: []) = exit 1 ["Positional arguments not allowed"] io w
        # (cs, io) = chars io
        # mstr = case mode of
                MHelp = Left [usageInfo ("Usage: " +++ argv0 +++ " [opts]\n") opts]
@@ -48,5 +51,4 @@ Start w
                MType = (\(e, x)->["type: ",toString x, "\n", toString e]) <$> (lex cs >>= parse >>= check)
                MInterpret = (\x->[toString x]) <$> (lex cs >>= parse >>= check >>= int o fst)
                MGen = lex cs >>= parse >>= check >>= gen o fst
-       = setReturnCode (either (const 1) (const 0) mstr)
-               (snd (fclose (foldr fwrites io (either id id mstr)) w))
+       = exit (either (\_->1) (\_->0) mstr) (either id id mstr) io w