From e93548963a2eea7b3b824147a3a45b7b7c2b7430 Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Fri, 8 Mar 2024 16:28:40 -0700
Subject: [PATCH] parse lambda

---
 src/Rlp/AltParse.y       | 9 ++++++++-
 src/Rlp/HindleyMilner.hs | 4 +++-
 src/Rlp/Lex.x            | 1 +
 3 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/src/Rlp/AltParse.y b/src/Rlp/AltParse.y
index 7499ad1..fd4f1e5 100644
--- a/src/Rlp/AltParse.y
+++ b/src/Rlp/AltParse.y
@@ -45,6 +45,7 @@ import Core.Syntax              qualified as Core
     '|'             { Located _ TokenPipe }
     '::'            { Located _ TokenHasType }
     ';'             { Located _ TokenSemicolon }
+    'λ'             { Located _ TokenLambda }
     '('             { Located _ TokenLParen }
     ')'             { Located _ TokenRParen }
     '->'            { Located _ TokenArrow }
@@ -118,7 +119,7 @@ AppT                :: { Type PsName }
 
 TyVars              :: { [PsName] }
                     : list0(varname)     { $1 <&> view ( to extract
-                                                       . singular _TokenVarName) }
+                                                       . singular _TokenVarName ) }
 
 FunD                :: { Decl PsName (RlpExpr PsName) }
                     : Var Pat1s '=' Expr    { FunD $1 $2 $4 }
@@ -128,6 +129,10 @@ Expr                :: { RlpExpr PsName }
                     | LetE                  { $1 }
                     | CaseE                 { $1 }
                     | Expr1                 { $1 }
+                    | LamE                  { $1 }
+
+LamE                :: { RlpExpr PsName }
+                    : 'λ' list0(varname) '->' Expr { Finl $ Core.LamF (fmap extractName $2) $4 }
 
 CaseE               :: { RlpExpr PsName }
                     : case Expr of CaseAlts { Finr $ CaseEF $2 $4 }
@@ -222,4 +227,6 @@ parseRlpExprR s = liftErrorful $ errorful (ma,es)
 
 parseError = error "explode"
 
+extractName = view $ to extract . singular _TokenVarName
+
 }
diff --git a/src/Rlp/HindleyMilner.hs b/src/Rlp/HindleyMilner.hs
index 6c8a92b..8f05712 100644
--- a/src/Rlp/HindleyMilner.hs
+++ b/src/Rlp/HindleyMilner.hs
@@ -70,7 +70,6 @@ instance IsRlpcError TypeError where
 -- throw any number of fatal or nonfatal errors. Run with @runErrorful@.
 type HMError = Errorful TypeError
 
-infer = undefined
 check = undefined
 
 fixCofree :: (Functor f, Functor g)
@@ -164,6 +163,9 @@ solve :: [Constraint] -> Maybe Subst
 solve = foldM go mempty where
     go s (Equality a b) = applySubst s a `mgu` applySubst s b
 
+infer :: RlpExpr PsName -> Cofree (RlpExprF PsName) (Type PsName)
+infer = undefined
+
 demoContext :: Context'
 demoContext = H.fromList
     [ ("id", ForallT "a" $ VarT "a" :-> VarT "a")
diff --git a/src/Rlp/Lex.x b/src/Rlp/Lex.x
index 88380e3..1d32914 100644
--- a/src/Rlp/Lex.x
+++ b/src/Rlp/Lex.x
@@ -170,6 +170,7 @@ lexReservedOp = \case
     ":"     -> TokenHasType
     "|"     -> TokenPipe
     "->"    -> TokenArrow
+    "\\"    -> TokenLambda
     s       -> error (show s)
 
 -- | @andBegin@, with the subtle difference that the start code is set