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

it may not be perfection but it is progress

Browse Source
This commit is contained in:
crumbtoo
2024-02-26 18:18:02 -07:00
parent 6086402d4e
commit 57eeed17a3
4 changed files with 36 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
src/Core/Parse.y
View File

@@ -76,7 +76,8 @@ Eof : eof { () }
| error { () }
StandaloneProgram :: { Program Var }
StandaloneProgram : Program eof {% finishTyping $1 }
-- StandaloneProgram : Program eof { undefined }
StandaloneProgram : ProgramUgh eof { $1 }
Program :: { Program PsName }
Program : ScTypeSig ';' Program { insTypeSig ($1 & _1 %~ Left) $3 }
@@ -86,6 +87,12 @@ Program : ScTypeSig ';' Program { insTypeSig ($1 & _1 %~ Left) $
| TLPragma Program {% doTLPragma $1 $2 }
| TLPragma {% doTLPragma $1 mempty }
ProgramUgh :: { Program Var }
: TypedScDef ';' ProgramUgh
{ $3 & insTypeSigUgh (fst $1)
& insScDef (snd $1) }
| OptSemi { mempty }
TLPragma :: { Pragma }
: '{-#' Words '#-}' { Pragma $2 }
@@ -100,6 +107,10 @@ OptSemi : ';' { () }
ScTypeSig :: { (Name, Type) }
ScTypeSig : Id ':' Type { ($1, $3) }
TypedScDef :: { (Var, ScDef Var) }
: Id ':' Type ';' Id ParListUgh '=' Expr
{ (MkVar $1 $3, mkTypedScDef $1 $3 $5 $6 $8) }
ScDefs :: { [ScDef PsName] }
ScDefs : ScDef ';' ScDefs { $1 : $3 }
| ScDef ';' { [$1] }
@@ -120,6 +131,10 @@ Type1 : '(' Type ')' { $2 }
| varname { TyVar $1 }
| conname { TyCon $1 }
ParListUgh :: { [Name] }
ParListUgh : varname ParListUgh { $1 : $2 }
| {- epsilon -} { [] }
ParList :: { [PsName] }
ParList : varname ParList { Left $1 : $2 }
| {- epsilon -} { [] }
@@ -207,6 +222,9 @@ astPragma _ = undefined
insTypeSig :: (Hashable b) => (b, Type) -> Program b -> Program b
insTypeSig ts = programTypeSigs %~ uncurry H.insert ts
insTypeSigUgh :: Var -> Program Var -> Program Var
insTypeSigUgh w@(MkVar _ t) = programTypeSigs %~ H.insert w t
singletonTypeSig :: (Hashable b) => (b, Type) -> Program b
singletonTypeSig ts = insTypeSig ts mempty