app/Gyehoek/ANF.hs

@@ -38,6 +38,7 @@ import Control.Category
 import Prelude hiding ((.), id)
 import Data.InvertibleGrammar.Base qualified as IG
 import Data.InvertibleGrammar.Base ((:-)((:-)))
+import qualified Gyehoek.Sexp
 
 
 -- data Val
@@ -57,7 +58,12 @@ data Exp
 
 
 collapseBindings
-  :: Prism' Exp a -> Getter a Exp -> Exp -> (List a, Exp)
+  -- | Match constructor.
+  :: Prism' a b
+  -- | Extract subexpression from match.
+  -> Getter b a
+  -> a
+  -> (List b, a)
 collapseBindings p l e =
   case e ^? p of
     Just a -> collapseBindings p l (a ^. l) & _1 %~ (a:)
@@ -72,15 +78,18 @@ instance SexpIso Exp where
     where
       letapp :: Grammar
         Position (Sexp :- t) (Exp :- List Val :- Val :- Text :- t)
-      letapp = Lam.letIso symbol (sexpIso @(NonEmpty Val)) (sexpIso @Exp)
-         >>> IG.Iso bluh hulb
-      bluh (e :- ((r,f:|xs):|bs) :- t) =
-        foldr (\(v,g:|ys) -> ExpLetApply v g ys) e bs :- xs :- f :- r :- t
-      hulb (e :- xs :- f :- r :- t) = e' :- ((r,f:|xs):|bs) :- t
-        where
-          -- (bs,e') = ([],e)
-          (bs,e') = collapseBindings #ExpLetApply _4 e
-                  & _1 . each %~ \(x,g,ys,_) -> (x,g:|ys)
+      letapp =
+        Gyehoek.Sexp.let_ symbol (sexpIso @(NonEmpty Val)) (sexpIso @Exp)
+         >>> foldLet
+      foldLet =
+        IG.Iso
+          (\(e :- ((r,f:|xs):|bs) :- t) ->
+             foldr (\(v,g:|ys) -> ExpLetApply v g ys) e bs
+               :- xs :- f :- r :- t)
+          (\(e :- xs :- f :- r :- t) ->
+             let (bs,e') = collapseBindings #ExpLetApply _4 e
+                           & _1 . each %~ \(x,g,ys,_) -> (x,g:|ys)
+             in e' :- ((r,f:|xs):|bs) :- t)