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