diff options
| author | Mirek Kratochvil <exa.exa@gmail.com> | 2022-11-26 16:03:45 +0100 |
|---|---|---|
| committer | Mirek Kratochvil <exa.exa@gmail.com> | 2022-11-26 16:03:45 +0100 |
| commit | 1cca8b8dce327369a81d97e68129aa3f1da39a33 (patch) | |
| tree | 21b2245e152aba4132639bce9cee75f90bb9c2d2 /app | |
| parent | 83e1cb5cc71e28adc444d8ea70b9530e06a64f08 (diff) | |
| download | prlg-1cca8b8dce327369a81d97e68129aa3f1da39a33.tar.gz prlg-1cca8b8dce327369a81d97e68129aa3f1da39a33.tar.bz2 | |
assert actually recompiles
Diffstat (limited to 'app')
| -rw-r--r-- | app/Builtins.hs | 16 | ||||
| -rw-r--r-- | app/Compiler.hs | 2 |
2 files changed, 5 insertions, 13 deletions
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 diff --git a/app/Compiler.hs b/app/Compiler.hs index 6ea6cbc..efa641c 100644 --- a/app/Compiler.hs +++ b/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 |
