   ] if ;
  
 :: grow-lr ( r p m h -- ast )
-  #! Placeholder for full left recursion implementation
-  r p m h (grow-lr) m pos>> pos set m ans>>
+  h p heads get set-at
+  r p m h (grow-lr) 
+  p heads get delete-at
+  m pos>> pos set m ans>>
   ;
+
+:: (setup-lr) ( r l s -- )
+  s head>> l head>> eq? [
+    l head>> s (>>head)
+    l head>> [ s rule>> add ] change-involved-set drop
+    r l s next>> (setup-lr)
+  ] unless ;
+
+:: setup-lr ( r l -- )
+  l head>> [
+    r V{ } clone V{ } clone <head> l (>>head)
+  ] unless
+  r l lrstack get (setup-lr) ;
+
+:: lr-answer ( r p m -- ast )
+  [let* |
+          h [ m ans>> head>> ]
+        |
+    h rule>> r eq? [
+      m ans>> seed>> m (>>ans)
+      m ans>> fail = [
+        fail
+      ] [
+        r p m h grow-lr
+      ] if
+    ] [
+      m ans>> seed>>
+    ] if
+  ] ;
+
+:: recall ( r p -- memo-entry )
+  [let* |
+          m [ p r memo ]
+          h [ p heads get at ]
+        |
+    h [
+      m r h involved-set>> h rule>> add member? not and [
+        fail p <memo-entry>
+      ] [
+        r h eval-set>> member? [
+          h [ r swap remove ] change-eval-set drop
+          r eval-rule
+          m (>>ans)
+          pos get m (>>pos)
+          m
+        ] [ 
+          m
+        ] if
+      ] if
+    ] [
+      m
+    ] if
+  ] ;
 
 :: apply-non-memo-rule ( r p -- ast )
   [let* |
-          lr  [ f <left-recursion> ]
-          m   [ lr p <memo-entry> dup p r set-memo ]
+          lr  [ fail r f lrstack get <left-recursion> ]
+          m   [ lr lrstack set lr p <memo-entry> dup p r set-memo ]
           ans [ r eval-rule ]
         |
-    ans m (>>ans)
+    lrstack get next>> lrstack set
     pos get m (>>pos)
-    lr detected?>> ans fail = not and [
-      r p m f grow-lr
-    ] [
+    lr head>> [
+      ans lr (>>seed)
+      r p m lr-answer
+    ] [
+      ans m (>>ans)
       ans
-    ] if 
-  ] ;
-
-: apply-memo-rule ( m -- ast )
-  [ ans>> ] [ pos>> ] bi 
-  pos set 
-  dup left-recursion? [
-    t swap (>>detected?)
-    fail  
-  ] when ;
+    ] if
+  ] ;
+
+:: apply-memo-rule ( r m -- ast )
+  m pos>> pos set 
+  m ans>> left-recursion? [ 
+    r m ans>> setup-lr
+    m ans>> seed>>
+  ] [
+    m ans>>
+  ] if ;
 
 :: apply-rule ( r p -- ast )
   [let* |
-          m [ p r memo ]
+          m [ r p recall ]
         | 
     m [
-      m apply-memo-rule
+      r m apply-memo-rule
     ] [
       r p apply-non-memo-rule
     ] if 

  swap [ 
    input set
    0 pos set
    H{ } clone packrat set
  ] H{ } make-assoc swap bind ;



:: (grow-lr) ( r p m h -- )
  p pos set
  h involved-set>> clone h (>>eval-set)
  r eval-rule
  dup fail = pos get m pos>> <= or [
    drop
