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