love when writing d instead of d-1 causes hours of stress

README.md

@@ -26,14 +26,12 @@ $ cabal test --test-show-details=direct
 #### TLDR
 
 ```sh
-# Compile and evaluate examples/rlp/QuickSort.rl
+# Compile and evaluate examples/factorial.cr, with evaluation info dumped to stderr
-$ rlpc examples/QuickSort.rl
+$ rlpc -ddump-eval examples/factorial.cr
 # Compile and evaluate t.cr, with evaluation info dumped to t.log
 $ rlpc -ddump-eval -l t.log t.cr
 # Compile and evaluate t.rl, dumping the desugared Core
 $ rlpc -ddump-desugared t.rl
-# Compile and evaluate t.rl with all compiler messages enabled
-$ rlpc -dALL t.rl
 ```
 
 #### Options
@@ -128,7 +126,7 @@ parsing remains.
     - [x] Garbage Collection
 - [ ] Stable documentation for the evaluation model
 
-### ~~February Release Plan~~
+### February Release Plan
 - [x] Beta rl' to Core
 - [x] UX improvements
     - [x] Actual compiler errors -- no more unexceptional `error` calls
@@ -136,14 +134,12 @@ parsing remains.
     - [x] Annotate the AST with token positions for errors (NOTE: As of Feb. 1,
       this has been done, but the locational info is not yet used in error messages)
 - [x] Compiler architecture diagram
-- [x] More examples
+- [ ] More examples
 
 ### March Release Plan
 - [ ] Tests
     - [ ] rl' parser
     - [ ] rl' lexer
-- [ ] Ditch TTG in favour of a simpler AST focusing on extendability via Fix, Free, 
-  Cofree, etc. rather than boilerplate-heavy type families
 
 ### Indefinite Release Plan
 
@@ -154,6 +150,8 @@ than the other release plans.
     - [ ] Complete all TODOs
     - [ ] Replace mtl with effectful
 - [ ] rl' type-checker
+- [ ] Ditch TTG in favour of a simpler AST focusing on extendability via Fix, Free, 
+  Cofree, etc. rather than boilerplate-heavy type families
 - [ ] Stable rl' to Core
 - [ ] Core polish
     - [ ] Better, stable parser
@@ -162,4 +160,3 @@ than the other release plans.
     - [ ] Less hacky pragmas
 - [ ] Choose a target. LLVM, JS, C, and WASM are currently top contenders
 - [ ] https://proglangdesign.net/wiki/challenges
-

app/CoreDriver.hs

@@ -6,7 +6,7 @@ module CoreDriver
 import Compiler.RLPC
 import Control.Monad
 import Data.Text                    qualified as T
-import Control.Lens.Combinators
+import Lens.Micro.Platform
 
 import Core.Lex
 import Core.Parse

app/Main.hs

@@ -19,7 +19,7 @@ import System.Exit              (exitSuccess)
 import Core
 import TI
 import GM
-import Control.Lens.Combinators hiding (argument)
+import Lens.Micro.Platform
 
 import CoreDriver               qualified
 import RlpDriver                qualified

cabal.project.local

@@ -0,0 +1,8 @@
+profiling: True
+ignore-project: False
+library-profiling: True
+executable-profiling: True
+profiling-detail: all-functions
+tests: True
+benchmarks: True
+

cabal.project.local~

@@ -0,0 +1,5 @@
+ignore-project: False
+library-profiling: True
+executable-profiling: True
+tests: True
+benchmarks: True

doc/src/commentary/gm.rst

@@ -63,13 +63,52 @@ an assembly target. The goal of our new G-Machine is to compile a *linear
 sequence of instructions* which, **when executed**, build up a graph
 representing the code.
 
-*************
+**************************
-The G-Machine
+Trees and Vines, in Theory
-*************
+**************************
+
+Rather than instantiating an expression at runtime -- traversing the AST and
+building a graph -- we want to compile all expressions at compile-time,
+generating a linear sequence of instructions which may be executed to build the
+graph.
+
+**************************
+Evaluation: Slurping Vines
+**************************
+
+WIP.
+
+Laziness
+--------
+
+WIP.
+
+* Instead of :code:`Slide (n+1); Unwind`, do :code:`Update n; Pop n; Unwind`
+
+****************************
+Compilation: Squashing Trees
+****************************
+
+WIP.
+
+Notice that we do not keep a (local) environment at run-time. The environment
+only exists at compile-time to map local names to stack indices. When compiling
+a supercombinator, the arguments are enumerated from zero (the top of the
+stack), and passed to :code:`compileR` as an environment.
 
 .. literalinclude:: /../../src/GM.hs
    :dedent:
-   :start-after: -- >> [ref/Instr]
+   :start-after: -- >> [ref/compileSc]
-   :end-before: -- << [ref/Instr]
+   :end-before: -- << [ref/compileSc]
+   :caption: src/GM.hs
+
+Of course, variables being indexed relative to the top of the stack means that
+they will become inaccurate the moment we push or pop the stack a single time.
+The way around this is quite simple: simply offset the stack when w
+
+.. literalinclude:: /../../src/GM.hs
+   :dedent:
+   :start-after: -- >> [ref/compileC]
+   :end-before: -- << [ref/compileC]
    :caption: src/GM.hs
 

doc/src/commentary/layout-lexing.rst

@@ -62,6 +62,159 @@ braces and semicolons. In developing our *layout* rules, we will follow in the
 pattern of translating the whitespace-sensitive source language to an explicitly
 sectioned language.
 
+But What About Haskell?
+***********************
+
+Parsing Haskell -- and thus rl' -- is only slightly more complex than Python,
+but the design is certainly more sensitive. 
+
+.. code-block:: haskell
+
+   -- line folds
+   something = this is a
+       single expression
+
+   -- an extremely common style found in haskell
+   data Some = Data
+       { is    :: Presented
+       , in    :: This
+       , silly :: Style
+       }
+
+   -- another style oddity
+   -- note that this is not a single
+   -- continued line! `look at`,
+   -- `this odd`, and `alignment` are all
+   -- discrete items!
+   anotherThing = do look at
+                     this odd
+                     alignment
+
+But enough fear, lets actually think about implementation. Firstly, some
+formality: what do we mean when we say layout? We will define layout as the
+rules we apply to an implicitly-sectioned language in order to yield one that is
+explicitly-sectioned. We will also define indentation of a lexeme as the column
+number of its first character.
+
+Thankfully for us, our entry point is quite clear; layouts only appear after a
+select few keywords, (with a minor exception; TODO: elaborate) being :code:`let`
+(followed by supercombinators), :code:`where` (followed by supercombinators),
+:code:`do` (followed by expressions), and :code:`of` (followed by alternatives)
+(TODO: all of these terms need linked glossary entries). In order to manage the
+cascade of layout contexts, our lexer will record a stack for which each element
+is either :math:`\varnothing`, denoting an explicit layout written with braces
+and semicolons, or a :math:`\langle n \rangle`, denoting an implicitly laid-out
+layout where the start of each item belonging to the layout is indented
+:math:`n` columns.
+
+.. code-block:: haskell
+
+    -- layout stack: []
+    module M where -- layout stack: [∅]
+
+    f x = let -- layout keyword; remember indentation of next token
+              y = w * w -- layout stack: [∅, <10>]
+              w = x + x
+              -- layout ends here
+          in do -- layout keyword; next token is a brace!
+              { -- layout stack: [∅]
+                  print y;
+                  print x;
+              }
+
+Finally, we also need the concept of "virtual" brace tokens, which as far as
+we're concerned at this moment are exactly like normal brace tokens, except
+implicitly inserted by the compiler. With the presented ideas in mind, we may
+begin to introduce a small set of informal rules describing the lexer's handling
+of layouts, the first being:
+
+1. If a layout keyword is followed by the token '{', push :math:`\varnothing`
+   onto the layout context stack. Otherwise, push :math:`\langle n \rangle` onto
+   the layout context stack where :math:`n` is the indentation of the token
+   following the layout keyword. Additionally, the lexer is to insert a virtual
+   opening brace after the token representing the layout keyword.
+
+Consider the following observations from that previous code sample:
+
+* Function definitions should belong to a layout, each of which may start at
+  column 1.
+
+* A layout can enclose multiple bodies, as seen in the :code:`let`-bindings and
+  the :code:`do`-expression.
+
+* Semicolons should *terminate* items, rather than *separate* them.
+
+Our current focus is the semicolons. In an implicit layout, items are on
+separate lines each aligned with the previous. A naïve implementation would be
+to insert the semicolon token when the EOL is reached, but this proves unideal
+when you consider the alignment requirement. In our implementation, our lexer
+will wait until the first token on a new line is reached, then compare
+indentation and insert a semicolon if appropriate. This comparison -- the
+nondescript measurement of "more, less, or equal indentation" rather than a
+numeric value -- is referred to as *offside* by myself internally and the
+Haskell report describing layouts. We informally formalise this rule as follows:
+
+2. When the first token on a line is preceeded only by whitespace, if the
+   token's first grapheme resides on a column number :math:`m` equal to the
+   indentation level of the enclosing context -- i.e. the :math:`\langle n
+   \rangle` on top of the layout stack. Should no such context exist on the
+   stack, assume :math:`m > n`.
+
+We have an idea of how to begin layouts, delimit the enclosed items, and last
+we'll need to end layouts. This is where the distinction between virtual and
+non-virtual brace tokens comes into play. The lexer needs only partial concern
+towards closing layouts; the complete responsibility is shared with the parser.
+This will be elaborated on in the next section. For now, we will be content with
+naïvely inserting a virtual closing brace when a token is indented right of the
+layout.
+
+3. Under the same conditions as rule 2., when :math:`m < n` the lexer shall
+   insert a virtual closing brace and pop the layout stack.
+
+This rule covers some cases including the top-level, however, consider
+tokenising the :code:`in` in a :code:`let`-expression. If our lexical analysis
+framework only allows for lexing a single token at a time, we cannot return both
+a virtual right-brace and a :code:`in`. Under this model, the lexer may simply
+pop the layout stack and return the :code:`in` token. As we'll see in the next
+section, as long as the lexer keeps track of its own context (i.e. the stack),
+the parser will cope just fine without the virtual end-brace.
+
+Parsing Lonely Braces
+*********************
+
+When viewed in the abstract, parsing and tokenising are near-identical tasks yet
+the two are very often decomposed into discrete systems with very different
+implementations. Lexers operate on streams of text and tokens, while parsers
+are typically far less linear, using a parse stack or recursing top-down. A
+big reason for this separation is state management: the parser aims to be as
+context-free as possible, while the lexer tends to burden the necessary
+statefulness. Still, the nature of a stream-oriented lexer makes backtracking
+difficult and quite inelegant.
+
+However, simply declaring a parse error to be not an error at all
+counterintuitively proves to be an elegant solution our layout problem which
+minimises backtracking and state in both the lexer and the parser. Consider the
+following definitions found in rlp's BNF:
+
+.. productionlist:: rlp
+   VOpen   : `vopen`
+   VClose  : `vclose` | `error`
+
+A parse error is recovered and treated as a closing brace. Another point of note
+in the BNF is the difference between virtual and non-virtual braces (TODO: i
+don't like that the BNF is formatted without newlines :/):
+
+.. productionlist:: rlp
+   LetExpr : `let` VOpen Bindings VClose `in` Expr | `let` `{` Bindings `}` `in` Expr
+
+This ensures that non-virtual braces are closed explicitly.
+
+This set of rules is adequete enough to satisfy our basic concerns about line
+continations and layout lists. For a more pedantic description of the layout
+system, see `chapter 10
+<https://www.haskell.org/onlinereport/haskell2010/haskellch10.html>`_ of the
+2010 Haskell Report, which I heavily referenced here.
+
 References
 ----------
 

examples/rlp/Help.rl

@@ -0,0 +1,10 @@
+id x = x
+
+thing = Identity 3
+
+data Identity a = Identity a
+
+main = case thing of
+    Identity x -> let y = x
+                  in y
+

examples/rlp/MapList.rl

@@ -0,0 +1,13 @@
+data List a = Nil | Cons a (List a)
+
+map :: (a -> b) -> List a -> List b
+map f l = case l of
+    Nil -> Nil
+    Cons a as -> Cons (f a) (map f as)
+
+list = Cons 1 (Cons 2 (Cons 3 Nil))
+
+lam x = *# x x
+
+main = print# (map lam list)
+

examples/rlp/QuickSort.rl

@@ -23,9 +23,18 @@ qsort l = case l of
             greater = filter (<# a) as
         in append (append (qsort lesser) (Cons a Nil)) (qsort greater)
 
-list :: List Int#
 list = Cons 9 (Cons 2 (Cons 3 (Cons 2
             (Cons 5 (Cons 2 (Cons 12 (Cons 89 Nil)))))))
 
-main = print# (qsort list)
+list2 = Cons 2 (Cons 3 Nil)
+
+lt :: Int# -> Int# -> Bool
+lt a = (>=# a)
+
+id x = x
+
+main = case list of
+    Nil -> Nil
+    Cons a as -> let lesser = filter (lt a) as
+                 in lesser
 

rlp.cabal

@@ -61,19 +61,28 @@ library
                     , hashable >= 1.4.3 && < 1.5
                     , mtl >= 2.3.1 && < 2.4
                     , text >= 2.0.2 && < 2.1
+                    , megaparsec >= 9.6.1 && < 9.7
+                    , microlens >= 0.4.13 && < 0.5
+                    , microlens-mtl >= 0.2.0 && < 0.3
+                    , microlens-platform >= 0.4.3 && < 0.5
+                    , microlens-th >= 0.4.3 && < 0.5
                     , unordered-containers >= 0.2.20 && < 0.3
                     , recursion-schemes >= 5.2.2 && < 5.3
                     , data-fix >= 0.3.2 && < 0.4
                     , utf8-string >= 1.0.2 && < 1.1
                     , extra >= 1.7.0 && < 2
-                    , semigroupoids >=6.0 && <6.1
+                    , semigroupoids
-                    , comonad >=5.0.0 && <6
+                    , comonad
-                    , lens >=5.2.3 && <6.0
+                    , lens
-                    , text-ansi >=0.2.0 && <0.4
+                    , text-ansi
+                    , microlens-pro ^>=0.2.0
                     , effectful-core ^>=2.3.0.0
                     , deriving-compat ^>=0.6.0
                     , these >=0.2 && <2.0
 
+    ghc-options:
+        -fprof-auto
+
     hs-source-dirs:   src
     default-language: GHC2021
 
@@ -96,9 +105,9 @@ executable rlpc
     build-depends: base >=4.17.0.0 && <4.20.0.0
                  , rlp
                  , optparse-applicative >= 0.18.1 && < 0.19
+                 , microlens-platform
                  , mtl >= 2.3.1 && < 2.4
                  , unordered-containers >= 0.2.20 && < 0.3
-                 , lens >=5.2.3 && <6.0
                  , text >= 2.0.2 && < 2.1
 
     hs-source-dirs:   app

src/Compiler/JustRun.hs

@@ -11,7 +11,6 @@ module Compiler.JustRun
     ( justLexCore
     , justParseCore
     , justTypeCheckCore
-    , justHdbg
     )
     where
 ----------------------------------------------------------------------------------
@@ -21,22 +20,14 @@ import Core.HindleyMilner
 import Core.Syntax                      (Program')
 import Compiler.RLPC
 import Control.Arrow                    ((>>>))
-import Control.Monad                    ((>=>), void)
+import Control.Monad                    ((>=>))
 import Control.Comonad
 import Control.Lens
 import Data.Text                        qualified as T
 import Data.Function                    ((&))
-import System.IO
 import GM
-import Rlp.Parse
-import Rlp2Core
 ----------------------------------------------------------------------------------
 
-justHdbg :: String -> IO GmState
-justHdbg s = do
-    p <- evalRLPCIO def (parseRlpProgR >=> desugarRlpProgR $ T.pack s)
-    withFile "/tmp/t.log" WriteMode $ hdbgProg p
-
 justLexCore :: String -> Either [MsgEnvelope RlpcError] [CoreToken]
 justLexCore s = lexCoreR (T.pack s)
               & mapped . each %~ extract

src/Compiler/RLPC.hs

@@ -64,8 +64,8 @@ import Data.Text.IO             qualified as T
 import System.IO
 import Text.ANSI                qualified as Ansi
 import Text.PrettyPrint         hiding ((<>))
-import Control.Lens
+import Lens.Micro.Platform
-import Data.Text.Lens           (packed, unpacked, IsText)
+import Lens.Micro.Platform.Internal
 import System.Exit
 ----------------------------------------------------------------------------------
 

src/Compiler/RlpcError.hs

@@ -21,7 +21,8 @@ import Control.Monad.Errorful
 import Data.Text                (Text)
 import Data.Text                qualified as T
 import GHC.Exts                 (IsString(..))
-import Control.Lens
+import Lens.Micro.Platform
+import Lens.Micro.Platform.Internal
 import Compiler.Types
 ----------------------------------------------------------------------------------
 

src/Control/Monad/Errorful.hs

@@ -20,7 +20,7 @@ import Data.Functor.Identity
 import Data.Coerce
 import Data.HashSet                 (HashSet)
 import Data.HashSet                 qualified as H
-import Control.Lens
+import Lens.Micro
 ----------------------------------------------------------------------------------
 
 newtype ErrorfulT e m a = ErrorfulT { runErrorfulT :: m (Maybe a, [e]) }

src/Core/Examples.hs

@@ -8,6 +8,7 @@ module Core.Examples where
 ----------------------------------------------------------------------------------
 import Core.Syntax
 import Core.TH
+import Rlp.TH
 ----------------------------------------------------------------------------------
 
 -- fac3 = undefined
@@ -244,3 +245,17 @@ namedConsCase = [coreProg|
 
 --}
 
+qsort = [rlpProg|
+    data List a = Nil | Cons a (List a)
+
+    list = Cons 9 (Cons 2 (Cons 3 (Cons 2
+                (Cons 5 (Cons 2 (Cons 12 (Cons 89 Nil)))))))
+
+    id x = x
+
+    main = case list of
+        Nil -> Nil
+        Cons a as -> let lesser = as
+                     in print# lesser
+|]
+

src/Core/HindleyMilner.hs

@@ -16,7 +16,9 @@ module Core.HindleyMilner
     )
     where
 ----------------------------------------------------------------------------------
-import Control.Lens             hiding (Context', Context)
+import Lens.Micro
+import Lens.Micro.Mtl
+import Lens.Micro.Platform
 import Data.Maybe               (fromMaybe)
 import Data.Text                qualified as T
 import Data.Pretty              (rpretty)

src/Core/Lex.x

@@ -26,7 +26,8 @@ import Compiler.RLPC
 import Compiler.Types
 -- TODO: unify Located definitions
 import Compiler.RlpcError
-import Control.Lens
+import Lens.Micro
+import Lens.Micro.TH
 }
 
 %wrapper "monad-strict-text"

src/Core/Parse.y

@@ -24,7 +24,7 @@ import Core.Syntax
 import Core.Lex
 import Compiler.RLPC
 import Control.Monad
-import Control.Lens         hiding (snoc)
+import Lens.Micro
 import Data.Default.Class   (def)
 import Data.Hashable        (Hashable)
 import Data.List.Extra

src/Core/Syntax.hs

@@ -60,6 +60,8 @@ import Data.Bifoldable              (bifoldr)
 import GHC.Generics                 (Generic, Generically(..))
 -- Lift instances for the Core quasiquoters
 import Language.Haskell.TH.Syntax   (Lift)
+-- import Lens.Micro.TH                (makeLenses)
+-- import Lens.Micro
 import Control.Lens
 ----------------------------------------------------------------------------------
 

src/Core/Utils.hs

@@ -13,7 +13,7 @@ import Data.Functor.Foldable
 import Data.Set                     (Set)
 import Data.Set                     qualified as S
 import Core.Syntax
-import Control.Lens
+import Lens.Micro
 import GHC.Exts                     (IsList(..))
 ----------------------------------------------------------------------------------
 

src/Core2Core.hs

@@ -20,10 +20,12 @@ import Control.Monad.State.Lazy
 import Control.Arrow            ((>>>))
 import Data.Text                qualified as T
 import Data.HashMap.Strict      (HashMap)
+import Debug.Trace
 import Numeric                  (showHex)
 
 import Data.Pretty
 import Compiler.RLPC
+-- import Lens.Micro.Platform
 import Control.Lens
 import Core.Syntax
 import Core.Utils

src/Data/Heap.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ImplicitParams #-}
 {-
 Module : Data.Heap
 Description : A model heap used by abstract machine
@@ -26,7 +27,10 @@ import Data.Map                     (Map, (!?))
 import Debug.Trace
 import Data.Map.Strict              qualified as M
 import Data.List                    (intersect)
-import GHC.Stack                    (HasCallStack)
+import Data.IORef
+import System.IO.Unsafe
+import Control.Monad
+import GHC.Stack
 import Control.Lens
 ----------------------------------------------------------------------------------
 
@@ -74,13 +78,19 @@ instance Traversable Heap where
 
 ----------------------------------------------------------------------------------
 
-alloc :: Heap a -> a -> (Heap a, Addr)
+godhelpme :: IORef Int
-alloc (Heap (u:us) m) v = (Heap us (M.insert u v m), u)
+godhelpme = unsafePerformIO $ newIORef 0
+
+alloc :: HasCallStack => Heap a -> a -> (Heap a, Addr)
+alloc (Heap (u:us) m) v = unsafePerformIO $ do
+    -- i <- readIORef godhelpme
+    -- when (i >= 60000) $ error "fuck"
+    -- modifyIORef godhelpme succ
+    pure (Heap us (M.insert u v m), u)
 alloc (Heap [] _)     _ = error "heap model ran out of memory..."
 
-update :: Addr -> a -> Heap a -> Heap a
+update :: HasCallStack => 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

@@ -9,12 +9,8 @@ module GM
     ( hdbgProg
     , evalProg
     , evalProgR
-    , GmState(..)
-    , gmCode, gmStack, gmDump, gmHeap, gmEnv, gmStats
     , Node(..)
-    , showState
     , gmEvalProg
-    , Stats(..)
     , finalStateOf
     , resultOf
     , resultOfExpr
@@ -26,13 +22,18 @@ import Data.List                    (mapAccumL)
 import Data.Maybe                   (fromMaybe, mapMaybe)
 import Data.Monoid                  (Endo(..))
 import Data.Tuple                   (swap)
-import Control.Lens
+import Lens.Micro
-import Data.Text.Lens               (IsText, packed, unpacked)
+import Lens.Micro.Extras            (view)
+import Lens.Micro.TH
+import Lens.Micro.Platform          (packed, unpacked)
+import Lens.Micro.Platform.Internal (IsText(..))
 import Text.Printf
 import Text.PrettyPrint             hiding ((<>))
 import Text.PrettyPrint.HughesPJ    (maybeParens)
 import Data.Foldable                (traverse_)
-import System.IO                    (Handle, hPutStrLn)
+import Control.Concurrent
+import System.Exit
+import System.IO                    (Handle, hPutStrLn, stderr)
 -- TODO: an actual output system
 -- TODO: an actual output system
 -- TODO: an actual output system
@@ -90,7 +91,6 @@ data Key = NameKey Name
          | ConstrKey Tag Int
          deriving (Show, Eq)
 
--- >> [ref/Instr]
 data Instr = Unwind
            | PushGlobal Name
            | PushConstr Tag Int
@@ -112,7 +112,6 @@ data Instr = Unwind
            | Print
            | Halt
            deriving (Show, Eq)
--- << [ref/Instr]
 
 data Node = NNum Int
           | NAp Addr Addr
@@ -155,7 +154,7 @@ evalProg p = res <&> (,sts)
         resAddr = final ^. gmStack ^? _head
         res = resAddr >>= flip hLookup h
 
-hdbgProg :: Program' -> Handle -> IO GmState
+hdbgProg :: Program' -> Handle -> IO (Node, Stats)
 hdbgProg p hio = do
     (renderOut . showState) `traverse_` states
     -- TODO: i'd like the statistics to be at the top of the file, but `sts`
@@ -163,7 +162,7 @@ hdbgProg p hio = do
     -- *can't* get partial logs in the case of a crash. this is in opposition to
     -- the above traversal which *will* produce partial logs. i love laziness :3
     renderOut . showStats $ sts
-    pure final
+    pure (res, sts)
     where
         renderOut r = hPutStrLn hio $ render r ++ "\n"
 
@@ -176,8 +175,11 @@ hdbgProg p hio = do
         [resAddr] = final ^. gmStack
         res = hLookupUnsafe resAddr h
 
-evalProgR :: (Monad m) => Program' -> RLPCT m (Node, Stats)
+evalProgR :: Program' -> RLPCIO (Node, Stats)
 evalProgR p = do
+    -- me <- liftIO myThreadId
+    -- liftIO $ forkIO $ threadDelay (5 * 10^6) *> throwTo me ExitSuccess *> exitSuccess
+    -- states & traverseOf_ (each . gmCode) (liftIO . print)
     (renderOut . showState) `traverse_` states
     renderOut . showStats $ sts
     pure (res, sts)
@@ -196,11 +198,11 @@ eval st = st : rest
     where
         rest | isFinal st   = []
              | otherwise    = eval next
-        next = doAdmin (step st)
+        next = doAdmin (step . (\a -> (unsafePerformIO . hPutStrLn stderr . ('\n':) . render . showState $ a) `seq` a) $ st)
 
 doAdmin :: GmState -> GmState
 doAdmin st = st & gmStats . stsReductions %~ succ
-                & doGC
+                -- & doGC
     where
         -- TODO: use heapTrigger option in RLPCOptions
         heapTrigger = 50
@@ -410,7 +412,8 @@ step st = case head (st ^. gmCode) of
                 (e:s) = st ^. gmStack
                 an = s !! n
                 h = st ^. gmHeap
-                h' = h `seq` update an (NInd e) h
+                -- PROBLEM HERE:
+                h' = update an (NInd e) h
 
         popI :: Int -> GmState
         popI n = st
@@ -659,7 +662,7 @@ buildInitialHeap (view programScDefs -> ss) = mapAccumL allocateSc mempty compil
 
         -- note that we don't count sc allocations in the stats
         allocateSc :: GmHeap -> CompiledSC -> (GmHeap, (Key, Addr))
-        allocateSc h (n,d,c) = (h', (NameKey n, a))
+        allocateSc h (n,d,c) = traceShow a (h', (NameKey n, a))
             where (h',a) = alloc h $ NGlobal d c
 
         -- >> [ref/compileSc]
@@ -746,17 +749,19 @@ buildInitialHeap (view programScDefs -> ss) = mapAccumL allocateSc mempty compil
         compileE _ (Lit l) = compileEL l
         compileE g (Let NonRec bs e) =
                 -- we use compileE instead of compileC
-                mconcat binders <> compileE g' e <> [Slide d]
+                traceShowId $ mconcat binders <> compileE g' e <> [Slide d]
             where
                 d = length bs
-                (g',binders) = mapAccumL compileBinder g bs
+                (g',binders) = mapAccumL compileBinder (argOffset (d-1) g) addressed
+                -- kinda gross. revisit this
+                addressed = bs `zip` reverse [0 .. d-1]
 
-                compileBinder :: Env -> Binding' -> (Env, Code)
+                compileBinder :: Env -> (Binding', Int) -> (Env, Code)
-                compileBinder m (k := v) = (m',c)
+                compileBinder m (k := v, a) = (m',c)
                     where
-                        m' = (NameKey k, 0) : argOffset 1 m
+                        m' = (NameKey k, a) : m
                         -- make note that we use m rather than m'!
-                        c = compileC m v
+                        c = trace (printf "compileC %s %s" (show m) (show v)) $ compileC m v
 
         compileE g (Let Rec bs e) =
                 Alloc d : initialisers <> body <> [Slide d]
@@ -783,7 +788,6 @@ buildInitialHeap (view programScDefs -> ss) = mapAccumL allocateSc mempty compil
         compileE g ("/#" :$ a :$ b)  = inlineOp2 g Div    a b
         compileE g ("==#" :$ a :$ b) = inlineOp2 g Equals a b
         compileE g ("<#" :$ a :$ b)  = inlineOp2 g Lesser a b
-        compileE g (">=#" :$ a :$ b)  = inlineOp2 g GreaterEq a b
 
         compileE g (Case e as) = compileE g e <> [CaseJump (compileD g as)]
 

src/Rlp/Lex.x

@@ -27,7 +27,8 @@ import Data.Text                (Text)
 import Data.Text                qualified as T
 import Data.Word
 import Data.Default
-import Control.Lens
+import Lens.Micro.Mtl
+import Lens.Micro
 
 import Debug.Trace
 import Rlp.Parse.Types

src/Rlp/Parse.y

@@ -13,7 +13,7 @@ import Rlp.Lex
 import Rlp.Syntax
 import Rlp.Parse.Types
 import Rlp.Parse.Associate
-import Control.Lens                 hiding (snoc, (.>), (<.), (<<~))
+import Lens.Micro.Platform
 import Data.List.Extra
 import Data.Fix
 import Data.Functor.Const

src/Rlp/Parse/Associate.hs

@@ -11,7 +11,7 @@ import Data.Functor.Const
 import Data.Functor
 import Data.Text                        qualified as T
 import Text.Printf
-import Control.Lens
+import Lens.Micro
 import Rlp.Parse.Types
 import Rlp.Syntax
 --------------------------------------------------------------------------------

src/Rlp/Parse/Types.hs

@@ -44,7 +44,8 @@ import Data.HashMap.Strict          qualified as H
 import Data.Void
 import Data.Word                    (Word8)
 import Data.Text                    qualified as T
-import Control.Lens                 hiding ((<<~))
+import Lens.Micro.TH
+import Lens.Micro
 import Rlp.Syntax
 import Compiler.Types
 --------------------------------------------------------------------------------

src/Rlp/Syntax.hs

@@ -57,7 +57,8 @@ import Data.Functor.Identity
 import Data.Kind                    (Type)
 import GHC.Generics
 import Language.Haskell.TH.Syntax   (Lift)
-import Control.Lens
+import Lens.Micro.Pro
+import Lens.Micro.Pro.TH
 import Core.Syntax                  hiding (Lit, Type, Binding, Binding')
 import Core                         (HasRHS(..), HasLHS(..))
 ----------------------------------------------------------------------------------

src/Rlp2Core.hs

@@ -13,6 +13,8 @@ import Control.Monad.Utils
 import Control.Arrow
 import Control.Applicative
 import Control.Comonad
+-- import Lens.Micro
+-- import Lens.Micro.Internal
 import Control.Lens
 import Compiler.RLPC
 import Data.List                        (mapAccumL, partition)

src/TI.hs

@@ -20,7 +20,8 @@ import System.IO                (Handle, hPutStr)
 import Text.Printf              (printf, hPrintf)
 import Data.Proxy               (Proxy(..))
 import Data.Monoid              (Endo(..))
-import Control.Lens
+import Lens.Micro
+import Lens.Micro.TH
 import Data.Pretty
 import Data.Heap
 import Core.Examples

tst/Arith.hs

@@ -41,7 +41,6 @@ evalArith (a ::* b)   = evalArith a * evalArith b
 evalArith (a ::- b)   = evalArith a - evalArith b
 
 instance Arbitrary ArithExpr where
-    -- TODO: implement shrink
     arbitrary = gen 4
         where
             gen :: Int -> Gen ArithExpr