-newDictsAtLoc :: InstOrigin s
- -> SrcLoc
- -> TcThetaType s
- -> NF_TcM s ([Inst s], [TcIdOcc s])
-newDictsAtLoc orig loc theta =
- tcGetUniques (length theta) `thenNF_Tc` \ new_uniqs ->
- let
- mk_dict u (clas, tys) = Dict u clas tys orig loc
- dicts = zipWithEqual "newDictsAtLoc" mk_dict new_uniqs theta
- in
- returnNF_Tc (dicts, map instToId dicts)
-
-newDictFromOld :: Inst s -> Class -> [TcType s] -> NF_TcM s (Inst s)
-newDictFromOld (Dict _ _ _ orig loc) clas tys
- = tcGetUnique `thenNF_Tc` \ uniq ->
- returnNF_Tc (Dict uniq clas tys orig loc)
-
-
-newMethod :: InstOrigin s
- -> TcIdOcc s
- -> [TcType s]
- -> NF_TcM s (LIE s, TcIdOcc s)
+newDictsAtLoc :: InstLoc
+ -> TcThetaType
+ -> NF_TcM [Inst]
+newDictsAtLoc inst_loc@(_,loc,_) theta
+ = tcGetUniques (length theta) `thenNF_Tc` \ new_uniqs ->
+ returnNF_Tc (zipWithEqual "newDictsAtLoc" mk_dict new_uniqs theta)
+ where
+ mk_dict uniq pred = Dict (mkVanillaId (mk_dict_name uniq pred) (mkPredTy pred)) pred inst_loc
+
+ mk_dict_name uniq (Class cls tys) = mkLocalName uniq (mkDictOcc (getOccName cls)) loc
+ mk_dict_name uniq (IParam name ty) = name
+
+newIPDict orig name ty
+ = tcGetInstLoc orig `thenNF_Tc` \ inst_loc ->
+ returnNF_Tc (Dict (mkVanillaId name ty) (IParam name ty) inst_loc)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Building methods (calls of overloaded functions)}
+%* *
+%************************************************************************
+
+tcInstId instantiates an occurrence of an Id.
+The instantiate_it loop runs round instantiating the Id.
+It has to be a loop because we are now prepared to entertain
+types like
+ f:: forall a. Eq a => forall b. Baz b => tau
+We want to instantiate this to
+ f2::tau {f2 = f1 b (Baz b), f1 = f a (Eq a)}
+
+The -fno-method-sharing flag controls what happens so far as the LIE
+is concerned. The default case is that for an overloaded function we
+generate a "method" Id, and add the Method Inst to the LIE. So you get
+something like
+ f :: Num a => a -> a
+ f = /\a (d:Num a) -> let m = (+) a d in \ (x:a) -> m x x
+If you specify -fno-method-sharing, the dictionary application
+isn't shared, so we get
+ f :: Num a => a -> a
+ f = /\a (d:Num a) (x:a) -> (+) a d x x
+This gets a bit less sharing, but
+ a) it's better for RULEs involving overloaded functions
+ b) perhaps fewer separated lambdas
+
+
+\begin{code}
+tcInstId :: Id -> NF_TcM (TcExpr, LIE, TcType)
+tcInstId fun
+ | opt_NoMethodSharing = loop_noshare (HsVar fun) (idType fun)
+ | otherwise = loop_share fun
+ where
+ orig = OccurrenceOf fun
+ loop_noshare fun fun_ty
+ = tcInstType fun_ty `thenNF_Tc` \ (tyvars, theta, tau) ->
+ let
+ ty_app = mkHsTyApp fun (mkTyVarTys tyvars)
+ in
+ if null theta then -- Is it overloaded?
+ returnNF_Tc (ty_app, emptyLIE, tau)
+ else
+ newDicts orig theta `thenNF_Tc` \ dicts ->
+ loop_noshare (mkHsDictApp ty_app (map instToId dicts)) tau `thenNF_Tc` \ (expr, lie, final_tau) ->
+ returnNF_Tc (expr, mkLIE dicts `plusLIE` lie, final_tau)
+
+ loop_share fun
+ = tcInstType (idType fun) `thenNF_Tc` \ (tyvars, theta, tau) ->
+ let
+ arg_tys = mkTyVarTys tyvars
+ in
+ if null theta then -- Is it overloaded?
+ returnNF_Tc (mkHsTyApp (HsVar fun) arg_tys, emptyLIE, tau)
+ else
+ -- Yes, it's overloaded
+ newMethodWithGivenTy orig fun arg_tys theta tau `thenNF_Tc` \ meth ->
+ loop_share (instToId meth) `thenNF_Tc` \ (expr, lie, final_tau) ->
+ returnNF_Tc (expr, unitLIE meth `plusLIE` lie, final_tau)
+
+
+newMethod :: InstOrigin
+ -> TcId
+ -> [TcType]
+ -> NF_TcM Inst