diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Builtins.hs | 22 | ||||
| -rw-r--r-- | app/Code.hs | 2 |
2 files changed, 23 insertions, 1 deletions
diff --git a/app/Builtins.hs b/app/Builtins.hs index 7ef4c10..fc0a1cb 100644 --- a/app/Builtins.hs +++ b/app/Builtins.hs @@ -245,6 +245,25 @@ structUnify arity str = do s {cur = cur {heap = h', gol = gcode ++ gol cur, hed = hcode ++ hed cur}} continue +{- terms -} +var :: InterpFn +var = do + heap <- gets (heap . cur) + scope <- gets (hvar . cur) + case derefHeap heap <$> scope M.!? 0 of + Nothing -> continue + Just (FreeRef _) -> continue + _ -> backtrack + +same_term :: InterpFn +same_term = do + heap <- gets (heap . cur) + scope <- gets (hvar . cur) + case map (fmap (derefHeap heap) . (scope M.!?)) [0, 1] of + [Just a, Just b] + | a == b -> continue + _ -> backtrack + {- operator management -} op :: InterpFn op = do @@ -351,7 +370,10 @@ addPrelude = do addProc (assertCode addClauseZ) "assert" 1 addBi retractall "retractall" 1 addBi call "call" 1 + {- terms -} addBi struct "struct" 3 + addBi var "var" 1 + addBi same_term "same_term" 2 {- code loading -} addBi (load False) "load" 1 addBi (load True) "source" 1 diff --git a/app/Code.hs b/app/Code.hs index f2a3856..709b309 100644 --- a/app/Code.hs +++ b/app/Code.hs @@ -81,7 +81,7 @@ data Dereferenced = FreeRef Int | BoundRef Int Datum | NoRef - deriving (Show) + deriving (Show, Eq) -- TRICKY: HeapRefs alone must not form a cycle other than the FreeRef case. derefHeap :: Heap -> Int -> Dereferenced |