Add fixity information to primops (ticket #6026)
[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     '='             { TEquals }
27     ','             { TComma }
28     '('             { TOpenParen }
29     ')'             { TCloseParen }
30     '(#'            { TOpenParenHash }
31     '#)'            { THashCloseParen }
32     '{'             { TOpenBrace }
33     '}'             { TCloseBrace }
34     section         { TSection }
35     primop          { TPrimop }
36     pseudoop        { TPseudoop }
37     primtype        { TPrimtype }
38     with            { TWith }
39     defaults        { TDefaults }
40     true            { TTrue }
41     false           { TFalse }
42     dyadic          { TDyadic }
43     monadic         { TMonadic }
44     compare         { TCompare }
45     genprimop       { TGenPrimOp }
46     fixity          { TFixity }
47     infix           { TInfixN }
48     infixl          { TInfixL }
49     infixr          { TInfixR }
50     nothing         { TNothing }
51     thats_all_folks { TThatsAllFolks }
52     lowerName       { TLowerName $$ }
53     upperName       { TUpperName $$ }
54     string          { TString $$ }
55     integer         { TInteger $$ }
56     noBraces        { TNoBraces $$ }
57
58 %%
59
60 info :: { Info }
61 info : pDefaults pEntries thats_all_folks { Info $1 $2 }
62
63 pDefaults :: { [Option] }
64 pDefaults : defaults pOptions { $2 }
65
66 pOptions :: { [Option] }
67 pOptions : pOption pOptions { $1 : $2 }
68          | {- empty -}      { [] }
69
70 pOption :: { Option }
71 pOption : lowerName '=' false               { OptionFalse  $1 }
72         | lowerName '=' true                { OptionTrue   $1 }
73         | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 }
74         | lowerName '=' integer             { OptionInteger $1 $3 }
75         | fixity    '=' pInfix              { OptionFixity $3 }
76
77 pInfix :: { Maybe Fixity }
78 pInfix : infix  integer { Just $ Fixity $2 InfixN }
79        | infixl integer { Just $ Fixity $2 InfixL }
80        | infixr integer { Just $ Fixity $2 InfixR }
81        | nothing        { Nothing }
82
83
84 pEntries :: { [Entry] }
85 pEntries : pEntry pEntries { $1 : $2 }
86          | {- empty -}   { [] }
87
88 pEntry :: { Entry }
89 pEntry : pPrimOpSpec   { $1 }
90        | pPrimTypeSpec { $1 }
91        | pPseudoOpSpec { $1 }
92        | pSection      { $1 }
93
94 pPrimOpSpec :: { Entry }
95 pPrimOpSpec : primop upperName string pCategory pType
96               pDesc pWithOptions
97               { PrimOpSpec {
98                     cons = $2,
99                     name = $3,
100                     cat = $4,
101                     ty = $5,
102                     desc = $6,
103                     opts = $7
104                 }
105               }
106
107 pPrimTypeSpec :: { Entry }
108 pPrimTypeSpec : primtype pType pDesc pWithOptions
109                 { PrimTypeSpec { ty = $2, desc = $3, opts = $4 } }
110
111 pPseudoOpSpec :: { Entry }
112 pPseudoOpSpec : pseudoop string pType pDesc pWithOptions
113                 { PseudoOpSpec { name = $2, ty = $3, desc = $4, opts = $5 } }
114
115 pSection :: { Entry }
116 pSection : section string pDesc { Section { title = $2, desc = $3 } }
117
118 pWithOptions :: { [Option] }
119 pWithOptions : with pOptions { $2 }
120              | {- empty -}   { [] }
121
122 pCategory :: { Category }
123 pCategory : dyadic { Dyadic }
124           | monadic { Monadic }
125           | compare { Compare }
126           | genprimop { GenPrimOp }
127
128 pDesc :: { String }
129 pDesc : pStuffBetweenBraces { $1 }
130       | {- empty -}         { "" }
131
132 pStuffBetweenBraces :: { String }
133 pStuffBetweenBraces : '{' pInsides '}' { $2 }
134
135 pInsides :: { String }
136 pInsides : pInside pInsides { $1 ++ $2 }
137          | {- empty -}      { "" }
138
139 pInside :: { String }
140 pInside : '{' pInsides '}' { "{" ++ $2 ++ "}" }
141         | noBraces         { $1 }
142
143 pType :: { Ty }
144 pType : paT '->' pType { TyF $1 $3 }
145       | paT            { $1 }
146
147 -- Atomic types
148 paT :: { Ty }
149 paT : pTycon ppTs     { TyApp $1 $2 }
150     | pUnboxedTupleTy { $1 }
151     | '(' pType ')'   { $2 }
152     | lowerName       { TyVar $1 }
153
154 pUnboxedTupleTy :: { Ty }
155 pUnboxedTupleTy : '(#' pCommaTypes '#)' { TyUTup $2 }
156
157 pCommaTypes :: { [Ty] }
158 pCommaTypes : pType ',' pCommaTypes { $1 : $3 }
159             | pType                 { [$1] }
160
161 ppTs :: { [Ty] }
162 ppTs : ppT ppTs    { $1 : $2 }
163      | {- empty -} { [] }
164
165 -- Primitive types
166 ppT :: { Ty }
167 ppT : lowerName { TyVar $1 }
168     | pTycon    { TyApp $1 [] }
169
170 pTycon :: { String }
171 pTycon : upperName { $1 }
172        | '(' ')'   { "()" }
173
174 {
175 parse :: String -> Either String Info
176 parse = run_parser parsex
177 }
178