utils/ext-core/Parser.y

   1 {
   2 module Parser ( parse ) where
   3
   4 import Core
   5 import ParseGlue
   6 import Lex
   7
   8 }
   9
  10 %name parse
  11 %tokentype { Token }
  12
  13 %token
  14  '%module'      { TKmodule }
  15  '%data'        { TKdata }
  16  '%newtype'     { TKnewtype }
  17  '%forall'      { TKforall }
  18  '%rec'         { TKrec }
  19  '%let'         { TKlet }
  20  '%in'          { TKin }
  21  '%case'        { TKcase }
  22  '%of'          { TKof }
  23  '%cast'        { TKcast }
  24  '%note'        { TKnote }
  25  '%external'    { TKexternal }
  26  '%_'           { TKwild }
  27  '('            { TKoparen }
  28  ')'            { TKcparen }
  29  '{'            { TKobrace }
  30  '}'            { TKcbrace }
  31  '#'            { TKhash}
  32  '='            { TKeq }
  33  '::'           { TKcoloncolon }
  34  '*'            { TKstar }
  35  '->'           { TKrarrow }
  36  '\\'           { TKlambda}
  37  '@'            { TKat }
  38  '.'            { TKdot }
  39  ':'            { TKcolon }
  40  '?'            { TKquestion}
  41  ';'            { TKsemicolon }
  42  NAME           { TKname $$ }
  43  CNAME          { TKcname $$ }
  44  INTEGER        { TKinteger $$ }
  45  RATIONAL       { TKrational $$ }
  46  STRING         { TKstring $$ }
  47  CHAR           { TKchar $$ }
  48
  49 %monad { P } { thenP } { returnP }
  50 %lexer { lexer } { TKEOF }
  51
  52 %%
  53
  54 module  :: { Module }
  55         : '%module' mname tdefs  vdefgs
  56                 { Module $2 $3 $4 }
  57
  58 tdefs   :: { [Tdef] }
  59         : {- empty -}   {[]}
  60         | tdef ';' tdefs        {$1:$3}
  61
  62 tdef    :: { Tdef }
  63         : '%data' qcname tbinds '=' '{' cons1 '}'
  64                 { Data $2 $3 $6 }
  65         | '%newtype' qcname tbinds trep
  66                 { Newtype $2 $3 $4 }
  67
  68 trep    :: { Maybe Ty }
  69         : {- empty -}   {Nothing}
  70         | '=' ty        { Just $2 }
  71
  72 tbind   :: { Tbind }
  73         :  name { ($1,Klifted) }
  74         |  '(' name '::' akind ')'
  75                 { ($2,$4) }
  76
  77 tbinds  :: { [Tbind] }
  78         : {- empty -}   { [] }
  79         | tbind tbinds  { $1:$2 }
  80
  81
  82 vbind   :: { Vbind }
  83         : '(' name '::' ty')'   { ($2,$4) }
  84
  85 vbinds  :: { [Vbind] }
  86         : {-empty -}    { [] }
  87         | vbind vbinds  { $1:$2 }
  88
  89 bind    :: { Bind }
  90         : '@' tbind     { Tb $2 }
  91         | vbind         { Vb $1 }
  92
  93 binds1  :: { [Bind] }
  94         : bind          { [$1] }
  95         | bind binds1   { $1:$2 }
  96
  97 attbinds :: { [Tbind] }
  98         : {- empty -}   { [] }
  99         | '@' tbind attbinds
 100                         { $2:$3 }
 101
 102 akind   :: { Kind }
 103         : '*'           {Klifted}
 104         | '#'           {Kunlifted}
 105         | '?'           {Kopen}
 106         | '(' kind ')'  { $2 }
 107
 108 kind    :: { Kind }
 109         : akind         { $1 }
 110         | akind '->' kind
 111                 { Karrow $1 $3 }
 112
 113 cons1   :: { [Cdef] }
 114         : con           { [$1] }
 115         | con ';' cons1 { $1:$3 }
 116
 117 con     :: { Cdef }
 118         : qcname attbinds atys
 119                 { Constr $1 $2 $3 }
 120
 121 atys    :: { [Ty] }
 122         : {- empty -} { [] }
 123         | aty atys      { $1:$2 }
 124
 125 aty     :: { Ty }
 126         : name  { Tvar $1 }
 127         | qcname { Tcon $1 }
 128         | '(' ty ')' { $2 }
 129
 130
 131 bty     :: { Ty }
 132         : aty   { $1 }
 133         | bty aty { Tapp $1 $2 }
 134
 135 ty      :: { Ty }
 136         : bty   {$1}
 137         | bty '->' ty
 138                 { tArrow $1 $3 }
 139         | '%forall' tbinds '.' ty
 140                 { foldr Tforall $4 $2 }
 141
 142 vdefgs  :: { [Vdefg] }
 143         : {- empty -}           { [] }
 144         | vdefg ';' vdefgs      {$1:$3 }
 145
 146 vdefg   :: { Vdefg }
 147         : '%rec' '{' vdefs1 '}'
 148                        { Rec $3 }
 149         |  vdef { Nonrec $1}
 150
 151 vdefs1  :: { [Vdef] }
 152         : vdef          { [$1] }
 153         | vdef ';' vdefs1 { $1:$3 }
 154
 155 vdef    :: { Vdef }
 156         : qname '::' ty '=' exp
 157                 { Vdef ($1,$3,$5) }
 158
 159 aexp    :: { Exp }
 160         : qname         { Var $1 }
 161         | qcname        { Dcon $1 }
 162         | lit           { Lit $1 }
 163         | '(' exp ')'   { $2 }
 164
 165 fexp    :: { Exp }
 166         : fexp aexp     { App $1 $2 }
 167         | fexp '@' aty  { Appt $1 $3 }
 168         | aexp          { $1 }
 169
 170 exp     :: { Exp }
 171         : fexp          { $1 }
 172         | '\\' binds1 '->' exp
 173                 { foldr Lam $4 $2 }
 174         | '%let' vdefg '%in' exp
 175                 { Let $2 $4 }
 176         | '%case' '(' ty ')' aexp '%of' vbind '{' alts1 '}'
 177                 { Case $5 $7 $3 $9 }
 178 -- Note: ty, not aty! You can cast something to a forall type
 179 -- Though now we have shift/reduce conflicts like woah
 180         | '%cast' exp ty
 181                 { Cast $2 $3 }
 182         | '%note' STRING exp
 183                 { Note $2 $3 }
 184         | '%external' STRING aty
 185                 { External $2 $3 }
 186
 187 alts1   :: { [Alt] }
 188         : alt           { [$1] }
 189         | alt ';' alts1 { $1:$3 }
 190
 191 alt     :: { Alt }
 192         : qcname attbinds vbinds '->' exp
 193                 { Acon $1 $2 $3 $5 }
 194         | lit '->' exp
 195                 { Alit $1 $3 }
 196         | '%_' '->' exp
 197                 { Adefault $3 }
 198
 199 lit     :: { Lit }
 200         : '(' INTEGER '::' aty ')'
 201                 { Lint $2 $4 }
 202         | '(' RATIONAL '::' aty ')'
 203                 { Lrational $2 $4 }
 204         | '(' CHAR '::' aty ')'
 205                 { Lchar $2 $4 }
 206         | '(' STRING '::' aty ')'
 207                 { Lstring $2 $4 }
 208
 209 name    :: { Id }
 210         : NAME  { $1 }
 211
 212 cname   :: { Id }
 213         : CNAME { $1 }
 214
 215 mname   :: { AnMname }
 216         : pkgName ':' cname
 217              { let (parentNames, childName) = splitModuleName $3 in
 218                  ($1, parentNames, childName) }
 219
 220 pkgName :: { Id }
 221         : NAME { $1 }
 222
 223 -- TODO: Clean this up. Now hierarchical names are z-encoded.
 224
 225 -- note that a sequence of mnames is either:
 226 -- empty, or a series of cnames separated by
 227 -- dots, with a leading dot
 228 -- See the definition of mnames: the "name" part
 229 -- is required.
 230 mnames :: { [Id] }
 231          : {- empty -} {[]}
 232          | '.' cname mnames {$2:$3}
 233
 234 -- it sucks to have to repeat the Maybe-checking twice,
 235 -- but otherwise we get reduce/reduce conflicts
 236
 237 -- TODO: this is the ambiguity here. mname '.' name --
 238 -- but by maximal-munch, in GHC.Base.Bool the entire
 239 -- thing gets counted as the module name. What to do,
 240 -- besides z-encoding the dots in the hierarchy again?
 241 -- (Or using syntax other than a dot to separate the
 242 -- module name from the variable name...)
 243 qname   :: { (Mname,Id) }
 244         : name { (Nothing, $1) }
 245         | mname '.' name
 246                 { (Just $1,$3) }
 247
 248 qcname  :: { (Mname,Id) }
 249         : cname { (Nothing, $1) }
 250         | mname '.' cname
 251                 { (Just $1,$3) }
 252
 253
 254 {
 255
 256 happyError :: P a
 257 happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l
 258
 259 }