-newDicts :: InstOrigin s
- -> [(Class, TcType s)]
- -> NF_TcM s (LIE s, [TcIdOcc s])
-newDicts orig theta
- = tcGetSrcLoc `thenNF_Tc` \ loc ->
- tcGetUniques (length theta) `thenNF_Tc` \ new_uniqs ->
- let
- mk_dict u (clas, ty) = Dict u clas ty orig loc
- dicts = zipWithEqual "newDicts" mk_dict new_uniqs theta
- in
- returnNF_Tc (listToBag dicts, map instToId dicts)
-
-newDictsAtLoc orig loc theta -- Local function, similar to newDicts,
- -- but with slightly different interface
- = tcGetUniques (length theta) `thenNF_Tc` \ new_uniqs ->
- let
- mk_dict u (clas, ty) = Dict u clas ty orig loc
- dicts = zipWithEqual "newDictsAtLoc" mk_dict new_uniqs theta
- in
- returnNF_Tc (dicts, map instToId dicts)
-
-newMethod :: InstOrigin s
- -> TcIdOcc s
- -> [TcType s]
- -> NF_TcM s (LIE s, TcIdOcc s)
-newMethod orig id tys
- = -- Get the Id type and instantiate it at the specified types
- (case id of
- RealId id -> let (tyvars, rho) = splitForAllTy (idType id)
- in
- (if length tyvars /= length tys then pprTrace "newMethod" (ppr PprDebug (idType id)) else \x->x) $
- tcInstType (zip{-Equal "newMethod"-} tyvars tys) rho
- TcId id -> let (tyvars, rho) = splitForAllTy (idType id)
- in returnNF_Tc (instantiateTy (zipEqual "newMethod(2)" tyvars tys) rho)
- ) `thenNF_Tc` \ rho_ty ->
- -- Our friend does the rest
- newMethodWithGivenTy orig id tys rho_ty
-
-
-newMethodWithGivenTy orig id tys rho_ty
- = tcGetSrcLoc `thenNF_Tc` \ loc ->
- tcGetUnique `thenNF_Tc` \ new_uniq ->
- let
- meth_inst = Method new_uniq id tys rho_ty orig loc
- in
- returnNF_Tc (unitLIE meth_inst, instToId meth_inst)
-
-newMethodAtLoc :: InstOrigin s -> SrcLoc -> Id -> [TcType s] -> NF_TcM s (Inst s, TcIdOcc s)
-newMethodAtLoc orig loc real_id tys -- Local function, similar to newMethod but with
- -- slightly different interface
- = -- Get the Id type and instantiate it at the specified types
- let
- (tyvars,rho) = splitForAllTy (idType real_id)
- in
- tcInstType (zipEqual "newMethodAtLoc" tyvars tys) rho `thenNF_Tc` \ rho_ty ->
- tcGetUnique `thenNF_Tc` \ new_uniq ->
- let
- meth_inst = Method new_uniq (RealId real_id) tys rho_ty orig loc
- in
- returnNF_Tc (meth_inst, instToId meth_inst)
-
-newOverloadedLit :: InstOrigin s
- -> OverloadedLit
- -> TcType s
- -> NF_TcM s (LIE s, TcIdOcc s)
-newOverloadedLit orig lit ty
- = tcGetSrcLoc `thenNF_Tc` \ loc ->
- tcGetUnique `thenNF_Tc` \ new_uniq ->
- let
- lit_inst = LitInst new_uniq lit ty orig loc
- in
- returnNF_Tc (unitLIE lit_inst, instToId lit_inst)
-\end{code}