inchworm (empty) → 1.0.0.1
raw patch · 8 files changed
+1034/−0 lines, 8 filesdep +basesetup-changed
Dependencies added: base
Files
- LICENSE +13/−0
- Setup.hs +2/−0
- Text/Lexer/Inchworm.hs +123/−0
- Text/Lexer/Inchworm/Char.hs +276/−0
- Text/Lexer/Inchworm/Combinator.hs +260/−0
- Text/Lexer/Inchworm/Scanner.hs +84/−0
- Text/Lexer/Inchworm/Source.hs +216/−0
- inchworm.cabal +60/−0
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright (c) 2016 The Inchworm Development Team++ Permission is hereby granted, free of charge, to any person+ obtaining a copy of this software and associated documentation+ files (the "Software"), to deal in the Software without+ restriction, including without limitation the rights to use,+ copy, modify, merge, publish, distribute, sublicense, and/or sell+ copies of the Software, and to permit persons to whom the+ Software is furnished to do so, subject to the following+ condition:++ The above copyright notice and this permission notice shall be+ included in all copies or substantial portions of the Software.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/Lexer/Inchworm.hs view
@@ -0,0 +1,123 @@++-- | Parser combinator framework specialized to lexical analysis.+-- Tokens can be specified via simple fold functions, +-- and we include baked in source location handling.+--+-- If you want to parse expressions instead of performing lexical+-- analysis then try the @parsec@ or @attoparsec@ packages, which+-- have more general purpose combinators.+--+-- Matchers for standard tokens like comments and strings +-- are in the "Text.Lexer.Inchworm.Char" module.+--+-- No dependencies other than the Haskell 'base' library.+--+-- __ Minimal example __+--+-- The following code demonstrates how to perform lexical analysis+-- of a simple LISP-like language. We use two separate name classes,+-- one for variables that start with a lower-case letter, +-- and one for constructors that start with an upper case letter. +--+-- Integers are scanned using the `scanInteger` function from the +-- "Text.Lexer.Inchworm.Char" module.+--+-- The result of @scanStringIO@ contains the list of leftover input+-- characters that could not be parsed. In a real lexer you should+-- check that this is empty to ensure there has not been a lexical+-- error.+--+-- @+-- import Text.Lexer.Inchworm.Char+-- import qualified Data.Char as Char+-- +-- -- | A source token.+-- data Token +-- = KBra | KKet | KVar String | KCon String | KInt Integer+-- deriving Show+-- +-- -- | A thing with attached location information.+-- data Located a+-- = Located FilePath Location a+-- deriving Show+-- +-- -- | Scanner for a lispy language.+-- scanner :: FilePath+-- -> Scanner IO Location [Char] (Located Token)+-- scanner fileName+-- = skip Char.isSpace+-- $ alts [ fmap (stamp id) $ accept '(' KBra+-- , fmap (stamp id) $ accept ')' KKet+-- , fmap (stamp KInt) $ scanInteger +-- , fmap (stamp KVar)+-- $ munchWord (\\ix c -> if ix == 0 then Char.isLower c+-- else Char.isAlpha c) +-- , fmap (stamp KCon) +-- $ munchWord (\\ix c -> if ix == 0 then Char.isUpper c+-- else Char.isAlpha c)+-- ]+-- where -- Stamp a token with source location information.+-- stamp k (l, t) +-- = Located fileName l (k t)+-- +-- main +-- = do let fileName = "Source.lispy"+-- let source = "(some (Lispy like) 26 Program 93 (for you))"+-- toks <- scanStringIO source (scanner fileName)+-- print toks+-- @+--+module Text.Lexer.Inchworm+ ( -- * Basic Types+ Source+ , Scanner++ -- * Generic Scanning+ , scanListIO++ -- ** Source Construction+ , makeListSourceIO++ -- ** Scanner Evaluation+ , scanSourceToList++ -- * Combinators++ -- ** Basic+ , satisfies, skip++ -- ** Accept+ , accept, accepts++ -- ** From+ , from, froms++ -- ** Alternation+ , alt, alts++ -- ** Munching+ , munchPred, munchWord, munchFold)+where+import Text.Lexer.Inchworm.Source+import Text.Lexer.Inchworm.Scanner+import Text.Lexer.Inchworm.Combinator+++-- | Scan a list of generic input tokens in the IO monad,+-- returning the source location of the final input token, +-- along with the remaining input.+--+-- NOTE: If you just want to scan a `String` of characters+-- use @scanStringIO@ from "Text.Lexer.Inchworm.Char"+--+scanListIO + :: Eq i+ => loc -- ^ Starting source location.+ -> (i -> loc -> loc) -- ^ Function to bump the current location by one input token.+ -> [i] -- ^ List of input tokens.+ -> Scanner IO loc [i] a -- ^ Scanner to apply.+ -> IO ([a], loc, [i])++scanListIO loc bump input scanner+ = do src <- makeListSourceIO loc bump input+ scanSourceToList src scanner
+ Text/Lexer/Inchworm/Char.hs view
@@ -0,0 +1,276 @@+{-# LANGUAGE BangPatterns #-}+-- | Character based scanners.+module Text.Lexer.Inchworm.Char+ ( module Text.Lexer.Inchworm++ -- * Driver+ , scanStringIO++ -- * Locations+ , Location (..)+ , bumpLocationWithChar++ -- * Scanners+ , scanInteger+ , scanHaskellChar+ , scanHaskellString+ , scanHaskellCommentBlock+ , scanHaskellCommentLine)+where+import Text.Lexer.Inchworm+import Text.Lexer.Inchworm.Source+import qualified Data.Char as Char+import qualified Data.List as List+import qualified Numeric as Numeric+++-- Driver ---------------------------------------------------------------------+-- | Scan a string in the IO monad.+scanStringIO+ :: String+ -> Scanner IO Location String a+ -> IO ([a], Location, String)++scanStringIO str scanner+ = scanListIO+ (Location 1 1)+ bumpLocationWithChar + str scanner+++-- Locations ------------------------------------------------------------------+-- | Bump a location using the given character,+-- updating the line and column number as appropriate. +-- +bumpLocationWithChar :: Char -> Location -> Location+bumpLocationWithChar c (Location line col)+ = case c of + '\n' -> Location (line + 1) 1+ _ -> Location line (col + 1) +++-- Integers -------------------------------------------------------------------+-- | Scan a decimal integer, with optional @-@ and @+@ sign specifiers.+scanInteger + :: Monad m + => Scanner m loc [Char] (loc, Integer)++scanInteger + = munchPred Nothing matchInt acceptInt+ where+ matchInt 0 !c + = c == '-' || c == '+' || Char.isDigit c++ matchInt _ !c = Char.isDigit c++ acceptInt ('+' : cs)+ | null cs = Nothing++ acceptInt ('-' : cs)+ | null cs = Nothing++ acceptInt cs = Just $ read cs++{-# SPECIALIZE INLINE+ scanInteger+ :: Scanner IO Location [Char] (Location, Integer)+ #-}++-- Strings --------------------------------------------------------------------+-- | Scan a literal string, enclosed in double quotes.+-- +-- We handle the escape codes listed in Section 2.6 of the Haskell Report, +-- but not string gaps or the @&@ terminator.+--+scanHaskellString + :: Monad m+ => Scanner m loc [Char] (loc, String)++scanHaskellString + = munchFold Nothing matchC (' ', True) acceptC+ where+ matchC 0 '\"' _ = Just ('\"', True)+ matchC _ _ (_, False) = Nothing++ matchC ix c (cPrev, True)+ | ix < 1 = Nothing+ | c == '"' && cPrev == '\\' = Just ('"', True)+ | c == '"' = Just (c, False)+ | otherwise = Just (c, True)++ acceptC ('"' : cs) + = case decodeString cs of+ (str, ('"' : [])) -> Just str+ _ -> Nothing++ acceptC _ = Nothing++{-# SPECIALIZE INLINE+ scanHaskellString+ :: Scanner IO Location [Char] (Location, String) + #-}+++-- Characters -----------------------------------------------------------------+-- | Scan a literal character, enclosed in single quotes.+-- +-- We handle the escape codes listed in Section 2.6 of the Haskell Report.+--+scanHaskellChar + :: Monad m+ => Scanner m loc [Char] (loc, Char)++scanHaskellChar + = munchFold Nothing matchC (' ', True) acceptC+ where+ matchC 0 '\'' _ = Just ('\'', True)+ matchC _ _ (_, False) = Nothing++ matchC ix c (cPrev, True)+ | ix < 1 = Nothing+ | c == '\'' && cPrev == '\\' = Just ('\'', True)+ | c == '\'' = Just (c, False)+ | otherwise = Just (c, True)++ acceptC ('\'' : cs) + = case readChar cs of+ Just (c, "\'") -> Just c+ _ -> Nothing++ acceptC _ = Nothing++{-# SPECIALIZE INLINE+ scanHaskellChar+ :: Scanner IO Location [Char] (Location, Char)+ #-}+++-- Comments -------------------------------------------------------------------+-- | Scan a Haskell block comment.+scanHaskellCommentBlock + :: Monad m+ => Scanner m loc [Char] (loc, String)++scanHaskellCommentBlock+ = munchFold Nothing matchC (' ', True) acceptC+ where+ matchC 0 '{' _ = Just ('{', True)+ matchC 1 '-' ('{', True) = Just ('-', True)++ matchC _ _ (_, False) = Nothing++ matchC ix c (cPrev, True)+ | ix < 2 = Nothing+ | cPrev == '-' && c == '}' = Just ('}', False)+ | otherwise = Just (c, True)++ acceptC cc@('{' : '-' : _) = Just cc+ acceptC _ = Nothing++{-# SPECIALIZE INLINE+ scanHaskellCommentBlock + :: Scanner IO Location [Char] (Location, String)+ #-}+++-- | Scan a Haskell line comment.+scanHaskellCommentLine + :: Monad m+ => Scanner m loc [Char] (loc, String)++scanHaskellCommentLine + = munchPred Nothing matchC acceptC+ where+ matchC 0 '-' = True+ matchC 1 '-' = True+ matchC _ '\n' = False+ matchC ix _ + | ix < 2 = False+ | otherwise = True++ acceptC cs = Just cs++{-# SPECIALIZE INLINE+ scanHaskellCommentLine+ :: Scanner IO Location [Char] (Location, String)+ #-}+++-------------------------------------------------------------------------------+-- | Decode escape codes in a string.+decodeString :: String -> (String, String)+decodeString ss0+ = go [] ss0+ where+ go !acc []+ = (reverse acc, [])++ go !acc ss@('\"' : _)+ = (reverse acc, ss)++ go !acc ss@(c : cs)+ = case readChar ss of+ Just (c', cs') -> go (c' : acc) cs'+ Nothing -> go (c : acc) cs+++-- | Read a character literal, handling escape codes.+readChar :: String -> Maybe (Char, String)++-- Control characters defined by hex escape codes.+readChar ('\\' : 'x' : cs)+ | [(x, rest)] <- Numeric.readHex cs = Just (Char.chr x, rest)+ | otherwise = Nothing++-- Control characters defined by octal escape codes.+readChar ('\\' : 'o' : cs)+ | [(x, rest)] <- Numeric.readOct cs = Just (Char.chr x, rest)+ | otherwise = Nothing++-- Control characters defined by carret characters, like \^G+readChar ('\\' : '^' : c : rest)+ | c >= 'A' && c <= 'Z' = Just (Char.chr (Char.ord c - 1), rest)+ | c == '@' = Just (Char.chr 0, rest)+ | c == '[' = Just (Char.chr 27, rest)+ | c == '\\' = Just (Char.chr 28, rest)+ | c == ']' = Just (Char.chr 29, rest)+ | c == '^' = Just (Char.chr 30, rest)+ | c == '_' = Just (Char.chr 31, rest)++-- Control characters defined by decimal escape codes.+readChar ('\\' : cs)+ | (csDigits, csRest) <- List.span Char.isDigit cs+ , not $ null csDigits+ = Just (Char.chr (read csDigits), csRest)++-- Control characters defined by ASCII escape codes.+readChar ('\\' : cs) + = let go [] = Nothing+ go ((str, c) : moar)+ = case List.stripPrefix str cs of+ Nothing -> go moar+ Just rest -> Just (c, rest)++ in go escapedChars++-- Just a regular character.+readChar (c : rest) = Just (c, rest)++-- Nothing to read.+readChar _ = Nothing++escapedChars :: [(String, Char)]+escapedChars + = [ ("a", '\a'), ("b", '\b'), ("f", '\f'), ("n", '\n')+ , ("r", '\r'), ("t", '\t'), ("v", '\v'), ("\\", '\\')+ , ("\"", '\"'), ("\'", '\'')+ , ("NUL", '\NUL'), ("SOH", '\SOH'), ("STX", '\STX'), ("ETX", '\ETX')+ , ("EOT", '\EOT'), ("ENQ", '\ENQ'), ("ACK", '\ACK'), ("BEL", '\BEL')+ , ("BS", '\BS'), ("HT", '\HT'), ("LF", '\LF'), ("VT", '\VT')+ , ("FF", '\FF'), ("CR", '\CR'), ("SO", '\SO'), ("SI", '\SI')+ , ("DLE", '\DLE'), ("DC1", '\DC1'), ("DC2", '\DC2'), ("DC3", '\DC3')+ , ("DC4", '\DC4'), ("NAK", '\NAK'), ("SYN", '\SYN'), ("ETB", '\ETB')+ , ("CAN", '\CAN'), ("EM", '\EM'), ("SUB", '\SUB'), ("ESC", '\ESC')+ , ("FS", '\FS'), ("GS", '\GS'), ("RS", '\RS'), ("US", '\US')+ , ("SP", '\SP'), ("DEL", '\DEL')]+
+ Text/Lexer/Inchworm/Combinator.hs view
@@ -0,0 +1,260 @@+{-# LANGUAGE FlexibleContexts #-}+module Text.Lexer.Inchworm.Combinator+ ( satisfies, skip+ , accept, accepts+ , from, froms+ , alt, alts+ , munchPred, munchWord, munchFold)+where+import Text.Lexer.Inchworm.Source+import Text.Lexer.Inchworm.Scanner+import Prelude hiding (length)+++-------------------------------------------------------------------------------+-- | Accept the next token if it matches the given predicate,+-- returning that token as the result.+satisfies+ :: Monad m + => (Elem input -> Bool)+ -> Scanner m loc input (loc, Elem input)++satisfies fPred+ = Scanner $ \ss + -> sourcePull ss fPred+{-# INLINE satisfies #-}+++-------------------------------------------------------------------------------+-- | Skip tokens that match the given predicate,+-- before applying the given argument scanner.+--+-- When lexing most source languages you can use this to skip whitespace.+--+skip :: Monad m+ => (Elem input -> Bool) -> Scanner m loc input a+ -> Scanner m loc input a+skip fPred (Scanner scan1)+ = Scanner $ \ss+ -> do sourceSkip ss fPred+ scan1 ss+{-# INLINE skip #-}+++-------------------------------------------------------------------------------+-- | Accept the next input token if it is equal to the given one,+-- and return a result of type @a@.+accept :: (Monad m, Eq (Elem input))+ => Elem input -> a+ -> Scanner m loc input (loc, a)+accept i a+ = from (\i' -> if i == i'+ then Just a+ else Nothing)+{-# INLINE accept #-}+++-- | Accept a fixed length sequence of tokens that match the +-- given sequence, and return a result of type @a@.+accepts :: (Monad m, Sequence input, Eq input)+ => input -> a+ -> Scanner m loc input (loc, a)+accepts is a+ = froms (Just (length is))+ (\is' -> if is == is'+ then Just a+ else Nothing)+{-# INLINE accepts #-}+++-------------------------------------------------------------------------------+-- | Use the given function to check whether to accept the next token,+-- returning the result it produces.+from :: Monad m+ => (Elem input -> Maybe a)+ -> Scanner m loc input (loc, a)++from fAccept + = Scanner $ \ss+ -> sourceTry ss+ $ do mx <- sourcePull ss (const True)+ case mx of+ Nothing -> return Nothing+ Just (l, x) + -> case fAccept x of+ Nothing -> return Nothing+ Just y -> return $ Just (l, y)+{-# INLINE from #-}+++-- | Use the given function to check whether to accept +-- a fixed length sequence of tokens,+-- returning the result it produces.+froms :: Monad m+ => Maybe Int -> (input -> Maybe a)+ -> Scanner m loc input (loc, a)++froms mLen fAccept+ = Scanner $ \ss+ -> sourceTry ss+ $ do mx <- sourcePulls ss mLen (\_ _ _ -> Just ()) ()+ case mx of+ Nothing -> return Nothing+ Just (l, xs) + -> case fAccept xs of+ Nothing -> return Nothing+ Just y -> return $ Just (l, y)+{-# INLINE froms #-}+++-------------------------------------------------------------------------------+-- | Combine two argument scanners into a result scanner,+-- where the first argument scanner is tried before the second.+alt :: Monad m + => Scanner m loc input a -> Scanner m loc input a+ -> Scanner m loc input a+alt (Scanner scan1) (Scanner scan2)+ = Scanner $ \ss+ -> do mx <- sourceTry ss (scan1 ss)+ case mx of+ Nothing -> scan2 ss+ Just r -> return (Just r)+{-# INLINE alt #-}+++-- | Combine a list of argumenet scanners a result scanner,+-- where each argument scanner is tried in turn until we find+-- one that matches (or not).+alts :: Monad m+ => [Scanner m loc input a] -> Scanner m loc input a+alts [] + = Scanner $ \_ -> return Nothing++alts (Scanner scan1 : xs)+ = Scanner $ \ss+ -> do mx <- sourceTry ss (scan1 ss)+ case mx of+ Nothing -> runScanner (alts xs) ss+ Just r -> return (Just r)+{-# INLINE alts #-}++-------------------------------------------------------------------------------+-- | Munch input tokens, using a predicate to select the prefix to consider.+--+-- Given @munch (Just n) match accept@, we select a contiguous sequence+-- of tokens up to length n using the predicate @match@, then pass+-- that sequence to @accept@ to make a result value out of it.+-- If @match@ selects no tokens, or @accept@ returns `Nothing`+-- then the scanner fails and no tokens are consumed from the source.+--+-- For example, to scan natural numbers use:+--+-- @+-- scanNat :: Monad m => Scanner m loc [Char] (loc, Integer)+-- scanNat = munchPred Nothing match accept+-- where match _ c = isDigit c+-- accept cs = Just (read cs)+-- @+--+-- To match Haskell style constructor names use:+--+-- @+-- scanCon :: Monad m => Scanner m loc [Char] (loc, String)+-- scanCon = munchPred Nothing match accept+-- where match 0 c = isUpper c+-- match _ c = isAlphaNum c+-- accept cs = Just cs+-- @+--+-- If you want to detect built-in constructor names like @Int@ and @Float@+-- then you can do it in the @accept@ function and produce a different+-- result constructor for each one.+--+munchPred + :: Monad m+ => Maybe Int+ -- ^ Maximum number of tokens to consider,+ -- or `Nothing` for no maximum.+ -> (Int -> Elem input -> Bool)+ -- ^ Predicate to decide whether to consider the next+ -- input token, also passed the index of the token+ -- in the prefix.++ -> (input -> Maybe a)+ -- ^ Take the prefix of input tokens and decide+ -- whether to produce a result value.++ -> Scanner m loc input (loc, a)+ -- ^ Scan a prefix of tokens of type @is@, + -- and produce a result of type @a@ if it matches.++munchPred mLenMax fPred fAccept+ = munchFold + mLenMax + (\ix i s -> if fPred ix i then Just s else Nothing)+ ()+ fAccept+{-# INLINE munchPred #-}+++-------------------------------------------------------------------------------+-- | Like `munchPred`, but we accept prefixes of any length, +-- and always accept the input tokens that match.+--+munchWord + :: Monad m+ => (Int -> Elem input -> Bool)+ -- ^ Predicate to decide whether to accept the next+ -- input token, also passed the index of the token+ -- in the prefix.+ -> Scanner m loc input (loc, input)++munchWord fPred + = munchFold + Nothing + (\ix i s -> if fPred ix i then Just s else Nothing)+ ()+ Just+{-# INLINE munchWord #-}+++-------------------------------------------------------------------------------+-- | Like `munchPred`, but we can use a fold function to select the +-- prefix of tokens to consider. This is useful when lexing comments, +-- and string literals where consecutive tokens can have special meaning +-- (ie escaped quote characters).+--+-- See the source of @scanHaskellChar@ in the "Text.Lexer.Inchworm.Char",+-- module for an example of its usage.+--+munchFold + :: Monad m+ => Maybe Int+ -- ^ Maximum number of tokens to consider,+ -- or `Nothing` for no maximum.+ -> (Int -> Elem input -> state -> Maybe state) + -- ^ Fold function to decide whether to consider the next+ -- input token. The next token will be considered if+ -- the function produces a `Just` with its new state.+ -- We stop considering tokens the first time it returns+ -- `Nothing`.+ -> state -- ^ Initial state for the fold.+ -> (input -> Maybe a)+ -- ^ Take the prefix of input tokens and decide+ -- whether to produce a result value.+ -> Scanner m loc input (loc, a)+ -- ^ Scan a prefix of tokens of type @is@,+ -- and produce a result of type @a@ if it matches.++munchFold mLenMax work s0 acceptC+ = Scanner $ \ss+ -> sourceTry ss+ $ do mr <- sourcePulls ss mLenMax work s0+ case mr of+ Nothing -> return Nothing+ Just (l, xs)+ -> case acceptC xs of+ Nothing -> return Nothing+ Just x -> return $ Just (l, x)+{-# INLINE munchFold #-}+
+ Text/Lexer/Inchworm/Scanner.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE InstanceSigs #-}++module Text.Lexer.Inchworm.Scanner+ ( Scanner (..)+ , scanSourceToList)+where+import Text.Lexer.Inchworm.Source+++-- | Scanner of input tokens that produces a result value+-- of type @a@ when successful.+data Scanner m loc input a+ = Scanner+ { runScanner :: Source m loc input -> m (Maybe a) }+++instance Monad m+ => Functor (Scanner m loc input) where+ fmap f (Scanner load)+ = Scanner $ \source + -> do r <- load source+ case r of+ Nothing -> return Nothing+ Just x -> return $ Just $ f x+ {-# INLINE fmap #-}+++instance Monad m+ => Applicative (Scanner m loc input) where+ pure x + = Scanner $ \_ -> return (Just x)++ (<*>) (Scanner loadF) (Scanner loadX)+ = Scanner $ \ss+ -> do mf <- loadF ss+ case mf of+ Nothing+ -> return Nothing++ Just f+ -> do mx <- loadX ss+ case mx of+ Nothing -> return Nothing+ Just x -> return $ Just (f x)++instance Monad m+ => Monad (Scanner m loc input) where+ return x+ = Scanner $ \_ -> return (Just x)++ (>>=) (Scanner loadX) f+ = Scanner $ \ss+ -> do mx <- loadX ss+ case mx of+ Nothing -> return Nothing+ Just x -> runScanner (f x) ss+++-- | Apply a scanner to a source of input tokens,+-- where the tokens are represented as a lazy list.+--+-- The result values are also produced in a lazy list.+--+scanSourceToList+ :: Monad m+ => Source m loc [i] -> Scanner m loc [i] a + -> m ([a], loc, [i])++scanSourceToList ss (Scanner load)+ = go []+ where go acc+ = load ss >>= \result+ -> case result of+ Just x -> go (x : acc)+ Nothing + -> do (loc, src') <- sourceRemaining ss+ return (reverse acc, loc, src')++{-# SPECIALIZE INLINE+ scanSourceToList+ :: Source IO Location [Char]+ -> Scanner IO Location [Char] a+ -> IO ([a], Location, [Char])+ #-}
+ Text/Lexer/Inchworm/Source.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE BangPatterns, RankNTypes, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Text.Lexer.Inchworm.Source+ ( Source (..), Location (..)+ , Sequence (..)+ , makeListSourceIO)+where+import Data.IORef+import qualified Data.List as List+import Prelude hiding (length)+++---------------------------------------------------------------------------------------------------+-- | Class of sequences of things.+class Sequence is where+ -- | An element of a sequence.+ type Elem is++ -- | Yield the length of a sequence.+ length :: is -> Int+++instance Sequence [a] where+ type Elem [a] = a+ length = List.length++++-- | An abstract source of input tokens that we want to perform lexical analysis on.+--+-- Each token is associated with a source location @loc@.+-- A a sequence of tokens has type @input@, and a single token type (`Elem` input).+--+data Source m loc input+ = Source+ { -- | Skip over values from the source that match the given predicate.+ sourceSkip :: (Elem input -> Bool) -> m ()++ -- | Try to evaluate the given computation that may pull values+ -- from the source. If it returns Nothing then rewind the + -- source to the original position.+ , sourceTry :: forall a. m (Maybe a) -> m (Maybe a)++ -- | Pull a value from the source,+ -- provided it matches the given predicate.+ , sourcePull :: (Elem input -> Bool)+ -> m (Maybe (loc, Elem input))++ -- | Use a fold function to select a some consecutive tokens from the source+ -- that we want to process, also passing the current index to the fold function.+ -- + -- The maximum number of tokens to select is set by the first argument,+ -- which can be set to `Nothing` for no maximum.+ , sourcePulls :: forall s+ . Maybe Int + -> (Int -> Elem input -> s -> Maybe s)+ -> s+ -> m (Maybe (loc, input))++ -- | Bump the source location using the given element.+ , sourceBumpLoc :: Elem input -> loc -> loc++ -- | Get the remaining input.+ , sourceRemaining :: m (loc, input)+ }+++---------------------------------------------------------------------------------------------------+-- | Make a source from a list of input tokens,+-- maintaining the state in the IO monad.+makeListSourceIO + :: forall i loc+ . Eq i + => loc -- ^ Starting source location.+ -> (i -> loc -> loc) -- ^ Function to bump the current location by one input token.+ -> [i] -- ^ List of input tokens.+ -> IO (Source IO loc [i])++makeListSourceIO loc00 bumpLoc cs0+ = do refLoc <- newIORef loc00+ refSrc <- newIORef cs0+ return + $ Source + (skipListSourceIO refLoc refSrc)+ (tryListSourceIO refLoc refSrc)+ (pullListSourceIO refLoc refSrc)+ (pullsListSourceIO refLoc refSrc)+ (bumpLoc)+ (remainingSourceIO refLoc refSrc)+ where+ -- Skip values from the source.+ skipListSourceIO refLoc refSrc fPred+ = do+ loc0 <- readIORef refLoc+ cc0 <- readIORef refSrc++ let eat !loc !cc+ = case cc of+ [] + -> do writeIORef refLoc loc+ writeIORef refSrc []+ return ()++ c : cs + | fPred c+ -> eat (bumpLoc c loc) cs++ | otherwise + -> do writeIORef refLoc loc+ writeIORef refSrc (c : cs)+ return ()++ eat loc0 cc0+++ -- Try to run the given computation,+ -- reverting source state changes if it returns Nothing.+ tryListSourceIO refLoc refSrc comp + = do loc <- readIORef refLoc+ cc <- readIORef refSrc+ mx <- comp+ case mx of+ Just i + -> return (Just i)++ Nothing + -> do writeIORef refLoc loc+ writeIORef refSrc cc+ return Nothing+++ -- Pull a single value from the source.+ pullListSourceIO refLoc refSrc fPred+ = do loc <- readIORef refLoc+ cc <- readIORef refSrc+ case cc of+ []+ -> return Nothing++ c : cs + | fPred c + -> do writeIORef refLoc (bumpLoc c loc)+ writeIORef refSrc cs+ return $ Just (loc, c)++ | otherwise+ -> return Nothing+++ -- Pull a vector of values that match the given predicate+ -- from the source.+ pullsListSourceIO + :: IORef loc -> IORef [i]+ -> Maybe Int -> (Int -> i -> s -> Maybe s) + -> s -> IO (Maybe (loc, [i]))++ pullsListSourceIO refLoc refSrc mLenMax work s0+ = do loc0 <- readIORef refLoc+ cc0 <- readIORef refSrc++ let eat !ix !(l :: loc) !cc !acc !s+ | Just mx <- mLenMax+ , ix >= mx+ = return (ix, l, cc, reverse acc)++ | otherwise+ = case cc of+ [] + -> return (ix, l, cc, reverse acc)++ c : cs+ -> case work ix c s of+ Nothing -> return (ix, l, cc, reverse acc)+ Just s' -> eat (ix + 1) (bumpLoc c l)+ cs (c : acc) s'++ (len, loc', cc', acc) + <- eat 0 loc0 cc0 [] s0++ case len of+ 0 -> return Nothing+ _ -> do writeIORef refLoc loc'+ writeIORef refSrc cc'+ return $ Just (loc0, acc)++ -- Get the remaining input.+ remainingSourceIO+ :: IORef loc -> IORef [i]+ -> IO (loc, [i])++ remainingSourceIO refLoc refSrc+ = do loc <- readIORef refLoc+ src <- readIORef refSrc+ return (loc, src)+++-------------------------------------------------------------------------------+-- | A location in a source file.+---+-- We define this here so that we can use it to specialize+-- makeListSourceIO.+--+data Location+ = Location + !Int -- Line.+ !Int -- Column.+ deriving Show+++{-# SPECIALIZE INLINE+ makeListSourceIO + :: Location+ -> (Char -> Location -> Location)+ -> [Char]+ -> IO (Source IO Location [Char])+ #-}
+ inchworm.cabal view
@@ -0,0 +1,60 @@+name: inchworm+version: 1.0.0.1+license: MIT+license-file: LICENSE+author: The Inchworm Development Team+maintainer: Ben Lippmeier <benl@ouroborus.net>+build-Type: Simple+cabal-Version: >=1.6+stability: experimental+homepage: https://github.com/DDCSF/inchworm+category: Parsing+synopsis: Inchworm Lexer Framework++description: Parser combinator framework specialized to lexical analysis.+ Tokens can be specified via simple fold functions, + and we include baked in source location handling.++ If you want to parse expressions instead of tokens then try+ try the @parsec@ or @attoparsec@ packages, which have more+ general purpose combinators.++ Comes with matchers for standard lexemes like integers,+ comments, and Haskell style strings with escape handling. ++ No dependencies other than the Haskell 'base' library.+++source-repository head+ type: git + location: https://github.com/DDCSF/inchworm.git+++library+ build-Depends: + base >= 4.8 && < 4.10+ + exposed-modules:+ Text.Lexer.Inchworm.Char+ Text.Lexer.Inchworm.Scanner+ Text.Lexer.Inchworm.Source+ Text.Lexer.Inchworm++ other-modules:+ Text.Lexer.Inchworm.Combinator+++ ghc-options:+ -Wall+ -fno-warn-orphans+ -fno-warn-type-defaults+ -fno-warn-missing-methods+ -fno-warn-redundant-constraints++ extensions:+ ParallelListComp+ PatternGuards+ RankNTypes+ FlexibleContexts+ KindSignatures+ BangPatterns