Replace genprimopcode's parsec parser with an alex+happy parser
[ghc.git] / utils / genprimopcode / Lexer.x
1
2 {
3 module Lexer (lex_tok) where
4
5 import Control.Monad.State (StateT, get)
6 import ParserM (ParserM (..), mkT, mkTv, Token(..), St, start_code,
7                 StartCode, Action, set_start_code,
8                 inc_brace_depth, dec_brace_depth,
9                 show_pos, position, input,
10                 AlexInput, alexGetChar, alexInputPrevChar)
11 }
12
13 words :-
14
15     <0>         $white+             ;
16     <0>         "--" [^\n]* \n      ;
17                 "{"                 { \i -> do {
18                                                 set_start_code in_braces;
19                                                 inc_brace_depth;
20                                                 mkT TOpenBrace i
21                                                }
22                                     }
23                 "}"                 { \i -> do {
24                                                 dec_brace_depth;
25                                                 mkT TCloseBrace i
26                                                }
27                                     }
28     <0>         "->"                { mkT TArrow }
29     <0>         "="                 { mkT TEquals }
30     <0>         ","                 { mkT TComma }
31     <0>         "("                 { mkT TOpenParen }
32     <0>         ")"                 { mkT TCloseParen }
33     <0>         "(#"                { mkT TOpenParenHash }
34     <0>         "#)"                { mkT THashCloseParen }
35     <0>         "section"           { mkT TSection }
36     <0>         "primop"            { mkT TPrimop }
37     <0>         "pseudoop"          { mkT TPseudoop }
38     <0>         "primtype"          { mkT TPrimtype }
39     <0>         "with"              { mkT TWith }
40     <0>         "defaults"          { mkT TDefaults }
41     <0>         "True"              { mkT TTrue }
42     <0>         "False"             { mkT TFalse }
43     <0>         "Dyadic"            { mkT TDyadic }
44     <0>         "Monadic"           { mkT TMonadic }
45     <0>         "Compare"           { mkT TCompare }
46     <0>         "GenPrimOp"         { mkT TGenPrimOp }
47     <0>         "thats_all_folks"   { mkT TThatsAllFolks }
48     <0>         [a-z][a-zA-Z0-9\#_]* { mkTv TLowerName }
49     <0>         [A-Z][a-zA-Z0-9\#_]* { mkTv TUpperName }
50     <0>         \" [^\"]* \"        { mkTv (TString . tail . init) }
51     <in_braces> [^\{\}]+            { mkTv TNoBraces }
52     <in_braces> \n                  { mkTv TNoBraces }
53
54 {
55 get_tok :: ParserM Token
56 get_tok = ParserM $ \i st ->
57    case alexScan i (start_code st) of
58        AlexEOF -> Right (i, st, TEOF)
59        AlexError _ -> Left ("Lexical error at " ++ show_pos (position i))
60        AlexSkip i' _ -> case get_tok of
61                             ParserM f -> f i' st
62        AlexToken i' l a -> case a $ take l $ input i of
63                                ParserM f -> f i' st
64
65 lex_tok :: (Token -> ParserM a) -> ParserM a
66 lex_tok cont = get_tok >>= cont
67 }
68