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

now we're fucking GETTING SOMEWHERE

Browse Source
This commit is contained in:
crumbtoo
2024-01-15 14:58:26 -07:00
parent 1c035d092a
commit a1a50bd013
7 changed files with 169 additions and 620 deletions
Download Patch File Download Diff File Expand all files Collapse all files

78
src/Rlp/Parse.y
View File

@@ -1,18 +1,19 @@
{
module Rlp.Parse
( parseRlpProgram
, parseTest
)
where
import Rlp.Lex
import Rlp.Syntax
import Rlp.Parse.Types
import Rlp.Parse.Associate
import Lens.Micro.Mtl
import Data.List.Extra
import Data.Fix
import Data.Functor.Const
}
%name parseRlpProgram StandaloneProgram
%name parseTest VL
%monad { P }
%lexer { lexDebug } { Located _ TokenEOF }
@@ -27,17 +28,22 @@ import Data.Functor.Const
'=' { Located _ TokenEquals }
'|' { Located _ TokenPipe }
';' { Located _ TokenSemicolon }
'(' { Located _ TokenLParen }
')' { Located _ TokenRParen }
'->' { Located _ TokenArrow }
vsemi { Located _ TokenSemicolonV }
'{' { Located _ TokenLBrace }
'}' { Located _ TokenRBrace }
vlbrace { Located _ TokenLBraceV }
vrbrace { Located _ TokenRBraceV }
%right '->'
%%
StandaloneProgram :: { [PartialDecl'] }
StandaloneProgram : '{' Decls '}' { $2 }
| VL Decls VR { $2 }
StandaloneProgram :: { RlpProgram' }
StandaloneProgram : '{' Decls '}' {% mkProgram $2 }
| VL DeclsV VR {% mkProgram $2 }
VL :: { () }
VL : vlbrace { () }
@@ -47,12 +53,14 @@ VR : vrbrace { () }
| error { () }
Decls :: { [PartialDecl'] }
Decls : Decl VS Decls { $1 : $3 }
| Decl VS { [$1] }
Decls : Decl ';' Decls { $1 : $3 }
| Decl ';' { [$1] }
| Decl { [$1] }
Semi :: { Located RlpToken }
Semi : ';' { $1 }
DeclsV :: { [PartialDecl'] }
DeclsV : Decl VS Decls { $1 : $3 }
| Decl VS { [$1] }
| Decl { [$1] }
VS :: { Located RlpToken }
VS : ';' { $1 }
@@ -60,22 +68,66 @@ VS : ';' { $1 }
Decl :: { PartialDecl' }
Decl : FunDecl { $1 }
| DataDecl { $1 }
DataDecl :: { PartialDecl' }
: data Con TyParams '=' DataCons { DataD $2 $3 $5 }
TyParams :: { [Name] }
: {- epsilon -} { [] }
| TyParams varname { $1 `snoc` $2 }
DataCons :: { [ConAlt] }
: DataCons '|' DataCon { $1 `snoc` $3 }
| DataCon { [$1] }
DataCon :: { ConAlt }
: Con Type1s { ConAlt $1 $2 }
Type1s :: { [Type] }
: {- epsilon -} { [] }
| Type1s Type1 { $1 `snoc` $2 }
Type1 :: { Type }
: '(' Type ')' { $2 }
| conname { TyCon $1 }
| varname { TyVar $1 }
Type :: { Type }
: Type '->' Type { $1 :-> $3 }
| Type1 { $1 }
FunDecl :: { PartialDecl' }
FunDecl : Var '=' Expr { FunD $1 [] (Const $3) Nothing }
FunDecl : Var Params '=' Expr { FunD $1 $2 (Const $4) Nothing }
Params :: { [Pat'] }
Params : {- epsilon -} { [] }
| Params Pat1 { $1 `snoc` $2 }
Pat1 :: { Pat' }
: Var { VarP $1 }
| Lit { LitP $1 }
Expr :: { PartialExpr' }
Expr : Literal { Fix . E $ LitEF $1 }
Expr : Lit { Fix . E $ LitEF $1 }
| Var { Fix . E $ VarEF $1 }
Literal :: { Lit' }
Literal : litint { IntL $1 }
Lit :: { Lit' }
Lit : litint { IntL $1 }
Var :: { VarId }
Var : varname { NameVar $1 }
Con :: { ConId }
: conname { NameCon $1 }
{
mkProgram :: [PartialDecl'] -> P RlpProgram'
mkProgram ds = do
pt <- use psOpTable
pure $ RlpProgram (associate pt <$> ds)
parseError :: Located RlpToken -> P a
parseError = error . show