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