Merge branch 'wip/simd'
[ghc.git] / utils / genprimopcode / Parser.y
1 {
2 {-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
3 {-# OPTIONS -w -Wwarn #-}
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 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 %expect    0
20 %tokentype { Token }
21 %monad     { ParserM }
22 %lexer     { lex_tok } { TEOF }
23
24 %token
25     '->'            { TArrow }
26     '=>'            { TDArrow }
27     '='             { TEquals }
28     ','             { TComma }
29     '('             { TOpenParen }
30     ')'             { TCloseParen }
31     '(#'            { TOpenParenHash }
32     '#)'            { THashCloseParen }
33     '{'             { TOpenBrace }
34     '}'             { TCloseBrace }
35     '['             { TOpenBracket }
36     ']'             { TCloseBracket }
37     '<'             { TOpenAngle }
38     '>'             { TCloseAngle }
39     section         { TSection }
40     primop          { TPrimop }
41     pseudoop        { TPseudoop }
42     primtype        { TPrimtype }
43     primclass       { TPrimclass }
44     with            { TWith }
45     defaults        { TDefaults }
46     true            { TTrue }
47     false           { TFalse }
48     dyadic          { TDyadic }
49     monadic         { TMonadic }
50     compare         { TCompare }
51     genprimop       { TGenPrimOp }
52     fixity          { TFixity }
53     infix           { TInfixN }
54     infixl          { TInfixL }
55     infixr          { TInfixR }
56     nothing         { TNothing }
57     vector          { TVector }
58     SCALAR          { TSCALAR }
59     VECTOR          { TVECTOR }
60     VECTUPLE        { TVECTUPLE }
61     thats_all_folks { TThatsAllFolks }
62     lowerName       { TLowerName $$ }
63     upperName       { TUpperName $$ }
64     string          { TString $$ }
65     integer         { TInteger $$ }
66     noBraces        { TNoBraces $$ }
67
68 %%
69
70 info :: { Info }
71 info : pDefaults pEntries thats_all_folks { Info $1 $2 }
72
73 pDefaults :: { [Option] }
74 pDefaults : defaults pOptions { $2 }
75
76 pOptions :: { [Option] }
77 pOptions : pOption pOptions { $1 : $2 }
78          | {- empty -}      { [] }
79
80 pOption :: { Option }
81 pOption : lowerName '=' false               { OptionFalse  $1 }
82         | lowerName '=' true                { OptionTrue   $1 }
83         | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 }
84         | lowerName '=' integer             { OptionInteger $1 $3 }
85         | vector    '=' pVectorTemplate     { OptionVector $3 }
86         | fixity    '=' pInfix              { OptionFixity $3 }
87
88 pInfix :: { Maybe Fixity }
89 pInfix : infix  integer { Just $ Fixity $2 InfixN }
90        | infixl integer { Just $ Fixity $2 InfixL }
91        | infixr integer { Just $ Fixity $2 InfixR }
92        | nothing        { Nothing }
93
94
95 pEntries :: { [Entry] }
96 pEntries : pEntry pEntries { $1 : $2 }
97          | {- empty -}   { [] }
98
99 pEntry :: { Entry }
100 pEntry : pPrimOpSpec   { $1 }
101        | pPrimTypeSpec { $1 }
102        | pPrimClassSpec { $1 }
103        | pPseudoOpSpec { $1 }
104        | pSection      { $1 }
105
106 pPrimOpSpec :: { Entry }
107 pPrimOpSpec : primop upperName string pCategory pType
108               pDesc pWithOptions
109               { PrimOpSpec {
110                     cons = $2,
111                     name = $3,
112                     cat = $4,
113                     ty = $5,
114                     desc = $6,
115                     opts = $7
116                 }
117               }
118
119 pPrimTypeSpec :: { Entry }
120 pPrimTypeSpec : primtype pType pDesc pWithOptions
121                 { PrimTypeSpec { ty = $2, desc = $3, opts = $4 } }
122
123 pPrimClassSpec :: { Entry }
124 pPrimClassSpec : primclass pType pDesc pWithOptions
125                 { PrimClassSpec { cls = $2, desc = $3, opts = $4 } }
126
127 pPseudoOpSpec :: { Entry }
128 pPseudoOpSpec : pseudoop string pType pDesc pWithOptions
129                 { PseudoOpSpec { name = $2, ty = $3, desc = $4, opts = $5 } }
130
131 pSection :: { Entry }
132 pSection : section string pDesc { Section { title = $2, desc = $3 } }
133
134 pWithOptions :: { [Option] }
135 pWithOptions : with pOptions { $2 }
136              | {- empty -}   { [] }
137
138 pCategory :: { Category }
139 pCategory : dyadic { Dyadic }
140           | monadic { Monadic }
141           | compare { Compare }
142           | genprimop { GenPrimOp }
143
144 pDesc :: { String }
145 pDesc : pStuffBetweenBraces { $1 }
146       | {- empty -}         { "" }
147
148 pStuffBetweenBraces :: { String }
149 pStuffBetweenBraces : '{' pInsides '}' { $2 }
150
151 pInsides :: { String }
152 pInsides : pInside pInsides { $1 ++ $2 }
153          | {- empty -}      { "" }
154
155 pInside :: { String }
156 pInside : '{' pInsides '}' { "{" ++ $2 ++ "}" }
157         | noBraces         { $1 }
158
159 pVectorTemplate :: { [(String, String, Int)] }
160 pVectorTemplate : '[' pVectors ']' { $2 }
161
162 pVectors :: { [(String, String, Int)] }
163 pVectors : pVector ',' pVectors { [$1] ++ $3 }
164          | pVector              { [$1] }
165          | {- empty -}          { [] }
166
167 pVector :: { (String, String, Int) }
168 pVector : '<' upperName ',' upperName ',' integer '>' { ($2, $4, $6) }
169  
170 pType :: { Ty }
171 pType : paT '->' pType { TyF $1 $3 }
172       | paT '=>' pType { TyC $1 $3 }
173       | paT            { $1 }
174
175 -- Atomic types
176 paT :: { Ty }
177 paT : pTycon ppTs     { TyApp $1 $2 }
178     | pUnboxedTupleTy { $1 }
179     | '(' pType ')'   { $2 }
180     | lowerName       { TyVar $1 }
181
182 pUnboxedTupleTy :: { Ty }
183 pUnboxedTupleTy : '(#' pCommaTypes '#)' { TyUTup $2 }
184
185 pCommaTypes :: { [Ty] }
186 pCommaTypes : pType ',' pCommaTypes { $1 : $3 }
187             | pType                 { [$1] }
188
189 ppTs :: { [Ty] }
190 ppTs : ppT ppTs    { $1 : $2 }
191      | {- empty -} { [] }
192
193 -- Primitive types
194 ppT :: { Ty }
195 ppT : lowerName { TyVar $1 }
196     | pTycon    { TyApp $1 [] }
197
198 pTycon :: { TyCon }
199 pTycon : upperName { TyCon $1 }
200        | '(' ')'   { TyCon "()" }
201        | SCALAR    { SCALAR }
202        | VECTOR    { VECTOR }
203        | VECTUPLE  { VECTUPLE }
204
205 {
206 parse :: String -> Either String Info
207 parse = run_parser parsex
208 }
209