Provide a utility to check API Annotations
[ghc.git] / utils / genprimopcode / Lexer.x
1
2 {
3 -- See Note [Warnings in code generated by Alex] in compiler/parser/Lexer.x
4 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
5 {-# OPTIONS_GHC -fno-warn-unused-binds #-}
6 {-# OPTIONS_GHC -fno-warn-tabs #-}
7 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
8 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
9
10 module Lexer (lex_tok) where
11
12 import ParserM (ParserM (..), mkT, mkTv, Token(..), start_code,
13                 set_start_code,
14                 inc_brace_depth, dec_brace_depth,
15                 show_pos, position,
16                 AlexInput, alexGetByte)
17 import qualified ParserM as ParserM (input)
18 }
19
20 words :-
21
22     <0>         $white+             ;
23     <0>         "--" [^\n]* \n      ;
24                 "{"                 { \i -> do {
25                                                 set_start_code in_braces;
26                                                 inc_brace_depth;
27                                                 mkT TOpenBrace i
28                                                }
29                                     }
30                 "}"                 { \i -> do {
31                                                 dec_brace_depth;
32                                                 mkT TCloseBrace i
33                                                }
34                                     }
35     <0>         "->"                { mkT TArrow }
36     <0>         "=>"                { mkT TDArrow }
37     <0>         "="                 { mkT TEquals }
38     <0>         ","                 { mkT TComma }
39     <0>         "("                 { mkT TOpenParen }
40     <0>         ")"                 { mkT TCloseParen }
41     <0>         "(#"                { mkT TOpenParenHash }
42     <0>         "#)"                { mkT THashCloseParen }
43     <0>         "["                 { mkT TOpenBracket }
44     <0>         "]"                 { mkT TCloseBracket }
45     <0>         "<"                 { mkT TOpenAngle }
46     <0>         ">"                 { mkT TCloseAngle }
47     <0>         "section"           { mkT TSection }
48     <0>         "primop"            { mkT TPrimop }
49     <0>         "pseudoop"          { mkT TPseudoop }
50     <0>         "primtype"          { mkT TPrimtype }
51     <0>         "with"              { mkT TWith }
52     <0>         "defaults"          { mkT TDefaults }
53     <0>         "True"              { mkT TTrue }
54     <0>         "False"             { mkT TFalse }
55     <0>         "Dyadic"            { mkT TDyadic }
56     <0>         "Monadic"           { mkT TMonadic }
57     <0>         "Compare"           { mkT TCompare }
58     <0>         "GenPrimOp"         { mkT TGenPrimOp }
59     <0>         "fixity"            { mkT TFixity }
60     <0>         "infix"             { mkT TInfixN }
61     <0>         "infixl"            { mkT TInfixL }
62     <0>         "infixr"            { mkT TInfixR }
63     <0>         "Nothing"           { mkT TNothing }
64     <0>         "vector"            { mkT TVector }
65     <0>         "thats_all_folks"   { mkT TThatsAllFolks }
66     <0>         "SCALAR"            { mkT TSCALAR }
67     <0>         "VECTOR"            { mkT TVECTOR }
68     <0>         "VECTUPLE"          { mkT TVECTUPLE }
69     <0>         [a-z][a-zA-Z0-9\#_]* { mkTv TLowerName }
70     <0>         [A-Z][a-zA-Z0-9\#_]* { mkTv TUpperName }
71     <0>         [0-9][0-9]*         { mkTv (TInteger . read) }
72     <0>         \" [^\"]* \"        { mkTv (TString . tail . init) }
73     <in_braces> [^\{\}]+            { mkTv TNoBraces }
74     <in_braces> \n                  { mkTv TNoBraces }
75
76 {
77 get_tok :: ParserM Token
78 get_tok = ParserM $ \i st ->
79    case alexScan i (start_code st) of
80        AlexEOF -> Right (i, st, TEOF)
81        AlexError _ -> Left ("Lexical error at " ++ show_pos (position i))
82        AlexSkip i' _ -> case get_tok of
83                             ParserM f -> f i' st
84        AlexToken i' l a -> case a $ take l $ ParserM.input i of
85                                ParserM f -> f i' st
86
87 lex_tok :: (Token -> ParserM a) -> ParserM a
88 lex_tok cont = get_tok >>= cont
89 }
90