utils/genprimopcode/Parser.y

   1
   2 {
   3 module Parser (parse) where
   4
   5 import Lexer (lex_tok)
   6 import ParserM (Token(..), ParserM, run_parser, get_pos, show_pos,
   7                 happyError)
   8 import Syntax
   9 }
  10
  11 %name      parsex
  12 %tokentype { Token }
  13 %monad     { ParserM }
  14 %lexer     { lex_tok } { TEOF }
  15
  16 %token
  17     '->'            { TArrow }
  18     '='             { TEquals }
  19     ','             { TComma }
  20     '('             { TOpenParen }
  21     ')'             { TCloseParen }
  22     '(#'            { TOpenParenHash }
  23     '#)'            { THashCloseParen }
  24     '{'             { TOpenBrace }
  25     '}'             { TCloseBrace }
  26     section         { TSection }
  27     primop          { TPrimop }
  28     pseudoop        { TPseudoop }
  29     primtype        { TPrimtype }
  30     with            { TWith }
  31     defaults        { TDefaults }
  32     true            { TTrue }
  33     false           { TFalse }
  34     dyadic          { TDyadic }
  35     monadic         { TMonadic }
  36     compare         { TCompare }
  37     genprimop       { TGenPrimOp }
  38     thats_all_folks { TThatsAllFolks }
  39     lowerName       { TLowerName $$ }
  40     upperName       { TUpperName $$ }
  41     string          { TString $$ }
  42     noBraces        { TNoBraces $$ }
  43
  44 %%
  45
  46 info :: { Info }
  47 info : pDefaults pEntries thats_all_folks { Info $1 $2 }
  48
  49 pDefaults :: { [Option] }
  50 pDefaults : defaults pOptions { $2 }
  51
  52 pOptions :: { [Option] }
  53 pOptions : pOption pOptions { $1 : $2 }
  54          | {- empty -}      { [] }
  55
  56 pOption :: { Option }
  57 pOption : lowerName '=' false               { OptionFalse  $1 }
  58         | lowerName '=' true                { OptionTrue   $1 }
  59         | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 }
  60
  61 pEntries :: { [Entry] }
  62 pEntries : pEntry pEntries { $1 : $2 }
  63          | {- empty -}   { [] }
  64
  65 pEntry :: { Entry }
  66 pEntry : pPrimOpSpec   { $1 }
  67        | pPrimTypeSpec { $1 }
  68        | pPseudoOpSpec { $1 }
  69        | pSection      { $1 }
  70
  71 pPrimOpSpec :: { Entry }
  72 pPrimOpSpec : primop upperName string pCategory pType
  73               pDesc pWithOptions
  74               { PrimOpSpec {
  75                     cons = $2,
  76                     name = $3,
  77                     cat = $4,
  78                     ty = $5,
  79                     desc = $6,
  80                     opts = $7
  81                 }
  82               }
  83
  84 pPrimTypeSpec :: { Entry }
  85 pPrimTypeSpec : primtype pType pDesc pWithOptions
  86                 { PrimTypeSpec { ty = $2, desc = $3, opts = $4 } }
  87
  88 pPseudoOpSpec :: { Entry }
  89 pPseudoOpSpec : pseudoop string pType pDesc pWithOptions
  90                 { PseudoOpSpec { name = $2, ty = $3, desc = $4, opts = $5 } }
  91
  92 pSection :: { Entry }
  93 pSection : section string pDesc { Section { title = $2, desc = $3 } }
  94
  95 pWithOptions :: { [Option] }
  96 pWithOptions : with pOptions { $2 }
  97              | {- empty -}   { [] }
  98
  99 pCategory :: { Category }
 100 pCategory : dyadic { Dyadic }
 101           | monadic { Monadic }
 102           | compare { Compare }
 103           | genprimop { GenPrimOp }
 104
 105 pDesc :: { String }
 106 pDesc : pStuffBetweenBraces { $1 }
 107       | {- empty -}         { "" }
 108
 109 pStuffBetweenBraces :: { String }
 110 pStuffBetweenBraces : '{' pInsides '}' { $2 }
 111
 112 pInsides :: { String }
 113 pInsides : pInside pInsides { $1 ++ $2 }
 114          | {- empty -}      { "" }
 115
 116 pInside :: { String }
 117 pInside : '{' pInsides '}' { "{" ++ $2 ++ "}" }
 118         | noBraces         { $1 }
 119
 120 pType :: { Ty }
 121 pType : paT '->' pType { TyF $1 $3 }
 122       | paT            { $1 }
 123
 124 -- Atomic types
 125 paT :: { Ty }
 126 paT : pTycon ppTs     { TyApp $1 $2 }
 127     | pUnboxedTupleTy { $1 }
 128     | '(' pType ')'   { $2 }
 129     | lowerName       { TyVar $1 }
 130
 131 pUnboxedTupleTy :: { Ty }
 132 pUnboxedTupleTy : '(#' pCommaTypes '#)' { TyUTup $2 }
 133
 134 pCommaTypes :: { [Ty] }
 135 pCommaTypes : pType ',' pCommaTypes { $1 : $3 }
 136             | pType                 { [$1] }
 137
 138 ppTs :: { [Ty] }
 139 ppTs : ppT ppTs    { $1 : $2 }
 140      | {- empty -} { [] }
 141
 142 -- Primitive types
 143 ppT :: { Ty }
 144 ppT : lowerName { TyVar $1 }
 145     | pTycon    { TyApp $1 [] }
 146
 147 pTycon :: { String }
 148 pTycon : upperName { $1 }
 149        | '(' ')'   { "()" }
 150
 151 {
 152 parse :: String -> Either String Info
 153 parse = run_parser parsex
 154 }
 155