A bit of refactoring on handling HsPar and friends
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 27 Jul 2011 05:21:43 +0000 (06:21 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 27 Jul 2011 05:21:43 +0000 (06:21 +0100)
This relates to Trac #4430 (infix expressions in TH),.
Mainly comments but a bit of code wibbling.

compiler/hsSyn/Convert.lhs
compiler/hsSyn/HsExpr.lhs
compiler/hsSyn/HsPat.lhs
compiler/hsSyn/HsTypes.lhs
compiler/hsSyn/HsUtils.lhs

index 6f44199..7a86c81 100644 (file)
@@ -95,6 +95,9 @@ failWith m = CvtM (\_ -> Left m)
 returnL :: a -> CvtM (Located a)
 returnL x = CvtM (\loc -> Right (L loc x))
 
+wrapParL :: (Located a -> a) -> a -> CvtM a
+wrapParL add_par x = CvtM (\loc -> Right (add_par (L loc x)))
+
 wrapMsg :: (Show a, TH.Ppr a) => String -> a -> CvtM b -> CvtM b
 -- E.g  wrapMsg "declaration" dec thing
 wrapMsg what item (CvtM m)
@@ -464,8 +467,8 @@ cvtl e = wrapL (cvt e)
     cvt (LamE ps e)    = do { ps' <- cvtPats ps; e' <- cvtl e 
                            ; return $ HsLam (mkMatchGroup [mkSimpleMatch ps' e']) }
     cvt (TupE [e])     = do { e' <- cvtl e; return $ HsPar e' }
-                          -- Note [Dropping constructors]
-                          -- Singleton tuples treated like nothing (just parens)
+                                -- Note [Dropping constructors]
+                                 -- Singleton tuples treated like nothing (just parens)
     cvt (TupE es)      = do { es' <- mapM cvtl es; return $ ExplicitTuple (map Present es') Boxed }
     cvt (UnboxedTupE es)      = do { es' <- mapM cvtl es; return $ ExplicitTuple (map Present es') Unboxed }
     cvt (CondE x y z)  = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z;
@@ -483,20 +486,27 @@ cvtl e = wrapL (cvt e)
       | Just s <- allCharLs xs       = do { l' <- cvtLit (StringL s); return (HsLit l') }
             -- Note [Converting strings]
       | otherwise                    = do { xs' <- mapM cvtl xs; return $ ExplicitList void xs' }
+
+    -- Infix expressions
     cvt (InfixE (Just x) s (Just y)) = do { x' <- cvtl x; s' <- cvtl s; y' <- cvtl y
-                                          ; x'' <- returnL (HsPar x'); y'' <- returnL (HsPar y')
-                                         ; e' <- returnL $ OpApp x'' s' undefined y''
-                                         ; return $ HsPar e' }
+                                         ; wrapParL HsPar $ 
+                                            OpApp (mkLHsPar x') s' undefined (mkLHsPar y') }
+                                           -- Parenthesise both arguments and result, 
+                                           -- to ensure this operator application does
+                                           -- does not get re-associated
+                           -- See Note [Operator association]
     cvt (InfixE Nothing  s (Just y)) = do { s' <- cvtl s; y' <- cvtl y
-                                         ; sec <- returnL $ SectionR s' y'
-                                         ; return $ HsPar sec }
+                                         ; wrapParL HsPar $ SectionR s' y' }
+                                           -- See Note [Sections in HsSyn] in HsExpr
     cvt (InfixE (Just x) s Nothing ) = do { x' <- cvtl x; s' <- cvtl s
-                                         ; sec <- returnL $ SectionL x' s'
-                                         ; return $ HsPar sec }
+                                         ; wrapParL HsPar $ SectionL x' s' }
+
     cvt (InfixE Nothing  s Nothing ) = do { s' <- cvtl s; return $ HsPar s' }
                                        -- Can I indicate this is an infix thing?
                                        -- Note [Dropping constructors]
+
     cvt (UInfixE x s y)  = do { x' <- cvtl x; cvtOpApp x' s y } --  Note [Converting UInfix]
+
     cvt (ParensE e)      = do { e' <- cvtl e; return $ HsPar e' }
     cvt (SigE e t)      = do { e' <- cvtl e; t' <- cvtType t
                              ; return $ ExprWithTySig e' t' }
@@ -534,8 +544,16 @@ cvtDD (FromThenR x y)     = do { x' <- cvtl x; y' <- cvtl y; return $ FromThen x
 cvtDD (FromToR x y)       = do { x' <- cvtl x; y' <- cvtl y; return $ FromTo x' y' }
 cvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; return $ FromThenTo x' y' z' }
 
-{- Note [Converting UInfix]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Operator assocation]
+We must be quite careful about adding parens:
+  * Infix (UInfix ...) op arg      Needs parens round the first arg
+  * Infix (Infix ...) op arg       Needs parens round the first arg
+  * UInfix (UInfix ...) op arg     No parens for first arg
+  * UInfix (Infix ...) op arg      Needs parens round first arg
+
+
+Note [Converting UInfix]
+~~~~~~~~~~~~~~~~~~~~~~~~
 When converting @UInfixE@ and @UInfixP@ values, we want to readjust
 the trees to reflect the fixities of the underlying operators:
 
@@ -697,31 +715,32 @@ cvtPat pat = wrapL (cvtp pat)
 
 cvtp :: TH.Pat -> CvtM (Hs.Pat RdrName)
 cvtp (TH.LitP l)
-  | overloadedLit l   = do { l' <- cvtOverLit l
-                          ; return (mkNPat l' Nothing) }
+  | overloadedLit l    = do { l' <- cvtOverLit l
+                           ; return (mkNPat l' Nothing) }
                                  -- Not right for negative patterns; 
                                  -- need to think about that!
-  | otherwise        = do { l' <- cvtLit l; return $ Hs.LitPat l' }
-cvtp (TH.VarP s)      = do { s' <- vName s; return $ Hs.VarPat s' }
-cvtp (TupP [p])       = do { p' <- cvtPat p; return $ ParPat p' } -- Note [Dropping constructors]
-cvtp (TupP ps)        = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed void }
+  | otherwise         = do { l' <- cvtLit l; return $ Hs.LitPat l' }
+cvtp (TH.VarP s)       = do { s' <- vName s; return $ Hs.VarPat s' }
+cvtp (TupP [p])        = do { p' <- cvtPat p; return $ ParPat p' } -- Note [Dropping constructors]
+cvtp (TupP ps)         = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed void }
 cvtp (UnboxedTupP ps)  = do { ps' <- cvtPats ps; return $ TuplePat ps' Unboxed void }
-cvtp (ConP s ps)      = do { s' <- cNameL s; ps' <- cvtPats ps; return $ ConPatIn s' (PrefixCon ps') }
-cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
-                           ; p1'' <- returnL (ParPat p1'); p2'' <- returnL (ParPat p2')
-                           ; p <- returnL $ ConPatIn s' (InfixCon p1'' p2'')
-                           ; return $ ParPat p }
-cvtp (UInfixP p1 s p2)= do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Converting UInfix]
-cvtp (ParensP p)      = do { p' <- cvtPat p; return $ ParPat p' }
-cvtp (TildeP p)       = do { p' <- cvtPat p; return $ LazyPat p' }
-cvtp (BangP p)        = do { p' <- cvtPat p; return $ BangPat p' }
-cvtp (TH.AsP s p)     = do { s' <- vNameL s; p' <- cvtPat p; return $ AsPat s' p' }
-cvtp TH.WildP         = return $ WildPat void
-cvtp (RecP c fs)      = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
-                          ; return $ ConPatIn c' $ Hs.RecCon (HsRecFields fs' Nothing) }
-cvtp (ListP ps)       = do { ps' <- cvtPats ps; return $ ListPat ps' void }
-cvtp (SigP p t)       = do { p' <- cvtPat p; t' <- cvtType t; return $ SigPatIn p' t' }
-cvtp (ViewP e p)      = do { e' <- cvtl e; p' <- cvtPat p; return $ ViewPat e' p' void }
+cvtp (ConP s ps)       = do { s' <- cNameL s; ps' <- cvtPats ps
+                            ; return $ ConPatIn s' (PrefixCon ps') }
+cvtp (InfixP p1 s p2)  = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
+                            ; wrapParL ParPat $ 
+                              ConPatIn s' (InfixCon (mkParPat p1') (mkParPat p2')) }
+                           -- See Note [Operator association]
+cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Converting UInfix]
+cvtp (ParensP p)       = do { p' <- cvtPat p; return $ ParPat p' }
+cvtp (TildeP p)        = do { p' <- cvtPat p; return $ LazyPat p' }
+cvtp (BangP p)         = do { p' <- cvtPat p; return $ BangPat p' }
+cvtp (TH.AsP s p)      = do { s' <- vNameL s; p' <- cvtPat p; return $ AsPat s' p' }
+cvtp TH.WildP          = return $ WildPat void
+cvtp (RecP c fs)       = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
+                          ; return $ ConPatIn c' $ Hs.RecCon (HsRecFields fs' Nothing) }
+cvtp (ListP ps)        = do { ps' <- cvtPats ps; return $ ListPat ps' void }
+cvtp (SigP p t)        = do { p' <- cvtPat p; t' <- cvtType t; return $ SigPatIn p' t' }
+cvtp (ViewP e p)       = do { e' <- cvtl e; p' <- cvtPat p; return $ ViewPat e' p' void }
 
 cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (HsRecField RdrName (LPat RdrName))
 cvtPatFld (s,p)
index 35bb17b..4179423 100644 (file)
@@ -120,11 +120,11 @@ data HsExpr id
   | NegApp      (LHsExpr id)    -- negated expr
                 (SyntaxExpr id) -- Name of 'negate'
 
-  | HsPar       (LHsExpr id)    -- parenthesised expr
+  | HsPar       (LHsExpr id)    -- Parenthesised expr; see Note [Parens in HsSyn]
 
-  | SectionL    (LHsExpr id)    -- operand
+  | SectionL    (LHsExpr id)    -- operand; see Note [Sections in HsSyn]
                 (LHsExpr id)    -- operator
-  | SectionR    (LHsExpr id)    -- operator
+  | SectionR    (LHsExpr id)    -- operator; see Note [Sections in HsSyn]
                 (LHsExpr id)    -- operand
 
   | ExplicitTuple              -- Used for explicit tuples and sections thereof
@@ -300,6 +300,28 @@ type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be
                                         -- pasted back in by the desugarer
 \end{code}
 
+Note [Parens in HsSyn]
+~~~~~~~~~~~~~~~~~~~~~~
+HsPar (and ParPat in patterns, HsParTy in types) is used as follows
+
+  * Generally HsPar is optional; the pretty printer adds parens where
+    necessary.  Eg (HsApp f (HsApp g x)) is fine, and prints 'f (g x)'
+
+  * HsPars are pretty printed as '( .. )' regardless of whether 
+    or not they are strictly necssary
+
+  * HsPars are respected when rearranging operator fixities.
+    So   a * (b + c)  means what it says (where the parens are an HsPar)
+
+Note [Sections in HsSyn]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Sections should always appear wrapped in an HsPar, thus
+        HsPar (SectionR ...)
+The parser parses sections in a wider variety of situations 
+(See Note [Parsing sections]), but the renamer checks for those
+parens.  This invariant makes pretty-printing easier; we don't need 
+a special case for adding the parens round sections.
+
 Note [Rebindable if]
 ~~~~~~~~~~~~~~~~~~~~
 The rebindable syntax for 'if' is a bit special, because when
@@ -400,8 +422,7 @@ ppr_expr (SectionR op expr)
 
     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
                        4 ((<>) pp_expr rparen)
-    pp_infixly v
-      = (sep [pprHsInfix v, pp_expr])
+    pp_infixly v = sep [pprHsInfix v, pp_expr]
 
 ppr_expr (ExplicitTuple exprs boxity)
   = tupleParens boxity (fcat (ppr_tup_args exprs))
@@ -557,29 +578,33 @@ pprDebugParendExpr expr
 
 pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
 pprParendExpr expr
-  = let
-        pp_as_was = pprLExpr expr
+  | hsExprNeedsParens (unLoc expr) = parens (pprLExpr expr)
+  | otherwise                      = pprLExpr expr
         -- Using pprLExpr makes sure that we go 'deeper'
         -- I think that is usually (always?) right
-    in
-    case unLoc expr of
-      ArithSeq {}       -> pp_as_was
-      PArrSeq {}        -> pp_as_was
-      HsLit {}          -> pp_as_was
-      HsOverLit {}      -> pp_as_was
-      HsVar {}          -> pp_as_was
-      HsIPVar {}        -> pp_as_was
-      ExplicitTuple {}  -> pp_as_was
-      ExplicitList {}   -> pp_as_was
-      ExplicitPArr {}   -> pp_as_was
-      HsPar {}          -> pp_as_was
-      HsBracket {}      -> pp_as_was
-      HsBracketOut _ [] -> pp_as_was
-      HsDo sc _ _
-       | isListCompExpr sc -> pp_as_was
-      _                    -> parens pp_as_was
-
-isAtomicHsExpr :: HsExpr id -> Bool -- A single token
+
+hsExprNeedsParens :: HsExpr id -> Bool
+-- True of expressions for which '(e)' and 'e' 
+-- mean the same thing
+hsExprNeedsParens (ArithSeq {})       = False
+hsExprNeedsParens (PArrSeq {})        = False
+hsExprNeedsParens (HsLit {})          = False
+hsExprNeedsParens (HsOverLit {})      = False
+hsExprNeedsParens (HsVar {})          = False
+hsExprNeedsParens (HsIPVar {})        = False
+hsExprNeedsParens (ExplicitTuple {})  = False
+hsExprNeedsParens (ExplicitList {})   = False
+hsExprNeedsParens (ExplicitPArr {})   = False
+hsExprNeedsParens (HsPar {})          = False
+hsExprNeedsParens (HsBracket {})      = False
+hsExprNeedsParens (HsBracketOut _ []) = False
+hsExprNeedsParens (HsDo sc _ _)
+       | isListCompExpr sc            = False
+hsExprNeedsParens _ = True
+
+
+isAtomicHsExpr :: HsExpr id -> Bool 
+-- True of a single token
 isAtomicHsExpr (HsVar {})     = True
 isAtomicHsExpr (HsLit {})     = True
 isAtomicHsExpr (HsOverLit {}) = True
index 7fb5f72..71dfe1d 100644 (file)
@@ -68,6 +68,7 @@ data Pat id
   | LazyPat     (LPat id)               -- Lazy pattern
   | AsPat      (Located id) (LPat id)  -- As pattern
   | ParPat      (LPat id)              -- Parenthesised pattern
+                                       -- See Note [Parens in HsSyn] in HsExpr
   | BangPat    (LPat id)               -- Bang pattern
 
        ------------ Lists, tuples, arrays ---------------
@@ -238,17 +239,8 @@ pprParendLPat :: (OutputableBndr name) => LPat name -> SDoc
 pprParendLPat (L _ p) = pprParendPat p
 
 pprParendPat :: (OutputableBndr name) => Pat name -> SDoc
-pprParendPat p | patNeedsParens p = parens (pprPat p)
-               | otherwise        = pprPat p
-
-patNeedsParens :: Pat name -> Bool
-patNeedsParens (ConPatIn _ d)               = not (null (hsConPatArgs d))
-patNeedsParens (ConPatOut { pat_args = d }) = not (null (hsConPatArgs d))
-patNeedsParens (SigPatIn {})  = True
-patNeedsParens (SigPatOut {}) = True
-patNeedsParens (ViewPat {})   = True
-patNeedsParens (CoPat {})     = True
-patNeedsParens _              = False
+pprParendPat p | hsPatNeedsParens p = parens (pprPat p)
+               | otherwise          = pprPat p
 
 pprPat :: (OutputableBndr name) => Pat name -> SDoc
 pprPat (VarPat var)      = pprPatBndr var
@@ -268,8 +260,9 @@ pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
   = getPprStyle $ \ sty ->     -- Tiresome; in TcBinds.tcRhs we print out a 
     if debugStyle sty then     -- typechecked Pat in an error message, 
                                -- and we want to make sure it prints nicely
-       ppr con <+> sep [ hsep (map pprPatBndr tvs) <+> hsep (map pprPatBndr dicts),
-                         ppr binds, pprConArgs details]
+       ppr con <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))
+                              , ppr binds])  
+                <+> pprConArgs details
     else pprUserCon con details
 
 pprPat (LitPat s)          = ppr s
@@ -438,29 +431,29 @@ isIrrefutableHsPat pat
     urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
 
 hsPatNeedsParens :: Pat a -> Bool
+hsPatNeedsParens (NPlusKPat {})      = True
+hsPatNeedsParens (QuasiQuotePat {})  = True
+hsPatNeedsParens (ConPatIn _ ds)     = conPatNeedsParens ds
+hsPatNeedsParens p@(ConPatOut {})    = conPatNeedsParens (pat_args p)
+hsPatNeedsParens (SigPatIn {})       = True
+hsPatNeedsParens (SigPatOut {})      = True
+hsPatNeedsParens (ViewPat {})        = True
+hsPatNeedsParens (CoPat {})          = True
 hsPatNeedsParens (WildPat {})        = False
 hsPatNeedsParens (VarPat {})         = False
 hsPatNeedsParens (LazyPat {})        = False
 hsPatNeedsParens (BangPat {})        = False
-hsPatNeedsParens (CoPat {})          = True
 hsPatNeedsParens (ParPat {})         = False
 hsPatNeedsParens (AsPat {})          = False
-hsPatNeedsParens (ViewPat {})        = True
-hsPatNeedsParens (SigPatIn {})       = True
-hsPatNeedsParens (SigPatOut {})      = True
 hsPatNeedsParens (TuplePat {})       = False
 hsPatNeedsParens (ListPat {})        = False
 hsPatNeedsParens (PArrPat {})        = False   
-hsPatNeedsParens (ConPatIn _ ds)     = conPatNeedsParens ds
-hsPatNeedsParens (ConPatOut {})      = True
 hsPatNeedsParens (LitPat {})                = False
 hsPatNeedsParens (NPat {})          = False
-hsPatNeedsParens (NPlusKPat {})      = True
-hsPatNeedsParens (QuasiQuotePat {})  = True
 
 conPatNeedsParens :: HsConDetails a b -> Bool
 conPatNeedsParens (PrefixCon args) = not (null args)
-conPatNeedsParens (InfixCon {})    = False
-conPatNeedsParens (RecCon {})      = False
+conPatNeedsParens (InfixCon {})    = True
+conPatNeedsParens (RecCon {})      = True
 \end{code}
 
index d565c96..35cdb7e 100644 (file)
@@ -161,13 +161,9 @@ data HsType name
 
   | HsOpTy             (LHsType name) (Located name) (LHsType name)
 
-  | HsParTy            (LHsType name)   
+  | HsParTy            (LHsType name)   -- See Note [Parens in HsSyn] in HsExpr
        -- Parenthesis preserved for the precedence re-arrangement in RnTypes
        -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
-       -- 
-       -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
-       -- interface files smaller), so when printing a HsType we may need to
-       -- add parens.  
 
   | HsPredTy           (HsPred name)   -- Only used in the type of an instance
                                        -- declaration, eg.  Eq [a] -> Eq a
index 6ddbd99..3ae566d 100644 (file)
@@ -22,6 +22,7 @@ module HsUtils(
   mkHsWrap, mkLHsWrap, mkHsWrapCo, mkLHsWrapCo,
   coToHsWrapper, mkHsDictLet, mkHsLams,
   mkHsOpApp, mkHsDo, mkHsComp, mkHsWrapPat, mkHsWrapPatCo,
+  mkLHsPar, 
 
   nlHsTyApp, nlHsVar, nlHsLit, nlHsApp, nlHsApps, nlHsIntLit, nlHsVarApps, 
   nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,
@@ -35,7 +36,7 @@ module HsUtils(
 
   -- Patterns
   mkNPat, mkNPlusKPat, nlVarPat, nlLitPat, nlConVarPat, nlConPat, nlInfixConPat,
-  nlNullaryConPat, nlWildConPat, nlWildPat, nlTuplePat, 
+  nlNullaryConPat, nlWildConPat, nlWildPat, nlTuplePat, mkParPat,
 
   -- Types
   mkHsAppTy, userHsTyVarBndrs,
@@ -120,15 +121,50 @@ unguardedGRHSs rhs = GRHSs (unguardedRHS rhs) emptyLocalBinds
 unguardedRHS :: LHsExpr id -> [LGRHS id]
 unguardedRHS rhs@(L loc _) = [L loc (GRHS [] rhs)]
 
+mkMatchGroup :: [LMatch id] -> MatchGroup id
+mkMatchGroup matches = MatchGroup matches placeHolderType
+
 mkHsAppTy :: LHsType name -> LHsType name -> LHsType name
 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)
 
+mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id
+mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
+       where
+         matches = mkMatchGroup [mkSimpleMatch pats body]
+
+mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr Id -> LHsExpr Id
+mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars <.> mkWpLams dicts) expr
+
+mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
+-- Used for constructing dictionary terms etc, so no locations 
+mkHsConApp data_con tys args 
+  = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args
+  where
+    mk_app f a = noLoc (HsApp f (noLoc a))
+
+mkSimpleHsAlt :: LPat id -> LHsExpr id -> LMatch id
+-- A simple lambda with a single pattern, no binds, no guards; pre-typechecking
+mkSimpleHsAlt pat expr 
+  = mkSimpleMatch [pat] expr
+
 nlHsTyApp :: name -> [Type] -> LHsExpr name
 nlHsTyApp fun_id tys = noLoc (HsWrap (mkWpTyApps tys) (HsVar fun_id))
 
+--------- Adding parens ---------
+mkLHsPar :: LHsExpr name -> LHsExpr name
+-- Wrap in parens if hsExprNeedsParens says it needs them
+-- So   'f x'  becomes '(f x)', but '3' stays as '3'
+mkLHsPar le@(L loc e) | hsExprNeedsParens e = L loc (HsPar le)
+                      | otherwise           = le
+
+mkParPat :: LPat name -> LPat name
+mkParPat lp@(L loc p) | hsPatNeedsParens p = L loc (ParPat lp)
+                      | otherwise          = lp
+
+--------- HsWrappers: type args, dict args, casts ---------
 mkLHsWrap :: HsWrapper -> LHsExpr id -> LHsExpr id
 mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e)
 
@@ -156,31 +192,9 @@ mkHsWrapPatCo :: Coercion -> Pat id -> Type -> Pat id
 mkHsWrapPatCo (Refl _) pat _  = pat
 mkHsWrapPatCo co       pat ty = CoPat (WpCast co) pat ty
 
-mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id
-mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
-       where
-         matches = mkMatchGroup [mkSimpleMatch pats body]
-
-mkMatchGroup :: [LMatch id] -> MatchGroup id
-mkMatchGroup matches = MatchGroup matches placeHolderType
-
-mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr Id -> LHsExpr Id
-mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars <.> mkWpLams dicts) expr
-
 mkHsDictLet :: TcEvBinds -> LHsExpr Id -> LHsExpr Id
 mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
 
-mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
--- Used for constructing dictionary terms etc, so no locations 
-mkHsConApp data_con tys args 
-  = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args
-  where
-    mk_app f a = noLoc (HsApp f (noLoc a))
-
-mkSimpleHsAlt :: LPat id -> LHsExpr id -> LMatch id
--- A simple lambda with a single pattern, no binds, no guards; pre-typechecking
-mkSimpleHsAlt pat expr 
-  = mkSimpleMatch [pat] expr
 
 -------------------------------
 -- These are the bits of syntax that contain rebindable names