slight cleanup, metacall

1 files changed, 8 insertions, 19 deletions

diff --git a/app/Interpreter.hs b/app/Interpreter.hs
index 21340ef..7192c7b 100644
--- a/app/Interpreter.hs
+++ b/app/Interpreter.hs
@@ -6,9 +6,12 @@ import Code
   , Cho(..)
   , Code
   , Datum(..)
+  , Dereferenced(..)
   , Heap(..)
   , Instr(..)
   , Interp(..)
+  , InterpFn
+  , derefHeap
   , emptyHeap
   , emptyScope
   )
@@ -43,13 +46,8 @@ prove g = do
         Nothing -> loop -- not finished yet
         Just x -> return x
 
-data Dereferenced
-  = FreeRef Int
-  | BoundRef Int Datum
-  | NoRef
-
 {- Simple "fail" backtracking -}
-backtrack :: PrlgEnv (Maybe (Either String Bool))
+backtrack :: InterpFn
 backtrack = do
   chos <- St.gets cho
   case chos
@@ -61,7 +59,7 @@ backtrack = do
     {- if there's no other choice, answer no -}
     _ -> pure . Just $ Right False
 
-proveStep :: PrlgEnv (Maybe (Either String Bool))
+proveStep :: InterpFn
 proveStep = St.get >>= go
   where
     finish = pure . Just
@@ -76,23 +74,14 @@ proveStep = St.get >>= go
         Just d -> cont d
         _ -> ifail $ "no definition: " ++ show fn
     {- Unification -}
-    go i@Interp {cur = cur@Cho { hed = U h:hs
-                               , gol = U g:gs
-                               , heap = heap@(Heap _ hmap)
-                               }} = unify h g
+    go i@Interp {cur = cur@Cho {hed = U h:hs, gol = U g:gs, heap = heap}} =
+      unify h g
       where
         uok = c i {cur = cur {hed = hs, gol = gs}}
         setHeap r x =
           c i {cur = cur {hed = hs, gol = gs, heap = writeHeap r x heap}}
         {- heap tools -}
-        deref x =
-          case hmap M.!? x of
-            Just (HeapRef x') ->
-              if x == x'
-                then FreeRef x'
-                else deref x'
-            Just x' -> BoundRef x x'
-            _ -> NoRef
+        deref = derefHeap heap
         writeHeap addr x (Heap nxt m) = Heap nxt (M.adjust (const x) addr m)
         newHeapVar h = head <$> newHeapVars 1 h
         newHeapVars n (Heap nxt m) =