inchworm 1.0.2.4 → 1.1.1.2
raw patch · 14 files changed
Files
- Changelog.md +10/−0
- LICENSE +14/−11
- Readme.md +72/−0
- Text/Lexer/Inchworm.hs +23/−5
- Text/Lexer/Inchworm/Char.hs +76/−39
- Text/Lexer/Inchworm/Combinator.hs +29/−31
- Text/Lexer/Inchworm/Source.hs +45/−34
- examples/lispy/Main.hs +39/−0
- examples/mlish/Main.hs +75/−0
- examples/mlish/Scanner/Named.hs +76/−0
- examples/mlish/Scanner/Operator.hs +36/−0
- examples/mlish/Scanner/Punctuation.hs +35/−0
- examples/mlish/Token.hs +27/−0
- inchworm.cabal +14/−9
+ Changelog.md view
@@ -0,0 +1,10 @@+## inchworm-1.1.1:++ * Matching combinators now produce the range of source locations that matched,+ instead of just the starting location.++ * Line and column offsets are now 0-based instead of 1-based,+ for easier inteface with client editors that expect this (eg VSCode).++ * Thanks to Amos Robinson: Haskell string parser now correctly handles strings+ gaps and the string escape character `'\&'`
LICENSE view
@@ -1,13 +1,16 @@-Copyright (c) 2016 The Inchworm Development Team+-------------------------------------------------------------------------------+The Inchworm License (MIT style) - 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:+Copyrite (K) 2016-2018 The Inchworm Development Team+All rights reversed. - The above copyright notice and this permission notice shall be- included in all copies or substantial portions of the Software.+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 copyrite notice and this permission notice shall be included in all+copies or substantial portions of the Software.+-------------------------------------------------------------------------------
+ Readme.md view
@@ -0,0 +1,72 @@+# Inchworm++Inchworm is a simple parser combinator framework specialized to+lexical analysis.+Tokens are specified via simple fold functions, and we include+baked in source location handling.++Matchers for standard tokens like comments and strings +are in the `Text.Lexer.Inchworm.Char` module.++No dependencies other than the Haskell `base` library.++If you want to parse expressions instead of performing lexical+analysis then try the `parsec` or `attoparsec` packages, which+have more general purpose combinators.++## 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 (Range 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 (range, t) + = Located fileName range (k t)++main :: IO ()+main + = do let fileName = "Source.lispy"+ let source = "(some (Lispy like) 26 Program 93 (for you))"+ let toks = scanString source (scanner fileName)+ print toks+```
Text/Lexer/Inchworm.hs view
@@ -3,15 +3,15 @@ -- 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. --+-- If you want to parse expressions instead of performing lexical+-- analysis then try the @parsec@ or @attoparsec@ packages, which+-- have more general purpose combinators.+-- -- __ Minimal example __ -- -- The following code demonstrates how to perform lexical analysis@@ -73,6 +73,7 @@ , Scanner -- * Generic Scanning+ , scanList , scanListIO -- ** Source Construction@@ -101,6 +102,7 @@ import Text.Lexer.Inchworm.Source import Text.Lexer.Inchworm.Scanner import Text.Lexer.Inchworm.Combinator+import System.IO.Unsafe -- | Scan a list of generic input tokens in the IO monad,@@ -108,8 +110,22 @@ -- along with the remaining input. -- -- NOTE: If you just want to scan a `String` of characters--- use @scanStringIO@ from "Text.Lexer.Inchworm.Char"+-- use @scanString@ from "Text.Lexer.Inchworm.Char" --+scanList + :: 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.+ -> ([a], loc, [i])+ +scanList loc bump input scanner+ = unsafePerformIO $ scanListIO loc bump input scanner+++ -- | Implementation for `scanList`,+-- that uses the IO monad to manage its state. scanListIO :: Eq i => loc -- ^ Starting source location.@@ -121,3 +137,5 @@ scanListIO loc bump input scanner = do src <- makeListSourceIO loc bump input scanSourceToList src scanner++
Text/Lexer/Inchworm/Char.hs view
@@ -4,10 +4,11 @@ ( module Text.Lexer.Inchworm -- * Driver+ , scanString , scanStringIO -- * Locations- , Location (..)+ , Range (..), Location (..) , bumpLocationWithChar -- * Scanners@@ -19,13 +20,29 @@ where import Text.Lexer.Inchworm import Text.Lexer.Inchworm.Source+import System.IO.Unsafe 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.+-- | Scan a string.+scanString+ :: String+ -> Scanner IO Location String a+ -> ([a], Location, String)++scanString str scanner+ = unsafePerformIO + $ scanListIO+ (Location 0 0)+ bumpLocationWithChar + str scanner+++-- | Implementation for `scanString`,+-- that uses the IO monad to maintain internal state. scanStringIO :: String -> Scanner IO Location String a@@ -33,7 +50,7 @@ scanStringIO str scanner = scanListIO- (Location 1 1)+ (Location 0 0) bumpLocationWithChar str scanner @@ -41,11 +58,10 @@ -- 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+ '\n' -> Location (line + 1) 0 _ -> Location line (col + 1) @@ -53,7 +69,7 @@ -- | Scan a decimal integer, with optional @-@ and @+@ sign specifiers. scanInteger :: Monad m - => Scanner m loc [Char] (loc, Integer)+ => Scanner m loc [Char] (Range loc, Integer) scanInteger = munchPred Nothing matchInt acceptInt@@ -61,30 +77,29 @@ matchInt 0 !c = c == '-' || c == '+' || Char.isDigit c - matchInt _ !c = Char.isDigit c+ matchInt _ !c = Char.isDigit c acceptInt ('+' : cs)- | null cs = Nothing+ | null cs = Nothing acceptInt ('-' : cs)- | null cs = Nothing+ | null cs = Nothing - acceptInt cs = Just $ read cs+ acceptInt cs = Just $ read cs {-# SPECIALIZE INLINE scanInteger- :: Scanner IO Location [Char] (Location, Integer)+ :: Scanner IO Location [Char] (Range 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.+-- We handle the escape codes listed in Section 2.6 of the Haskell Report. -- scanHaskellString :: Monad m- => Scanner m loc [Char] (loc, String)+ => Scanner m loc [Char] (Range loc, String) scanHaskellString = munchFold Nothing matchC (False, False) acceptC@@ -113,7 +128,7 @@ {-# SPECIALIZE INLINE scanHaskellString- :: Scanner IO Location [Char] (Location, String) + :: Scanner IO Location [Char] (Range Location, String) #-} @@ -124,7 +139,7 @@ -- scanHaskellChar :: Monad m- => Scanner m loc [Char] (loc, Char)+ => Scanner m loc [Char] (Range loc, Char) scanHaskellChar = munchFold Nothing matchC (False, False) acceptC@@ -142,14 +157,16 @@ acceptC ('\'' : cs) = case readChar cs of- Just (c, "\'") -> Just c+ -- Character literals do not support gaps or+ -- escape terminators+ Just (Just c, "\'") -> Just c _ -> Nothing acceptC _ = Nothing {-# SPECIALIZE INLINE scanHaskellChar- :: Scanner IO Location [Char] (Location, Char)+ :: Scanner IO Location [Char] (Range Location, Char) #-} @@ -157,7 +174,7 @@ -- | Scan a Haskell block comment. scanHaskellCommentBlock :: Monad m- => Scanner m loc [Char] (loc, String)+ => Scanner m loc [Char] (Range loc, String) scanHaskellCommentBlock = munchFold Nothing matchC (' ', True) acceptC@@ -177,14 +194,14 @@ {-# SPECIALIZE INLINE scanHaskellCommentBlock - :: Scanner IO Location [Char] (Location, String)+ :: Scanner IO Location [Char] (Range Location, String) #-} -- | Scan a Haskell line comment. scanHaskellCommentLine :: Monad m- => Scanner m loc [Char] (loc, String)+ => Scanner m loc [Char] (Range loc, String) scanHaskellCommentLine = munchPred Nothing matchC acceptC@@ -201,7 +218,7 @@ {-# SPECIALIZE INLINE scanHaskellCommentLine- :: Scanner IO Location [Char] (Location, String)+ :: Scanner IO Location [Char] (Range Location, String) #-} @@ -219,54 +236,74 @@ go !acc ss@(c : cs) = case readChar ss of- Just (c', cs') -> go (c' : acc) cs'- Nothing -> go (c : acc) cs+ Just (Just c', cs') -> go (c' : acc) cs'+ Just (Nothing, cs') -> go acc cs'+ Nothing -> go (c : acc) cs +-- | Result of reading a character: either a real char, or an empty string+-- that is a successful read, but contains no characters.+-- These empty strings are sometimes required to remove ambiguity:+-- for example,'\SO' and '\SOH' are both valid escapes.+-- To distinguish between the strings ['\SO', 'H'] and ['\SOH'],+-- it is necessary to explicitly terminate the escape for the former:+-- '\SO\&H' means ['\SO', 'H'].+type CharGap = Maybe Char -- | Read a character literal, handling escape codes.-readChar :: String -> Maybe (Char, String)+readChar :: String -> Maybe (CharGap, String) -- Control characters defined by hex escape codes. readChar ('\\' : 'x' : cs)- | [(x, rest)] <- Numeric.readHex cs = Just (Char.chr x, rest)+ | [(x, rest)] <- Numeric.readHex cs = Just (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)+ | [(x, rest)] <- Numeric.readOct cs = Just (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)+ | c >= 'A' && c <= 'Z' = Just (Just $ Char.chr (Char.ord c - 1), rest)+ | c == '@' = Just (Just $ Char.chr 0, rest)+ | c == '[' = Just (Just $ Char.chr 27, rest)+ | c == '\\' = Just (Just $ Char.chr 28, rest)+ | c == ']' = Just (Just $ Char.chr 29, rest)+ | c == '^' = Just (Just $ Char.chr 30, rest)+ | c == '_' = Just (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)+ = Just (Just $ Char.chr (read csDigits), csRest) +-- Escape terminator '\&': see CharGap above+readChar ('\\' : '&' : rest)+ = Just (Nothing, rest)++-- String gap: two backslashes enclosing whitespace.+-- As above, this is equivalent to an empty string.+readChar ('\\' : cs)+ -- At least one character of whitespace+ | (_:_, '\\' : rest) <- List.span Char.isSpace cs+ = Just (Nothing, rest)+ -- 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)+ Nothing -> go moar+ Just rest -> Just (Just c, rest) in go escapedChars -- Just a regular character.-readChar (c : rest) = Just (c, rest)+readChar (c : rest) = Just (Just c, rest) -- Nothing to read.-readChar _ = Nothing+readChar _ = Nothing escapedChars :: [(String, Char)] escapedChars
Text/Lexer/Inchworm/Combinator.hs view
@@ -17,7 +17,7 @@ satisfies :: Monad m => (Elem input -> Bool)- -> Scanner m loc input (loc, Elem input)+ -> Scanner m loc input (Range loc, Elem input) satisfies fPred = Scanner $ \ss @@ -46,7 +46,7 @@ -- and return a result of type @a@. accept :: (Monad m, Eq (Elem input)) => Elem input -> a- -> Scanner m loc input (loc, a)+ -> Scanner m loc input (Range loc, a) accept i a = from (\i' -> if i == i' then Just a@@ -58,7 +58,7 @@ -- given sequence, and return a result of type @a@. accepts :: (Monad m, Sequence input, Eq input) => input -> a- -> Scanner m loc input (loc, a)+ -> Scanner m loc input (Range loc, a) accepts is a = froms (Just (length is)) (\is' -> if is == is'@@ -72,18 +72,18 @@ -- returning the result it produces. from :: Monad m => (Elem input -> Maybe a)- -> Scanner m loc input (loc, a)+ -> Scanner m loc input (Range loc, a) from fAccept = Scanner $ \ss -> sourceTry ss- $ do mx <- sourcePull ss (const True)+ $ do mx <- sourcePull ss (const True) case mx of Nothing -> return Nothing- Just (l, x) + Just (range, x) -> case fAccept x of Nothing -> return Nothing- Just y -> return $ Just (l, y)+ Just y -> return $ Just (range, y) {-# INLINE from #-} @@ -92,18 +92,18 @@ -- returning the result it produces. froms :: Monad m => Maybe Int -> (input -> Maybe a)- -> Scanner m loc input (loc, a)+ -> Scanner m loc input (Range loc, a) froms mLen fAccept = Scanner $ \ss -> sourceTry ss- $ do mx <- sourcePulls ss mLen (\_ _ _ -> Just ()) ()+ $ do mx <- sourcePulls ss mLen (\_ _ _ -> Just ()) () case mx of- Nothing -> return Nothing- Just (l, xs) + Nothing -> return Nothing+ Just (range, xs) -> case fAccept xs of Nothing -> return Nothing- Just y -> return $ Just (l, y)+ Just y -> return $ Just (range, y) {-# INLINE froms #-} @@ -115,10 +115,10 @@ -> Scanner m loc input a alt (Scanner scan1) (Scanner scan2) = Scanner $ \ss- -> do mx <- sourceTry ss (scan1 ss)+ -> do mx <- sourceTry ss (scan1 ss) case mx of- Nothing -> scan2 ss- Just r -> return (Just r)+ Nothing -> scan2 ss+ Just r -> return (Just r) {-# INLINE alt #-} @@ -132,10 +132,10 @@ alts (Scanner scan1 : xs) = Scanner $ \ss- -> do mx <- sourceTry ss (scan1 ss)+ -> do mx <- sourceTry ss (scan1 ss) case mx of- Nothing -> runScanner (alts xs) ss- Just r -> return (Just r)+ Nothing -> runScanner (alts xs) ss+ Just r -> return (Just r) {-# INLINE alts #-} -------------------------------------------------------------------------------@@ -150,7 +150,7 @@ -- For example, to scan natural numbers use: -- -- @--- scanNat :: Monad m => Scanner m loc [Char] (loc, Integer)+-- scanNat :: Monad m => Scanner m loc [Char] (Range loc, Integer) -- scanNat = munchPred Nothing match accept -- where match _ c = isDigit c -- accept cs = Just (read cs)@@ -159,7 +159,7 @@ -- To match Haskell style constructor names use: -- -- @--- scanCon :: Monad m => Scanner m loc [Char] (loc, String)+-- scanCon :: Monad m => Scanner m loc [Char] (Range loc, String) -- scanCon = munchPred Nothing match accept -- where match 0 c = isUpper c -- match _ c = isAlphaNum c@@ -184,7 +184,7 @@ -- ^ Take the prefix of input tokens and decide -- whether to produce a result value. - -> Scanner m loc input (loc, a)+ -> Scanner m loc input (Range loc, a) -- ^ Scan a prefix of tokens of type @is@, -- and produce a result of type @a@ if it matches. @@ -192,8 +192,7 @@ = munchFold mLenMax (\ix i s -> if fPred ix i then Just s else Nothing)- ()- fAccept+ () fAccept {-# INLINE munchPred #-} @@ -207,14 +206,13 @@ -- ^ 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)+ -> Scanner m loc input (Range loc, input) munchWord fPred = munchFold Nothing (\ix i s -> if fPred ix i then Just s else Nothing)- ()- Just+ () Just {-# INLINE munchWord #-} @@ -242,19 +240,19 @@ -> (input -> Maybe a) -- ^ Take the prefix of input tokens and decide -- whether to produce a result value.- -> Scanner m loc input (loc, a)+ -> Scanner m loc input (Range 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+ $ do mr <- sourcePulls ss mLenMax work s0 case mr of- Nothing -> return Nothing- Just (l, xs)+ Nothing -> return Nothing+ Just (Range locFirst locFinal, xs) -> case acceptC xs of Nothing -> return Nothing- Just x -> return $ Just (l, x)+ Just x -> return $ Just (Range locFirst locFinal, x) {-# INLINE munchFold #-}
Text/Lexer/Inchworm/Source.hs view
@@ -1,11 +1,12 @@ {-# LANGUAGE BangPatterns, RankNTypes, TypeFamilies, FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Text.Lexer.Inchworm.Source- ( Source (..), Location (..)+ ( Source (..), Range(..), Location (..) , Sequence (..) , makeListSourceIO) where import Data.IORef+import Data.Maybe import qualified Data.List as List import Prelude hiding (length) @@ -25,7 +26,6 @@ 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@.@@ -41,21 +41,26 @@ -- 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.+ -- | Pull a value from the source, provided it matches the given predicate.+ -- In the result we get the location if the first and final element tha+ -- matched. , sourcePull :: (Elem input -> Bool)- -> m (Maybe (loc, Elem input))+ -> m (Maybe (Range 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.+ -- 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.+ --+ -- In the result we get the location of the first and final element that+ -- matched. , sourcePulls :: forall s . Maybe Int -> (Int -> Elem input -> s -> Maybe s) -> s- -> m (Maybe (loc, input))+ -> m (Maybe (Range loc, input)) -- | Bump the source location using the given element. , sourceBumpLoc :: Elem input -> loc -> loc@@ -69,18 +74,16 @@ -- | Make a source from a list of input tokens, -- maintaining the state in the IO monad. makeListSourceIO - :: forall i loc- . Eq i + :: 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 + = do refLoc <- newIORef loc00+ refSrc <- newIORef cs0+ return $ Source (skipListSourceIO refLoc refSrc) (tryListSourceIO refLoc refSrc) (pullListSourceIO refLoc refSrc)@@ -112,7 +115,6 @@ eat loc0 cc0 - -- Try to run the given computation, -- reverting source state changes if it returns Nothing. tryListSourceIO refLoc refSrc comp @@ -128,61 +130,64 @@ writeIORef refSrc cc return Nothing - -- Pull a single value from the source. pullListSourceIO refLoc refSrc fPred- = do loc <- readIORef refLoc- cc <- readIORef refSrc+ = do locFirst <- readIORef refLoc+ cc <- readIORef refSrc case cc of [] -> return Nothing c : cs | fPred c - -> do writeIORef refLoc (bumpLoc c loc)+ -> do writeIORef refLoc (bumpLoc c locFirst) writeIORef refSrc cs- return $ Just (loc, c)+ return $ Just (Range locFirst locFirst, 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]))+ -> s -> IO (Maybe (Range loc, [i])) pullsListSourceIO refLoc refSrc mLenMax work s0- = do loc0 <- readIORef refLoc+ = do lFirst <- readIORef refLoc cc0 <- readIORef refSrc - let eat !ix !(l :: loc) !cc !acc !s+ let eat !ix !(mlPrev :: Maybe loc) !(lHere :: loc) !cc !acc !s | Just mx <- mLenMax , ix >= mx- = return (ix, l, cc, reverse acc)+ = return (ix, mlPrev, lHere, cc, reverse acc) | otherwise = case cc of [] - -> return (ix, l, cc, reverse acc)+ -> return (ix, mlPrev, lHere, 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+ Nothing -> return (ix, mlPrev, lHere, cc, reverse acc)+ Just s' -> eat (ix + 1) (Just lHere) (bumpLoc c lHere)+ cs (c : acc) s'+ (len, mlPrev, lEnd, cc', acc) + <- eat 0 Nothing lFirst cc0 [] s0 case len of 0 -> return Nothing- _ -> do writeIORef refLoc loc'+ _ -> do writeIORef refLoc lEnd writeIORef refSrc cc'- return $ Just (loc0, acc) + -- If we have only matched a single character then+ -- the final position is set to the same as the + -- starting position, otherwise it's set to the final+ -- position in the token, *not* the next char to test.+ let lFinal = fromMaybe lFirst mlPrev + return $ Just (Range lFirst lFinal, acc)+ -- Get the remaining input. remainingSourceIO :: IORef loc -> IORef [i]@@ -195,6 +200,12 @@ -------------------------------------------------------------------------------+-- | A range of locations in a source file.+data Range loc+ = Range !loc !loc+ deriving (Show, Eq, Ord)++ -- | A location in a source file. --- -- We define this here so that we can use it to specialize@@ -204,7 +215,7 @@ = Location !Int -- Line. !Int -- Column.- deriving Show+ deriving (Show, Eq, Ord) {-# SPECIALIZE INLINE
+ examples/lispy/Main.hs view
@@ -0,0 +1,39 @@++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 (Range 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 (range, t) + = Located fileName range (k t)++main :: IO ()+main + = do let fileName = "Source.lispy"+ let source = "(some (Lispy like) 26 Program 93 (for you))"+ let toks = scanString source (scanner fileName)+ print toks
+ examples/mlish/Main.hs view
@@ -0,0 +1,75 @@++import Scanner.Named+import Scanner.Operator+import Scanner.Punctuation+import Token+import Text.Lexer.Inchworm+import Text.Lexer.Inchworm.Char+import qualified Data.Char as Char++main+ = do let fileName = "Source.mlish"+ let source+ = unlines+ [ "(box (run {:de:} {- this is a comment -} -1234 + 37))"+ , "-- derp"+ , "let junk = 35 in junk + junk"+ , "'d', 'e', 'r', 'p'"+ , "'\\n', '\\a', '\\''"+ , "'\\BEL'"+ , "'\\137'"+ , "\"derpo\\ntro\\BELnic\""]++ let result = scanString source (scanner fileName)+ print result+++scanner fileName+ = skip (\c -> c == ' ' || c == '\t')+ $ alts [ + -- Block comments.+ fmap (stamp' KComment) $ scanHaskellCommentBlock++ -- Line comments.+ , fmap (stamp' KComment) $ scanHaskellCommentLine++ -- New line characters.+ , fmap stamp $ scanNewLine++ -- Punctuation.+ , fmap stamp $ scanPunctuation++ -- Named keywords, variables and constructors.+ -- These are handled in one scanner because keyword names like+ -- 'box' have the same lexical structure as variable names.+ , fmap stamp $ scanNamed++ -- Literal integers.+ -- Needs to come before scanOp so we don't take '-' independently.+ , fmap (stamp' (KLit . LInteger)) $ scanInteger++ -- Literal characters.+ , fmap (stamp' (KLit . LChar)) $ scanHaskellChar++ -- Literal strings.+ , fmap (stamp' (KLit . LString)) $ scanHaskellString++ -- Operator names.+ -- Needs to come after scanInteger so we don't take '-' independently.+ , fmap stamp $ scanOperator+ ]+ where + stamp (range, t)+ = Located fileName range t++ stamp' k (range, t)+ = Located fileName range (k t)+++scanNewLine :: Scanner IO Location [Char] (Range Location, Token)+scanNewLine + = accept '\n' KNewLine++++
+ examples/mlish/Scanner/Named.hs view
@@ -0,0 +1,76 @@++module Scanner.Named+ (scanNamed)+where+import Token+import Text.Lexer.Inchworm.Char+import qualified Data.Char as Char+++-- Named ---------------------------------------------------------------------+-- | Scan a named thing.+scanNamed :: Scanner IO Location [Char] (Range Location, Token)+scanNamed = alt scanKeyVar scanCon+++-- Variables and Keywords -----------------------------------------------------+keywords+ = [ "import", "export" + , "box", "run"+ , "let", "in"+ , "case", "of"+ , "do"+ , "if", "then", "else"]+++-- | Scan a keyword or variable.+scanKeyVar :: Scanner IO Location [Char] (Range Location, Token)+scanKeyVar+ = munchPred Nothing matchKeyVar acceptKeyVar+ where+ matchKeyVar :: Int -> Char -> Bool+ matchKeyVar 0 c = isVarStart c+ matchKeyVar _ c = isVarBody c++ acceptKeyVar :: [Char] -> Maybe Token+ acceptKeyVar cs+ | elem cs keywords = Just $ KKeyWord cs+ | otherwise = Just $ KVar cs+++isVarStart :: Char -> Bool+isVarStart c+ = Char.isLower c+ || c == '?'++isVarBody :: Char -> Bool+isVarBody c+ = Char.isAlpha c+ || Char.isDigit c+ || c == '_' || c == '\'' || c == '$' || c == '#'+++-- Constructors ---------------------------------------------------------------+scanCon :: Scanner IO Location [Char] (Range Location, Token)+scanCon+ = munchPred Nothing matchCon acceptCon+ where + matchCon 0 c = isConStart c+ matchCon _ c = isConBody c++ acceptCon cs = Just $ KCon cs+++-- | Character can start a constructor name+isConStart :: Char -> Bool+isConStart c+ = Char.isUpper c+++-- | Character can be in the body of a constructor name.+isConBody :: Char -> Bool+isConBody c+ = Char.isAlpha c+ || Char.isDigit c + || c == '_' || c == '\'' || c == '#'+
+ examples/mlish/Scanner/Operator.hs view
@@ -0,0 +1,36 @@++module Scanner.Operator+ (scanOperator)+where+import Token+import Text.Lexer.Inchworm.Char+++-- | Scan an infix operator.+scanOperator :: Scanner IO Location [Char] (Range Location, Token)+scanOperator + = munchPred Nothing matchOp acceptOp+ where+ matchOp 0 c = isOpStart c+ matchOp _ c = isOpBody c+ acceptOp cs = Just $ KOp cs+++-- | Character can start an operator.+isOpStart :: Char -> Bool+isOpStart c+ = c == '~' || c == '!' || c == '#' + || c == '$' || c == '%' || c == '&' + || c == '*' || c == '-' || c == '+' || c == '='+ || c == ':' || c == '/' || c == '|'+ || c == '<' || c == '>'+++-- | Character can be part of an operator body.+isOpBody :: Char -> Bool+isOpBody c+ = c == '~' || c == '!' || c == '#' + || c == '$' || c == '%' || c == '^' || c == '&' + || c == '*' || c == '-' || c == '+' || c == '='+ || c == ':' || c == '?' || c == '/' || c == '|'+ || c == '<' || c == '>'
+ examples/mlish/Scanner/Punctuation.hs view
@@ -0,0 +1,35 @@++module Scanner.Punctuation+ (scanPunctuation)+where+import Token+import Text.Lexer.Inchworm.Char+++puncs1 + = [ '(', ')'+ , '[', ']'+ , '{', '}'+ , '.', ',', ';' ]++puncs2 + = [ "[:", ":]", "{:", ":}" ]+++-- | Scan a punctuation character.+scanPunctuation :: Scanner IO Location [Char] (Range Location, Token)+scanPunctuation + = alt (munchPred (Just 2) matchPunc2 acceptPunc2)+ (from acceptPunc1)+ where + acceptPunc1 c+ | elem c puncs1 = Just $ KPunc [c]+ | otherwise = Nothing++ matchPunc2 0 c = elem c ['[', '{', ':']+ matchPunc2 1 c = elem c [']', '}', ':']+ matchPunc2 _ _ = False++ acceptPunc2 cs+ | elem cs puncs2 = Just $ KPunc cs+ | otherwise = Nothing
+ examples/mlish/Token.hs view
@@ -0,0 +1,27 @@++module Token where+import Text.Lexer.Inchworm.Char+++data Located a+ = Located FilePath (Range Location) a+ deriving Show++data Token+ = KNewLine+ | KComment String+ | KPunc String+ | KKeyWord String+ | KVar String+ | KCon String+ | KOp String+ | KLit Lit+ deriving Show+++data Lit+ = LInteger Integer+ | LChar Char+ | LString String+ deriving Show+
inchworm.cabal view
@@ -1,5 +1,5 @@ name: inchworm-version: 1.0.2.4+version: 1.1.1.2 license: MIT license-file: LICENSE author: The Inchworm Development Team@@ -9,26 +9,31 @@ stability: experimental homepage: https://github.com/discus-lang/inchworm category: Parsing-synopsis: Inchworm Lexer Framework+synopsis: Simple parser combinators for lexical analysis. 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.+ Tokens are specified via simple fold functions, and we include+ baked in source location handling. Comes with matchers for standard lexemes like integers, comments, and Haskell style strings with escape handling. No dependencies other than the Haskell 'base' library. + If you want to parse expressions instead of tokens then try+ try the @parsec@ or @attoparsec@ packages, which have more+ general purpose combinators. +extra-source-files:+ Readme.md+ Changelog.md+ examples/lispy/*.hs+ examples/mlish/*.hs+ examples/mlish/Scanner/*.hs+ source-repository head type: git location: https://github.com/discus-lang/inchworm.git- library build-Depends: