Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
651 lines (521 sloc) 23.9 KB
{
module HaskellParser where
import Alex
EDITED !
import HaskellAbsSyn
}
%tokentype { Token' }
%token
"}" { Tk_CSym _ '}' }
";" { Tk_CSym _ ';' }
"{" { Tk_CSym _ '{' }
")" { Tk_CSym _ ')' }
"(" { Tk_CSym _ '(' }
"," { Tk_CSym _ ',' }
"=" { Tk_CSym _ '=' }
"]" { Tk_CSym _ ']' }
"[" { Tk_CSym _ '[' }
"|" { Tk_CSym _ '|' }
"!" { Tk_CSym _ '!' }
"-" { Tk_CSym _ '-' }
"\\" { Tk_CSym _ '\\' }
"@" { Tk_CSym _ '@' }
"_" { Tk_CSym _ '_' }
"~" { Tk_CSym _ '~' }
"`" { Tk_CSym _ '`' }
":" { Tk_CSym _ ':' }
"where" { Tk_SSym _ "where" }
"module" { Tk_SSym _ "module" }
".." { Tk_SSym _ ".." }
"as" { Tk_SSym _ "as" }
"qualified"{ Tk_SSym _ "qualified" }
"import" { Tk_SSym _ "import" }
"type" { Tk_SSym _ "type" }
"data" { Tk_SSym _ "data" }
"newtype" { Tk_SSym _ "newtype" }
"class" { Tk_SSym _ "class" }
"instance"{ Tk_SSym _ "instance" }
"default" { Tk_SSym _ "default" }
"=>" { Tk_SSym _ "=>" }
"::" { Tk_SSym _ "::" }
"infixl" { Tk_SSym _ "infixl" }
"infixr" { Tk_SSym _ "infixr" }
"infix" { Tk_SSym _ "infix" }
"->" { Tk_SSym _ "->" }
"deriving"{ Tk_SSym _ "deriving" }
"in" { Tk_SSym _ "in" }
"let" { Tk_SSym _ "let" }
"else" { Tk_SSym _ "else" }
"then" { Tk_SSym _ "then" }
"if" { Tk_SSym _ "if" }
"of" { Tk_SSym _ "of" }
"case" { Tk_SSym _ "case" }
"do" { Tk_SSym _ "do" }
"<-" { Tk_SSym _ "<-" }
qconid { Tk_qconid _ $$ }
conid { Tk_conid _ $$ }
qvarid { Tk_qvarid _ $$ }
varid { Tk_varid _ $$ }
qvarsym { Tk_qvarsym _ $$ }
varsym { Tk_varsym _ $$ }
qconsym { Tk_qconsym _ $$ }
consym { Tk_consym _ $$ }
integer { Tk_integer _ $$ }
float { Tk_float _ $$ }
char { Tk_char _ $$ }
string { Tk_string _ $$ }
%left "in" "else" "->"
%left "::"
%left "-"
%name modul modul
%%
modul :: { Modul }
: "module" modid exportspec "where" body { (Module $2 (Just $3) $5) }
| "module" modid "where" body { (Module $2 (Nothing) $4) }
body :: { ([Impdecl], [Decl]) }
: "{" impdecls ";" topdecls "}" { ($2, $4) }
| "{" impdecls "}" { ($2, []) }
| "{" topdecls "}" { ([], $2) }
impdecls :: { [Impdecl] }
: impdecl impdecls_1_1 { ($1 : $2) }
| impdecl { ($1 : []) }
exportspec :: { [Export] }
: "(" exports ")" { $2 }
exports :: { [Export] }
: { [] }
| export exports_1_1 { ($1 : $2) }
| export { ($1 : []) }
export :: { Export }
: qvar { (ExportQVar $1) }
| qtycon exportdetails { (ExportType $1 $2) }
| "module" modid { (ExportModule $2) }
exportdetails :: { Details }
: details { $1 }
details :: { Details }
: { (NoDetails ) }
| "(" ".." ")" { (AllDetails ) }
| "(" details_1_1 ")" { (SpecificDetails $2) }
| "(" ")" { (SpecificDetails []) }
qcname :: { Id }
: qvar { $1 }
| qcon { $1 }
impdecl :: { Impdecl }
: "import" "qualified" modid "as" modid impspec { (Import (Just "qualified") $3 (Just $5) (Just $6)) }
| "import" "qualified" modid "as" modid { (Import (Just "qualified") $3 (Just $5) (Nothing)) }
| "import" "qualified" modid impspec { (Import (Just "qualified") $3 (Nothing) (Just $4)) }
| "import" "qualified" modid { (Import (Just "qualified") $3 (Nothing) (Nothing)) }
| "import" modid "as" modid impspec { (Import (Nothing) $2 (Just $4) (Just $5)) }
| "import" modid "as" modid { (Import (Nothing) $2 (Just $4) (Nothing)) }
| "import" modid impspec { (Import (Nothing) $2 (Nothing) (Just $3)) }
| "import" modid { (Import (Nothing) $2 (Nothing) (Nothing)) }
impspec :: { [Import] }
: "(" imports ")" { $2 }
imports :: { [Import] }
: { [] }
| import imports_1_1 { ($1 : $2) }
| import { ($1 : []) }
import :: { Import }
: var { (ImportVar $1) }
| tycon importdetails { (ImportType $1 $2) }
importdetails :: { Details }
: details { $1 }
topdecls :: { [Decl] }
: topdecl topdecls_1_1 { ($1 : $2) }
| topdecl { ($1 : []) }
topdecl :: { Decl }
: "type" simpletype "=" type { (Type $2 $4) }
| "data" optcontext simpletype "=" constrs deriving { (Data $2 $3 $5 (Just $6)) }
| "data" optcontext simpletype "=" constrs { (Data $2 $3 $5 (Nothing)) }
| "newtype" optcontext simpletype "=" newconstr deriving { (Newtype $2 $3 $5 (Just $6)) }
| "newtype" optcontext simpletype "=" newconstr { (Newtype $2 $3 $5 (Nothing)) }
| "class" optscontext tycls tyvar "where" cdecls { (Class $2 $3 $4 (Just $6)) }
| "class" optscontext tycls tyvar { (Class $2 $3 $4 (Nothing)) }
| "instance" optscontext qtycls inst "where" idecls { (Instance $2 $3 $4 (Just $6)) }
| "instance" optscontext qtycls inst { (Instance $2 $3 $4 (Nothing)) }
| "default" "(" defaults ")" { (Default $3) }
| decl { $1 }
optcontext :: { [Type] }
: { [] }
| context "=>" { $1 }
optscontext :: { [Type] }
: { [] }
| scontext "=>" { $1 }
defaults :: { [Type] }
: { [] }
| type defaults_1_1 { ($1 : $2) }
| type { ($1 : []) }
decls :: { [Decl] }
: "{" "}" { [] }
| "{" decl decls_1_1 "}" { ($2 : $3) }
| "{" decl "}" { ($2 : []) }
decl :: { Decl }
: gendecl { $1 }
| funlhs rhs { (FunDecl $1 $2) }
| pat0n rhs { (PatDecl $1 $2) }
cdecls :: { [Decl] }
: { [] }
| cdecl cdecls_1_1 { ($1 : $2) }
| cdecl { ($1 : []) }
cdecl :: { Decl }
: decl { $1 }
idecls :: { [Decl] }
: "{" "}" { [] }
| "{" idecl idecls_1_1 "}" { ($2 : $3) }
| "{" idecl "}" { ($2 : []) }
idecl :: { Decl }
: funlhs rhs { (FunDecl $1 $2) }
| qfunlhs rhs { (FunDecl $1 $2) }
| pvar rhs { (PatDecl $1 $2) }
| pqvar rhs { (PatDecl $1 $2) }
pvar :: { Pat }
: var { (VarPat $1) }
pqvar :: { Pat }
: qvar { (VarPat $1) }
gendecl :: { Decl }
: vars "::" qualtype { (TypeSig $1 $3) }
| fixity integer ops { (Fixity $1 (Just $2) $3) }
| fixity ops { (Fixity $1 (Nothing) $2) }
qualtype :: { Qualtype }
: optcontext type { (QualType $1 $2) }
ops :: { [Id] }
: op ops_1_1 { ($1 : $2) }
| op { ($1 : []) }
vars :: { [Id] }
: var vars_1_1 { ($1 : $2) }
| var { ($1 : []) }
fixity :: { Fixity }
: "infixl" { (InfixL ) }
| "infixr" { (InfixR ) }
| "infix" { (Infix ) }
type :: { Type }
: btype "->" type { (FunType $1 $3) }
| btype { $1 }
btype :: { Type }
: btype atype { (AppType $1 $2) }
| atype { $1 }
atype :: { Type }
: gtycon { (ConType $1) }
| tyvar { (VarType $1) }
| "(" type "," type defaults_1_1 ")" { (TupleType ($2 : ($4 : $5))) }
| "(" type "," type ")" { (TupleType ($2 : ($4 : []))) }
| "[" type "]" { (ListType $2) }
| "(" type ")" { $2 }
gtycon :: { Gtycon }
: qtycon { (GTycon $1) }
| "(" ")" { (UnitTycon ) }
| "[" "]" { (ListTycon ) }
| "(" "->" ")" { (FunTycon ) }
| "(" "," gtycon_2_1 ")" { (TupleTycon (',' : $3)) }
| "(" "," ")" { (TupleTycon (',' : [])) }
context :: { [Type] }
: type { [$1] }
scontext :: { [Type] }
: type { [$1] }
simpletype :: { Simpletype }
: tycon simpletype_1_1 { (SimpleType $1 $2) }
| tycon { (SimpleType $1 []) }
constrs :: { [Constr] }
: constr constrs_1_1 { ($1 : $2) }
| constr { ($1 : []) }
constr :: { Constr }
: con constr_1_1 { (Constr $1 $2) }
| con { (Constr $1 []) }
| conoptype conop conoptype { (Constr $2 [$1, $3]) }
| con "{" fielddecls "}" { (ConstrFields $1 $3) }
strictness :: { Strictness }
: "!" { (Strict ) }
| { (Lazy ) }
conoptype :: { (Strictness, Type) }
: btype { ((Lazy ), $1) }
| "!" atype { ((Strict ), $2) }
fielddecls :: { [([Id], (Strictness, Type))] }
: { [] }
| fielddecl fielddecls_1_1 { ($1 : $2) }
| fielddecl { ($1 : []) }
newconstr :: { Newconstr }
: con atype { (NewConstr $1 $2) }
| con "{" var "::" type "}" { (NewConstrField $1 $3 $5) }
fielddecl :: { ([Id], (Strictness, Type)) }
: vars "::" fieldtype { ($1, $3) }
fieldtype :: { (Strictness, Type) }
: type { ((Lazy ), $1) }
| "!" atype { ((Strict ), $2) }
deriving :: { [QTycls] }
: "deriving" dclasses { $2 }
dclasses :: { [QTycls] }
: { [] }
| dclass { [$1] }
| "(" ")" { [] }
| "(" dclass dclasses_1_1 ")" { ($2 : $3) }
| "(" dclass ")" { ($2 : []) }
dclass :: { QTycls }
: qtycls { $1 }
inst :: { Inst }
: gtycon { (ConInst $1 []) }
| "(" gtycon simpletype_1_1 ")" { (ConInst $2 $3) }
| "(" gtycon ")" { (ConInst $2 []) }
| "(" tyvar "," tyvar inst_1_1 ")" { (TupleInst ($2 : ($4 : $5))) }
| "(" tyvar "," tyvar ")" { (TupleInst ($2 : ($4 : []))) }
| "[" tyvar "]" { (ListInst $2) }
| "(" tyvar "->" tyvar ")" { (FunInst $2 $4) }
funlhs :: { (Id, [Pat]) }
: var apat funlhs_2_1 { ($1, ($2 : $3)) }
| var apat { ($1, ($2 : [])) }
| pat0n varop pat0n { ($2, [$1, $3]) }
qfunlhs :: { (Id, [Pat]) }
: qvar apat funlhs_2_1 { ($1, ($2 : $3)) }
| qvar apat { ($1, ($2 : [])) }
| pat0n qvarop pat0n { ($2, [$1, $3]) }
rhs :: { Rhs }
: "=" exp wheredecls { (Rhs $2 $3) }
| gdrhs wheredecls { (GdRhs $1 $2) }
wheredecls :: { [Decl] }
: { [] }
| "where" decls { $2 }
gdrhs :: { [(Exp, Exp)] }
: gd "=" exp gdrhs_2_1 { (($1, $3) : $4) }
| gd "=" exp { (($1, $3) : []) }
gd :: { Exp }
: "|" exp0n { $2 }
exp :: { Exp }
: exp0n "::" qualtype { (TypedExp $1 $3) }
| exp0n { $1 }
exp0n :: { Exp }
: exp0n qop exp0n %prec "-" { (OpExp $1 $2 $3) }
| "-" exp0n { (NegExp $2) }
| exp10n { $1 }
exp10n :: { Exp }
: "\\" pat exp10n_2_1 "->" exp { (Lambda ($2 : $3) $5) }
| "\\" pat "->" exp { (Lambda ($2 : []) $4) }
| "let" decls "in" exp { (Let $2 $4) }
| "if" exp "then" exp "else" exp { (If $2 $4 $6) }
| "case" exp "of" "{" alts "}" { (Case $2 $5) }
| "do" "{" stmts "}" { (Do $3) }
| fexp { $1 }
fexp :: { Exp }
: fexp aexp { (App $1 $2) }
| aexp { $1 }
aexp :: { Exp }
: qvar { (VarExp $1) }
| gcon { (ConExp $1) }
| literal { (Lit $1) }
| "(" exp ")" { (ParenExp $2) }
| "(" exp "," exp aexp_1_1 ")" { (TupleExp ($2 : ($4 : $5))) }
| "(" exp "," exp ")" { (TupleExp ($2 : ($4 : []))) }
| "[" exp aexp_1_1 "]" { (ListExp ($2 : $3)) }
| "[" exp "]" { (ListExp ($2 : [])) }
| "[" exp "," exp ".." exp "]" { (Seq $2 (Just $4) (Just $6)) }
| "[" exp "," exp ".." "]" { (Seq $2 (Just $4) (Nothing)) }
| "[" exp ".." exp "]" { (Seq $2 (Nothing) (Just $4)) }
| "[" exp ".." "]" { (Seq $2 (Nothing) (Nothing)) }
| "(" exp0n qop ")" { (LSection $2 $3) }
| "(" qop exp0n ")" { (RSection $2 $3) }
| aexp "{" fbinds "}" { (FieldUpd $1 $3) }
qual :: { Qual }
: exp "<-" exp { (GenQual $1 $3) }
| "let" decls { (LetQual $2) }
| exp { (GdGual $1) }
alts :: { [Alt] }
: { [] }
| alt alts_1_1 { ($1 : $2) }
| alt { ($1 : []) }
alt :: { Alt }
: pat "->" exp wheredecls { (Alt $1 $3 $4) }
| pat gdpat wheredecls { (GdAlt $1 $2 $3) }
gdpat :: { [(Exp, Exp)] }
: gd "->" exp gdpat_2_1 { (($1, $3) : $4) }
| gd "->" exp { (($1, $3) : []) }
stmts :: { ([Qual], Exp) }
: stmts_1_1 exp ";" { ($1, $2) }
| stmts_1_1 exp { ($1, $2) }
| exp ";" { ([], $1) }
| exp { ([], $1) }
stmt :: { Qual }
: qual ";" { $1 }
fbinds :: { [(Id, Exp)] }
: { [] }
| fbind fbinds_1_1 { ($1 : $2) }
| fbind { ($1 : []) }
fbind :: { (Id, Exp) }
: qvar "=" exp { ($1, $3) }
pat :: { Pat }
: pat0n { $1 }
pat0n :: { Pat }
: pat0n qconop pat0n %prec "-" { (OpPat $1 $2 $3) }
| "-" pat0n { (NegPat $2) }
| pat10n { $1 }
pat10n :: { Pat }
: apat { $1 }
| gcon apat funlhs_2_1 { (ConPat $1 ($2 : $3)) }
| gcon apat { (ConPat $1 ($2 : [])) }
apat :: { Pat }
: var { (VarPat $1) }
| var "@" apat { (As $1 $3) }
| gcon { (ConPat $1 []) }
| qcon "{" fpats "}" { (FieldPat $1 $3) }
| literal { (LitPat $1) }
| "_" { (Wildcard ) }
| "(" pat ")" { (ParenPat $2) }
| "(" pat "," pat apat_1_1 ")" { (TuplePat ($2 : ($4 : $5))) }
| "(" pat "," pat ")" { (TuplePat ($2 : ($4 : []))) }
| "[" pat apat_1_1 "]" { (ListPat ($2 : $3)) }
| "[" pat "]" { (ListPat ($2 : [])) }
| "~" apat { (IrrPat $2) }
fpats :: { [(Id, Pat)] }
: { [] }
| fpat fpats_1_1 { ($1 : $2) }
| fpat { ($1 : []) }
fpat :: { (Id, Pat) }
: qvar "=" pat { ($1, $3) }
gcon :: { Gcon }
: "(" ")" { (UnitCon ) }
| "[" "]" { (NilCon ) }
| "(" "," gtycon_2_1 ")" { (TupleCon (',' : $3)) }
| "(" "," ")" { (TupleCon (',' : [])) }
| qcon { (QCon $1) }
var :: { Id }
: varid { (Id $1) }
| "(" varsym ")" { (SymId $2) }
qvar :: { Id }
: qvarid { (QId $1) }
| "(" qvarsym ")" { (QdSymId $2) }
con :: { Id }
: conid { (ConId $1) }
| "(" consym ")" { (ConsymId $2) }
qcon :: { Id }
: qconid { (QConId $1) }
| "(" gconsym ")" { (QConsymId $2) }
varop :: { Id }
: varsym { (Op $1) }
| "`" varid "`" { (IdOp $2) }
qvarop :: { Id }
: qvarsym { (QOp $1) }
| "`" qvarid "`" { (QIdOp $2) }
conop :: { Id }
: consym { (ConOp $1) }
| "`" conid "`" { (ConIdOp $2) }
qconop :: { Id }
: gconsym { (QConOp $1) }
| "`" qconid "`" { (QConIdOp $2) }
op :: { Id }
: varop { $1 }
| conop { $1 }
qop :: { Id }
: qvarop { $1 }
| qconop { $1 }
gconsym :: { String }
: ":" { ":" }
| qconsym { $1 }
modid :: { Modid }
: conid { (ModId $1) }
qtycon :: { Qtycon }
: qconid { (QTycon $1) }
tycon :: { Tycon }
: conid { (Tycon $1) }
tyvar :: { Tyvar }
: varid { (Tyvar $1) }
tycls :: { Tycls }
: conid { (Tycls $1) }
qtycls :: { QTycls }
: qconid { (QTycls $1) }
literal :: { String }
: integer { $1 }
| float { $1 }
| char { $1 }
| string { $1 }
impdecls_1_1 :: { [Impdecl] }
: ";" impdecl impdecls_1_1 { ($2 : $3) }
| ";" impdecl { [$2] }
exports_1_1 :: { [Export] }
: "," export exports_1_1 { ($2 : $3) }
| "," export { [$2] }
details_1_1 :: { [Id] }
: qcname details_1_1 { ($1 : $2) }
| qcname { [$1] }
imports_1_1 :: { [Import] }
: "," import imports_1_1 { ($2 : $3) }
| "," import { [$2] }
topdecls_1_1 :: { [Decl] }
: ";" topdecl topdecls_1_1 { ($2 : $3) }
| ";" topdecl { [$2] }
defaults_1_1 :: { [Type] }
: "," type defaults_1_1 { ($2 : $3) }
| "," type { [$2] }
decls_1_1 :: { [Decl] }
: ";" decl decls_1_1 { ($2 : $3) }
| ";" decl { [$2] }
cdecls_1_1 :: { [Decl] }
: ";" cdecl cdecls_1_1 { ($2 : $3) }
| ";" cdecl { [$2] }
idecls_1_1 :: { [Decl] }
: ";" idecl idecls_1_1 { ($2 : $3) }
| ";" idecl { [$2] }
ops_1_1 :: { [Id] }
: "," op ops_1_1 { ($2 : $3) }
| "," op { [$2] }
vars_1_1 :: { [Id] }
: "," var vars_1_1 { ($2 : $3) }
| "," var { [$2] }
gtycon_2_1 :: { [Char] }
: "," gtycon_2_1 { (',' : $2) }
| "," { [','] }
simpletype_1_1 :: { [Tyvar] }
: tyvar simpletype_1_1 { ($1 : $2) }
| tyvar { [$1] }
constrs_1_1 :: { [Constr] }
: "|" constr constrs_1_1 { ($2 : $3) }
| "|" constr { [$2] }
constr_1_1 :: { [(Strictness, Type)] }
: strictness atype constr_1_1 { (($1, $2) : $3) }
| strictness atype { [($1, $2)] }
fielddecls_1_1 :: { [([Id], (Strictness, Type))] }
: "," fielddecl fielddecls_1_1 { ($2 : $3) }
| "," fielddecl { [$2] }
dclasses_1_1 :: { [QTycls] }
: "," dclass dclasses_1_1 { ($2 : $3) }
| "," dclass { [$2] }
inst_1_1 :: { [Tyvar] }
: "," tyvar inst_1_1 { ($2 : $3) }
| "," tyvar { [$2] }
funlhs_2_1 :: { [Pat] }
: apat funlhs_2_1 { ($1 : $2) }
| apat { [$1] }
gdrhs_2_1 :: { [(Exp, Exp)] }
: gd "=" exp gdrhs_2_1 { (($1, $3) : $4) }
| gd "=" exp { [($1, $3)] }
exp10n_2_1 :: { [Pat] }
: pat exp10n_2_1 { ($1 : $2) }
| pat { [$1] }
aexp_1_1 :: { [Exp] }
: "," exp aexp_1_1 { ($2 : $3) }
| "," exp { [$2] }
alts_1_1 :: { [Alt] }
: ";" alt alts_1_1 { ($2 : $3) }
| ";" alt { [$2] }
gdpat_2_1 :: { [(Exp, Exp)] }
: gd "->" exp gdpat_2_1 { (($1, $3) : $4) }
| gd "->" exp { [($1, $3)] }
stmts_1_1 :: { [Qual] }
: stmt stmts_1_1 { ($1 : $2) }
| stmt { [$1] }
fbinds_1_1 :: { [(Id, Exp)] }
: "," fbind fbinds_1_1 { ($2 : $3) }
| "," fbind { [$2] }
apat_1_1 :: { [Pat] }
: "," pat apat_1_1 { ($2 : $3) }
| "," pat { [$2] }
fpats_1_1 :: { [(Id, Pat)] }
: "," fpat fpats_1_1 { ($2 : $3) }
| "," fpat { [$2] }
{
parse' :: String -> Modul
parse' s = modul (tokens' s)
happyError :: [Token'] -> a
happyError tks = error ("Parse error at " ++ lcn ++ "\n")
where
lcn = case tks of
[] -> "end of file"
tk:_ -> "line " ++ show l ++ ", column " ++ show c
where
Pn _ l c = token'pos tk
}