diff options
Diffstat (limited to 'utils/genprimopcode/Lexer.x')
| -rw-r--r-- | utils/genprimopcode/Lexer.x | 68 |
1 files changed, 68 insertions, 0 deletions
diff --git a/utils/genprimopcode/Lexer.x b/utils/genprimopcode/Lexer.x new file mode 100644 index 0000000000..19b0f667d6 --- /dev/null +++ b/utils/genprimopcode/Lexer.x @@ -0,0 +1,68 @@ + +{ +module Lexer (lex_tok) where + +import Control.Monad.State (StateT, get) +import ParserM (ParserM (..), mkT, mkTv, Token(..), St, start_code, + StartCode, Action, set_start_code, + inc_brace_depth, dec_brace_depth, + show_pos, position, input, + AlexInput, alexGetChar, alexInputPrevChar) +} + +words :- + + <0> $white+ ; + <0> "--" [^\n]* \n ; + "{" { \i -> do { + set_start_code in_braces; + inc_brace_depth; + mkT TOpenBrace i + } + } + "}" { \i -> do { + dec_brace_depth; + mkT TCloseBrace i + } + } + <0> "->" { mkT TArrow } + <0> "=" { mkT TEquals } + <0> "," { mkT TComma } + <0> "(" { mkT TOpenParen } + <0> ")" { mkT TCloseParen } + <0> "(#" { mkT TOpenParenHash } + <0> "#)" { mkT THashCloseParen } + <0> "section" { mkT TSection } + <0> "primop" { mkT TPrimop } + <0> "pseudoop" { mkT TPseudoop } + <0> "primtype" { mkT TPrimtype } + <0> "with" { mkT TWith } + <0> "defaults" { mkT TDefaults } + <0> "True" { mkT TTrue } + <0> "False" { mkT TFalse } + <0> "Dyadic" { mkT TDyadic } + <0> "Monadic" { mkT TMonadic } + <0> "Compare" { mkT TCompare } + <0> "GenPrimOp" { mkT TGenPrimOp } + <0> "thats_all_folks" { mkT TThatsAllFolks } + <0> [a-z][a-zA-Z0-9\#_]* { mkTv TLowerName } + <0> [A-Z][a-zA-Z0-9\#_]* { mkTv TUpperName } + <0> \" [^\"]* \" { mkTv (TString . tail . init) } + <in_braces> [^\{\}]+ { mkTv TNoBraces } + <in_braces> \n { mkTv TNoBraces } + +{ +get_tok :: ParserM Token +get_tok = ParserM $ \i st -> + case alexScan i (start_code st) of + AlexEOF -> Right (i, st, TEOF) + AlexError _ -> Left ("Lexical error at " ++ show_pos (position i)) + AlexSkip i' _ -> case get_tok of + ParserM f -> f i' st + AlexToken i' l a -> case a $ take l $ input i of + ParserM f -> f i' st + +lex_tok :: (Token -> ParserM a) -> ParserM a +lex_tok cont = get_tok >>= cont +} + |