Use OPTIONS rather than OPTIONS_GHC for pragmas
[ghc.git] / utils / genprimopcode / Parser.y
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/CodingStyle#Warnings
8 -- for details
9
10 module Parser (parse) where
11
12 import Lexer (lex_tok)
13 import ParserM (Token(..), ParserM, run_parser, get_pos, show_pos,
14                 happyError)
15 import Syntax
16 }
17
18 %name      parsex
19 %tokentype { Token }
20 %monad     { ParserM }
21 %lexer     { lex_tok } { TEOF }
22
23 %token
24     '->'            { TArrow }
25     '='             { TEquals }
26     ','             { TComma }
27     '('             { TOpenParen }
28     ')'             { TCloseParen }
29     '(#'            { TOpenParenHash }
30     '#)'            { THashCloseParen }
31     '{'             { TOpenBrace }
32     '}'             { TCloseBrace }
33     section         { TSection }
34     primop          { TPrimop }
35     pseudoop        { TPseudoop }
36     primtype        { TPrimtype }
37     with            { TWith }
38     defaults        { TDefaults }
39     true            { TTrue }
40     false           { TFalse }
41     dyadic          { TDyadic }
42     monadic         { TMonadic }
43     compare         { TCompare }
44     genprimop       { TGenPrimOp }
45     thats_all_folks { TThatsAllFolks }
46     lowerName       { TLowerName $$ }
47     upperName       { TUpperName $$ }
48     string          { TString $$ }
49     noBraces        { TNoBraces $$ }
50
51 %%
52
53 info :: { Info }
54 info : pDefaults pEntries thats_all_folks { Info $1 $2 }
55
56 pDefaults :: { [Option] }
57 pDefaults : defaults pOptions { $2 }
58
59 pOptions :: { [Option] }
60 pOptions : pOption pOptions { $1 : $2 }
61          | {- empty -}      { [] }
62
63 pOption :: { Option }
64 pOption : lowerName '=' false               { OptionFalse  $1 }
65         | lowerName '=' true                { OptionTrue   $1 }
66         | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 }
67
68 pEntries :: { [Entry] }
69 pEntries : pEntry pEntries { $1 : $2 }
70          | {- empty -}   { [] }
71
72 pEntry :: { Entry }
73 pEntry : pPrimOpSpec   { $1 }
74        | pPrimTypeSpec { $1 }
75        | pPseudoOpSpec { $1 }
76        | pSection      { $1 }
77
78 pPrimOpSpec :: { Entry }
79 pPrimOpSpec : primop upperName string pCategory pType
80               pDesc pWithOptions
81               { PrimOpSpec {
82                     cons = $2,
83                     name = $3,
84                     cat = $4,
85                     ty = $5,
86                     desc = $6,
87                     opts = $7
88                 }
89               }
90
91 pPrimTypeSpec :: { Entry }
92 pPrimTypeSpec : primtype pType pDesc pWithOptions
93                 { PrimTypeSpec { ty = $2, desc = $3, opts = $4 } }
94
95 pPseudoOpSpec :: { Entry }
96 pPseudoOpSpec : pseudoop string pType pDesc pWithOptions
97                 { PseudoOpSpec { name = $2, ty = $3, desc = $4, opts = $5 } }
98
99 pSection :: { Entry }
100 pSection : section string pDesc { Section { title = $2, desc = $3 } }
101
102 pWithOptions :: { [Option] }
103 pWithOptions : with pOptions { $2 }
104              | {- empty -}   { [] }
105
106 pCategory :: { Category }
107 pCategory : dyadic { Dyadic }
108           | monadic { Monadic }
109           | compare { Compare }
110           | genprimop { GenPrimOp }
111
112 pDesc :: { String }
113 pDesc : pStuffBetweenBraces { $1 }
114       | {- empty -}         { "" }
115
116 pStuffBetweenBraces :: { String }
117 pStuffBetweenBraces : '{' pInsides '}' { $2 }
118
119 pInsides :: { String }
120 pInsides : pInside pInsides { $1 ++ $2 }
121          | {- empty -}      { "" }
122
123 pInside :: { String }
124 pInside : '{' pInsides '}' { "{" ++ $2 ++ "}" }
125         | noBraces         { $1 }
126
127 pType :: { Ty }
128 pType : paT '->' pType { TyF $1 $3 }
129       | paT            { $1 }
130
131 -- Atomic types
132 paT :: { Ty }
133 paT : pTycon ppTs     { TyApp $1 $2 }
134     | pUnboxedTupleTy { $1 }
135     | '(' pType ')'   { $2 }
136     | lowerName       { TyVar $1 }
137
138 pUnboxedTupleTy :: { Ty }
139 pUnboxedTupleTy : '(#' pCommaTypes '#)' { TyUTup $2 }
140
141 pCommaTypes :: { [Ty] }
142 pCommaTypes : pType ',' pCommaTypes { $1 : $3 }
143             | pType                 { [$1] }
144
145 ppTs :: { [Ty] }
146 ppTs : ppT ppTs    { $1 : $2 }
147      | {- empty -} { [] }
148
149 -- Primitive types
150 ppT :: { Ty }
151 ppT : lowerName { TyVar $1 }
152     | pTycon    { TyApp $1 [] }
153
154 pTycon :: { String }
155 pTycon : upperName { $1 }
156        | '(' ')'   { "()" }
157
158 {
159 parse :: String -> Either String Info
160 parse = run_parser parsex
161 }
162