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