diff --git a/docs/src/commentary/gm.rst b/docs/src/commentary/gm.rst index fe1bf84..29a9bd5 100644 --- a/docs/src/commentary/gm.rst +++ b/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 ************************** diff --git a/src/GM.hs b/src/GM.hs index 1a2c8c3..6c9edb5 100644 --- a/src/GM.hs +++ b/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' = 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 - s' = a : s - (h',a) = alloc h (NNum 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