diff options
Diffstat (limited to 'app/Interpreter.hs')
| -rw-r--r-- | app/Interpreter.hs | 29 |
1 files changed, 10 insertions, 19 deletions
diff --git a/app/Interpreter.hs b/app/Interpreter.hs index 15ab1e5..d82793b 100644 --- a/app/Interpreter.hs +++ b/app/Interpreter.hs @@ -7,13 +7,15 @@ import Code , Code , Datum(..) , Dereferenced(..) - , Heap(..) , Instr(..) , Interp(..) , InterpFn , derefHeap , emptyHeap , emptyScope + , newHeapVar + , withNewHeapStruct + , writeHeap ) import qualified Control.Monad.Trans.State.Lazy as St import Env (PrlgEnv) @@ -82,23 +84,10 @@ proveStep = St.get >>= go c i {cur = cur {hed = hs, gol = gs, heap = writeHeap r x heap}} {- heap tools -} 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) = - let addrs = [nxt + i - 1 | i <- [1 .. n]] - in ( Heap (nxt + n) $ - foldr (uncurry M.insert) m [(a, HeapRef a) | a <- addrs] - , addrs) - allocLocal (LocalRef reg) scope cont + withNewLocal (LocalRef reg) scope cont | Just addr <- scope M.!? reg = cont scope heap addr | (heap', addr) <- newHeapVar heap = cont (M.insert reg addr scope) heap' addr - newHeapStruct addr s@(Struct Id {arity = arity}) cont = - let (Heap nxt' m', addrs) = newHeapVars (arity + 1) heap - m'' = - M.insert addr (HeapRef $ head addrs) . M.insert (head addrs) s $ - m' - in cont (map HeapRef $ tail addrs) (Heap nxt' m'') {- simple cases first -} unify VoidRef VoidRef = uok unify (Atom a) (Atom b) @@ -117,7 +106,7 @@ proveStep = St.get >>= go unify VoidRef (LocalRef _) = uok {- allocate heap for LocalRefs and retry with HeapRefs -} unify lr@(LocalRef _) _ = - allocLocal lr (hvar cur) $ \hvar' heap' addr -> + withNewLocal lr (hvar cur) $ \hvar' heap' addr -> c i { cur = @@ -125,7 +114,7 @@ proveStep = St.get >>= go {hed = U (HeapRef addr) : hs, hvar = hvar', heap = heap'} } unify _ lr@(LocalRef _) = - allocLocal lr (gvar cur) $ \gvar' heap' addr -> + withNewLocal lr (gvar cur) $ \gvar' heap' addr -> c i { cur = @@ -142,9 +131,10 @@ proveStep = St.get >>= go case g of atom@(Atom _) -> setHeap hr atom s@(Struct _) -> - newHeapStruct + withNewHeapStruct hr s + heap (\nhs nheap -> c i @@ -176,9 +166,10 @@ proveStep = St.get >>= go case h of atom@(Atom _) -> setHeap gr atom s@(Struct _) -> - newHeapStruct + withNewHeapStruct gr s + heap (\ngs nheap -> c i |