[commit: ghc] wip/T9953: Pass spec_eqs to tc_patsyn_finish (fe7651c)

git at git.haskell.org git at git.haskell.org
Sat Jan 3 13:01:40 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T9953
Link       : http://ghc.haskell.org/trac/ghc/changeset/fe7651ca5cbf7eff75b6197de4acf4473aa604fd/ghc

>---------------------------------------------------------------

commit fe7651ca5cbf7eff75b6197de4acf4473aa604fd
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Sat Jan 3 15:50:48 2015 +0800

    Pass spec_eqs to tc_patsyn_finish


>---------------------------------------------------------------

fe7651ca5cbf7eff75b6197de4acf4473aa604fd
 compiler/typecheck/TcPatSyn.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index d0b316e..2f60f3c 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -98,6 +98,7 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L loc name), psb_args = details,
        ; tc_patsyn_finish lname dir is_infix lpat'
                           (univ_tvs, req_theta, ev_binds, req_dicts)
                           (ex_tvs, map mkTyVarTy ex_tvs, prov_theta, emptyTcEvBinds, prov_dicts)
+                          []
                           (zip args $ repeat idHsWrapper)
                           pat_ty }
 
@@ -194,6 +195,7 @@ tcCheckPatSynDecl PSB{ psb_id = lname@(L loc name), psb_args = details,
        ; tc_patsyn_finish lname dir is_infix lpat'
                           (univ_tvs, req_theta, req_ev_binds, req_dicts)
                           (ex_tvs, ex_tys, prov_theta, prov_ev_binds, prov_dicts)
+                          spec_eqs
                           wrapped_args
                           pat_ty }
   where
@@ -212,17 +214,20 @@ tc_patsyn_finish :: Located Name
                  -> LPat Id
                  -> ([TcTyVar], [PredType], TcEvBinds, [EvVar])
                  -> ([TcTyVar], [TcType], [PredType], TcEvBinds, [EvVar])
+                 -> [(TcTyVar, TcType)]
                  -> [(Var, HsWrapper)]
                  -> TcType
                  -> TcM (PatSyn, LHsBinds Id)
 tc_patsyn_finish lname dir is_infix lpat'
                  (univ_tvs, req_theta, req_ev_binds, req_dicts)
                  (ex_tvs, subst, prov_theta, prov_ev_binds, prov_dicts)
+                 spec_eqs
                  wrapped_args
                  pat_ty
   = do { traceTc "tc_patsyn_finish" $
          ppr (univ_tvs, req_theta, req_ev_binds, req_dicts) $$
          ppr (ex_tvs, subst, prov_theta, prov_ev_binds, prov_dicts) $$
+         ppr spec_eqs $$
          ppr wrapped_args $$
          ppr pat_ty
 
@@ -237,7 +242,7 @@ tc_patsyn_finish lname dir is_infix lpat'
        ; let patSyn = mkPatSyn (unLoc lname) is_infix
                         (univ_tvs, req_theta)
                         (ex_tvs, prov_theta)
-                        []
+                        spec_eqs
                         arg_tys
                         pat_ty
                         matcher_id builder_id



More information about the ghc-commits mailing list