From 980fbbb0333047d814dcb6ae1ae4067526257f5d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Thu, 7 May 2026 07:31:33 -0600 Subject: [PATCH] --- app/Gyehoek/ANF.hs | 10 +++------- app/Gyehoek/Syntax.hs | 12 +++++++++--- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/app/Gyehoek/ANF.hs b/app/Gyehoek/ANF.hs index b34d174..9a51f3e 100644 --- a/app/Gyehoek/ANF.hs +++ b/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' diff --git a/app/Gyehoek/Syntax.hs b/app/Gyehoek/Syntax.hs index e0344bf..f949ee5 100644 --- a/app/Gyehoek/Syntax.hs +++ b/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