flatparse 0.1.1.1 → 0.1.1.2

raw patch · 3 files changed

+84/−74 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• flatparse.cabal +2/−2
• src/FlatParse/Examples/BasicLambda/Lexer.hs +45/−38
• src/FlatParse/Examples/BasicLambda/Parser.hs +37/−34

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: aa216bc46905b15bd49381505a4e05c27e49635a2d8d9bfbe8ef1f5db26a0d08+-- hash: 6fc2738e15d36543cda3fca41f2488ee555e8d976429e2d1f0798f033e10ea20  name:           flatparse-version:        0.1.1.1+version:        0.1.1.2 synopsis:       High-performance parsing from strict bytestrings description:    @Flatparse@ is a high-performance parsing library, focusing on programming languages and                 human-readable data formats. See the README for more information:

@@ -14,40 +14,44 @@ import qualified Data.ByteString as B import Language.Haskell.TH +import Data.String import qualified Data.Set as S  --------------------------------------------------------------------------------  -- | An expected item which is displayed in error messages. data Expected-  = Lit String  -- ^ An expected literal string.-  | Msg String  -- ^ A description of what's expected.+  = Msg String  -- ^ An error message.+  | Lit String  -- ^ A literal expected thing.   deriving (Eq, Show, Ord) --- | A parsing error, without source position.-data Error'-  = Precise Expected     -- ^ A precisely known error, like leaving out "in" from "let".-  | Imprecise [Expected] -- ^ An imprecise error, when we expect a number of different things,-                         --   but parse something else.-  deriving Show+instance IsString Expected where fromString = Lit --- | A source-annotated error.-data Error = Error !Pos !Error'+-- | A parsing error.+data Error+  = Precise Pos Expected     -- ^ A precisely known error, like leaving out "in" from "let".+  | Imprecise Pos [Expected] -- ^ An imprecise error, when we expect a number of different things,+                             --   but parse something else.   deriving Show --- | Merge two errors. Imprecise errors are merged by appending lists of expected items.  If we have---   a precise and an imprecise error, we throw away the imprecise one. If we have two precise---   errors, we choose the left one, which is by convention the one throw by an inner parser.+errorPos :: Error -> Pos+errorPos (Precise p _)   = p+errorPos (Imprecise p _) = p++-- | Merge two errors. Inner errors (which were thrown at points with more consumed inputs)+--   are preferred. If errors are thrown at identical input positions, we prefer precise errors+--   to imprecise ones. -- --   The point of prioritizing inner and precise errors is to suppress the deluge of "expected" --   items, and instead try to point to a concrete issue to fix. merge :: Error -> Error -> Error-merge err@(Error p e) err'@(Error p' e') = case (e, e') of-  (Precise _, _)                -> err   -- pick the inner concrete error-  (_, Precise _)                -> err'  -- pick the outer concrete error-  (Imprecise ss, Imprecise ss') -> Error p (Imprecise (ss ++ ss'))-   -- note: we never recover from errors, so all merged errors will in fact have exactly the same-   -- Pos. So we can simply throw away one of the two here.+merge e e' = case (errorPos e, errorPos e') of+  (p, p') | p < p' -> e'+  (p, p') | p > p' -> e+  (p, p')          -> case (e, e') of+    (Precise{}      , _               ) -> e+    (_              , Precise{}       ) -> e'+    (Imprecise _ es , Imprecise _ es' ) -> Imprecise p (es ++ es') {-# noinline merge #-} -- merge is "cold" code, so we shouldn't inline it.  type Parser = FP.Parser () Error@@ -55,27 +59,30 @@ -- | Pretty print an error. The `B.ByteString` input is the source file. The offending line from the --   source is displayed in the output. prettyError :: B.ByteString -> Error -> String-prettyError b (Error pos e) =+prettyError b e = -  let ls       = FP.lines b+  let pos :: Pos+      pos      = case e of Imprecise pos e -> pos+                           Precise pos e   -> pos+      ls       = FP.lines b       [(l, c)] = posLineCols b [pos]-      line     = if null ls then "" else ls !! l+      line     = if l < length ls then ls !! l else ""       linum    = show l       lpad     = map (const ' ') linum        expected (Lit s) = show s       expected (Msg s) = s -      err (Precise exp)    = expected exp-      err (Imprecise exps) = imprec $ S.toList $ S.fromList exps+      err (Precise _ e)    = expected e+      err (Imprecise _ es) = imprec $ S.toList $ S.fromList es        imprec :: [Expected] -> String       imprec []     = error "impossible"-      imprec [s]    = expected s-      imprec (s:ss) = expected s ++ go ss where+      imprec [e]    = expected e+      imprec (e:es) = expected e ++ go es where         go []     = ""-        go [s]    = " or " ++ expected s-        go (s:ss) = ", " ++ expected s ++ go ss+        go [e]    = " or " ++ expected e+        go (e:es) = ", " ++ expected e ++ go es    in show l ++ ":" ++ show c ++ ":\n" ++      lpad   ++ "|\n" ++@@ -84,17 +91,17 @@      "parse error: expected " ++      err e --- | Imprecise cut: we slap a list of expected things on inner errors.+-- | Imprecise cut: we slap a list of items on inner errors. cut :: Parser a -> [Expected] -> Parser a-cut p exps = do+cut p es = do   pos <- getPos-  FP.cutting p (Error pos (Imprecise exps)) merge+  FP.cutting p (Imprecise pos es) merge --- | Precise cut: we propagate at most a single expected thing.+-- | Precise cut: we propagate at most a single error. cut' :: Parser a -> Expected -> Parser a-cut' p exp = do+cut' p e = do   pos <- getPos-  FP.cutting p (Error pos (Precise exp)) merge+  FP.cutting p (Precise pos e) merge  runParser :: Parser a -> B.ByteString -> Result Error a runParser p = FP.runParser p ()@@ -169,13 +176,13 @@ symbol str = [| token $(FP.string str) |]  -- | Parser a non-keyword string, throw precise error on failure.-cutSymbol :: String -> Q Exp-cutSymbol str = [| $(symbol str) `cut'` Lit str |]+symbol' :: String -> Q Exp+symbol' str = [| $(symbol str) `cut'` Lit str |]  -- | Parse a keyword string. keyword :: String -> Q Exp keyword str = [| token ($(FP.string str) `notFollowedBy` identChar) |]  -- | Parse a keyword string, throw precise error on failure.-cutKeyword :: String -> Q Exp-cutKeyword str = [| $(keyword str) `cut'` Lit str |]+keyword' :: String -> Q Exp+keyword' str = [| $(keyword str) `cut'` Lit str |]

@@ -49,11 +49,11 @@ --   keyword. ident :: Parser Name ident = token $ byteStringOf $-  spanned (identStartChar *> many_ identChar) (\_ -> fails . isKeyword)+  spanned (identStartChar *> many_ identChar) (\_ span -> fails (isKeyword span))  -- | Parse an identifier, throw a precise error on failure.-cutIdent :: Parser Name-cutIdent = ident `cut'` (Msg "identifier")+ident' :: Parser Name+ident' = ident `cut'` (Msg "identifier")  digit :: Parser Int digit = (\c -> ord c - ord '0') <$> satisfyASCII isDigit@@ -69,73 +69,76 @@    <|> (BoolLit True  <$  $(keyword "true"))    <|> (BoolLit False <$  $(keyword "false"))    <|> (IntLit        <$> int)-   <|> ($(symbol "(") *> tm <* $(cutSymbol ")"))+   <|> ($(symbol "(") *> tm' <* $(symbol' ")")) -expectAtom :: [Expected]-expectAtom = [Msg "identifier", Lit "true", Lit "false", Msg "parenthesized expression"]+atom' :: Parser Tm+atom' = atom+  `cut` [Msg "identifier", "true", "false", Msg "parenthesized expression", Msg "integer literal"]  -- | Parse an `App`-level expression.-app :: Parser Tm-app = chainl App (atom `cut` expectAtom) atom+app' :: Parser Tm+app' = chainl App atom' atom  -- | Parse a `Mul`-level expression.-mul :: Parser Tm-mul = chainl Mul app ($(symbol "*") *> app)+mul' :: Parser Tm+mul' = chainl Mul app' ($(symbol "*") *> app')  -- | Parse an `Add`-level expression.-add :: Parser Tm-add = chainl Add mul ($(symbol "+") *> mul)+add' :: Parser Tm+add' = chainl Add mul' ($(symbol "+") *> mul')  -- | Parse an `Eq` or `Lt`-level expression.-eqLt :: Parser Tm-eqLt =-  add >>= \e1 ->-  branch $(symbol "==") (Eq e1 <$> add) $-  branch $(symbol "<")  (Lt e1 <$> add) $+eqLt' :: Parser Tm+eqLt' =+  add' >>= \e1 ->+  branch $(symbol "==") (Eq e1 <$> add') $+  branch $(symbol "<")  (Lt e1 <$> add') $   pure e1  -- | Parse a `Let`. pLet :: Parser Tm pLet = do   $(keyword "let")-  x <- cutIdent-  $(cutSymbol "=")-  t <- tm-  $(cutKeyword "in")-  u <- tm+  x <- ident'+  $(symbol' "=")+  t <- tm'+  $(keyword' "in")+  u <- tm'   pure $ Let x t u  -- | Parse a `Lam`. lam :: Parser Tm lam = do   $(keyword "lam")-  x <- cutIdent-  $(cutSymbol ".")-  t <- tm+  x <- ident'+  $(symbol' ".")+  t <- tm'   pure $ Lam x t  -- | Parse an `If`. pIf :: Parser Tm pIf = do   $(keyword "if")-  t <- tm-  $(cutKeyword "then")-  u <- tm-  $(cutKeyword "else")-  v <- tm+  t <- tm'+  $(keyword' "then")+  u <- tm'+  $(keyword' "else")+  v <- tm'   pure $ If t u v  -- | Parse any `Tm`.-tm :: Parser Tm-tm = pLet <|> lam <|> pIf <|> eqLt+tm' :: Parser Tm+tm' = (pLet <|> lam <|> pIf <|> eqLt') `cut` ["let", "lam", "if"]  -- | Parse a complete source file.-src :: Parser Tm-src = ws *> tm <* eof `cut` (Msg "end of input" : expectAtom)+src' :: Parser Tm+src' = ws *> tm' <* eof `cut` [Msg "end of input (lexical error)"]  + -- Examples --------------------------------------------------------------------------------+  -- testParser src p1 p1 = unlines [