{-# 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 Data.Word (Word8) import Data.Char (ord) import qualified Data.Bits -- | Encode a Haskell String to a list of Word8 values, in UTF8 format. utf8Encode :: Char -> [Word8] utf8Encode = map fromIntegral . go . ord where go oc | oc <= 0x7f = [oc] | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6) , 0x80 + oc Data.Bits..&. 0x3f ] | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12) , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) , 0x80 + oc Data.Bits..&. 0x3f ] | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18) , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f) , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) , 0x80 + oc Data.Bits..&. 0x3f ] type Byte = Word8 -- ----------------------------------------------------------------------------- -- The input type type AlexInput = (AlexPosn, -- current position, Char, -- previous char [Byte], -- pending bytes on current char String) -- current input string ignorePendingBytes :: AlexInput -> AlexInput ignorePendingBytes (p,c,_ps,s) = (p,c,[],s) alexInputPrevChar :: AlexInput -> Char alexInputPrevChar (_p,c,_bs,_s) = c alexGetByte :: AlexInput -> Maybe (Byte,AlexInput) alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s)) alexGetByte (_,_,[],[]) = Nothing alexGetByte (p,_,[],(c:s)) = let p' = alexMove p c (b:bs) = utf8Encode c in p' `seq` Just (b, (p', c, bs, s)) -- ----------------------------------------------------------------------------- -- 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-1) `div` alex_tab_size)*alex_tab_size+1) alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1) 1 alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1) -- ----------------------------------------------------------------------------- -- Default monad -- ----------------------------------------------------------------------------- -- Monad (with ByteString input) -- ----------------------------------------------------------------------------- -- 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. alexGScan stop__ state__ inp__ = alex_gscan stop__ alexStartPos '\n' [] inp__ (0,state__) alex_gscan stop__ p c bs inp__ (sc,state__) = case alexScan (p,c,bs,inp__) sc of AlexEOF -> stop__ p c inp__ (sc,state__) AlexError _ -> stop__ p c inp__ (sc,state__) AlexSkip (p',c',bs',inp__') _len -> alex_gscan stop__ p' c' bs' inp__' (sc,state__) AlexToken (p',c',bs',inp__') len k -> k p c inp__ len (\scs -> alex_gscan stop__ p' c' bs' inp__' scs) (sc,state__)