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

src/Parser/Parse.idr

@@ -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 [])

tests/fin.pi

@@ -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