From 97e6cd1d48840800913c2140cfe14fa8431e05c0 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Sat, 18 Feb 2023 21:30:35 +0100
Subject: useful stuff

---
 app/Builtins.hs | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

(limited to 'app/Builtins.hs')

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
-- 
cgit v1.2.3