utils/genprimopcode/Lexer.x

   1
   2 {
   3 {-# OPTIONS -w #-}
   4 -- The above warning supression flag is a temporary kludge.
   5 -- While working on this module you are encouraged to remove it and fix
   6 -- any warnings in the module. See
   7 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
   8 -- for details
   9
  10 module Lexer (lex_tok) where
  11
  12 import ParserM (ParserM (..), mkT, mkTv, Token(..), St, start_code,
  13                 set_start_code,
  14                 inc_brace_depth, dec_brace_depth,
  15                 show_pos, position, input,
  16                 AlexInput, alexGetChar, alexInputPrevChar)
  17 }
  18
  19 words :-
  20
  21     <0>         $white+             ;
  22     <0>         "--" [^\n]* \n      ;
  23                 "{"                 { \i -> do {
  24                                                 set_start_code in_braces;
  25                                                 inc_brace_depth;
  26                                                 mkT TOpenBrace i
  27                                                }
  28                                     }
  29                 "}"                 { \i -> do {
  30                                                 dec_brace_depth;
  31                                                 mkT TCloseBrace i
  32                                                }
  33                                     }
  34     <0>         "->"                { mkT TArrow }
  35     <0>         "="                 { mkT TEquals }
  36     <0>         ","                 { mkT TComma }
  37     <0>         "("                 { mkT TOpenParen }
  38     <0>         ")"                 { mkT TCloseParen }
  39     <0>         "(#"                { mkT TOpenParenHash }
  40     <0>         "#)"                { mkT THashCloseParen }
  41     <0>         "section"           { mkT TSection }
  42     <0>         "primop"            { mkT TPrimop }
  43     <0>         "pseudoop"          { mkT TPseudoop }
  44     <0>         "primtype"          { mkT TPrimtype }
  45     <0>         "with"              { mkT TWith }
  46     <0>         "defaults"          { mkT TDefaults }
  47     <0>         "True"              { mkT TTrue }
  48     <0>         "False"             { mkT TFalse }
  49     <0>         "Dyadic"            { mkT TDyadic }
  50     <0>         "Monadic"           { mkT TMonadic }
  51     <0>         "Compare"           { mkT TCompare }
  52     <0>         "GenPrimOp"         { mkT TGenPrimOp }
  53     <0>         "thats_all_folks"   { mkT TThatsAllFolks }
  54     <0>         [a-z][a-zA-Z0-9\#_]* { mkTv TLowerName }
  55     <0>         [A-Z][a-zA-Z0-9\#_]* { mkTv TUpperName }
  56     <0>         \" [^\"]* \"        { mkTv (TString . tail . init) }
  57     <in_braces> [^\{\}]+            { mkTv TNoBraces }
  58     <in_braces> \n                  { mkTv TNoBraces }
  59
  60 {
  61 get_tok :: ParserM Token
  62 get_tok = ParserM $ \i st ->
  63    case alexScan i (start_code st) of
  64        AlexEOF -> Right (i, st, TEOF)
  65        AlexError _ -> Left ("Lexical error at " ++ show_pos (position i))
  66        AlexSkip i' _ -> case get_tok of
  67                             ParserM f -> f i' st
  68        AlexToken i' l a -> case a $ take l $ input i of
  69                                ParserM f -> f i' st
  70
  71 lex_tok :: (Token -> ParserM a) -> ParserM a
  72 lex_tok cont = get_tok >>= cont
  73 }
  74