fixup

fixup

src/Data/Heap.hs

@@ -24,7 +24,7 @@ module Data.Heap
 ----------------------------------------------------------------------------------
 import Data.Map                     (Map, (!?))
 import Debug.Trace
-import Data.Map qualified as M
+import Data.Map.Strict              qualified as M
 import Data.List                    (intersect)
 import GHC.Stack                    (HasCallStack)
 ----------------------------------------------------------------------------------
@@ -60,10 +60,11 @@ instance Traversable Heap where
 
 alloc :: Heap a -> a -> (Heap a, Addr)
 alloc (Heap (u:us) m) v = (Heap us (M.insert u v m), u)
-alloc (Heap [] _)     _ = error "STG heap model ran out of memory..."
+alloc (Heap [] _)     _ = error "heap model ran out of memory..."
 
 update :: Addr -> a -> Heap a -> Heap a
 update k v (Heap u m) = Heap u (M.adjust (const v) k m)
+-- update k v (Heap u m) = Heap u (M.adjust (undefined) k m)
 
 adjust :: Addr -> (a -> a) -> Heap a -> Heap a
 adjust k f (Heap u m) = Heap u (M.adjust f k m)

src/GM.hs

@@ -25,6 +25,7 @@ import Data.Foldable                (traverse_)
 import System.IO                    (Handle, hPutStrLn)
 import Data.String                  (IsString)
 import Data.Heap
+import Debug.Trace
 import Core
 ----------------------------------------------------------------------------------
 
@@ -181,10 +182,11 @@ step st = case head (st ^. gmCode) of
         packI :: Tag -> Int -> GmState
         packI t n = st
                   & advanceCode
-                  & gmStack %~ (a:)
+                  & gmStack .~ s'
                   & gmHeap  .~ h'
             where
                 (as,s) = splitAt n (st ^. gmStack)
+                s' = a:s
                 (h',a) = alloc (st ^. gmHeap) $ NConstr t as
 
         pushGlobalI :: Name -> GmState
@@ -305,8 +307,8 @@ step st = case head (st ^. gmCode) of
              where
                 (e:s) = st ^. gmStack
                 an = s !! n
-                h' = st ^. gmHeap
-                    & update an (NInd e)
+                h = st ^. gmHeap
+                h' = h `seq` update an (NInd e) h
 
         popI :: Int -> GmState
         popI n = st