Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
4a8695c5
Commit
4a8695c5
authored
Sep 20, 2006
by
bjorn@bringert.net
Browse files
Merged stand-alone deriving with FC stuff.
parent
9c5aa098
Changes
5
Hide whitespace changes
Inline
Side-by-side
compiler/parser/Parser.y.pp
View file @
4a8695c5
...
...
@@ -456,8 +456,10 @@ topdecl :: { OrdList (LHsDecl RdrName) }
:
cl_decl
{
unitOL
(
L1
(
TyClD
(
unLoc
$1
)))
}
|
ty_decl
{
unitOL
(
L1
(
TyClD
(
unLoc
$1
)))
}
|
'instance'
inst_type
where
{
let
(
binds
,
sigs
)
=
cvBindsAndSigs
(
unLoc
$3
)
in
unitOL
(
L
(
comb3
$1
$2
$3
)
(
InstD
(
InstDecl
$2
binds
sigs
)))
}
{
let
(
binds
,
sigs
,
ats
)
=
cvBindsAndSigs
(
unLoc
$3
)
in
unitOL
(
L
(
comb3
$1
$2
$3
)
(
InstD
(
InstDecl
$2
binds
sigs
ats
)))
}
|
stand_alone_deriving
{
unitOL
(
LL
(
DerivD
(
unLoc
$1
)))
}
|
'default'
'('
comma_types0
')'
{
unitOL
(
LL
$
DefD
(
DefaultDecl
$3
))
}
|
'foreign'
fdecl
{
unitOL
(
LL
(
unLoc
$2
))
}
|
'{-# DEPRECATED'
deprecations
'#-}'
{
$2
}
...
...
compiler/typecheck/TcDeriv.lhs
View file @
4a8695c5
...
...
@@ -386,7 +386,11 @@ makeDerivEqns overlap_flag tycl_decls deriv_decls
mk_eqn_help loc orig gla_exts new_or_data tycon deriv_tvs clas tys
------------------------------------------------------------------
mk_eqn_help gla_exts DataType tycon deriv_tvs clas tys
-- data/newtype T a = ... deriving( C t1 t2 )
-- leads to a call to mk_eqn_help with
-- tycon = T, deriv_tvs = ftv(t1,t2), clas = C, tys = [t1,t2]
mk_eqn_help loc orig gla_exts DataType tycon deriv_tvs clas tys
| Just err <- checkSideConditions gla_exts tycon deriv_tvs clas tys
= bale_out (derivingThingErr clas tys tycon (tyConTyVars tycon) err)
| otherwise
...
...
compiler/typecheck/TcInstDcls.lhs
View file @
4a8695c5
...
...
@@ -179,16 +179,19 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
-- (3) Instances from generic class declarations
; generic_inst_info <- getGenericInstances clas_decls
-- (3) Compute instances from "deriving" clauses;
-- This stuff computes a context for the derived instance decl, so it
-- needs to know about all the instances possible; hence inst_env4
tcDeriving tycl_decls `thenM` \ (deriv_inst_info, deriv_binds) ->
addInsts deriv_inst_info $
-- Next, construct the instance environment so far, consisting
-- of
-- a) local instance decls
-- b) generic instances
-- c) local family instance decls
; addInsts local_info $ do {
; addInsts generic_inst_info $ do {
; addFamInsts at_idx_tycon $ do {
-- (4) Compute instances from "deriving" clauses;
-- This stuff computes a context for the derived instance
-- decl, so it needs to know about all the instances possible
; (deriv_inst_info, deriv_binds) <- tcDeriving tycl_decls
; (deriv_inst_info, deriv_binds) <- tcDeriving tycl_decls
deriv_decls
; addInsts deriv_inst_info $ do {
; gbl_env <- getGblEnv
...
...
compiler/typecheck/TcSimplify.lhs
View file @
4a8695c5
...
...
@@ -2162,7 +2162,7 @@ tcSimplifyDeriv orig tc tyvars theta
-- The main loop may do unification, and that may crash if
-- it doesn't see a TcTyVar, so we have to instantiate. Sigh
-- ToDo: what if two of them do get unified?
newDict
s DerivO
rig
in
(substTheta tenv theta) `thenM` \ wanteds ->
newDict
BndrsO o
rig (substTheta tenv theta) `thenM` \ wanteds ->
simpleReduceLoop doc reduceMe wanteds `thenM` \ (frees, _, irreds) ->
ASSERT( null frees ) -- reduceMe never returns Free
...
...
compiler/typecheck/TcType.lhs
View file @
4a8695c5
...
...
@@ -673,6 +673,7 @@ tcSplitPhiTy ty = split ty ty []
| Just p <- tcSplitPredTy_maybe arg = split res res (p:ts)
split orig_ty ty ts = (reverse ts, orig_ty)
tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
tcSplitSigmaTy ty = case tcSplitForAllTys ty of
(tvs, rho) -> case tcSplitPhiTy rho of
(theta, tau) -> (tvs, theta, tau)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment