NNum sharing

docs/src/commentary/gm.rst

@@ -60,6 +60,9 @@ Trees and Vines, in Theory
 
 WIP. state transition rules
 
+Core Transition Rules
+---------------------
+
 1. Lookup a global by name and push its value onto the stack
 
 .. math::
@@ -207,6 +210,60 @@ WIP. state transition rules
    & m
    }
 
+Extension Rules
+---------------
+
+1. A sneaky trick to enable sharing of :code:`NNum` nodes. We note that the
+   global environment is a mapping of :code:`Name` objects (i.e. identifiers) to
+   heap addresses. Strings of digits are not considered valid identifiers! We
+   abuse this by modifying Core Rule 2 to update the global environment with the
+   new node's address. Consider how this rule might impact garbage collection
+   (remember that the environment is intended for *globals*).
+
+.. math::
+   \transrule
+   { \mathtt{PushInt} \; n : i
+   & s
+   & h
+   & m
+   }
+   { i
+   & a : s
+   & h
+   \begin{bmatrix}
+        a : \mathtt{NNum} \; n
+   \end{bmatrix}
+   & m
+   \begin{bmatrix}
+        n' : a
+   \end{bmatrix}
+   \\
+   \SetCell[c=5]{c}
+   \text{where $n'$ is the base-10 string rep. of $n$}
+   }
+
+2. In order for Extension Rule 1. to be effective, we are also required to take
+   action when a number already exists in the environment:
+
+.. math::
+   \transrule
+   { \mathtt{PushInt} \; n : i
+   & s
+   & h
+   & m
+   \begin{bmatrix}
+        n' : a
+   \end{bmatrix}
+   }
+   { i
+   & a : s
+   & h
+   & m
+   \\
+   \SetCell[c=5]{c}
+   \text{where $n'$ is the base-10 string rep. of $n$}
+   }
+
 **************************
 Evaluation: Slurping Vines
 **************************

src/GM.hs

@@ -132,23 +132,52 @@ step st = case head (st ^. gmCode) of
                 a = fromMaybe (error $ "undefined var: " <> show k)
                         $ lookup k m
 
+        -- Extension Rules 1,2 (sharing)
         pushInt :: Int -> GmState -> GmState
-        pushInt n st = st
+        pushInt n st = case lookup n' m of
+            Just a  -> st
+                     & gmCode  %~ drop 1
+                     & gmStack .~ s'
+                where
+                    s' = a : s
+            Nothing -> st
                      & gmCode  %~ drop 1
                      & gmStack .~ s'
                      & gmHeap  .~ h'
+                     -- record the newly allocated int
+                     & gmStats . stsAllocations %~ succ --
                 where
-                s = st ^. gmStack
-                h = st ^. gmHeap
-
                     s' = a : s
                     (h',a) = alloc h (NNum n)
+                    m' = (n',a) : m
+            where
+                m = st ^. gmEnv
+                s = st ^. gmStack
+                h = st ^. gmHeap
+                n' = show n
+
+
+        -- Core Rule 2. (no sharing)
+        -- pushInt :: Int -> GmState -> GmState
+        -- pushInt n st = st
+        --              & gmCode  %~ drop 1
+        --              & gmStack .~ s'
+        --              & gmHeap  .~ h'
+        --              & gmStats . stsAllocations %~ succ
+        --     where
+        --         s = st ^. gmStack
+        --         h = st ^. gmHeap
+
+        --         s' = a : s
+        --         (h',a) = alloc h (NNum n)
 
         mkAp :: GmState -> GmState
         mkAp st = st
                 & gmCode  %~ drop 1
                 & gmStack .~ s'
                 & gmHeap  .~ h'
+                -- record the application we allocated
+                & gmStats . stsAllocations %~ succ
             where
                 (f:x:ss) = st ^. gmStack
                 h = st ^. gmHeap
@@ -224,6 +253,7 @@ buildInitialHeap (Program ss) = mapAccumL allocateSc mempty compiled
     where
         compiled = fmap compileSc ss
 
+        -- note that we don't count sc allocations in the stats
         allocateSc :: GmHeap -> CompiledSC -> (GmHeap, (Name, Addr))
         allocateSc h (n,d,c) = (h', (n, a))
             where (h',a) = alloc h $ NGlobal d c