{-# LINE 1 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Alex wrapper code. -- -- This code is in the PUBLIC DOMAIN; you may copy it freely and use -- it for any purpose whatsoever. import Control.Applicative as App (Applicative (..)) import Data.Word (Word8) import Data.Int (Int64) import qualified Data.Char import qualified Data.ByteString.Lazy as ByteString import qualified Data.ByteString.Internal as ByteString (w2c) type Byte = Word8 -- ----------------------------------------------------------------------------- -- The input type type AlexInput = (AlexPosn, -- current position, Char, -- previous char ByteString.ByteString, -- current input string Int64) -- bytes consumed so far ignorePendingBytes :: AlexInput -> AlexInput ignorePendingBytes i = i -- no pending bytes when lexing bytestrings alexInputPrevChar :: AlexInput -> Char alexInputPrevChar (_,c,_,_) = c alexGetByte :: AlexInput -> Maybe (Byte,AlexInput) alexGetByte (p,_,cs,n) = case ByteString.uncons cs of Nothing -> Nothing Just (b, cs') -> let c = ByteString.w2c b p' = alexMove p c n' = n+1 in p' `seq` cs' `seq` n' `seq` Just (b, (p', c, cs',n')) -- ----------------------------------------------------------------------------- -- Token positions -- `Posn' records the location of a token in the input text. It has three -- fields: the address (number of chacaters preceding the token), line number -- and column of a token within the file. `start_pos' gives the position of the -- start of the file and `eof_pos' a standard encoding for the end of file. -- `move_pos' calculates the new position after traversing a given character, -- assuming the usual eight character tab stops. data AlexPosn = AlexPn !Int !Int !Int deriving (Eq,Show) alexStartPos :: AlexPosn alexStartPos = AlexPn 0 1 1 alexMove :: AlexPosn -> Char -> AlexPosn alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (c+alex_tab_size-((c-1) `mod` alex_tab_size)) alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1) 1 alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1) -- ----------------------------------------------------------------------------- -- Monad (default and with ByteString input) data AlexState = AlexState { alex_pos :: !AlexPosn, -- position at current input location alex_bpos:: !Int64, -- bytes consumed so far alex_inp :: ByteString.ByteString, -- the current input alex_chr :: !Char, -- the character before the input alex_scd :: !Int -- the current startcode , alex_ust :: AlexUserState -- AlexUserState will be defined in the user program } -- Compile with -funbox-strict-fields for best results! runAlex :: ByteString.ByteString -> Alex a -> Either String a runAlex input__ (Alex f) = case f (AlexState {alex_bpos = 0, alex_pos = alexStartPos, alex_inp = input__, alex_chr = '\n', alex_ust = alexInitUserState, alex_scd = 0}) of Left msg -> Left msg Right ( _, a ) -> Right a newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) } instance Functor Alex where fmap f a = Alex $ \s -> case unAlex a s of Left msg -> Left msg Right (s', a') -> Right (s', f a') instance Applicative Alex where pure a = Alex $ \s -> Right (s, a) fa <*> a = Alex $ \s -> case unAlex fa s of Left msg -> Left msg Right (s', f) -> case unAlex a s' of Left msg -> Left msg Right (s'', b) -> Right (s'', f b) instance Monad Alex where m >>= k = Alex $ \s -> case unAlex m s of Left msg -> Left msg Right (s',a) -> unAlex (k a) s' return = App.pure alexGetInput :: Alex AlexInput alexGetInput = Alex $ \s@AlexState{alex_pos=pos,alex_bpos=bpos,alex_chr=c,alex_inp=inp__} -> Right (s, (pos,c,inp__,bpos)) alexSetInput :: AlexInput -> Alex () alexSetInput (pos,c,inp__,bpos) = Alex $ \s -> case s{alex_pos=pos, alex_bpos=bpos, alex_chr=c, alex_inp=inp__} of state__@(AlexState{}) -> Right (state__, ()) alexError :: String -> Alex a alexError message = Alex $ const $ Left message alexGetStartCode :: Alex Int alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc) alexSetStartCode :: Int -> Alex () alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ()) alexMonadScan = do inp__@(_,_,_,n) <- alexGetInput sc <- alexGetStartCode case alexScan inp__ sc of AlexEOF -> alexEOF AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column) AlexSkip inp__' _len -> do alexSetInput inp__' alexMonadScan AlexToken inp__'@(_,_,_,n') _ action -> let len = n'-n in do alexSetInput inp__' action (ignorePendingBytes inp__) len -- ----------------------------------------------------------------------------- -- Useful token actions type AlexAction result = AlexInput -> Int64 -> Alex result -- just ignore this token and scan another one -- skip :: AlexAction result skip _input _len = alexMonadScan -- ignore this token, but set the start code to a new value -- begin :: Int -> AlexAction result begin code _input _len = do alexSetStartCode code; alexMonadScan -- perform an action for this token, and set the start code to a new value andBegin :: AlexAction result -> Int -> AlexAction result (action `andBegin` code) input__ len = do alexSetStartCode code action input__ len token :: (AlexInput -> Int64 -> token) -> AlexAction token token t input__ len = return (t input__ len) -- ----------------------------------------------------------------------------- -- Basic wrapper -- ----------------------------------------------------------------------------- -- Basic wrapper, ByteString version -- ----------------------------------------------------------------------------- -- Posn wrapper -- Adds text positions to the basic model. -- ----------------------------------------------------------------------------- -- Posn wrapper, ByteString version -- ----------------------------------------------------------------------------- -- GScan wrapper -- For compatibility with previous versions of Alex, and because we can.