app/Gyehoek/ANF.hs

@@ -74,13 +74,9 @@ instance SexpIso Exp where
         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) =
+      bluh (e :- ((r,f:|xs):|bs) :- t) =
         foldr (\(v,g:|ys) -> ExpLetApply v g ys) e bs :- xs :- f :- r :- t
-      bluh _ = error "empty let lol"
-      hulb :: (Exp :- ([Val] :- (Val :- (Text :- t))))
-           -> Exp :- ([(Name, NonEmpty Val)] :- t)
-      hulb (e :- xs :- f :- r :- t) = e' :- ((r,f:|xs):bs) :- t
-      -- hulb (e :- xs :- f :- r :- t) = ExpLetApply r f xs e' :- bs :- t
+      hulb (e :- xs :- f :- r :- t) = e' :- ((r,f:|xs):|bs) :- t
         where
           -- (bs,e') = ([],e)
           (bs,e') = collapseBindings #ExpLetApply _4 e
@@ -219,7 +215,7 @@ lower'
 lower' (ExpVal v) k = lowerVal v k
 
 lower' (ExpLetApply r f xs e) k =
-  blah (lowerVal @es <$> (f:|xs)) \(f':xs') -> do
+  telescope (lowerVal @es <$> (f:|xs)) \(f':|xs') -> do
     Emit [ QBE.Call
             (Just (lowerName r, QBE.AbiBaseTy QBE.Long))
             f'

app/Gyehoek/Syntax.hs

@@ -11,6 +11,7 @@ import Language.SexpGrammar.Generic
 import GHC.Generics
 import Prelude hiding ((.), id)
 import Control.Category
+import Data.List.NonEmpty (NonEmpty ((:|)))
 
 
 type Name = Text
@@ -27,7 +28,7 @@ data Val
   deriving (Show, Generic)
 
 data Exp
-  = ExpLet (List (Name, Exp)) Exp
+  = ExpLet (NonEmpty (Name, Exp)) Exp
   | ExpApply Exp (List Exp)
   | ExpBegin (List Exp)
   | ExpVal Val
@@ -35,15 +36,20 @@ data Exp
 
 
 
+nonempty :: SexpGrammar a -> SexpGrammar (NonEmpty a)
+nonempty a =
+  list (el a >>> rest a) >>>
+    pair >>> iso (uncurry (:|)) (\(x :| xs) -> (x, xs))
+
 letIso
   :: (forall t. Grammar Position (Sexp :- t) (a :- t))
   -> (forall t. Grammar Position (Sexp :- t) (b :- t))
-  -> Grammar Position (Sexp :- (List (a, b) :- t1)) t2
+  -> Grammar Position (Sexp :- (NonEmpty (a, b) :- t1)) t2
   -> Grammar Position (Sexp :- t1) t2
 letIso name rhs e = list (el (sym "let") >>> el bindings >>> el e)
   where
     -- bindings :: Grammar Position (Sexp :- _) (List (_, _) :- _)
-    bindings = list $ rest binding
+    bindings = nonempty binding
     binding :: Grammar Position (Sexp :- t) ((_, _) :- t)
     binding = list (el name >>> el rhs) >>> pair