-------------------------------------------------------------------------------
-- |
  Module       :   CCO.Lexing
  Copyright    :   ( c ) 2008 Utrecht University
-- License     :  All rights reserved
--
-- Maintainer  :  
-- Stability   :  provisional
-- Portability :  portable
--
-- A library of lexer combinators that expose their functionality through an
-- 'Applicative' interface.
--
-------------------------------------------------------------------------------

module CCO.Lexing (
  * 
    Lexer                                -- abstract, instances: Functor,
                                         -- Applicative, Alternative
  : :  
  , message                              -- :: String -> Lexer a

    -- * Derived lexers
  : :  
  : : [      
  : : [      
  : : (  ,  ) - >  
  : : (  ,  ) - >  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  

    -- * Ignoring recognised input
  : :  a - >  b

    -- * Symbols
  , LexicalUnit (Token, Error, Msg)
  , Symbols (Symbols)

  * Lexing
  : :  a - > Source - > String - >
                                         --    Symbols a

    -- * Utilities
  : : Symbols a - > [ ( SourcePos , a ) ]
  , tokens_                              -- :: Symbols a -> [a]
) where

import Prelude hiding (lex)
import CCO.SourcePos (Source, Pos (Pos, EOF), SourcePos (SourcePos))
import Control.Applicative (Applicative (..), Alternative (..), (<$>))
import Data.Char

-------------------------------------------------------------------------------
-- Steps
-------------------------------------------------------------------------------

-- | A @Steps@ represents the tokenisation associated with the recognition of
  a ( part of a ) lexeme .
data Steps a = None         -- ^ No tokenisation yet.
  ^ Produces as a token a value of type 
             | Ignore       -- ^ Produces a value of type @a@ but ignores it as
                            --   far as tokenisation is concerned.
                            --   (Typically used on lexemes that constitute
                            --   comments or whitespace.)
             | Fail String  -- ^ Fail with a specified error message.

instance Functor Steps where
  fmap _ None       = None
  fmap f (Return x) = Return (f x)
  fmap _ Ignore     = Ignore
  fmap _ (Fail msg) = Fail msg

instance Applicative Steps where
  pure x = Return x

  (Fail msg) <*> _          = Fail msg
  _          <*> (Fail msg) = Fail msg
  None       <*> _          = None
  _          <*> None       = None
  Return f   <*> Return x   = Return (f x)
  _          <*> _          = Ignore

instance Alternative Steps where
  empty = None

  steps@(Return _) <|> _                = steps
  steps@Ignore     <|> _                = steps
  _                <|> steps@(Return _) = steps
  _                <|> steps@Ignore     = steps
  None             <|> steps            = steps
  steps            <|> _                = steps

-------------------------------------------------------------------------------
  
-------------------------------------------------------------------------------

  | Type of lexers that produce tokens of type 
data Lexer a = Trie (Steps a) [(Char -> Bool, Lexer (Char -> a))]
               -- ^ A @Lexer@ consists of a @Steps@-component that represents
    the tokenisation for the lexeme currently recognised and
               --   a multi-mapping from characters to lexers that represent
               --   the next state of the scanner.

instance Functor Lexer where
  fmap f (Trie steps edges) =
    Trie (fmap f steps) [(p, fmap (f .) next) | (p, next) <- edges]

instance Applicative Lexer where
  pure x = Trie (pure x) []

  Trie None edges <*> lexer = Trie None
    [(p, flip <$> next <*> lexer) | (p, next) <- edges]
  Trie (Fail msg) edges <*> lexer = Trie (Fail msg)
    [(p, flip <$> next <*> lexer) | (p, next) <- edges]
  Trie steps edges <*> lexer@(Trie steps' edges') = Trie (steps <*> steps') $
    [(p, smap ((.) <$> steps) next) | (p, next) <- edges'] ++
    [(p, flip <$> next <*> lexer) | (p, next) <- edges]

instance Alternative Lexer where
  empty = Trie empty []
  Trie steps edges <|> Trie steps' edges' =
    Trie (steps <|> steps') (edges ++ edges')

  | Maps a tokenisation over a '  ' .  
smap :: Steps (a -> b) -> Lexer a -> Lexer b
smap steps (Trie steps' edges) = Trie (steps <*> steps')
  [(p, smap ((.) <$> steps) next) | (p, next) <- edges] 

  | A '  ' that recognises any character that satisfies a specified
-- predicate.
satisfy :: (Char -> Bool) -> Lexer Char
satisfy p = Trie None [(p, Trie (Return id) [])]

  | A '  ' that will produce a specified error message .
message :: String -> Lexer a
message msg = Trie (Fail msg) []

-------------------------------------------------------------------------------
-- Derived lexers
-------------------------------------------------------------------------------

  | The trivial '  ' that recognises any character .
anyChar :: Lexer Char
anyChar = satisfy (const True)

  | A '  ' that recognises any character that appears in a given list .
anyCharFrom :: [Char] -> Lexer Char
anyCharFrom cs = satisfy (`elem` cs)

  | A '  ' that recognises any character that does not appear in a given
-- list.
anyCharBut :: [Char] -> Lexer Char
anyCharBut tabus = satisfy (`notElem` tabus)

  | A '  ' that recognises any character that appears in a given range .
-- More efficent than @\\(low, up) -> anyCharFrom [low .. up]@.
range :: (Char, Char) -> Lexer Char
range (low, up) = satisfy (\c -> c >= low && c <= up)

  | A '  ' that recognises any character that does not appear in a given
-- range.
notInRange :: (Char, Char) -> Lexer Char
notInRange (low, up) = satisfy (\c -> c < low || c > up)

  | A '  ' that recognises a specified character .
char :: Char -> Lexer Char
char c = satisfy (== c)

  | A '  ' that recognises a specified ' String ' .
string :: String -> Lexer String
string []       = pure []
string (c : cs) = (:) <$> char c <*> string cs

  | A '  ' that recognises a whitespace character
space :: Lexer Char
space = satisfy isSpace

  | A '  ' that recognises lower - case alphabetic characters .
lower :: Lexer Char
lower = satisfy isLower

  | A '  ' that recognises upper - case or title - case alphabetic characters .
upper :: Lexer Char
upper = satisfy isUpper

  | A '  ' that recognises alphabetic characters . Equivalent to ' alpha ' .
letter :: Lexer Char
letter = alpha

  | A '  ' that recognises alphabetic characters . Equivalet to ' letter ' .
alpha :: Lexer Char
alpha = satisfy isAlpha

  | A '  ' that recognises alphabetic or numeric characters .
alphaNum :: Lexer Char
alphaNum = satisfy isAlphaNum

  | A '  ' that recognises a digit .
digit :: Lexer Char
digit = satisfy isDigit

  | A '  ' that recognises a digit and tokenises it as an ' Int ' .
digit_ :: Lexer Int
digit_ = (\c -> ord c - ordZero) <$> digit

  | A '  ' that recognises a binary digit .
binDigit :: Lexer Char
binDigit = range ('0', '1')

  | A '  ' that recognises a binary digit and tokenises it as an ' Int ' .
binDigit_ :: Lexer Int
binDigit_ = (\c -> ord c - ordZero) <$> binDigit

  | A '  ' that recognises an octal digit .
octDigit :: Lexer Char
octDigit = satisfy isOctDigit

  | A '  ' that recognises an octal digit and tokenises it as an ' Int ' .
octDigit_ :: Lexer Int
octDigit_ = (\c -> ord c - ordZero) <$> octDigit

  | A '  that recognises a hexedecimal digit .
hexDigit :: Lexer Char
hexDigit = satisfy isHexDigit

  | A '  ' that recognises a hexadecimal digit and tokenises it as an
-- 'Int'.
hexDigit_ :: Lexer Int
hexDigit_ = (\c -> ord c - ordZero) <$> digit <|>
            (\c -> 10 + (ord c - ordLowerA)) <$> range ('a', 'f') <|>
            (\c -> 10 + (ord c - ordUpperA)) <$> range ('A', 'F')

-------------------------------------------------------------------------------
-- Ignoring recognised input
-------------------------------------------------------------------------------

  | Produces a '  ' that recognises the same inputs as a given underlying
  '  ' , but that does not result in any tokenisation .
--
  The input recognised by a '  ' constructed with @ignore@ is simply
  ignored when the '  ' is used to turn a stream of characters into a
  stream of ' LexicalUnit 's .
-- 
-- Mainly used to suppress the generation of tokens for lexemes that constitute-- lexical units like comments and whitespace.

ignore :: Lexer a -> Lexer b
ignore = smap Ignore

-------------------------------------------------------------------------------
-- Symbols
-------------------------------------------------------------------------------

-- | The type of lexical units.
data LexicalUnit a
  ^ A tokenised lexeme : its token , its
                                   --   position, the characters it consists
                                   --   of, and its its trailing characters in
                                   --   the input stream.
   | Error Pos String String       -- ^ An invalid lexeme: its position, the
                                   --   characters it consists of, and its
                                   --   trailing characters in the input
                                   --   stream.
  ^ An invalid lexeme , labeled by a custom
                                   --   error message: the message, its
                                   --   position, the characters it consists
                                   --   of, and its trailing characters in the
                                   --   input stream.

-- | The type of streams of symbols described by tokens of type 'a'.
data Symbols a = Symbols Source [LexicalUnit a]

-------------------------------------------------------------------------------
  Lexing
-------------------------------------------------------------------------------

-- | A @Scan@: an accumulator for the input recognised, a tokenisation for the
-- input recognised, the current position, and the remaining input.
type Scan a = (String -> String, Steps a, Pos, String)

  | Scanner : takes a '  ' , an input position , and an input stream and then
  produces a ' Scan ' for the next lexeme .
scan :: Lexer a -> Pos -> String -> Scan a
scan (Trie steps edges) pos input = (id, steps, pos, input) `sor` consume input
  where
    consume []       = (id, None, pos, input)
    consume (c : cs) =
      let lexer                       = choice [next | (p, next) <- edges, p c]
          (acc, steps', pos', input') =
            scan (lexer <*> pure c) (incrPos c pos) cs
      in  ((c :) . acc, steps', pos', input')

  | Picks the \"best\ " of two ' Scan 's , favouring the second over the first ,
  except when the second does not allow any tokenisation .
sor :: Scan a -> Scan a -> Scan a
sor scn (_, None, _, _) = scn
sor _ scn               = scn

-- | Runs a lexer on a specified input stream.
lex :: Lexer a -> Source -> String ->  Symbols a
lex lexer src = let initpos = initialPos
                in  Symbols src . tokenise initpos id initpos
  where
    tokenise errpos prefix pos input =
      let sentinel = case prefix "" of
                       []     -> id 
                       lexeme -> (Error errpos lexeme input :)
      in  case scan lexer pos input of
            (_, None, _, [])              -> sentinel []
            (acc, None, pos', c : input') -> tokenise errpos (prefix . (c :))
                                               (incrPos c pos') input'
            (acc, Return x, pos', input') -> sentinel $
                                               Token x pos (acc "") input' :
                                               tokenise pos' id pos' input'
            (acc, Fail msg, pos', input') -> Msg msg errpos (acc "") input' :
                                               tokenise pos' id pos' input'
            (_, _, pos', input')          -> sentinel
                                               (tokenise pos' id pos' input')

-------------------------------------------------------------------------------
-- Source positions
-------------------------------------------------------------------------------

  | Retrieves the first position in an input stream .
initialPos :: Pos
initialPos = Pos 1 1

-- | Increments a 'Pos' based on the character consumed.
-- If a newline character is consumed, the line number is incremented and the
  column number is reset to 1 ; for any other character , the line number is
  kept unchanged and the column number is incremented by 1 .
-- Fails if an attempt is made to increment an 'EOF'-value.
incrPos :: Char -> Pos -> Pos
incrPos '\n' (Pos line column) = Pos (line + 1) 1
incrPos _    (Pos line column) = Pos line (column + 1)

-------------------------------------------------------------------------------
  Utilities
-------------------------------------------------------------------------------

-- | The 'ord' of '\'0\''.
ordZero :: Int
ordZero = ord '0'

-- | The 'ord' of '\'a\''.
ordLowerA :: Int
ordLowerA = ord 'a'

-- | The 'ord' of '\'A\''.
ordUpperA :: Int
ordUpperA = ord 'A'

-- | Combines multiple 'Alternative's by means of '<|>'.
choice :: Alternative f => [f a] -> f a
choice []  = empty
choice [x] = x
choice xs  = foldr1 (<|>) xs

-- | Retrieves all tokens together with their source positions from a list of
-- 'Symbols'.
tokens :: Symbols a -> [(SourcePos, a)]
tokens (Symbols src units) =
  [(SourcePos src pos, x) | Token x pos _ _ <- units]

-- | Retrieves all tokens from a list of 'Symbols'.
tokens_ :: Symbols a -> [a]
tokens_ (Symbols _ units) = [x | Token x _ _ _ <- units]
-----------------------------------------------------------------------------
 |
 License     :  All rights reserved

 Maintainer  :  
 Stability   :  provisional
 Portability :  portable

 A library of lexer combinators that expose their functionality through an
 'Applicative' interface.

-----------------------------------------------------------------------------
 abstract, instances: Functor,
 Applicative, Alternative
 :: String -> Lexer a
 * Derived lexers
 * Ignoring recognised input
 * Symbols
    Symbols a
 * Utilities
 :: Symbols a -> [a]
-----------------------------------------------------------------------------
 Steps
-----------------------------------------------------------------------------
 | A @Steps@ represents the tokenisation associated with the recognition of
 ^ No tokenisation yet.
 ^ Produces a value of type @a@ but ignores it as
   far as tokenisation is concerned.
   (Typically used on lexemes that constitute
   comments or whitespace.)
 ^ Fail with a specified error message.
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
 ^ A @Lexer@ consists of a @Steps@-component that represents
   a multi-mapping from characters to lexers that represent
   the next state of the scanner.
 predicate.
-----------------------------------------------------------------------------
 Derived lexers
-----------------------------------------------------------------------------
 list.
 More efficent than @\\(low, up) -> anyCharFrom [low .. up]@.
 range.
 'Int'.
-----------------------------------------------------------------------------
 Ignoring recognised input
-----------------------------------------------------------------------------

 
 Mainly used to suppress the generation of tokens for lexemes that constitute-- lexical units like comments and whitespace.
-----------------------------------------------------------------------------
 Symbols
-----------------------------------------------------------------------------
 | The type of lexical units.
   position, the characters it consists
   of, and its its trailing characters in
   the input stream.
 ^ An invalid lexeme: its position, the
   characters it consists of, and its
   trailing characters in the input
   stream.
   error message: the message, its
   position, the characters it consists
   of, and its trailing characters in the
   input stream.
 | The type of streams of symbols described by tokens of type 'a'.
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
 | A @Scan@: an accumulator for the input recognised, a tokenisation for the
 input recognised, the current position, and the remaining input.
 | Runs a lexer on a specified input stream.
-----------------------------------------------------------------------------
 Source positions
-----------------------------------------------------------------------------
 | Increments a 'Pos' based on the character consumed.
 If a newline character is consumed, the line number is incremented and the
 Fails if an attempt is made to increment an 'EOF'-value.
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
 | The 'ord' of '\'0\''.
 | The 'ord' of '\'a\''.
 | The 'ord' of '\'A\''.
 | Combines multiple 'Alternative's by means of '<|>'.
 | Retrieves all tokens together with their source positions from a list of
 'Symbols'.
 | Retrieves all tokens from a list of 'Symbols'.
  Module       :   CCO.Lexing
  Copyright    :   ( c ) 2008 Utrecht University

module CCO.Lexing (
  * 
  : :  

  : :  
  : : [      
  : : [      
  : : (  ,  ) - >  
  : : (  ,  ) - >  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  
  : :  

  : :  a - >  b

  , LexicalUnit (Token, Error, Msg)
  , Symbols (Symbols)

  * Lexing
  : :  a - > Source - > String - >

  : : Symbols a - > [ ( SourcePos , a ) ]
) where

import Prelude hiding (lex)
import CCO.SourcePos (Source, Pos (Pos, EOF), SourcePos (SourcePos))
import Control.Applicative (Applicative (..), Alternative (..), (<$>))
import Data.Char


  a ( part of a ) lexeme .
  ^ Produces as a token a value of type 

instance Functor Steps where
  fmap _ None       = None
  fmap f (Return x) = Return (f x)
  fmap _ Ignore     = Ignore
  fmap _ (Fail msg) = Fail msg

instance Applicative Steps where
  pure x = Return x

  (Fail msg) <*> _          = Fail msg
  _          <*> (Fail msg) = Fail msg
  None       <*> _          = None
  _          <*> None       = None
  Return f   <*> Return x   = Return (f x)
  _          <*> _          = Ignore

instance Alternative Steps where
  empty = None

  steps@(Return _) <|> _                = steps
  steps@Ignore     <|> _                = steps
  _                <|> steps@(Return _) = steps
  _                <|> steps@Ignore     = steps
  None             <|> steps            = steps
  steps            <|> _                = steps

  

  | Type of lexers that produce tokens of type 
data Lexer a = Trie (Steps a) [(Char -> Bool, Lexer (Char -> a))]
    the tokenisation for the lexeme currently recognised and

instance Functor Lexer where
  fmap f (Trie steps edges) =
    Trie (fmap f steps) [(p, fmap (f .) next) | (p, next) <- edges]

instance Applicative Lexer where
  pure x = Trie (pure x) []

  Trie None edges <*> lexer = Trie None
    [(p, flip <$> next <*> lexer) | (p, next) <- edges]
  Trie (Fail msg) edges <*> lexer = Trie (Fail msg)
    [(p, flip <$> next <*> lexer) | (p, next) <- edges]
  Trie steps edges <*> lexer@(Trie steps' edges') = Trie (steps <*> steps') $
    [(p, smap ((.) <$> steps) next) | (p, next) <- edges'] ++
    [(p, flip <$> next <*> lexer) | (p, next) <- edges]

instance Alternative Lexer where
  empty = Trie empty []
  Trie steps edges <|> Trie steps' edges' =
    Trie (steps <|> steps') (edges ++ edges')

  | Maps a tokenisation over a '  ' .  
smap :: Steps (a -> b) -> Lexer a -> Lexer b
smap steps (Trie steps' edges) = Trie (steps <*> steps')
  [(p, smap ((.) <$> steps) next) | (p, next) <- edges] 

  | A '  ' that recognises any character that satisfies a specified
satisfy :: (Char -> Bool) -> Lexer Char
satisfy p = Trie None [(p, Trie (Return id) [])]

  | A '  ' that will produce a specified error message .
message :: String -> Lexer a
message msg = Trie (Fail msg) []


  | The trivial '  ' that recognises any character .
anyChar :: Lexer Char
anyChar = satisfy (const True)

  | A '  ' that recognises any character that appears in a given list .
anyCharFrom :: [Char] -> Lexer Char
anyCharFrom cs = satisfy (`elem` cs)

  | A '  ' that recognises any character that does not appear in a given
anyCharBut :: [Char] -> Lexer Char
anyCharBut tabus = satisfy (`notElem` tabus)

  | A '  ' that recognises any character that appears in a given range .
range :: (Char, Char) -> Lexer Char
range (low, up) = satisfy (\c -> c >= low && c <= up)

  | A '  ' that recognises any character that does not appear in a given
notInRange :: (Char, Char) -> Lexer Char
notInRange (low, up) = satisfy (\c -> c < low || c > up)

  | A '  ' that recognises a specified character .
char :: Char -> Lexer Char
char c = satisfy (== c)

  | A '  ' that recognises a specified ' String ' .
string :: String -> Lexer String
string []       = pure []
string (c : cs) = (:) <$> char c <*> string cs

  | A '  ' that recognises a whitespace character
space :: Lexer Char
space = satisfy isSpace

  | A '  ' that recognises lower - case alphabetic characters .
lower :: Lexer Char
lower = satisfy isLower

  | A '  ' that recognises upper - case or title - case alphabetic characters .
upper :: Lexer Char
upper = satisfy isUpper

  | A '  ' that recognises alphabetic characters . Equivalent to ' alpha ' .
letter :: Lexer Char
letter = alpha

  | A '  ' that recognises alphabetic characters . Equivalet to ' letter ' .
alpha :: Lexer Char
alpha = satisfy isAlpha

  | A '  ' that recognises alphabetic or numeric characters .
alphaNum :: Lexer Char
alphaNum = satisfy isAlphaNum

  | A '  ' that recognises a digit .
digit :: Lexer Char
digit = satisfy isDigit

  | A '  ' that recognises a digit and tokenises it as an ' Int ' .
digit_ :: Lexer Int
digit_ = (\c -> ord c - ordZero) <$> digit

  | A '  ' that recognises a binary digit .
binDigit :: Lexer Char
binDigit = range ('0', '1')

  | A '  ' that recognises a binary digit and tokenises it as an ' Int ' .
binDigit_ :: Lexer Int
binDigit_ = (\c -> ord c - ordZero) <$> binDigit

  | A '  ' that recognises an octal digit .
octDigit :: Lexer Char
octDigit = satisfy isOctDigit

  | A '  ' that recognises an octal digit and tokenises it as an ' Int ' .
octDigit_ :: Lexer Int
octDigit_ = (\c -> ord c - ordZero) <$> octDigit

  | A '  that recognises a hexedecimal digit .
hexDigit :: Lexer Char
hexDigit = satisfy isHexDigit

  | A '  ' that recognises a hexadecimal digit and tokenises it as an
hexDigit_ :: Lexer Int
hexDigit_ = (\c -> ord c - ordZero) <$> digit <|>
            (\c -> 10 + (ord c - ordLowerA)) <$> range ('a', 'f') <|>
            (\c -> 10 + (ord c - ordUpperA)) <$> range ('A', 'F')


  | Produces a '  ' that recognises the same inputs as a given underlying
  '  ' , but that does not result in any tokenisation .
  The input recognised by a '  ' constructed with @ignore@ is simply
  ignored when the '  ' is used to turn a stream of characters into a
  stream of ' LexicalUnit 's .

ignore :: Lexer a -> Lexer b
ignore = smap Ignore


data LexicalUnit a
  ^ A tokenised lexeme : its token , its
  ^ An invalid lexeme , labeled by a custom

data Symbols a = Symbols Source [LexicalUnit a]

  Lexing

type Scan a = (String -> String, Steps a, Pos, String)

  | Scanner : takes a '  ' , an input position , and an input stream and then
  produces a ' Scan ' for the next lexeme .
scan :: Lexer a -> Pos -> String -> Scan a
scan (Trie steps edges) pos input = (id, steps, pos, input) `sor` consume input
  where
    consume []       = (id, None, pos, input)
    consume (c : cs) =
      let lexer                       = choice [next | (p, next) <- edges, p c]
          (acc, steps', pos', input') =
            scan (lexer <*> pure c) (incrPos c pos) cs
      in  ((c :) . acc, steps', pos', input')

  | Picks the \"best\ " of two ' Scan 's , favouring the second over the first ,
  except when the second does not allow any tokenisation .
sor :: Scan a -> Scan a -> Scan a
sor scn (_, None, _, _) = scn
sor _ scn               = scn

lex :: Lexer a -> Source -> String ->  Symbols a
lex lexer src = let initpos = initialPos
                in  Symbols src . tokenise initpos id initpos
  where
    tokenise errpos prefix pos input =
      let sentinel = case prefix "" of
                       []     -> id 
                       lexeme -> (Error errpos lexeme input :)
      in  case scan lexer pos input of
            (_, None, _, [])              -> sentinel []
            (acc, None, pos', c : input') -> tokenise errpos (prefix . (c :))
                                               (incrPos c pos') input'
            (acc, Return x, pos', input') -> sentinel $
                                               Token x pos (acc "") input' :
                                               tokenise pos' id pos' input'
            (acc, Fail msg, pos', input') -> Msg msg errpos (acc "") input' :
                                               tokenise pos' id pos' input'
            (_, _, pos', input')          -> sentinel
                                               (tokenise pos' id pos' input')


  | Retrieves the first position in an input stream .
initialPos :: Pos
initialPos = Pos 1 1

  column number is reset to 1 ; for any other character , the line number is
  kept unchanged and the column number is incremented by 1 .
incrPos :: Char -> Pos -> Pos
incrPos '\n' (Pos line column) = Pos (line + 1) 1
incrPos _    (Pos line column) = Pos line (column + 1)

  Utilities

ordZero :: Int
ordZero = ord '0'

ordLowerA :: Int
ordLowerA = ord 'a'

ordUpperA :: Int
ordUpperA = ord 'A'

choice :: Alternative f => [f a] -> f a
choice []  = empty
choice [x] = x
choice xs  = foldr1 (<|>) xs

tokens :: Symbols a -> [(SourcePos, a)]
tokens (Symbols src units) =
  [(SourcePos src pos, x) | Token x pos _ _ <- units]

tokens_ :: Symbols a -> [a]
tokens_ (Symbols _ units) = [x | Token x _ _ _ <- units]