semicolon colons semi

4 files changed, 22 insertions, 9 deletions

diff --git a/app/Builtins.hs b/app/Builtins.hs
index c63fb25..b38eaf0 100644
--- a/app/Builtins.hs
+++ b/app/Builtins.hs
@@ -104,12 +104,13 @@ assertRule addClause =
     scope <- use (cur . hvar)
     heap <- use (cur . heap)
     comma <- findAtom ","
+    semi <- findAtom ";"
     cut <- 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.seqGoals (Co.compileGoals comma cut gs)
+              Co.compileGoal hs ++ Co.compileGoals comma semi cut gs
          in do addClause cs s
                continue
       _ -> prlgError "assert clause failure"
@@ -131,10 +132,11 @@ exec' fgol =
     case Co.squashVars <$> Co.heapStructPrlgInt Nothing heap arg of
       Just gs -> do
         comma <- findAtom ","
+        semi <- findAtom ";"
         cut <- findAtom "!"
         zoom cur $ do
           hvar .= M.empty
-          hed .= Co.seqGoals (Co.compileGoals comma cut gs)
+          hed .= Co.compileGoals comma semi cut gs
           gol %= fgol
         continue
       _ -> prlgError "bad goal"
@@ -356,6 +358,7 @@ addPrelude = do
   addProc [[U (LocalRef 0), U (LocalRef 0), Done]] "=" 2
   {- clauses -}
   addOp $ O.xfy "," 1000
+  addOp $ O.xfy ";" 1100
   addOp $ O.xfx ":-" 1200
   addOp $ O.fx ":-" 1200
   horn1 <- findStruct ":-" 1
diff --git a/app/Compiler.hs b/app/Compiler.hs
index afa7e71..f77a969 100644
--- a/app/Compiler.hs
+++ b/app/Compiler.hs
@@ -53,15 +53,25 @@ squashVars x =
         [(idx, VarI idx' 0) | ((idx, n), idx') <- zip occurs [1 ..], n > 1]
    in renumVars (m' M.!?) x
 
-compileGoals :: Int -> Int -> PrlgInt -> [Code]
-compileGoals andop cut = go'
+squashChoices :: [Code] -> Code
+squashChoices = out . concatMap go
+  where
+    go [Choices cs] = cs
+    go x = [x]
+    out [] = error "choice compilation"
+    out [x] = x
+    out xs = [Choices xs]
+
+compileGoals :: Int -> Int -> Int -> PrlgInt -> Code
+compileGoals andop orop cut = (++ [Done]) . go'
   where
     go' = go . struct2goal
     go p@(CallI x args@[_, _])
       | x == andop = concatMap go' args
+      | x == orop = squashChoices $ map go' args
     go p@(CallI x [])
-      | x == cut = [[Cut]]
-    go x = [compileGoal x]
+      | x == cut = [Cut]
+    go x = compileGoal x
 
 compileGoal :: PrlgInt -> Code
 compileGoal = compileArg . struct2goal
diff --git a/app/Heap.hs b/app/Heap.hs
index 0dc79e6..4108089 100644
--- a/app/Heap.hs
+++ b/app/Heap.hs
@@ -30,8 +30,7 @@ deref :: Int -> PrlgEnv Dereferenced
 deref = uses (cur . heap) . flip deref'
 
 writeHeap :: Int -> Datum -> PrlgEnv ()
-writeHeap a v =
-  cur . heap %= (\(Heap nxt m) -> Heap nxt $ M.insert a v m)
+writeHeap a v = cur . heap %= (\(Heap nxt m) -> Heap nxt $ M.insert a v m)
 
 allocHeap :: Int -> PrlgEnv Int
 allocHeap n = do
diff --git a/app/Load.hs b/app/Load.hs
index 85a6d03..f705114 100644
--- a/app/Load.hs
+++ b/app/Load.hs
@@ -39,8 +39,9 @@ intern prlgs = do
 compile :: IR.PrlgInt -> PrlgEnv Code
 compile prlgv = do
   comma <- findAtom ","
+  semi <- findAtom ";"
   cut <- findAtom "!"
-  return $ C.seqGoals (C.compileGoals comma cut prlgv)
+  return $ C.compileGoals comma semi cut prlgv
 
 expansion ::
      (Int -> IR.PrlgInt -> IR.PrlgInt)