1 files changed, 17 insertions, 21 deletions
diff --git a/app/Compiler.hs b/app/Compiler.hs
index 693bf99..0886533 100644
--- a/app/Compiler.hs
+++ b/app/Compiler.hs
@@ -1,6 +1,7 @@
 module Compiler where
 
 import Constant
+import Control.Monad
 import Data.Char (isUpper)
 import qualified Data.Map as M
 
@@ -45,28 +46,28 @@ squashVars x =
         [(idx, VarI idx') | ((idx, n), idx') <- zip occurs [1 ..], n > 1]
    in renumVars (m' M.!?) x
 
-squashChoices :: [Code] -> Code
+squashChoices :: [Code] -> Either String Code
 squashChoices = out . concatMap go
   where
     go [Choices cs] = cs
     go x = [x]
-    out [] = error "choice compilation"
-    out [x] = x
-    out xs = [Choices xs]
+    out [] = Left "goal compilation has no choices?"
+    out [x] = pure x
+    out xs = pure [Choices xs]
 
-compileGoals :: Int -> Int -> Int -> PrlgInt -> Code
-compileGoals andop orop cut = (++ [Done]) . go'
+compileGoals :: Int -> Int -> Int -> PrlgInt -> Either String Code
+compileGoals andop orop cut = fmap (++ [Done]) . go'
   where
-    go' = go . struct2goal
+    go' = struct2goal >=> go
     go p@(CallI x args@[_, _])
-      | x == andop = concatMap go' args
-      | x == orop = squashChoices $ map go' args
+      | x == andop = concat <$> traverse go' args
+      | x == orop = traverse go' args >>= squashChoices
     go p@(CallI x [])
-      | x == cut = [Cut]
+      | x == cut = pure [Cut]
     go x = compileGoal x
 
-compileGoal :: PrlgInt -> Code
-compileGoal = compileArg . struct2goal
+compileGoal :: PrlgInt -> Either String Code
+compileGoal = fmap compileArg . struct2goal
 
 compileArg :: PrlgInt -> Code
 compileArg (CallI i args) =
@@ -88,12 +89,7 @@ heapStructPrlgInt heaperr heap ref = heapStruct atom struct hrec heap ref
       | r == ref = pure $ VarI r
       | otherwise = heaperr
 
--- TODO check if this is used
-goal2struct :: PrlgInt -> PrlgInt
-goal2struct (CallI s []) = ConstI (Atom s)
-goal2struct x = x
-
-struct2goal :: PrlgInt -> PrlgInt
-struct2goal (ConstI (Atom s)) = CallI s []
-struct2goal call@(CallI _ _) = call
-struct2goal _ = error "TODO."
+struct2goal :: PrlgInt -> Either String PrlgInt
+struct2goal (ConstI (Atom s)) = pure $ CallI s []
+struct2goal call@(CallI _ _) = pure call
+struct2goal x = Left $ "cannot compile goal: " ++ show x