diff options
Diffstat (limited to 'app/Builtins.hs')
| -rw-r--r-- | app/Builtins.hs | 36 |
1 files changed, 19 insertions, 17 deletions
diff --git a/app/Builtins.hs b/app/Builtins.hs index 7996926..60653df 100644 --- a/app/Builtins.hs +++ b/app/Builtins.hs @@ -96,11 +96,13 @@ assertFact :: (Code -> Id -> PrlgEnv ()) -> InterpFn assertFact addClause = withArgs [0] $ \[arg] -> do heap <- use (cur . heap) - case Co.compileGoal . Co.squashVars <$> - Co.heapStructPrlgInt Nothing heap arg of - Just (U (Struct s):head) -> do - addClause (head ++ [Done]) s - continue + case Co.heapStructPrlgInt Nothing heap arg of + Just x -> do + case Co.compileGoal $ Co.squashVars x of + Right (U (Struct s):head) -> do + addClause (head ++ [Done]) s + continue + Left err -> prlgError err _ -> prlgError "assert fact failure" assertRule :: (Code -> Id -> PrlgEnv ()) -> InterpFn @@ -108,16 +110,13 @@ assertRule addClause = withArgs [0, 1] $ \args -> do scope <- use (cur . hvar) heap <- use (cur . heap) - comma <- findAtom "," - semi <- findAtom ";" - cut <- findAtom "!" + [comma, semi, cut] <- traverse 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.compileGoals comma semi cut gs - in do addClause cs s - continue + case (++) <$> Co.compileGoal hs <*> Co.compileGoals comma semi cut gs of + Right (U (Struct s):cs) -> addClause cs s >> continue + Left err -> prlgError err _ -> prlgError "assert clause failure" retractall :: InterpFn @@ -139,11 +138,14 @@ exec' fgol = comma <- findAtom "," semi <- findAtom ";" cut <- findAtom "!" - zoom cur $ do - hvar .= M.empty - hed .= Co.compileGoals comma semi cut gs - gol %= fgol - continue + case Co.compileGoals comma semi cut gs of + Right nhed -> do + zoom cur $ do + hvar .= M.empty + hed .= nhed + gol %= fgol + continue + Left err -> prlgError err _ -> prlgError "bad goal" call :: InterpFn |