From 1cca8b8dce327369a81d97e68129aa3f1da39a33 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Sat, 26 Nov 2022 16:03:45 +0100
Subject: assert actually recompiles

---
 app/Builtins.hs | 16 ++++------------
 1 file changed, 4 insertions(+), 12 deletions(-)

(limited to 'app/Builtins.hs')

diff --git a/app/Builtins.hs b/app/Builtins.hs
index cc0a4e9..b81d298 100644
--- a/app/Builtins.hs
+++ b/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
 
-- 
cgit v1.2.3