// = 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
, 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]
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