diff options
Diffstat (limited to 'compiler/iface/TcIface.lhs')
| -rw-r--r-- | compiler/iface/TcIface.lhs | 35 |
1 files changed, 13 insertions, 22 deletions
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 980796afdf..2cf0cf7816 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -584,7 +584,8 @@ tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc ; return (ACoAxiom axiom) } tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name - , ifPatHasWrapper = has_wrapper + , ifPatMatcher = matcher_name + , ifPatWrapper = wrapper_name , ifPatIsInfix = is_infix , ifPatUnivTvs = univ_tvs , ifPatExTvs = ex_tvs @@ -594,20 +595,24 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name , ifPatTy = pat_ty }) = do { name <- lookupIfaceTop occ_name ; traceIf (ptext (sLit "tc_iface_decl") <+> ppr name) + ; matcher <- tcExt "Matcher" matcher_name + ; wrapper <- case wrapper_name of + Nothing -> return Nothing + Just wn -> do { wid <- tcExt "Wrapper" wn + ; return (Just wid) } ; bindIfaceTyVars univ_tvs $ \univ_tvs -> do { bindIfaceTyVars ex_tvs $ \ex_tvs -> do - { bindIfaceIdVars args $ \args -> do - { ~(prov_theta, req_theta, pat_ty) <- forkM (mk_doc name) $ + { patsyn <- forkM (mk_doc name) $ do { prov_theta <- tcIfaceCtxt prov_ctxt ; req_theta <- tcIfaceCtxt req_ctxt ; pat_ty <- tcIfaceType pat_ty - ; return (prov_theta, req_theta, pat_ty) } - ; bindIfaceTyVar (fsLit "r", toIfaceKind liftedTypeKind) $ \tv -> do - { patsyn <- buildPatSyn name is_infix has_wrapper args univ_tvs ex_tvs prov_theta req_theta pat_ty tv - ; return (AConLike (PatSynCon patsyn)) }}}}} + ; arg_tys <- mapM tcIfaceType args + ; return $ buildPatSyn name is_infix matcher wrapper + arg_tys univ_tvs ex_tvs prov_theta req_theta pat_ty } + ; return $ AConLike . PatSynCon $ patsyn }}} where mk_doc n = ptext (sLit "Pattern synonym") <+> ppr n - + tcExt s name = forkM (ptext (sLit s) <+> ppr name) $ tcIfaceExtId name tc_ax_branches :: TyCon -> [IfaceAxBranch] -> IfL [CoAxBranch] tc_ax_branches tc if_branches = foldlM (tc_ax_branch (tyConKind tc)) [] if_branches @@ -1516,20 +1521,6 @@ bindIfaceTyVars bndrs thing_inside where (occs,kinds) = unzip bndrs -bindIfaceIdVar :: IfaceIdBndr -> (Id -> IfL a) -> IfL a -bindIfaceIdVar (occ, ty) thing_inside - = do { name <- newIfaceName (mkVarOccFS occ) - ; ty' <- tcIfaceType ty - ; let id = mkLocalId name ty' - ; extendIfaceIdEnv [id] (thing_inside id) } - -bindIfaceIdVars :: [IfaceIdBndr] -> ([Id] -> IfL a) -> IfL a -bindIfaceIdVars [] thing_inside = thing_inside [] -bindIfaceIdVars (v:vs) thing_inside - = bindIfaceIdVar v $ \ v' -> - bindIfaceIdVars vs $ \ vs' -> - thing_inside (v':vs') - isSuperIfaceKind :: IfaceKind -> Bool isSuperIfaceKind (IfaceTyConApp (IfaceTc n) []) = n == superKindTyConName isSuperIfaceKind _ = False |