utils/genprimopcode/Parser.y

   1
   2 {
   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     thats_all_folks { TThatsAllFolks }
  47     lowerName       { TLowerName $$ }
  48     upperName       { TUpperName $$ }
  49     string          { TString $$ }
  50     noBraces        { TNoBraces $$ }
  51
  52 %%
  53
  54 info :: { Info }
  55 info : pDefaults pEntries thats_all_folks { Info $1 $2 }
  56
  57 pDefaults :: { [Option] }
  58 pDefaults : defaults pOptions { $2 }
  59
  60 pOptions :: { [Option] }
  61 pOptions : pOption pOptions { $1 : $2 }
  62          | {- empty -}      { [] }
  63
  64 pOption :: { Option }
  65 pOption : lowerName '=' false               { OptionFalse  $1 }
  66         | lowerName '=' true                { OptionTrue   $1 }
  67         | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 }
  68
  69 pEntries :: { [Entry] }
  70 pEntries : pEntry pEntries { $1 : $2 }
  71          | {- empty -}   { [] }
  72
  73 pEntry :: { Entry }
  74 pEntry : pPrimOpSpec   { $1 }
  75        | pPrimTypeSpec { $1 }
  76        | pPseudoOpSpec { $1 }
  77        | pSection      { $1 }
  78
  79 pPrimOpSpec :: { Entry }
  80 pPrimOpSpec : primop upperName string pCategory pType
  81               pDesc pWithOptions
  82               { PrimOpSpec {
  83                     cons = $2,
  84                     name = $3,
  85                     cat = $4,
  86                     ty = $5,
  87                     desc = $6,
  88                     opts = $7
  89                 }
  90               }
  91
  92 pPrimTypeSpec :: { Entry }
  93 pPrimTypeSpec : primtype pType pDesc pWithOptions
  94                 { PrimTypeSpec { ty = $2, desc = $3, opts = $4 } }
  95
  96 pPseudoOpSpec :: { Entry }
  97 pPseudoOpSpec : pseudoop string pType pDesc pWithOptions
  98                 { PseudoOpSpec { name = $2, ty = $3, desc = $4, opts = $5 } }
  99
 100 pSection :: { Entry }
 101 pSection : section string pDesc { Section { title = $2, desc = $3 } }
 102
 103 pWithOptions :: { [Option] }
 104 pWithOptions : with pOptions { $2 }
 105              | {- empty -}   { [] }
 106
 107 pCategory :: { Category }
 108 pCategory : dyadic { Dyadic }
 109           | monadic { Monadic }
 110           | compare { Compare }
 111           | genprimop { GenPrimOp }
 112
 113 pDesc :: { String }
 114 pDesc : pStuffBetweenBraces { $1 }
 115       | {- empty -}         { "" }
 116
 117 pStuffBetweenBraces :: { String }
 118 pStuffBetweenBraces : '{' pInsides '}' { $2 }
 119
 120 pInsides :: { String }
 121 pInsides : pInside pInsides { $1 ++ $2 }
 122          | {- empty -}      { "" }
 123
 124 pInside :: { String }
 125 pInside : '{' pInsides '}' { "{" ++ $2 ++ "}" }
 126         | noBraces         { $1 }
 127
 128 pType :: { Ty }
 129 pType : paT '->' pType { TyF $1 $3 }
 130       | paT            { $1 }
 131
 132 -- Atomic types
 133 paT :: { Ty }
 134 paT : pTycon ppTs     { TyApp $1 $2 }
 135     | pUnboxedTupleTy { $1 }
 136     | '(' pType ')'   { $2 }
 137     | lowerName       { TyVar $1 }
 138
 139 pUnboxedTupleTy :: { Ty }
 140 pUnboxedTupleTy : '(#' pCommaTypes '#)' { TyUTup $2 }
 141
 142 pCommaTypes :: { [Ty] }
 143 pCommaTypes : pType ',' pCommaTypes { $1 : $3 }
 144             | pType                 { [$1] }
 145
 146 ppTs :: { [Ty] }
 147 ppTs : ppT ppTs    { $1 : $2 }
 148      | {- empty -} { [] }
 149
 150 -- Primitive types
 151 ppT :: { Ty }
 152 ppT : lowerName { TyVar $1 }
 153     | pTycon    { TyApp $1 [] }
 154
 155 pTycon :: { String }
 156 pTycon : upperName { $1 }
 157        | '(' ')'   { "()" }
 158
 159 {
 160 parse :: String -> Either String Info
 161 parse = run_parser parsex
 162 }
 163