parse lambda

This commit is contained in:
crumbtoo
2024-03-08 16:28:40 -07:00
parent 215feb433b
commit e93548963a
3 changed files with 12 additions and 2 deletions

View File

@@ -45,6 +45,7 @@ import Core.Syntax qualified as Core
'|' { Located _ TokenPipe } '|' { Located _ TokenPipe }
'::' { Located _ TokenHasType } '::' { Located _ TokenHasType }
';' { Located _ TokenSemicolon } ';' { Located _ TokenSemicolon }
'λ' { Located _ TokenLambda }
'(' { Located _ TokenLParen } '(' { Located _ TokenLParen }
')' { Located _ TokenRParen } ')' { Located _ TokenRParen }
'->' { Located _ TokenArrow } '->' { Located _ TokenArrow }
@@ -118,7 +119,7 @@ AppT :: { Type PsName }
TyVars :: { [PsName] } TyVars :: { [PsName] }
: list0(varname) { $1 <&> view ( to extract : list0(varname) { $1 <&> view ( to extract
. singular _TokenVarName) } . singular _TokenVarName ) }
FunD :: { Decl PsName (RlpExpr PsName) } FunD :: { Decl PsName (RlpExpr PsName) }
: Var Pat1s '=' Expr { FunD $1 $2 $4 } : Var Pat1s '=' Expr { FunD $1 $2 $4 }
@@ -128,6 +129,10 @@ Expr :: { RlpExpr PsName }
| LetE { $1 } | LetE { $1 }
| CaseE { $1 } | CaseE { $1 }
| Expr1 { $1 } | Expr1 { $1 }
| LamE { $1 }
LamE :: { RlpExpr PsName }
: 'λ' list0(varname) '->' Expr { Finl $ Core.LamF (fmap extractName $2) $4 }
CaseE :: { RlpExpr PsName } CaseE :: { RlpExpr PsName }
: case Expr of CaseAlts { Finr $ CaseEF $2 $4 } : case Expr of CaseAlts { Finr $ CaseEF $2 $4 }
@@ -222,4 +227,6 @@ parseRlpExprR s = liftErrorful $ errorful (ma,es)
parseError = error "explode" parseError = error "explode"
extractName = view $ to extract . singular _TokenVarName
} }

View File

@@ -70,7 +70,6 @@ instance IsRlpcError TypeError where
-- throw any number of fatal or nonfatal errors. Run with @runErrorful@. -- throw any number of fatal or nonfatal errors. Run with @runErrorful@.
type HMError = Errorful TypeError type HMError = Errorful TypeError
infer = undefined
check = undefined check = undefined
fixCofree :: (Functor f, Functor g) fixCofree :: (Functor f, Functor g)
@@ -164,6 +163,9 @@ solve :: [Constraint] -> Maybe Subst
solve = foldM go mempty where solve = foldM go mempty where
go s (Equality a b) = applySubst s a `mgu` applySubst s b 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 :: Context'
demoContext = H.fromList demoContext = H.fromList
[ ("id", ForallT "a" $ VarT "a" :-> VarT "a") [ ("id", ForallT "a" $ VarT "a" :-> VarT "a")

View File

@@ -170,6 +170,7 @@ lexReservedOp = \case
":" -> TokenHasType ":" -> TokenHasType
"|" -> TokenPipe "|" -> TokenPipe
"->" -> TokenArrow "->" -> TokenArrow
"\\" -> TokenLambda
s -> error (show s) s -> error (show s)
-- | @andBegin@, with the subtle difference that the start code is set -- | @andBegin@, with the subtle difference that the start code is set