parser stuff

This commit is contained in:
rhiannon morris 2022-05-09 18:31:30 +02:00
parent 5b1dab24f2
commit a26eba7d7f
5 changed files with 37 additions and 11 deletions

View file

@ -83,12 +83,12 @@ tokens = choice [
keyword "case" Case, keyword "of" Of, keyword "case" Case, keyword "of" Of,
keyword "ω" Omega, keyword "ω" Omega,
keyword "Π" Pi, keyword "Σ" Sigma, keyword "W" W, keyword "Π" Pi, keyword "Σ" Sigma, keyword "W" W,
simple '' $ K TYPE,
match name $ Name, match name $ Name,
match symbol $ Symbol . assert_total strTail, match symbol $ Symbol . assert_total strTail,
match decimal $ N . natToNumber . cast match decimal $ N . natToNumber . cast,
match (is '' <+> decimal) $ TYPE . cast . assert_total strTail
] ]

View file

@ -45,14 +45,23 @@ lexParseAll grm = lex' >=> parseAll grm
export
punc : Punc -> Grammar True () punc : Punc -> Grammar True ()
punc p = terminal (show p) $ \case punc p = terminal (show p) $ \case
P p' => if p == p' then Just () else Nothing P p' => if p == p' then Just () else Nothing
_ => Nothing _ => Nothing
export
keyword : Keyword -> Grammar True ()
keyword k = terminal (show k) $ \case
K k' => if k == k' then Just () else Nothing
_ => Nothing
export
between : Punc -> Punc -> Grammar True a -> Grammar True a between : Punc -> Punc -> Grammar True a -> Grammar True a
between opener closer inner = punc opener *> inner <* punc closer between opener closer inner = punc opener *> inner <* punc closer
export
parens, squares, braces : Grammar True a -> Grammar True a parens, squares, braces : Grammar True a -> Grammar True a
parens = between LParen RParen parens = between LParen RParen
squares = between LSquare RSquare squares = between LSquare RSquare
@ -67,6 +76,11 @@ number = terminal "number" $ \case
N (Other k) => Just k N (Other k) => Just k
_ => Nothing _ => Nothing
export
universe : Grammar True Nat
universe = terminal "universe" $ \case TYPE k => Just k; _ => Nothing
export
zero, one, omega : Grammar True () zero, one, omega : Grammar True ()
zero = terminal "0" $ \case N Zero => Just (); _ => Nothing zero = terminal "0" $ \case N Zero => Just (); _ => Nothing
one = terminal "1" $ \case N One => Just (); _ => Nothing one = terminal "1" $ \case N One => Just (); _ => Nothing
@ -137,6 +151,7 @@ mutual
term : (dvars : Vars d) -> (tvars : Vars n) -> Grammar True (Term d n) term : (dvars : Vars d) -> (tvars : Vars n) -> Grammar True (Term d n)
term dvars tvars = term dvars tvars =
E <$> squares (elim {dvars, tvars}) E <$> squares (elim {dvars, tvars})
<|> TYPE . U <$> universe
export export
elim : (dvars : Vars d) -> (tvars : Vars n) -> Grammar True (Elim d n) elim : (dvars : Vars d) -> (tvars : Vars n) -> Grammar True (Elim d n)

View file

@ -25,7 +25,7 @@ data Punc
public export public export
data Keyword data Keyword
= Lam | Let | In | Case | Of | Omega = Lam | Let | In | Case | Of | Omega
| Pi | Sigma | W | TYPE | Pi | Sigma | W
%runElab derive "Keyword" [Generic, Meta, Eq, Ord, DecEq, Show] %runElab derive "Keyword" [Generic, Meta, Eq, Ord, DecEq, Show]
@ -41,9 +41,9 @@ data Number = Zero | One | Other Nat
public export public export
data Token data Token
= P Punc = P Punc
| Name String | Symbol String
| N Number
| K Keyword | K Keyword
| Name String | Symbol String
| N Number | TYPE Nat
%runElab derive "Token" [Generic, Meta, Eq, Ord, DecEq, Show] %runElab derive "Token" [Generic, Meta, Eq, Ord, DecEq, Show]

View file

@ -127,10 +127,14 @@ tests = "lexer" :- [
acceptsWith' "Π" [K Pi], acceptsWith' "Π" [K Pi],
acceptsWith' "Σ" [K Sigma], acceptsWith' "Σ" [K Sigma],
acceptsWith' "W" [K W], acceptsWith' "W" [K W],
acceptsWith' "" [K TYPE],
acceptsWith' "WAAA" [Name "WAAA"] acceptsWith' "WAAA" [Name "WAAA"]
], ],
"universes" :- [
acceptsWith' "★10" [TYPE 10],
rejects' ""
],
"numbers" :- [ "numbers" :- [
acceptsWith' "0" [N Zero], acceptsWith' "0" [N Zero],
acceptsWith' "1" [N One], acceptsWith' "1" [N One],

View file

@ -128,10 +128,17 @@ tests = "parser" :- [
trejects = rejectsNote tgrm " (term)" trejects = rejectsNote tgrm " (term)"
erejects = rejectsNote egrm " (elim)" erejects = rejectsNote egrm " (elim)"
in [ in [
"universes" :- [
tparses "★0" (TYPE 0),
tparses "★1000" (TYPE 1000)
],
"variables" :- [
eparses "a" (F "a"), eparses "a" (F "a"),
eparses "x" (BV 2), eparses "x" (BV 2),
trejects "a", trejects "a",
tparses "[a]" (FT "a"), tparses "[a]" (FT "a"),
tparses "[x]" (BVT 2) tparses "[x]" (BVT 2)
] ]
]
] ]