assert actually recompiles

app/Builtins.hs

@@ -9,6 +9,7 @@ import Code
   , Interp(..)
   , heapStruct
   )
+import qualified Compiler as Co
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.State.Lazy (get, gets, modify)
@@ -73,19 +74,10 @@ assertFact :: BuiltinFn
 assertFact = do
   scope <- gets (hvar . cur)
   heap <- gets (heap . cur)
-  {- TODO this needs to go through PrlgInt because of cuts in assertClause -}
-  let atom a = Just [U a]
-      struct s args = Just (U s : concat args)
-      hrec (HeapRef tgt) src
-        | src == tgt = Just [U (LocalRef tgt 0)]
-        | otherwise = Nothing
-      code = heapStruct atom struct hrec heap . fst $ scope M.! 0
-  case code of
+  case Co.compileGoal . Co.struct2goal . Co.squashVars <$>
+       Co.heapStructPrlgInt Nothing heap (fst $ scope M.! 0) of
     Just (U (Struct s):head) -> do
-      addClause s (head ++ [NoGoal])
-      return Nothing
-    Just [U (Atom a)] -> do
-      addClause (IR.Id a 0) [NoGoal]
+      addClause s $ head ++ [NoGoal]
       return Nothing
     _ -> backtrack
 

app/Compiler.hs

@@ -48,7 +48,7 @@ compileGoals andop cut = go'
     go x = [compileGoal x]
 
 compileGoal :: PrlgInt -> Code
-compileGoal = compileArg
+compileGoal = compileArg . struct2goal
 
 compileArg :: PrlgInt -> Code
 compileArg (CallI s args) = U (Struct s) : concatMap compileArg args