1 files changed, 30 insertions, 24 deletions

diff --git a/Sjit/Compile.icl b/Sjit/Compile.icl
index 31b6523..5e4cef5 100644
--- a/Sjit/Compile.icl
+++ b/Sjit/Compile.icl
@@ -5,6 +5,9 @@ import StdGeneric
 import StdMaybe
 import StdOverloadedList
 
+import Control.Applicative
+import Control.Monad
+import Data.Either
 from Data.Func import mapSt, $
 from Data.Map import :: Map(..), get, put, newMap, fromList
 
@@ -80,39 +83,42 @@ where
 			ccall init_jit "II:Vpp"
 		}
 
-compile :: !Function !CompileState -> CompileState
+compile :: !Function !CompileState -> Either String CompileState
 compile f cs
 # cs & funs = put f.fun_name cs.pc cs.funs
 # vars = cs.vars
 # cs & vars = foldr (uncurry put) cs.vars [(v,sp) \\ v <- f.fun_args & sp <- [cs.sp+1..]]
-# (is,cs) = expr f.fun_expr cs
-# is = {i \\ i <- reverse [Ret:Put (max 1 (length f.fun_args)+1):is]}
-=
-	{ cs
-	& vars   = vars
-	, pc     = cs.pc+2
-	, blocks = cs.blocks ++| [!is!]
-	, jitst  = appendProgram (f.fun_name == "main") is cs.jitst
-	}
+= case expr f.fun_expr cs of
+	Left e -> Left e
+	Right (is,cs)
+		# is = {i \\ i <- reverse [Ret:Put (max 1 (length f.fun_args)+1):is]}
+		-> Right
+			{ cs
+			& vars   = vars
+			, pc     = cs.pc+2
+			, blocks = cs.blocks ++| [!is!]
+			, jitst  = appendProgram (f.fun_name == "main") is cs.jitst
+			}
 where
-	expr :: !Expr !CompileState -> (![Instr], !CompileState)
-	expr (Int i) cs = ([PushI i], {cs & sp=cs.sp+1, pc=cs.pc+1})
+	expr :: !Expr !CompileState -> Either String (![Instr], !CompileState)
+	expr (Int i) cs = Right ([PushI i], {cs & sp=cs.sp+1, pc=cs.pc+1})
 	expr (Var v) cs = case get v cs.vars of
-		Just i  -> ([PushRef (i-cs.sp)], {cs & sp=cs.sp+1, pc=cs.pc+1})
-		Nothing -> abort "undefined variable\n"
+		Just i  -> Right ([PushRef (i-cs.sp)], {cs & sp=cs.sp+1, pc=cs.pc+1})
+		Nothing -> Left ("undefined variable '" +++ v +++ "'")
 	expr (App f args) cs
 	# args = if (args=:[]) [Int 0] args
-	# (iss,cs) = mapSt expr args {cs & sp=cs.sp+1}
-	= case get f cs.funs of
-		Just f  -> ([Pop (length args-1):Call f:flatten iss], {cs & sp=cs.sp+2-length args, pc=cs.pc+2})
-		Nothing -> abort "undefined function\n"
+	= case mapStM expr args {cs & sp=cs.sp+1} of
+		Left e -> Left e
+		Right (iss,cs) -> case get f cs.funs of
+			Just f  -> Right
+				( [Pop (length args-1):Call f:flatten iss]
+				, {cs & sp=cs.sp+2-length args, pc=cs.pc+2}
+				)
+			Nothing -> Left ("undefined function '" +++ toString f +++ "'")
 
-compile_all :: !(Maybe CompileState) ![Function] -> CompileState
-compile_all mcs funs
-# cs = case mcs of
-	Just cs -> cs
-	Nothing -> snd bootstrap
-= foldl (flip compile) cs funs
+	mapStM :: !(a st -> m (b, st)) ![a] !st -> m ([b], st) | Monad m
+	mapStM _ [] st = pure ([], st)
+	mapStM f [x:xs] st = f x st >>= \(y,st) -> mapStM f xs st >>= \(ys,st) -> pure ([y:ys],st)
 
 generic gEncodedSize a :: !a -> Int
 gEncodedSize{|Int|} _ = 1