struct structs

1 files changed, 20 insertions, 0 deletions

diff --git a/app/Code.hs b/app/Code.hs
index eecd5b6..eb5149c 100644
--- a/app/Code.hs
+++ b/app/Code.hs
@@ -77,6 +77,7 @@ data Dereferenced
   = FreeRef Int
   | BoundRef Int Datum
   | NoRef
+  deriving (Show)
 
 -- TRICKY: HeapRefs alone must not form a cycle other than the FreeRef case.
 derefHeap :: Heap -> Int -> Dereferenced
@@ -89,6 +90,25 @@ derefHeap h@(Heap _ hmap) x =
     Just x' -> BoundRef x x'
     _ -> NoRef
 
+writeHeap :: Int -> Datum -> Heap -> Heap
+writeHeap addr x (Heap nxt m) = Heap nxt (M.adjust (const x) addr m)
+
+newHeapVar :: Heap -> (Heap, Int)
+newHeapVar heap = head <$> newHeapVars 1 heap
+
+newHeapVars :: Int -> Heap -> (Heap, [Int])
+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)
+
+withNewHeapStruct :: Int -> Datum -> Heap -> ([Datum] -> Heap -> a) -> a
+withNewHeapStruct addr s@(Struct Id {arity = arity}) heap 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'')
+
 -- TODO are we actually going to use this?
 codeStruct ::
      Monad m