TltLexer.x

{
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.TLT.TltLexer
-- Copyright   :  (c) 2011 University of Minho
-- License     :  BSD3
--
-- Maintainer  :  hpacheco@di.uminho.pt
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Multifocal:
-- Bidirectional Two-level Transformation of XML Schemas
-- 
-- Lexer for the two-level language.
--
-----------------------------------------------------------------------------

module Language.TLT.TltLexer where

import Text.ParserCombinators.Parsec (SourcePos)
}

%wrapper "monad"

$digit = 0-9			-- digits
$alpha = [a-zA-Z]		-- alphabetic characters

tokens :-

$white+										;
\"[^\"]*\"									{ makeAlexAction (\s -> TokString $ tail $ init s) }
\(											{ makeAlexAction (\s -> TokSym '(') }
\)											{ makeAlexAction (\s -> TokSym ')') }
"nop"										{ makeAlexAction (\s -> TokNop) }
">>"										{ makeAlexAction (\s -> TokComp) }
"||"										{ makeAlexAction (\s -> TokChoice) }
"try"										{ makeAlexAction (\s -> TokTry) }
"many"										{ makeAlexAction (\s -> TokMany) }
"all"										{ makeAlexAction (\s -> TokAll) }
"once"										{ makeAlexAction (\s -> TokOnce) }
"everywhere"								{ makeAlexAction (\s -> TokEverywhere) }
"outermost"									{ makeAlexAction (\s -> TokOutermost) }
"at"										{ makeAlexAction (\s -> TokAt) }
"when"										{ makeAlexAction (\s -> TokWhen) }
"hoist"										{ makeAlexAction (\s -> TokHoist) }
"plunge"									{ makeAlexAction (\s -> TokPlunge) }
"rename"									{ makeAlexAction (\s -> TokRename) }
"erase"										{ makeAlexAction (\s -> TokErase) }
"select"									{ makeAlexAction (\s -> TokSelect) }

{

makeAlexAction ::Monad m => (String -> Token) -> AlexInput -> Int -> m Token
makeAlexAction cons = \ (_,_,inp) len ->return $cons (take len inp)

-- | Just to make alexMonadScan work, although we do not use it
alexEOF = return undefined

data Token = TokNop | TokComp | TokChoice | TokTry | TokMany
               | TokAll | TokOnce | TokEverywhere | TokOutermost
               | TokAt | TokWhen | TokHoist | TokPlunge | TokRename
               | TokErase | TokSelect
               | TokString String | TokSym Char
	deriving Show

alexMonadScanTokens :: Alex [Token]
alexMonadScanTokens = do
  inp <- alexGetInput
  sc <- alexGetStartCode
  case alexScan inp sc of
    AlexEOF -> return []
    AlexError inp' -> alexError "lexical error"
    AlexSkip  inp' len -> do
        alexSetInput inp'
        alexMonadScanTokens
    AlexToken inp' len action -> do
        alexSetInput inp'
        token <- action inp len
	tokens <- alexMonadScanTokens
	return $ token : tokens

lexTLT :: String -> Either String [Token]
lexTLT s = runAlex s alexMonadScanTokens

}