diff options
author | Iavor S. Diatchki <iavor.diatchki@gmail.com> | 2014-07-19 14:29:57 -0700 |
---|---|---|
committer | Iavor S. Diatchki <iavor.diatchki@gmail.com> | 2014-07-19 14:29:57 -0700 |
commit | 524634641c61ab42c555452f6f87119b27f6c331 (patch) | |
tree | f78d17bb6b09fb3b2e22cb4d93c2a3d45accc2d9 /compiler/deSugar/DsMeta.hs | |
parent | 79ad1d20c5500e17ce5daaf93b171131669bddad (diff) | |
parent | c41b716d82b1722f909979d02a76e21e9b68886c (diff) | |
download | haskell-wip/ext-solver.tar.gz |
Merge branch 'master' into wip/ext-solverwip/ext-solver
Diffstat (limited to 'compiler/deSugar/DsMeta.hs')
-rw-r--r-- | compiler/deSugar/DsMeta.hs | 22 |
1 files changed, 13 insertions, 9 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 73c1adfdc8..adfc0f688f 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2006 @@ -394,10 +396,10 @@ repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn }) ; repTySynInst tc eqn1 } repTyFamEqn :: LTyFamInstEqn Name -> DsM (Core TH.TySynEqnQ) -repTyFamEqn (L loc (TyFamInstEqn { tfie_pats = HsWB { hswb_cts = tys - , hswb_kvs = kv_names - , hswb_tvs = tv_names } - , tfie_rhs = rhs })) +repTyFamEqn (L loc (TyFamEqn { tfe_pats = HsWB { hswb_cts = tys + , hswb_kvs = kv_names + , hswb_tvs = tv_names } + , tfe_rhs = rhs })) = do { let hs_tvs = HsQTvs { hsq_kvs = kv_names , hsq_tvs = userHsTyVarBndrs loc tv_names } -- Yuk ; addTyClTyVarBinds hs_tvs $ \ _ -> @@ -705,12 +707,14 @@ addTyVarBinds :: LHsTyVarBndrs Name -- the binders to -- the computations passed as the second argument is executed in that extended -- meta environment and gets the *new* names on Core-level as an argument -addTyVarBinds tvs m - = do { freshNames <- mkGenSyms (hsLKiTyVarNames tvs) - ; term <- addBinds freshNames $ - do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (hsQTvBndrs tvs `zip` freshNames) +addTyVarBinds (HsQTvs { hsq_kvs = kvs, hsq_tvs = tvs }) m + = do { fresh_kv_names <- mkGenSyms kvs + ; fresh_tv_names <- mkGenSyms (map hsLTyVarName tvs) + ; let fresh_names = fresh_kv_names ++ fresh_tv_names + ; term <- addBinds fresh_names $ + do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (tvs `zip` fresh_tv_names) ; m kbs } - ; wrapGenSyms freshNames term } + ; wrapGenSyms fresh_names term } where mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v) |