diff --git a/Changelog.md b/Changelog.md new file mode 100644 --- /dev/null +++ b/Changelog.md @@ -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 `'\&'` diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. +------------------------------------------------------------------------------- diff --git a/Readme.md b/Readme.md new file mode 100644 --- /dev/null +++ b/Readme.md @@ -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 +``` diff --git a/Text/Lexer/Inchworm.hs b/Text/Lexer/Inchworm.hs --- a/Text/Lexer/Inchworm.hs +++ b/Text/Lexer/Inchworm.hs @@ -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 + + diff --git a/Text/Lexer/Inchworm/Char.hs b/Text/Lexer/Inchworm/Char.hs --- a/Text/Lexer/Inchworm/Char.hs +++ b/Text/Lexer/Inchworm/Char.hs @@ -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 diff --git a/Text/Lexer/Inchworm/Combinator.hs b/Text/Lexer/Inchworm/Combinator.hs --- a/Text/Lexer/Inchworm/Combinator.hs +++ b/Text/Lexer/Inchworm/Combinator.hs @@ -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 #-} diff --git a/Text/Lexer/Inchworm/Source.hs b/Text/Lexer/Inchworm/Source.hs --- a/Text/Lexer/Inchworm/Source.hs +++ b/Text/Lexer/Inchworm/Source.hs @@ -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 diff --git a/examples/lispy/Main.hs b/examples/lispy/Main.hs new file mode 100644 --- /dev/null +++ b/examples/lispy/Main.hs @@ -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 diff --git a/examples/mlish/Main.hs b/examples/mlish/Main.hs new file mode 100644 --- /dev/null +++ b/examples/mlish/Main.hs @@ -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 + + + + diff --git a/examples/mlish/Scanner/Named.hs b/examples/mlish/Scanner/Named.hs new file mode 100644 --- /dev/null +++ b/examples/mlish/Scanner/Named.hs @@ -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 == '#' + diff --git a/examples/mlish/Scanner/Operator.hs b/examples/mlish/Scanner/Operator.hs new file mode 100644 --- /dev/null +++ b/examples/mlish/Scanner/Operator.hs @@ -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 == '>' diff --git a/examples/mlish/Scanner/Punctuation.hs b/examples/mlish/Scanner/Punctuation.hs new file mode 100644 --- /dev/null +++ b/examples/mlish/Scanner/Punctuation.hs @@ -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 diff --git a/examples/mlish/Token.hs b/examples/mlish/Token.hs new file mode 100644 --- /dev/null +++ b/examples/mlish/Token.hs @@ -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 + diff --git a/inchworm.cabal b/inchworm.cabal --- a/inchworm.cabal +++ b/inchworm.cabal @@ -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: