compiler can compile errors

1 files changed, 19 insertions, 17 deletions

diff --git a/app/Builtins.hs b/app/Builtins.hs
index 7996926..60653df 100644
--- a/app/Builtins.hs
+++ b/app/Builtins.hs
@@ -96,11 +96,13 @@ assertFact :: (Code -> Id -> PrlgEnv ()) -> InterpFn
 assertFact addClause =
   withArgs [0] $ \[arg] -> do
     heap <- use (cur . heap)
-    case Co.compileGoal . Co.squashVars <$>
-         Co.heapStructPrlgInt Nothing heap arg of
-      Just (U (Struct s):head) -> do
-        addClause (head ++ [Done]) s
-        continue
+    case Co.heapStructPrlgInt Nothing heap arg of
+      Just x -> do
+        case Co.compileGoal $ Co.squashVars x of
+          Right (U (Struct s):head) -> do
+            addClause (head ++ [Done]) s
+            continue
+          Left err -> prlgError err
       _ -> prlgError "assert fact failure"
 
 assertRule :: (Code -> Id -> PrlgEnv ()) -> InterpFn
@@ -108,16 +110,13 @@ assertRule addClause =
   withArgs [0, 1] $ \args -> do
     scope <- use (cur . hvar)
     heap <- use (cur . heap)
-    comma <- findAtom ","
-    semi <- findAtom ";"
-    cut <- findAtom "!"
+    [comma, semi, cut] <- traverse findAtom [",", ";", "!"]
     case Co.squashVars . IR.CallI 0 <$>
          traverse (Co.heapStructPrlgInt Nothing heap) args of
       Just (IR.CallI 0 [hs, gs]) ->
-        let (U (Struct s):cs) =
-              Co.compileGoal hs ++ Co.compileGoals comma semi cut gs
-         in do addClause cs s
-               continue
+        case (++) <$> Co.compileGoal hs <*> Co.compileGoals comma semi cut gs of
+          Right (U (Struct s):cs) -> addClause cs s >> continue
+          Left err -> prlgError err
       _ -> prlgError "assert clause failure"
 
 retractall :: InterpFn
@@ -139,11 +138,14 @@ exec' fgol =
         comma <- findAtom ","
         semi <- findAtom ";"
         cut <- findAtom "!"
-        zoom cur $ do
-          hvar .= M.empty
-          hed .= Co.compileGoals comma semi cut gs
-          gol %= fgol
-        continue
+        case Co.compileGoals comma semi cut gs of
+          Right nhed -> do
+            zoom cur $ do
+              hvar .= M.empty
+              hed .= nhed
+              gol %= fgol
+            continue
+          Left err -> prlgError err
       _ -> prlgError "bad goal"
 
 call :: InterpFn