X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsUtils.lhs;h=1839aefa0d0faf2ae58c231e99ae737c77ec00fc;hb=15cb792d18b1094e98c035dca6ecec5dad516056;hp=50d12a3dc7201acc61e5a4bd957660fa5a93d3a4;hpb=df540a334232b9f2da702e48e1ebaf4b289997bc;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index 50d12a3..1839aef 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -71,13 +71,11 @@ mkHsAppTy t1 t2 = addCLoc t1 t2 (HsAppTy t1 t2)
 mkHsApp :: LHsExpr name -> LHsExpr name -> LHsExpr name
 mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2)
 
-mkHsTyApp :: LHsExpr name -> [Type] -> LHsExpr name
-mkHsTyApp expr []  = expr
-mkHsTyApp expr tys = L (getLoc expr) (TyApp expr tys)
+nlHsTyApp :: name -> [Type] -> LHsExpr name
+nlHsTyApp fun_id tys = noLoc (HsCoerce (mkCoTyApps tys) (HsVar fun_id))
 
-mkHsDictApp :: LHsExpr name -> [name] -> LHsExpr name
-mkHsDictApp expr []	 = expr
-mkHsDictApp expr dict_vars = L (getLoc expr) (DictApp expr dict_vars)
+mkLHsCoerce :: ExprCoFn -> LHsExpr id -> LHsExpr id
+mkLHsCoerce co_fn (L loc e) = L loc (mkHsCoerce co_fn e)
 
 mkHsCoerce :: ExprCoFn -> HsExpr id -> HsExpr id
 mkHsCoerce co_fn e | isIdCoercion co_fn = e
@@ -91,12 +89,6 @@ mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
 mkMatchGroup :: [LMatch id] -> MatchGroup id
 mkMatchGroup matches = MatchGroup matches placeHolderType
 
-mkHsTyLam []     expr = expr
-mkHsTyLam tyvars expr = L (getLoc expr) (TyLam tyvars expr)
-
-mkHsDictLam []    expr = expr
-mkHsDictLam dicts expr = L (getLoc expr) (DictLam dicts expr)
-
 mkHsDictLet :: LHsBinds Id -> LHsExpr Id -> LHsExpr Id
 -- Used for the dictionary bindings gotten from TcSimplify
 -- We make them recursive to be on the safe side
@@ -109,7 +101,7 @@ mkHsDictLet binds expr
 mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
 -- Used for constructing dictinoary terms etc, so no locations 
 mkHsConApp data_con tys args 
-  = foldl mk_app (noLoc (HsVar (dataConWrapId data_con)) `mkHsTyApp` tys) args
+  = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args
   where
     mk_app f a = noLoc (HsApp f (noLoc a))
 
@@ -385,7 +377,9 @@ collectl (L l pat) bndrs
     go (TuplePat pats _ _)  	  = foldr collectl bndrs pats
 				  
     go (ConPatIn c ps)   	  = foldr collectl bndrs (hsConArgs ps)
-    go (ConPatOut c _ ds bs ps _) = map noLoc ds
+    go (ConPatOut { pat_dicts = ds, 
+		    pat_binds = bs, pat_args = ps })
+				  = map noLoc ds
 				    ++ collectHsBindLocatedBinders bs
 				    ++ foldr collectl bndrs (hsConArgs ps)
     go (LitPat _)	      	  = bndrs