remove unused fatal flag in parser

This commit is contained in:
2026-01-16 10:39:31 -08:00
parent a21dd2fd94
commit 77a052ca98
2 changed files with 20 additions and 38 deletions

View File

@@ -695,16 +695,3 @@ parseMod = do
decls <- manySame parseDecl decls <- manySame parseDecl
let name = joinBy "" (name :: rest) let name = joinBy "" (name :: rest)
pure $ MkModule name imports decls pure $ MkModule name imports decls
-- data ReplCmd =
-- Def Decl
-- | Norm Raw -- or just name?
-- | Check Raw
-- -- Eventually I'd like immediate actions in the file, like lean, but I
-- -- also want to REPL to work and we can do that first.
-- parseRepl : Parser ReplCmd
-- parseRepl = Def <$> parseDecl <|> Norm <$ keyword "#nf" <*> typeExpr
-- <|> Check <$ keyword "#check" <*> typeExpr

View File

@@ -16,12 +16,12 @@ TokenList = List BTok
data Result : U -> U where data Result : U -> U where
OK : a. a -> Bounds -> (toks : TokenList) -> (com : Bool) -> Operators -> Result a OK : a. a -> Bounds -> (toks : TokenList) -> (com : Bool) -> Operators -> Result a
Fail : a. Bool -> Error -> Bounds -> (toks : TokenList) -> (com : Bool) -> Operators -> Result a Fail : a. Error -> Bounds -> (toks : TokenList) -> (com : Bool) -> Operators -> Result a
instance Functor Result where instance Functor Result where
map f (OK a last toks com ops) = OK (f a) last toks com ops map f (OK a last toks com ops) = OK (f a) last toks com ops
map _ (Fail fatal err last toks com ops) = Fail fatal err last toks com ops map _ (Fail err last toks com ops) = Fail err last toks com ops
-- So sixty just has a newtype function here now (probably for perf). -- So sixty just has a newtype function here now (probably for perf).
-- A record might be more ergonomic, but would require a record impl before -- A record might be more ergonomic, but would require a record impl before
@@ -50,7 +50,7 @@ perror fn ((MkBounded val bnds) :: _) msg = E (MkFC fn bnds) msg
parse : a. String -> Parser a -> TokenList -> Either Error a parse : a. String -> Parser a -> TokenList -> Either Error a
parse fn pa toks = case runP pa emptyBounds toks False emptyMap (MkFC fn (MkBounds -1 -1 -1 -1)) of parse fn pa toks = case runP pa emptyBounds toks False emptyMap (MkFC fn (MkBounds -1 -1 -1 -1)) of
Fail fatal err last toks com ops => Left err Fail err last toks com ops => Left err
OK a _ Nil _ _ => Right a OK a _ Nil _ _ => Right a
OK a _ ts _ _ => Left (perror fn ts "Extra toks") OK a _ ts _ _ => Left (perror fn ts "Extra toks")
@@ -58,22 +58,17 @@ parse fn pa toks = case runP pa emptyBounds toks False emptyMap (MkFC fn (MkBoun
partialParse : a. String -> Parser a -> Operators -> TokenList -> Either (Error × TokenList) (a × Operators × TokenList) partialParse : a. String -> Parser a -> Operators -> TokenList -> Either (Error × TokenList) (a × Operators × TokenList)
partialParse fn pa ops toks = case runP pa emptyBounds toks False ops (emptyFC' fn) of partialParse fn pa ops toks = case runP pa emptyBounds toks False ops (emptyFC' fn) of
Fail fatal err last toks com ops => Left (err, toks) Fail err last toks com ops => Left (err, toks)
OK a last toks _ ops => Right (a,ops,toks) OK a last toks _ ops => Right (a,ops,toks)
try : a. Parser a -> Parser a try : a. Parser a -> Parser a
try (P pa) = P $ \last toks com ops col => case pa last toks com ops col of try (P pa) = P $ \last toks com ops col => case pa last toks com ops col of
(Fail x err last toks _ ops) => Fail x err last toks com ops (Fail err last toks _ ops) => Fail err last toks com ops
res => res res => res
fail : a. String -> Parser a fail : a. String -> Parser a
fail msg = P $ \last toks com ops col => Fail False (perror col.file toks msg) last toks com ops fail msg = P $ \last toks com ops col => Fail (perror col.file toks msg) last toks com ops
-- fatal : ∀ a. String -> Parser a
-- fatal msg = P $ \last toks com ops col => Fail True (perror col.file toks msg) last toks com ops
getOps : Parser (Operators) getOps : Parser (Operators)
getOps = P $ \last toks com ops col => OK ops last toks com ops getOps = P $ \last toks com ops col => OK ops last toks com ops
@@ -85,7 +80,7 @@ addOp nm prec fix = P $ \ last toks com ops col =>
case parts of case parts of
"" :: key :: rule => OK MkUnit last toks com (updateMap key (MkOp nm prec fix False rule) ops) "" :: key :: rule => OK MkUnit last toks com (updateMap key (MkOp nm prec fix False rule) ops)
key :: rule => OK MkUnit last toks com (updateMap key (MkOp nm prec fix True rule) ops) key :: rule => OK MkUnit last toks com (updateMap key (MkOp nm prec fix True rule) ops)
Nil => Fail False (perror col.file toks "Internal error parsing mixfix") last toks com ops Nil => Fail (perror col.file toks "Internal error parsing mixfix") last toks com ops
instance Functor Parser where instance Functor Parser where
map f (P pa) = P $ \ last toks com ops col => map f (pa last toks com ops col) map f (P pa) = P $ \ last toks com ops col => map f (pa last toks com ops col)
@@ -95,11 +90,11 @@ instance Applicative Parser where
return pa = P (\ last toks com ops col => OK pa last toks com ops) return pa = P (\ last toks com ops col => OK pa last toks com ops)
P pab <*> P pa = P $ \last toks com ops col => P pab <*> P pa = P $ \last toks com ops col =>
case pab last toks com ops col of case pab last toks com ops col of
Fail fatal err last toks com ops => Fail fatal err last toks com ops Fail err last toks com ops => Fail err last toks com ops
OK f last toks com ops => OK f last toks com ops =>
case pa last toks com ops col of case pa last toks com ops col of
(OK x last toks com ops) => OK (f x) last toks com ops (OK x last toks com ops) => OK (f x) last toks com ops
(Fail fatal err last toks com ops) => Fail fatal err last toks com ops (Fail err last toks com ops) => Fail err last toks com ops
-- Second argument lazy so we don't have circular refs when defining parsers. -- Second argument lazy so we don't have circular refs when defining parsers.
@@ -107,9 +102,9 @@ instance Alternative Parser where
(P pa) <|> (P pb) = P $ \last toks com ops col => (P pa) <|> (P pb) = P $ \last toks com ops col =>
case pa last toks False ops col of case pa last toks False ops col of
OK a last' toks' _ ops => OK a last' toks' com ops OK a last' toks' _ ops => OK a last' toks' com ops
Fail True err last' toks' com ops => Fail True err last' toks' com ops -- Fail err last' toks' com ops => Fail err last' toks' com ops
Fail fatal err last' toks' True ops => Fail fatal err last' toks' True ops Fail err last' toks' True ops => Fail err last' toks' True ops
Fail fatal err last' toks' False ops => pb last toks com ops col Fail err last' toks' False ops => pb last toks com ops col
instance Monad Parser where instance Monad Parser where
@@ -117,14 +112,14 @@ instance Monad Parser where
bind (P pa) pab = P $ \last toks com ops col => bind (P pa) pab = P $ \last toks com ops col =>
case pa last toks com ops col of case pa last toks com ops col of
(OK a last toks com ops) => runP (pab a) last toks com ops col (OK a last toks com ops) => runP (pab a) last toks com ops col
(Fail fatal err last toks x ops) => Fail fatal err last toks x ops (Fail err last toks x ops) => Fail err last toks x ops
satisfy : (BTok -> Bool) -> String -> Parser String satisfy : (BTok -> Bool) -> String -> Parser String
satisfy f msg = P $ \last toks com ops col => satisfy f msg = P $ \last toks com ops col =>
case toks of case toks of
(t :: ts) => if f t then OK (value t) t.bounds ts True ops else Fail False (perror col.file toks "\{msg} at \{show t.val.kind}:\{value t}") last toks com ops (t :: ts) => if f t then OK (value t) t.bounds ts True ops else Fail (perror col.file toks "\{msg} at \{show t.val.kind}:\{value t}") last toks com ops
Nil => Fail False (perror col.file toks "\{msg} at EOF") last toks com ops Nil => Fail (perror col.file toks "\{msg} at EOF") last toks com ops
some : a. Parser a -> Parser (List a) some : a. Parser a -> Parser (List a)
@@ -155,13 +150,13 @@ bounded : ∀ a. Parser a → Parser (WithBounds a)
bounded pa = P $ \last toks com ops indent => bounded pa = P $ \last toks com ops indent =>
case runP pa last toks com ops indent of case runP pa last toks com ops indent of
(OK a last toks' com ops) => (OK (MkBounded a (tokStart toks + last)) last toks' com ops) (OK a last toks' com ops) => (OK (MkBounded a (tokStart toks + last)) last toks' com ops)
(Fail fatal err last toks x ops) => Fail fatal err last toks x ops (Fail err last toks x ops) => Fail err last toks x ops
withFC : a. Parser a Parser (FC × a) withFC : a. Parser a Parser (FC × a)
withFC pa = P $ \last toks com ops indent => withFC pa = P $ \last toks com ops indent =>
case runP pa last toks com ops indent of case runP pa last toks com ops indent of
(OK a last toks' com ops) => OK ((MkFC indent.file $ tokStart toks + last), a) last toks' com ops (OK a last toks' com ops) => OK ((MkFC indent.file $ tokStart toks + last), a) last toks' com ops
(Fail fatal err last toks x ops) => Fail fatal err last toks x ops (Fail err last toks x ops) => Fail err last toks x ops
-- Start an indented block and run parser in it -- Start an indented block and run parser in it
@@ -185,8 +180,8 @@ sameLevel (P p) = P $ \last toks com ops indent => case toks of
let (tl,tc) = getStart t in let (tl,tc) = getStart t in
let (MkFC file (MkBounds line col _ _)) = indent in let (MkFC file (MkBounds line col _ _)) = indent in
if tc == col then p last toks com ops (MkFC file t.bounds) if tc == col then p last toks com ops (MkFC file t.bounds)
else if col < tc then Fail False (perror file toks "unexpected indent") last toks com ops else if col < tc then Fail (perror file toks "unexpected indent") last toks com ops
else Fail False (perror file toks "unexpected indent") last toks com ops else Fail (perror file toks "unexpected indent") last toks com ops
someSame : a. Parser a -> Parser (List a) someSame : a. Parser a -> Parser (List a)
someSame pa = some $ sameLevel pa someSame pa = some $ sameLevel pa
@@ -203,7 +198,7 @@ indented (P p) = P $ \last toks com ops indent => case toks of
(t :: _) => (t :: _) =>
let (tl,tc) = getStart t let (tl,tc) = getStart t
in if tc > fcCol indent || tl == fcLine indent then p last toks com ops indent in if tc > fcCol indent || tl == fcLine indent then p last toks com ops indent
else Fail False (perror indent.file toks "unexpected outdent") last toks com ops else Fail (perror indent.file toks "unexpected outdent") last toks com ops
-- expect token of given kind -- expect token of given kind