msyds/rlp
1
0
Fork 0
Code Issues 4 Pull Requests Actions Packages Projects Releases 2 Wiki Activity

parse

Browse Source
This commit is contained in:
crumbtoo
2024-02-27 05:12:19 -07:00
parent d60bd86842
commit 1315ea7ea8
1 changed files with 29 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
src/Core/Parse.y
View File

@@ -76,23 +76,16 @@ Eof : eof { () }
| error { () } | error { () }
StandaloneProgram :: { Program Var } StandaloneProgram :: { Program Var }
-- StandaloneProgram : Program eof { undefined } StandaloneProgram : Program eof { $1 }
StandaloneProgram : ProgramUgh eof { $1 }
Program :: { Program PsName } Program :: { Program Var }
Program : ScTypeSig ';' Program { insTypeSig ($1 & _1 %~ Left) $3 } : TypedScDef ';' Program { $3 & insTypeSig (fst $1)
| ScTypeSig OptSemi { singletonTypeSig ($1 & _1 %~ Left) } & insScDef (snd $1) }
| ScDef ';' Program { insScDef $1 $3 } | TypedScDef OptSemi { mempty & insTypeSig (fst $1)
| ScDef OptSemi { singletonScDef $1 } & insScDef (snd $1) }
| TLPragma Program {% doTLPragma $1 $2 } | TLPragma Program {% doTLPragma $1 $2 }
| TLPragma {% doTLPragma $1 mempty } | TLPragma {% doTLPragma $1 mempty }
ProgramUgh :: { Program Var }
: TypedScDef ';' ProgramUgh
{ $3 & insTypeSigUgh (fst $1)
& insScDef (snd $1) }
| OptSemi { mempty }
TLPragma :: { Pragma } TLPragma :: { Pragma }
: '{-#' Words '#-}' { Pragma $2 } : '{-#' Words '#-}' { Pragma $2 }
@@ -108,17 +101,17 @@ ScTypeSig :: { (Name, Type) }
ScTypeSig : Id ':' Type { ($1, $3) } ScTypeSig : Id ':' Type { ($1, $3) }
TypedScDef :: { (Var, ScDef Var) } TypedScDef :: { (Var, ScDef Var) }
: Id ':' Type ';' Id ParListUgh '=' Expr : Id ':' Type ';' Id ParList '=' Expr
{ (MkVar $1 $3, mkTypedScDef $1 $3 $5 $6 $8) } { (MkVar $1 $3, mkTypedScDef $1 $3 $5 $6 $8) }
ScDefs :: { [ScDef PsName] } -- ScDefs :: { [ScDef PsName] }
ScDefs : ScDef ';' ScDefs { $1 : $3 } -- ScDefs : ScDef ';' ScDefs { $1 : $3 }
| ScDef ';' { [$1] } -- | ScDef ';' { [$1] }
| ScDef { [$1] } -- | ScDef { [$1] }
--
ScDef :: { ScDef PsName } -- ScDef :: { ScDef PsName }
ScDef : Id ParList '=' Expr { ScDef (Left $1) $2 -- ScDef : Id ParList '=' Expr { ScDef (Left $1) $2
($4 & binders %~ Right) } -- ($4 & binders %~ Right) }
Type :: { Type } Type :: { Type }
: Type1 '->' Type { $1 :-> $3 } : Type1 '->' Type { $1 :-> $3 }
@@ -131,12 +124,8 @@ Type1 : '(' Type ')' { $2 }
| varname { TyVar $1 } | varname { TyVar $1 }
| conname { TyCon $1 } | conname { TyCon $1 }
ParListUgh :: { [Name] } ParList :: { [Name] }
ParListUgh : varname ParListUgh { $1 : $2 } ParList : varname ParList { $1 : $2 }
| {- epsilon -} { [] }
ParList :: { [PsName] }
ParList : varname ParList { Left $1 : $2 }
| {- epsilon -} { [] } | {- epsilon -} { [] }
StandaloneExpr :: { Expr Var } StandaloneExpr :: { Expr Var }
@@ -219,20 +208,20 @@ exprPragma _ = undefined
astPragma :: [String] -> RLPC (Expr Var) astPragma :: [String] -> RLPC (Expr Var)
astPragma _ = undefined astPragma _ = undefined
insTypeSig :: (Hashable b) => (b, Type) -> Program b -> Program b -- insTypeSig :: (Hashable b) => (b, Type) -> Program b -> Program b
insTypeSig ts = programTypeSigs %~ uncurry H.insert ts -- insTypeSig ts = programTypeSigs %~ uncurry H.insert ts
insTypeSigUgh :: Var -> Program Var -> Program Var insTypeSig :: Var -> Program Var -> Program Var
insTypeSigUgh w@(MkVar _ t) = programTypeSigs %~ H.insert w t insTypeSig w@(MkVar _ t) = programTypeSigs %~ H.insert w t
singletonTypeSig :: (Hashable b) => (b, Type) -> Program b -- singletonTypeSig :: (Hashable b) => (b, Type) -> Program b
singletonTypeSig ts = insTypeSig ts mempty -- singletonTypeSig ts = insTypeSig ts mempty
insScDef :: (Hashable b) => ScDef b -> Program b -> Program b insScDef :: (Hashable b) => ScDef b -> Program b -> Program b
insScDef sc = programScDefs %~ (sc:) insScDef sc = programScDefs %~ (sc:)
singletonScDef :: (Hashable b) => ScDef b -> Program b -- singletonScDef :: (Hashable b) => ScDef b -> Program b
singletonScDef sc = insScDef sc mempty -- singletonScDef sc = insScDef sc mempty
parseCoreExprR :: (Monad m) => [Located CoreToken] -> RLPCT m (Expr Var) parseCoreExprR :: (Monad m) => [Located CoreToken] -> RLPCT m (Expr Var)
parseCoreExprR = liftMaybe . snd . flip runP def . parseCoreExpr parseCoreExprR = liftMaybe . snd . flip runP def . parseCoreExpr
@@ -257,7 +246,7 @@ happyBind m k = m >>= k
happyPure :: a -> RLPC a happyPure :: a -> RLPC a
happyPure a = pure a happyPure a = pure a
doTLPragma :: Pragma -> Program PsName -> P (Program PsName) doTLPragma :: Pragma -> Program Var -> P (Program Var)
-- TODO: warn unrecognised pragma -- TODO: warn unrecognised pragma
doTLPragma (Pragma []) p = pure p doTLPragma (Pragma []) p = pure p