X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsUtils.lhs;h=d793a3b882fff718b7987365bf78879d693d938b;hb=1e50fd4185479a62e02d987bdfcb1c62712859ca;hp=958feb47da8bd08f4c47e27899489f4482ffab29;hpb=d95ce839533391e7118257537044f01cbb1d6694;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index 958feb4..d793a3b 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -1,4 +1,3 @@
-
 %
 % (c) The University of Glasgow, 1992-2006
 %
@@ -246,9 +245,6 @@ nlWildConPat :: DataCon -> LPat RdrName
 nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
 				   (PrefixCon (nOfThem (dataConSourceArity con) nlWildPat)))
 
-nlTuplePat :: [LPat id] -> Boxity -> LPat id
-nlTuplePat pats box = noLoc (TuplePat pats box placeHolderType)
-
 nlWildPat :: LPat id
 nlWildPat  = noLoc (WildPat placeHolderType)	-- Pre-typechecking
 
@@ -262,14 +258,12 @@ nlHsLam  :: LMatch id -> LHsExpr id
 nlHsPar  :: LHsExpr id -> LHsExpr id
 nlHsIf   :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id
 nlHsCase :: LHsExpr id -> [LMatch id] -> LHsExpr id
-nlTuple  :: [LHsExpr id] -> Boxity -> LHsExpr id
 nlList   :: [LHsExpr id] -> LHsExpr id
 
 nlHsLam	match		= noLoc (HsLam (mkMatchGroup [match]))
 nlHsPar e		= noLoc (HsPar e)
 nlHsIf cond true false	= noLoc (HsIf cond true false)
 nlHsCase expr matches	= noLoc (HsCase expr (mkMatchGroup matches))
-nlTuple exprs box	= noLoc (ExplicitTuple exprs box)
 nlList exprs		= noLoc (ExplicitList placeHolderType exprs)
 
 nlHsAppTy :: LHsType name -> LHsType name -> LHsType name
@@ -284,7 +278,24 @@ nlHsTyConApp :: name -> [LHsType name] -> LHsType name
 nlHsTyConApp tycon tys  = foldl nlHsAppTy (nlHsTyVar tycon) tys
 \end{code}
 
+Tuples.  All these functions are *pre-typechecker* because they lack
+types on the tuple.
+
+\begin{code}
+mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a
+-- Makes a pre-typechecker boxed tuple, deals with 1 case
+mkLHsTupleExpr [e] = e
+mkLHsTupleExpr es  = noLoc $ ExplicitTuple (map Present es) Boxed
+
+mkLHsVarTuple :: [a] -> LHsExpr a
+mkLHsVarTuple ids  = mkLHsTupleExpr (map nlHsVar ids)
+
+nlTuplePat :: [LPat id] -> Boxity -> LPat id
+nlTuplePat pats box = noLoc (TuplePat pats box placeHolderType)
 
+missingTupArg :: HsTupArg a
+missingTupArg = Missing placeHolderType
+\end{code}
 
 %************************************************************************
 %*									*
@@ -300,12 +311,8 @@ mkFunBind fn ms = FunBind { fun_id = fn, fun_infix = False, fun_matches = mkMatc
 			    fun_tick = Nothing }
 
 
-mkHsVarBind :: SrcSpan -> id -> LHsExpr id -> LHsBind id
-mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
-
-mkVarBind :: id -> LHsExpr id -> LHsBind id
-mkVarBind var rhs = L (getLoc rhs) $
-		    VarBind { var_id = var, var_rhs = rhs, var_inline = False }
+mkVarBind :: SrcSpan -> id -> LHsExpr id -> LHsBind id
+mkVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
 
 ------------
 mk_easy_FunBind :: SrcSpan -> id -> [LPat id]
@@ -331,9 +338,8 @@ mkMatch pats expr binds
   = noLoc (Match (map paren pats) Nothing 
 		 (GRHSs (unguardedRHS expr) binds))
   where
-    paren p = case p of
-		L _ (VarPat _) -> p
-		L l _	       -> L l (ParPat p)
+    paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat lp) 
+		     | otherwise          = lp
 \end{code}