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  '%coerce'      { TKcoerce }
  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  '?'            { TKquestion}
  40  ';'            { TKsemicolon }
  41  NAME           { TKname $$ }
  42  CNAME          { TKcname $$ }
  43  INTEGER        { TKinteger $$ }
  44  RATIONAL       { TKrational $$ }
  45  STRING         { TKstring $$ }
  46  CHAR           { TKchar $$ }
  47
  48 %monad { P } { thenP } { returnP }
  49 %lexer { lexer } { TKEOF }
  50
  51 %%
  52
  53 module  :: { Module }
  54         : '%module' mname tdefs  vdefgs
  55                 { Module $2 $3 $4 }
  56
  57 tdefs   :: { [Tdef] }
  58         : {- empty -}   {[]}
  59         | tdef ';' tdefs        {$1:$3}
  60
  61 tdef    :: { Tdef }
  62         : '%data' qcname tbinds '=' '{' cons1 '}'
  63                 { Data $2 $3 $6 }
  64         | '%newtype' qcname tbinds trep
  65                 { Newtype $2 $3 $4 }
  66
  67 trep    :: { Maybe Ty }
  68         : {- empty -}   {Nothing}
  69         | '=' ty        { Just $2 }
  70
  71 tbind   :: { Tbind }
  72         :  name { ($1,Klifted) }
  73         |  '(' name '::' akind ')'
  74                 { ($2,$4) }
  75
  76 tbinds  :: { [Tbind] }
  77         : {- empty -}   { [] }
  78         | tbind tbinds  { $1:$2 }
  79
  80
  81 vbind   :: { Vbind }
  82         : '(' name '::' ty')'   { ($2,$4) }
  83
  84 vbinds  :: { [Vbind] }
  85         : {-empty -}    { [] }
  86         | vbind vbinds  { $1:$2 }
  87
  88 bind    :: { Bind }
  89         : '@' tbind     { Tb $2 }
  90         | vbind         { Vb $1 }
  91
  92 binds1  :: { [Bind] }
  93         : bind          { [$1] }
  94         | bind binds1   { $1:$2 }
  95
  96 attbinds :: { [Tbind] }
  97         : {- empty -}   { [] }
  98         | '@' tbind attbinds
  99                         { $2:$3 }
 100
 101 akind   :: { Kind }
 102         : '*'           {Klifted}
 103         | '#'           {Kunlifted}
 104         | '?'           {Kopen}
 105         | '(' kind ')'  { $2 }
 106
 107 kind    :: { Kind }
 108         : akind         { $1 }
 109         | akind '->' kind
 110                 { Karrow $1 $3 }
 111
 112 cons1   :: { [Cdef] }
 113         : con           { [$1] }
 114         | con ';' cons1 { $1:$3 }
 115
 116 con     :: { Cdef }
 117         : qcname attbinds atys
 118                 { Constr $1 $2 $3 }
 119
 120 atys    :: { [Ty] }
 121         : {- empty -} { [] }
 122         | aty atys      { $1:$2 }
 123
 124 aty     :: { Ty }
 125         : name  { Tvar $1 }
 126         | qcname { Tcon $1 }
 127         | '(' ty ')' { $2 }
 128
 129
 130 bty     :: { Ty }
 131         : aty   { $1 }
 132         | bty aty { Tapp $1 $2 }
 133
 134 ty      :: { Ty }
 135         : bty   {$1}
 136         | bty '->' ty
 137                 { tArrow $1 $3 }
 138         | '%forall' tbinds '.' ty
 139                 { foldr Tforall $4 $2 }
 140
 141 vdefgs  :: { [Vdefg] }
 142         : {- empty -}           { [] }
 143         | vdefg ';' vdefgs      {$1:$3 }
 144
 145 vdefg   :: { Vdefg }
 146         : '%rec' '{' vdefs1 '}'
 147                        { Rec $3 }
 148         |  vdef { Nonrec $1}
 149
 150 vdefs1  :: { [Vdef] }
 151         : vdef          { [$1] }
 152         | vdef ';' vdefs1 { $1:$3 }
 153
 154 vdef    :: { Vdef }
 155         : qname '::' ty '=' exp
 156                 { Vdef ($1,$3,$5) }
 157
 158 aexp    :: { Exp }
 159         : qname         { Var $1 }
 160         | qcname        { Dcon $1 }
 161         | lit           { Lit $1 }
 162         | '(' exp ')'   { $2 }
 163
 164 fexp    :: { Exp }
 165         : fexp aexp     { App $1 $2 }
 166         | fexp '@' aty  { Appt $1 $3 }
 167         | aexp          { $1 }
 168
 169 exp     :: { Exp }
 170         : fexp          { $1 }
 171         | '\\' binds1 '->' exp
 172                 { foldr Lam $4 $2 }
 173         | '%let' vdefg '%in' exp
 174                 { Let $2 $4 }
 175         | '%case' aexp '%of' vbind '{' alts1 '}'
 176                 { Case $2 $4 $6 }
 177         | '%coerce' aty exp
 178                 { Coerce $2 $3 }
 179         | '%note' STRING exp
 180                 { Note $2 $3 }
 181         | '%external' STRING aty
 182                 { External $2 $3 }
 183
 184 alts1   :: { [Alt] }
 185         : alt           { [$1] }
 186         | alt ';' alts1 { $1:$3 }
 187
 188 alt     :: { Alt }
 189         : qcname attbinds vbinds '->' exp
 190                 { Acon $1 $2 $3 $5 }
 191         | lit '->' exp
 192                 { Alit $1 $3 }
 193         | '%_' '->' exp
 194                 { Adefault $3 }
 195
 196 lit     :: { Lit }
 197         : '(' INTEGER '::' aty ')'
 198                 { Lint $2 $4 }
 199         | '(' RATIONAL '::' aty ')'
 200                 { Lrational $2 $4 }
 201         | '(' CHAR '::' aty ')'
 202                 { Lchar $2 $4 }
 203         | '(' STRING '::' aty ')'
 204                 { Lstring $2 $4 }
 205
 206 name    :: { Id }
 207         : NAME  { $1 }
 208
 209 cname   :: { Id }
 210         : CNAME { $1 }
 211
 212 mname   :: { Id }
 213         : CNAME { $1 }
 214
 215 qname   :: { (Id,Id) }
 216         : name  { ("",$1) }
 217         | mname '.' name
 218                 { ($1,$3) }
 219
 220 qcname  :: { (Id,Id) }
 221         : mname '.' cname
 222                 { ($1,$3) }
 223
 224
 225 {
 226
 227 happyError :: P a
 228 happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l
 229
 230 }