ref: babfc4330d44ac59cb99f0fe3b2b128443e06fa8
parent: f4695cf81d14743d25f7506bfbe18e6452693646
author: Lennart Augustsson <lennart@augustsson.net>
date: Sun Aug 27 12:52:12 EDT 2023
Make parser error contain last token.
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.1
-694
-(($A :0 ((_517 _471) ((($S' ($C ((($C' ($S' _517)) ($C _2)) (($B ($B (_517 _545))) ((($C' ($S' $C)) ((($C' ($C' $C)) ((($C' ($C' ($C' $S'))) (($B ($B ($B $C))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($S' $B))))) ((($C' ($C' ($C' ($C' ($C' $S))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' ($C' $B)))))) ((($C' ($C' ($C' ($S' ($C' $B))))) (($B ($B ($B ($B ($B $B))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) (($B $B) (($B $B) (($B $C') (($B ($S' _518)) ((($C' $B) (($B _605) (($B _535) ((($C' _643) _8) 0)))) (($B (_605 _538)) (($B (_550 "top level defns: ")) _499)))))))) ((($S' $B) (($B $B) (($B ($C' $B)) (($B ($B $B)) (($B ($B _518)) ((($C' $B) (($B _605) (($B _535) ((($C' _643) _8) 1)))) (_534 ($T (($B ($B (_605 _538))) ((($C' $B) _550) (($B (_550 " = ")) _367))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _518))) ((($C' $B) (($B $B) (($B _605) (($B _540) _11)))) (($B ($B (_550 _1))) (($B (($C' _550) _499)) (_550 (($O 10) $K))))))) (($B ($B (_517 _545))) ((($C' $B) (($B $B) (($B _605) (($B _535) ((($C' _643) _8) 0))))) (($B ($B (_605 _538))) (($B ($B (_550 "final pass "))) ((($C' ($C' _550)) (($B ($B (_512 6))) (($B ($B _499)) _637))) "ms")))))))) _3)))) _496))) (($B (($C' $C) (($B ($C _555)) _367))) (($C _568) (_585 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B ($B ($B (_550 "(($A :"))))) (($B ($B (($C' $B) (($B _550) _499)))) (($B ($B ($B (_550 (($O 32) $K))))) ((($C' $B) (($B ($C' _550)) ($B _367))) (($B (_550 ") ")) (($C _550) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _344)) $I))) ($BK $K))) $K))))) $T)) (($B (($S' _605) (($B _602) (($B (_605 _652)) (($B (_550 "main: findIdent: ")) _443))))) ($C _489)))) (($B ($B _493)) (($B (($C' _552) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B ($C $P))) $K)))))) (($C _568) (_585 0)))))) (($B (_605 _343)) (($B (_550 (($O 95) $K))) _499))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _567) (_554 (_510 "-v")))) ((_584 _510) "-r"))) (($B (_548 (($O 46) $K))) (($B _604) (_553 ((_572 _628) "-i")))))) (($B (_605 _579)) ((($C' _550) (($B _604) (_553 ((_572 _628) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _639) _567) 1)) (_652 "Usage: uhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _579)) (_554 ((_606 _648) ((_606 (_510 (($O 45) $K))) (_565 1)))))))) (($A :1 "v3.1\10&") (($A :2 ((($S' ($S' _517)) _16) (($B ($B ($B (_517 _545)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _518) (($B (_605 _536)) (($B (_605 (_566 1000000))) _170)))))) (($B ($B ($B ($B (_517 _545))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _518))) ((($C' $B) (($B $B) (($B _605) (($B _535) ((($C' _643) _8) 0))))) (($B ($B (_605 _538))) (($B ($B (_550 "combinator conversion "))) ((($C' ($C' _550)) (($B ($B (_512 6))) (($B ($B _499)) _637))) "ms"))))))) (($B ($B _519)) (($B $P) (($C _395) "main"))))))) (_552 ($T ((($C' ($C' $O)) ((($C' $B) $P) _370)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_605 _6)))) ($C $C))) (($B ($B $Y)) (($B ($B ($B _337))) (($C' ($C' _552)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _605) (($B _602) (($B (_605 _652)) (_550 "not found "))))) ($C _338))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _369))) (($B (_605 (_602 (_652 "primlookup")))) (($C (_588 _510)) _5))))) (_652 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "S'") $S')) (($O (($P (($O 80) $K)) $P)) (($O (($P (($O 73) $K)) $I)) (($O (($P (($O 83) $K)) $S)) (($O (($P (($O 84) $K)) $T)) (($O (($P (($O 89) $K)) $Y)) (($O (($P "B'") $B')) (($O (($P "BK") $BK)) (($O (($P (($O 43) $K)) $+)) (($O (($P (($O 45) $K
\ No newline at end of file
+695
+(($A :0 ((_518 _472) ((($S' ($C ((($C' ($S' _518)) ($C _2)) (($B ($B (_518 _546))) ((($C' ($S' $C)) ((($C' ($C' $C)) ((($C' ($C' ($C' $S'))) (($B ($B ($B $C))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($S' $B))))) ((($C' ($C' ($C' ($C' ($C' $S))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' ($C' $B)))))) ((($C' ($C' ($C' ($S' ($C' $B))))) (($B ($B ($B ($B ($B $B))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) (($B $B) (($B $B) (($B $C') (($B ($S' _519)) ((($C' $B) (($B _606) (($B _536) ((($C' _644) _8) 0)))) (($B (_606 _539)) (($B (_551 "top level defns: ")) _500)))))))) ((($S' $B) (($B $B) (($B ($C' $B)) (($B ($B $B)) (($B ($B _519)) ((($C' $B) (($B _606) (($B _536) ((($C' _644) _8) 1)))) (_535 ($T (($B ($B (_606 _539))) ((($C' $B) _551) (($B (_551 " = ")) _368))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _519))) ((($C' $B) (($B $B) (($B _606) (($B _541) _11)))) (($B ($B (_551 _1))) (($B (($C' _551) _500)) (_551 (($O 10) $K))))))) (($B ($B (_518 _546))) ((($C' $B) (($B $B) (($B _606) (($B _536) ((($C' _644) _8) 0))))) (($B ($B (_606 _539))) (($B ($B (_551 "final pass "))) ((($C' ($C' _551)) (($B ($B (_513 6))) (($B ($B _500)) _638))) "ms")))))))) _3)))) _497))) (($B (($C' $C) (($B ($C _556)) _368))) (($C _569) (_586 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B ($B ($B (_551 "(($A :"))))) (($B ($B (($C' $B) (($B _551) _500)))) (($B ($B ($B (_551 (($O 32) $K))))) ((($C' $B) (($B ($C' _551)) ($B _368))) (($B (_551 ") ")) (($C _551) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _345)) $I))) ($BK $K))) $K))))) $T)) (($B (($S' _606) (($B _603) (($B (_606 _653)) (($B (_551 "main: findIdent: ")) _444))))) ($C _490)))) (($B ($B _494)) (($B (($C' _553) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B ($C $P))) $K)))))) (($C _569) (_586 0)))))) (($B (_606 _344)) (($B (_551 (($O 95) $K))) _500))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _568) (_555 (_511 "-v")))) ((_585 _511) "-r"))) (($B (_549 (($O 46) $K))) (($B _605) (_554 ((_573 _629) "-i")))))) (($B (_606 _580)) ((($C' _551) (($B _605) (_554 ((_573 _629) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _640) _568) 1)) (_653 "Usage: uhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _580)) (_555 ((_607 _649) ((_607 (_511 (($O 45) $K))) (_566 1)))))))) (($A :1 "v3.1\10&") (($A :2 ((($S' ($S' _518)) _16) (($B ($B ($B (_518 _546)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _519) (($B (_606 _537)) (($B (_606 (_567 1000000))) _171)))))) (($B ($B ($B ($B (_518 _546))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _519))) ((($C' $B) (($B $B) (($B _606) (($B _536) ((($C' _644) _8) 0))))) (($B ($B (_606 _539))) (($B ($B (_551 "combinator conversion "))) ((($C' ($C' _551)) (($B ($B (_513 6))) (($B ($B _500)) _638))) "ms"))))))) (($B ($B _520)) (($B $P) (($C _396) "main"))))))) (_553 ($T ((($C' ($C' $O)) ((($C' $B) $P) _371)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_606 _6)))) ($C $C))) (($B ($B $Y)) (($B ($B ($B _338))) (($C' ($C' _553)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _606) (($B _603) (($B (_606 _653)) (_551 "not found "))))) ($C _339))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _370))) (($B (_606 (_603 (_653 "primlookup")))) (($C (_589 _511)) _5))))) (_653 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "S'") $S')) (($O (($P (($O 80) $K)) $P)) (($O (($P (($O 73) $K)) $I)) (($O (($P (($O 83) $K)) $S)) (($O (($P (($O 84) $K)) $T)) (($O (($P (($O 89) $K)) $Y)) (($O (($P "B'") $B')) (($O (($P "BK") $BK)) (($O (($P (($O 43) $K)) $+)) (($O (($P (($O 45) $K
\ No newline at end of file
--- a/src/MicroHs/Lex.hs
+++ b/src/MicroHs/Lex.hs
@@ -1,4 +1,4 @@
-module MicroHs.Lex(lexTop) where
+module MicroHs.Lex(lexTop, Token(..), Line, Col, Loc, isLower_) where
import Prelude --Xhiding(lex, showChar)
import Data.Char
--Ximport Compat
--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -12,7 +12,6 @@
import Data.List
import Text.ParserComb as P
--import Debug.Trace
---import MicroHs.Lex
import MicroHs.Expr
--Ximport Compat
@@ -659,10 +658,10 @@
----------------
-formatFailed :: String -> String -> LastFail -> String
+formatFailed :: String -> String -> LastFail Char -> String
formatFailed fn file lf =
case lf of
- LastFail len _ ->
+ LastFail len _ _ ->
let
(pre, post) = splitAt (length file - len) file
count lc x =
--- a/src/Text/ParserComb.hs
+++ b/src/Text/ParserComb.hs
@@ -8,7 +8,7 @@
fail, guard,
get, put, modify,
Prsr, runPrsr,
- satisfy, eof,
+ satisfy, satisfyM, eof,
choice,
many, emany, optional, eoptional,
some, esome,
@@ -23,29 +23,29 @@
--import Debug.Trace
--import Compat
-data LastFail
- = LastFail Int [(String, [String])]
+data LastFail t
+ = LastFail Int [t] [(String, [String])]
--deriving (Show)
maxInt :: Int
maxInt = 1000000000
-noFail :: LastFail
-noFail = LastFail maxInt []
+noFail :: forall t . LastFail t
+noFail = LastFail maxInt [] []
-longest :: LastFail -> LastFail -> LastFail
-longest lf1@(LastFail l1 x1) lf2@(LastFail l2 x2) =
+longest :: forall t . LastFail t -> LastFail t -> LastFail t
+longest lf1@(LastFail l1 t1 x1) lf2@(LastFail l2 t2 x2) =
if l1 < l2 then
lf1
else if l2 < l1 then
lf2
else
- LastFail l1 (x1 ++ x2)
+ LastFail l1 (t1 ++ t2) (x1 ++ x2)
-longests :: [LastFail] -> LastFail
+longests :: forall t . [LastFail t] -> LastFail t
longests xs = foldl1 longest xs
-data Res s t a = Many [(a, ([t], s))] LastFail
+data Res s t a = Many [(a, ([t], s))] (LastFail t)
--deriving (Show)
data Prsr s t a = P (([t], s) -> Res s t a)
@@ -105,7 +105,7 @@
guard b = if b then pure () else empty
empty :: forall s t a . Prsr s t a
-empty = P $ \ t -> Many [] (LastFail (length (fst t)) [("empty", ["<empty>"])])+empty = P $ \ (ts, _) -> Many [] (LastFail (length ts) (take 1 ts) [("empty", ["<empty>"])])--Xinfixl 3 <|>
--Yinfixl 3 <|>
@@ -117,7 +117,7 @@
Many b lfb -> Many (a ++ b) (longest lfa lfb)
fail :: forall s t a . String -> Prsr s t a
-fail m = P $ \ (ts, _) -> Many [] (LastFail (length ts) [("fail", [m])])+fail m = P $ \ (ts, _) -> Many [] (LastFail (length ts) (take 1 ts) [("fail", [m])])get :: forall s t . Prsr s t s
get = P $ \ t@(_, s) -> Many [(s, t)] noFail
@@ -156,7 +156,7 @@
eoptional p = (Just <$> p) <|< pure Nothing
runPrsr :: forall s t a . --X(Show a, Show s) =>
- s -> Prsr s t a -> [t] -> Either LastFail [(a, s)]
+ s -> Prsr s t a -> [t] -> Either (LastFail t) [(a, s)]
runPrsr s (P p) f =
case p (f, s) of
Many [] lf -> Left lf
@@ -170,33 +170,39 @@
satisfy msg f = P $ \ (acs, s) ->
case acs of
c:cs | f c -> Many [(c, (cs, s))] noFail
- _ -> Many [] (LastFail (length acs) [("satisfy", [msg])])+ _ -> Many [] (LastFail (length acs) (take 1 acs) [("satisfy", [msg])])+satisfyM :: forall s t a . String -> (t -> Maybe a) -> Prsr s t a
+satisfyM msg f = P $ \ (acs, s) ->
+ case acs of
+ c:cs | Just a <- f c -> Many [(a, (cs, s))] noFail
+ _ -> Many [] (LastFail (length acs) (take 1 acs) [("satisfyM", [msg])])+
eof :: forall s t . Prsr s t ()
eof = P $ \ t@(cs, _) ->
if null cs then
Many [((), t)] noFail
else
- Many [] (LastFail (length cs) [("eof", ["end-of-file"])])+ Many [] (LastFail (length cs) (take 1 cs) [("eof", ["end-of-file"])])(<?>) :: forall s t a . Prsr s t a -> String -> Prsr s t a
(<?>) p e = P $ \ t ->
-- trace ("<?> " ++ show e) $case runP p t of
- Many rs (LastFail l xs) ->
- Many rs (LastFail l [(m, e:es) | (m, es) <- xs ])
+ Many rs (LastFail l ts xs) ->
+ Many rs (LastFail l ts [(m, e:es) | (m, es) <- xs ])
notFollowedBy :: forall s t a . Prsr s t a -> Prsr s t ()
-notFollowedBy p = P $ \ t ->
+notFollowedBy p = P $ \ t@(ts,_) ->
case runP p t of
Many [] _ -> Many [((), t)] noFail
- _ -> Many [] (LastFail (length (fst t)) [("notFollowedBy", [])])+ _ -> Many [] (LastFail (length ts) (take 1 ts) [("notFollowedBy", [])])lookAhead :: forall s t a . Prsr s t a -> Prsr s t ()
lookAhead p = P $ \ t ->
case runP p t of
- Many [] (LastFail l xs) -> Many [] (LastFail l [("lookAhead-" ++ m, es) | mes <- xs, let { (m, es) = mes }])- _ -> Many [((), t)] noFail
+ Many [] (LastFail l ts xs) -> Many [] (LastFail l (take 1 ts) [("lookAhead-" ++ m, es) | (m, es) <- xs ])+ _ -> Many [((), t)] noFail
inject :: forall s t . [t] -> Prsr s t ()
inject s = P $ \ (cs, st) -> Many [((), (s ++ cs, st))] noFail
--
⑨