parser stuff
This commit is contained in:
parent
5b1dab24f2
commit
a26eba7d7f
5 changed files with 37 additions and 11 deletions
|
@ -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
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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]
|
||||||
|
|
||||||
|
|
|
@ -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],
|
||||||
|
|
|
@ -128,10 +128,17 @@ tests = "parser" :- [
|
||||||
trejects = rejectsNote tgrm " (term)"
|
trejects = rejectsNote tgrm " (term)"
|
||||||
erejects = rejectsNote egrm " (elim)"
|
erejects = rejectsNote egrm " (elim)"
|
||||||
in [
|
in [
|
||||||
eparses "a" (F "a"),
|
"universes" :- [
|
||||||
eparses "x" (BV 2),
|
tparses "★0" (TYPE 0),
|
||||||
trejects "a",
|
tparses "★1000" (TYPE 1000)
|
||||||
tparses "[a]" (FT "a"),
|
],
|
||||||
tparses "[x]" (BVT 2)
|
|
||||||
|
"variables" :- [
|
||||||
|
eparses "a" (F "a"),
|
||||||
|
eparses "x" (BV 2),
|
||||||
|
trejects "a",
|
||||||
|
tparses "[a]" (FT "a"),
|
||||||
|
tparses "[x]" (BVT 2)
|
||||||
|
]
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|
Loading…
Reference in a new issue