removed backtracking behaviour of tarr, parser is ~400x faster now

This commit is contained in:
Rachel Lambda Samuelsson 2022-07-28 04:24:48 +02:00
parent 60954c21c3
commit 1560c7ce8f
2 changed files with 25 additions and 18 deletions

View File

@ -2,6 +2,7 @@ module Parser.Parse
import Text.Lexer
import Text.Parser
import Text.Parser.Core
import Data.Vect
import Data.List
@ -25,6 +26,8 @@ data PiTokenKind
| PTComma
| PTLParen
| PTRParen
| PTLBracket
| PTRBracket
| PTColon
| PTLet
| PTDefEq
@ -55,6 +58,8 @@ Eq PiTokenKind where
(==) PTComma PTComma = True
(==) PTLParen PTLParen = True
(==) PTRParen PTRParen = True
(==) PTLBracket PTLBracket = True
(==) PTRBracket PTRBracket = True
(==) PTColon PTColon = True
(==) PTLet PTLet = True
(==) PTDefEq PTDefEq = True
@ -86,6 +91,8 @@ Show PiTokenKind where
show PTComma = "PTComma"
show PTLParen = "PTLParen"
show PTRParen = "PTRParen"
show PTLBracket = "PTLBracket"
show PTRBracket = "PTRBracket"
show PTColon = "PTColon"
show PTLet = "PTLet"
show PTDefEq = "PTDefEq"
@ -126,6 +133,8 @@ TokenKind PiTokenKind where
tokValue PTComma _ = ()
tokValue PTLParen _ = ()
tokValue PTRParen _ = ()
tokValue PTLBracket _ = ()
tokValue PTRBracket _ = ()
tokValue PTColon _ = ()
tokValue PTLet _ = ()
tokValue PTDefEq _ = ()
@ -180,6 +189,8 @@ tokenmap = [
(is ',', PTComma),
(is '(', PTLParen),
(is ')', PTRParen),
(is '', PTLBracket),
(is '', PTRBracket),
(is ':', PTColon),
(is '', PTDefEq),
(is '', PTTop),
@ -214,10 +225,9 @@ mutual
expr : List String -> (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
expr defs n env = tpi defs n env
<|> tsigma defs n env
<|> tarr defs n env
<|> (do
e <- expr1 defs n env
tapp defs n env e <|> pure e)
tarr defs n env e <|> tapp defs n env e <|> pure e)
expr1 : List String -> (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
@ -277,9 +287,7 @@ mutual
tnat = match PTNat >> pure TNat
tnum : Grammar () PiToken True (Term n)
tnum = do
n <- match PTNum
pure (conv n)
tnum = match PTNum >>= pure . conv
where
conv : Nat -> Term n
conv 0 = TZero
@ -314,12 +322,12 @@ mutual
tpair : List String -> (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tpair defs n env = do
match PTLParen
match PTLBracket
commit
x <- expr defs n env
match PTComma
commit
y <- expr defs n env
match PTRParen
match PTRBracket
pure (TPair x y)
tsigind : List String -> (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
@ -394,9 +402,8 @@ mutual
b <- expr defs (S n) (arg :: env)
pure (TPi a b)
tarr : List String -> (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tarr defs n env = do
l <- expr1 defs n env
tarr : List String -> (n : Nat) -> Vect n String -> Term n -> Grammar () PiToken True (Term n)
tarr defs n env l = do
match PTArrow
commit
r <- expr defs (S n) ("" :: env)
@ -451,20 +458,20 @@ parsePi defs parseEntry toks =
public export
parse : List String -> Grammar () PiToken True a -> String -> Either String a
parse defs parseEntry x =
parseD : List String -> Grammar () PiToken True a -> String -> Either String a
parseD defs parseEntry x =
case lexPi x of
Just toks => parsePi defs parseEntry toks
Nothing => Left "Failed to lex."
public export
parse0 : String -> Either String (Term 0)
parse0 = parse [] (expr [] 0 [])
parse0 = parseD [] (expr [] 0 [])
public export
parseEnv : List String -> String -> Either String (Term 0)
parseEnv defs = parse defs (expr defs 0 [])
parseEnv defs = parseD defs (expr defs 0 [])
public export
toplevel : String -> Either String (List String, List (Term 0, Term 0))
toplevel = parse [] (definitions [])
toplevel = parseD [] (definitions [])

View File

@ -10,10 +10,10 @@ let bool : Type
≔ fin 2
let false : bool
(0, ★)
⟨0, ★⟩
let true : bool
(1, ★)
⟨1, ★⟩
{-
let boolind : Π (C : bool → Type) C false → C true → Π (b : bool) C b