compiler/deSugar/DsListComp.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[DsListComp]{Desugaring list comprehensions and array comprehensions}
   5
   6 \begin{code}
   7 module DsListComp ( dsListComp, dsPArrComp ) where
   8
   9 #include "HsVersions.h"
  10
  11 import {-# SOURCE #-} DsExpr ( dsLExpr, dsLocalBinds )
  12
  13 import BasicTypes       ( Boxity(..) )
  14 import HsSyn
  15 import TcHsSyn          ( hsLPatType, mkVanillaTuplePat )
  16 import CoreSyn
  17
  18 import DsMonad          -- the monadery used in the desugarer
  19 import DsUtils
  20
  21 import DynFlags         ( DynFlag(..), dopt )
  22 import StaticFlags      ( opt_RulesOff )
  23 import CoreUtils        ( exprType, mkIfThenElse )
  24 import Id               ( idType )
  25 import Var              ( Id )
  26 import Type             ( mkTyVarTy, mkFunTys, mkFunTy, Type,
  27                           splitTyConApp_maybe )
  28 import TysPrim          ( alphaTyVar )
  29 import TysWiredIn       ( nilDataCon, consDataCon, trueDataConId, falseDataConId,
  30                           unitDataConId, unitTy, mkListTy, parrTyCon )
  31 import Match            ( matchSimply )
  32 import PrelNames        ( foldrName, buildName, replicatePName, mapPName,
  33                           filterPName, zipPName, crossPName )
  34 import PrelInfo         ( pAT_ERROR_ID )
  35 import SrcLoc           ( noLoc, unLoc )
  36 import Panic            ( panic )
  37 \end{code}
  38
  39 List comprehensions may be desugared in one of two ways: ``ordinary''
  40 (as you would expect if you read SLPJ's book) and ``with foldr/build
  41 turned on'' (if you read Gill {\em et al.}'s paper on the subject).
  42
  43 There will be at least one ``qualifier'' in the input.
  44
  45 \begin{code}
  46 dsListComp :: [LStmt Id]
  47            -> LHsExpr Id
  48            -> Type              -- Type of list elements
  49            -> DsM CoreExpr
  50 dsListComp lquals body elt_ty
  51   = getDOptsDs  `thenDs` \dflags ->
  52     let
  53         quals = map unLoc lquals
  54     in
  55     if opt_RulesOff || dopt Opt_IgnoreInterfacePragmas dflags
  56         -- Either rules are switched off, or we are ignoring what there are;
  57         -- Either way foldr/build won't happen, so use the more efficient
  58         -- Wadler-style desugaring
  59         || isParallelComp quals
  60                 -- Foldr-style desugaring can't handle
  61                 -- parallel list comprehensions
  62         then deListComp quals body (mkNilExpr elt_ty)
  63
  64    else         -- Foldr/build should be enabled, so desugar
  65                 -- into foldrs and builds
  66     newTyVarsDs [alphaTyVar]    `thenDs` \ [n_tyvar] ->
  67     let
  68         n_ty = mkTyVarTy n_tyvar
  69         c_ty = mkFunTys [elt_ty, n_ty] n_ty
  70     in
  71     newSysLocalsDs [c_ty,n_ty]          `thenDs` \ [c, n] ->
  72     dfListComp c n quals body           `thenDs` \ result ->
  73     dsLookupGlobalId buildName  `thenDs` \ build_id ->
  74     returnDs (Var build_id `App` Type elt_ty
  75                            `App` mkLams [n_tyvar, c, n] result)
  76
  77   where isParallelComp (ParStmt bndrstmtss : _) = True
  78         isParallelComp _                        = False
  79 \end{code}
  80
  81 %************************************************************************
  82 %*                                                                      *
  83 \subsection[DsListComp-ordinary]{Ordinary desugaring of list comprehensions}
  84 %*                                                                      *
  85 %************************************************************************
  86
  87 Just as in Phil's chapter~7 in SLPJ, using the rules for
  88 optimally-compiled list comprehensions.  This is what Kevin followed
  89 as well, and I quite happily do the same.  The TQ translation scheme
  90 transforms a list of qualifiers (either boolean expressions or
  91 generators) into a single expression which implements the list
  92 comprehension.  Because we are generating 2nd-order polymorphic
  93 lambda-calculus, calls to NIL and CONS must be applied to a type
  94 argument, as well as their usual value arguments.
  95 \begin{verbatim}
  96 TE << [ e | qs ] >>  =  TQ << [ e | qs ] ++ Nil (typeOf e) >>
  97
  98 (Rule C)
  99 TQ << [ e | ] ++ L >> = Cons (typeOf e) TE <<e>> TE <<L>>
 100
 101 (Rule B)
 102 TQ << [ e | b , qs ] ++ L >> =
 103     if TE << b >> then TQ << [ e | qs ] ++ L >> else TE << L >>
 104
 105 (Rule A')
 106 TQ << [ e | p <- L1, qs ]  ++  L2 >> =
 107   letrec
 108     h = \ u1 ->
 109           case u1 of
 110             []        ->  TE << L2 >>
 111             (u2 : u3) ->
 112                   (( \ TE << p >> -> ( TQ << [e | qs]  ++  (h u3) >> )) u2)
 113                     [] (h u3)
 114   in
 115     h ( TE << L1 >> )
 116
 117 "h", "u1", "u2", and "u3" are new variables.
 118 \end{verbatim}
 119
 120 @deListComp@ is the TQ translation scheme.  Roughly speaking, @dsExpr@
 121 is the TE translation scheme.  Note that we carry around the @L@ list
 122 already desugared.  @dsListComp@ does the top TE rule mentioned above.
 123
 124 To the above, we add an additional rule to deal with parallel list
 125 comprehensions.  The translation goes roughly as follows:
 126      [ e | p1 <- e11, let v1 = e12, p2 <- e13
 127          | q1 <- e21, let v2 = e22, q2 <- e23]
 128      =>
 129      [ e | ((x1, .., xn), (y1, ..., ym)) <-
 130                zip [(x1,..,xn) | p1 <- e11, let v1 = e12, p2 <- e13]
 131                    [(y1,..,ym) | q1 <- e21, let v2 = e22, q2 <- e23]]
 132 where (x1, .., xn) are the variables bound in p1, v1, p2
 133       (y1, .., ym) are the variables bound in q1, v2, q2
 134
 135 In the translation below, the ParStmt branch translates each parallel branch
 136 into a sub-comprehension, and desugars each independently.  The resulting lists
 137 are fed to a zip function, we create a binding for all the variables bound in all
 138 the comprehensions, and then we hand things off the the desugarer for bindings.
 139 The zip function is generated here a) because it's small, and b) because then we
 140 don't have to deal with arbitrary limits on the number of zip functions in the
 141 prelude, nor which library the zip function came from.
 142 The introduced tuples are Boxed, but only because I couldn't get it to work
 143 with the Unboxed variety.
 144
 145 \begin{code}
 146 deListComp :: [Stmt Id] -> LHsExpr Id -> CoreExpr -> DsM CoreExpr
 147
 148 deListComp (ParStmt stmtss_w_bndrs : quals) body list
 149   = mappM do_list_comp stmtss_w_bndrs   `thenDs` \ exps ->
 150     mkZipBind qual_tys                  `thenDs` \ (zip_fn, zip_rhs) ->
 151
 152         -- Deal with [e | pat <- zip l1 .. ln] in example above
 153     deBindComp pat (Let (Rec [(zip_fn, zip_rhs)]) (mkApps (Var zip_fn) exps))
 154                    quals body list
 155
 156   where
 157         bndrs_s = map snd stmtss_w_bndrs
 158
 159         -- pat is the pattern ((x1,..,xn), (y1,..,ym)) in the example above
 160         pat      = mkTuplePat pats
 161         pats     = map mk_hs_tuple_pat bndrs_s
 162
 163         -- Types of (x1,..,xn), (y1,..,yn) etc
 164         qual_tys = map mk_bndrs_tys bndrs_s
 165
 166         do_list_comp (stmts, bndrs)
 167           = dsListComp stmts (mk_hs_tuple_expr bndrs)
 168                        (mk_bndrs_tys bndrs)
 169
 170         mk_bndrs_tys bndrs = mkCoreTupTy (map idType bndrs)
 171
 172         -- Last: the one to return
 173 deListComp [] body list         -- Figure 7.4, SLPJ, p 135, rule C above
 174   = dsLExpr body                `thenDs` \ core_body ->
 175     returnDs (mkConsExpr (exprType core_body) core_body list)
 176
 177         -- Non-last: must be a guard
 178 deListComp (ExprStmt guard _ _ : quals) body list       -- rule B above
 179   = dsLExpr guard               `thenDs` \ core_guard ->
 180     deListComp quals body list  `thenDs` \ core_rest ->
 181     returnDs (mkIfThenElse core_guard core_rest list)
 182
 183 -- [e | let B, qs] = let B in [e | qs]
 184 deListComp (LetStmt binds : quals) body list
 185   = deListComp quals body list  `thenDs` \ core_rest ->
 186     dsLocalBinds binds core_rest
 187
 188 deListComp (BindStmt pat list1 _ _ : quals) body core_list2 -- rule A' above
 189   = dsLExpr list1                   `thenDs` \ core_list1 ->
 190     deBindComp pat core_list1 quals body core_list2
 191 \end{code}
 192
 193
 194 \begin{code}
 195 deBindComp pat core_list1 quals body core_list2
 196   = let
 197         u3_ty@u1_ty = exprType core_list1       -- two names, same thing
 198
 199         -- u1_ty is a [alpha] type, and u2_ty = alpha
 200         u2_ty = hsLPatType pat
 201
 202         res_ty = exprType core_list2
 203         h_ty   = u1_ty `mkFunTy` res_ty
 204     in
 205     newSysLocalsDs [h_ty, u1_ty, u2_ty, u3_ty]  `thenDs` \ [h, u1, u2, u3] ->
 206
 207     -- the "fail" value ...
 208     let
 209         core_fail   = App (Var h) (Var u3)
 210         letrec_body = App (Var h) core_list1
 211     in
 212     deListComp quals body core_fail             `thenDs` \ rest_expr ->
 213     matchSimply (Var u2) (StmtCtxt ListComp) pat
 214                 rest_expr core_fail             `thenDs` \ core_match ->
 215     let
 216         rhs = Lam u1 $
 217               Case (Var u1) u1 res_ty
 218                    [(DataAlt nilDataCon,  [],       core_list2),
 219                     (DataAlt consDataCon, [u2, u3], core_match)]
 220                         -- Increasing order of tag
 221     in
 222     returnDs (Let (Rec [(h, rhs)]) letrec_body)
 223 \end{code}
 224
 225
 226 \begin{code}
 227 mkZipBind :: [Type] -> DsM (Id, CoreExpr)
 228 -- mkZipBind [t1, t2]
 229 -- = (zip, \as1:[t1] as2:[t2]
 230 --         -> case as1 of
 231 --              [] -> []
 232 --              (a1:as'1) -> case as2 of
 233 --                              [] -> []
 234 --                              (a2:as'2) -> (a2,a2) : zip as'1 as'2)]
 235
 236 mkZipBind elt_tys
 237   = mappM newSysLocalDs  list_tys       `thenDs` \ ass ->
 238     mappM newSysLocalDs  elt_tys        `thenDs` \ as' ->
 239     mappM newSysLocalDs  list_tys       `thenDs` \ as's ->
 240     newSysLocalDs zip_fn_ty             `thenDs` \ zip_fn ->
 241     let
 242         inner_rhs = mkConsExpr ret_elt_ty
 243                         (mkCoreTup (map Var as'))
 244                         (mkVarApps (Var zip_fn) as's)
 245         zip_body  = foldr mk_case inner_rhs (zip3 ass as' as's)
 246     in
 247     returnDs (zip_fn, mkLams ass zip_body)
 248   where
 249     list_tys    = map mkListTy elt_tys
 250     ret_elt_ty  = mkCoreTupTy elt_tys
 251     list_ret_ty = mkListTy ret_elt_ty
 252     zip_fn_ty   = mkFunTys list_tys list_ret_ty
 253
 254     mk_case (as, a', as') rest
 255           = Case (Var as) as list_ret_ty
 256                   [(DataAlt nilDataCon,  [],        mkNilExpr ret_elt_ty),
 257                    (DataAlt consDataCon, [a', as'], rest)]
 258                         -- Increasing order of tag
 259 -- Helper functions that makes an HsTuple only for non-1-sized tuples
 260 mk_hs_tuple_expr :: [Id] -> LHsExpr Id
 261 mk_hs_tuple_expr []   = nlHsVar unitDataConId
 262 mk_hs_tuple_expr [id] = nlHsVar id
 263 mk_hs_tuple_expr ids  = noLoc $ ExplicitTuple [ nlHsVar i | i <- ids ] Boxed
 264
 265 mk_hs_tuple_pat :: [Id] -> LPat Id
 266 mk_hs_tuple_pat bs  = mkTuplePat (map nlVarPat bs)
 267 \end{code}
 268
 269
 270 %************************************************************************
 271 %*                                                                      *
 272 \subsection[DsListComp-foldr-build]{Foldr/Build desugaring of list comprehensions}
 273 %*                                                                      *
 274 %************************************************************************
 275
 276 @dfListComp@ are the rules used with foldr/build turned on:
 277
 278 \begin{verbatim}
 279 TE[ e | ]            c n = c e n
 280 TE[ e | b , q ]      c n = if b then TE[ e | q ] c n else n
 281 TE[ e | p <- l , q ] c n = let
 282                                 f = \ x b -> case x of
 283                                                   p -> TE[ e | q ] c b
 284                                                   _ -> b
 285                            in
 286                            foldr f n l
 287 \end{verbatim}
 288
 289 \begin{code}
 290 dfListComp :: Id -> Id                  -- 'c' and 'n'
 291            -> [Stmt Id]         -- the rest of the qual's
 292            -> LHsExpr Id
 293            -> DsM CoreExpr
 294
 295         -- Last: the one to return
 296 dfListComp c_id n_id [] body
 297   = dsLExpr body                `thenDs` \ core_body ->
 298     returnDs (mkApps (Var c_id) [core_body, Var n_id])
 299
 300         -- Non-last: must be a guard
 301 dfListComp c_id n_id (ExprStmt guard _ _  : quals) body
 302   = dsLExpr guard                       `thenDs` \ core_guard ->
 303     dfListComp c_id n_id quals body     `thenDs` \ core_rest ->
 304     returnDs (mkIfThenElse core_guard core_rest (Var n_id))
 305
 306 dfListComp c_id n_id (LetStmt binds : quals) body
 307   -- new in 1.3, local bindings
 308   = dfListComp c_id n_id quals body     `thenDs` \ core_rest ->
 309     dsLocalBinds binds core_rest
 310
 311 dfListComp c_id n_id (BindStmt pat list1 _ _ : quals) body
 312     -- evaluate the two lists
 313   = dsLExpr list1                       `thenDs` \ core_list1 ->
 314
 315     -- find the required type
 316     let x_ty   = hsLPatType pat
 317         b_ty   = idType n_id
 318     in
 319
 320     -- create some new local id's
 321     newSysLocalsDs [b_ty,x_ty]                  `thenDs` \ [b,x] ->
 322
 323     -- build rest of the comprehesion
 324     dfListComp c_id b quals body                `thenDs` \ core_rest ->
 325
 326     -- build the pattern match
 327     matchSimply (Var x) (StmtCtxt ListComp)
 328                 pat core_rest (Var b)           `thenDs` \ core_expr ->
 329
 330     -- now build the outermost foldr, and return
 331     dsLookupGlobalId foldrName          `thenDs` \ foldr_id ->
 332     returnDs (
 333       Var foldr_id `App` Type x_ty
 334                    `App` Type b_ty
 335                    `App` mkLams [x, b] core_expr
 336                    `App` Var n_id
 337                    `App` core_list1
 338     )
 339 \end{code}
 340
 341 %************************************************************************
 342 %*                                                                      *
 343 \subsection[DsPArrComp]{Desugaring of array comprehensions}
 344 %*                                                                      *
 345 %************************************************************************
 346
 347 \begin{code}
 348
 349 -- entry point for desugaring a parallel array comprehension
 350 --
 351 --   [:e | qss:] = <<[:e | qss:]>> () [:():]
 352 --
 353 dsPArrComp      :: [Stmt Id]
 354                 -> LHsExpr Id
 355                 -> Type             -- Don't use; called with `undefined' below
 356                 -> DsM CoreExpr
 357 dsPArrComp qs body _  =
 358   dsLookupGlobalId replicatePName                         `thenDs` \repP ->
 359   let unitArray = mkApps (Var repP) [Type unitTy,
 360                                      mkIntExpr 1,
 361                                      mkCoreTup []]
 362   in
 363   dePArrComp qs body (mkTuplePat []) unitArray
 364
 365 -- the work horse
 366 --
 367 dePArrComp :: [Stmt Id]
 368            -> LHsExpr Id
 369            -> LPat Id           -- the current generator pattern
 370            -> CoreExpr          -- the current generator expression
 371            -> DsM CoreExpr
 372 --
 373 --  <<[:e' | :]>> pa ea = mapP (\pa -> e') ea
 374 --
 375 dePArrComp [] e' pa cea =
 376   dsLookupGlobalId mapPName                               `thenDs` \mapP    ->
 377   let ty = parrElemType cea
 378   in
 379   deLambda ty pa e'                                       `thenDs` \(clam,
 380                                                                      ty'e') ->
 381   returnDs $ mkApps (Var mapP) [Type ty, Type ty'e', clam, cea]
 382 --
 383 --  <<[:e' | b, qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)
 384 --
 385 dePArrComp (ExprStmt b _ _ : qs) body pa cea =
 386   dsLookupGlobalId filterPName                    `thenDs` \filterP  ->
 387   let ty = parrElemType cea
 388   in
 389   deLambda ty pa b                                `thenDs` \(clam,_) ->
 390   dePArrComp qs body pa (mkApps (Var filterP) [Type ty, clam, cea])
 391 --
 392 --  <<[:e' | p <- e, qs:]>> pa ea =
 393 --    let ef = filterP (\x -> case x of {p -> True; _ -> False}) e
 394 --    in
 395 --    <<[:e' | qs:]>> (pa, p) (crossP ea ef)
 396 --
 397 dePArrComp (BindStmt p e _ _ : qs) body pa cea =
 398   dsLookupGlobalId filterPName                    `thenDs` \filterP ->
 399   dsLookupGlobalId crossPName                     `thenDs` \crossP  ->
 400   dsLExpr e                                       `thenDs` \ce      ->
 401   let ty'cea = parrElemType cea
 402       ty'ce  = parrElemType ce
 403       false  = Var falseDataConId
 404       true   = Var trueDataConId
 405   in
 406   newSysLocalDs ty'ce                                     `thenDs` \v       ->
 407   matchSimply (Var v) (StmtCtxt PArrComp) p true false    `thenDs` \pred    ->
 408   let cef    = mkApps (Var filterP) [Type ty'ce, mkLams [v] pred, ce]
 409       ty'cef = ty'ce                            -- filterP preserves the type
 410       pa'    = mkTuplePat [pa, p]
 411   in
 412   dePArrComp qs body pa' (mkApps (Var crossP) [Type ty'cea, Type ty'cef, cea, cef])
 413 --
 414 --  <<[:e' | let ds, qs:]>> pa ea =
 415 --    <<[:e' | qs:]>> (pa, (x_1, ..., x_n))
 416 --                    (mapP (\v@pa -> (v, let ds in (x_1, ..., x_n))) ea)
 417 --  where
 418 --    {x_1, ..., x_n} = DV (ds)         -- Defined Variables
 419 --
 420 dePArrComp (LetStmt ds : qs) body pa cea =
 421   dsLookupGlobalId mapPName                               `thenDs` \mapP    ->
 422   let xs     = map unLoc (collectLocalBinders ds)
 423       ty'cea = parrElemType cea
 424   in
 425   newSysLocalDs ty'cea                                    `thenDs` \v       ->
 426   dsLocalBinds ds (mkCoreTup (map Var xs))                `thenDs` \clet    ->
 427   newSysLocalDs (exprType clet)                           `thenDs` \let'v   ->
 428   let projBody = mkDsLet (NonRec let'v clet) $
 429                  mkCoreTup [Var v, Var let'v]
 430       errTy    = exprType projBody
 431       errMsg   = "DsListComp.dePArrComp: internal error!"
 432   in
 433   mkErrorAppDs pAT_ERROR_ID errTy errMsg                  `thenDs` \cerr    ->
 434   matchSimply (Var v) (StmtCtxt PArrComp) pa projBody cerr`thenDs` \ccase   ->
 435   let pa'    = mkTuplePat [pa, mkTuplePat (map nlVarPat xs)]
 436       proj   = mkLams [v] ccase
 437   in
 438   dePArrComp qs body pa' (mkApps (Var mapP) [Type ty'cea, proj, cea])
 439 --
 440 --  <<[:e' | qs | qss:]>> pa ea =
 441 --    <<[:e' | qss:]>> (pa, (x_1, ..., x_n))
 442 --                     (zipP ea <<[:(x_1, ..., x_n) | qs:]>>)
 443 --    where
 444 --      {x_1, ..., x_n} = DV (qs)
 445 --
 446 dePArrComp (ParStmt qss : qs) body pa cea =
 447   dsLookupGlobalId crossPName                           `thenDs` \crossP  ->
 448   deParStmt qss                                         `thenDs` \(pQss,
 449                                                                    ceQss) ->
 450   let ty'cea   = parrElemType cea
 451       ty'ceQss = parrElemType ceQss
 452       pa'      = mkTuplePat [pa, pQss]
 453   in
 454   dePArrComp qs body pa' (mkApps (Var crossP) [Type ty'cea, Type ty'ceQss,
 455                                                cea, ceQss])
 456   where
 457     deParStmt []             =
 458       -- empty parallel statement lists have not source representation
 459       panic "DsListComp.dePArrComp: Empty parallel list comprehension"
 460     deParStmt ((qs, xs):qss) =          -- first statement
 461       let res_expr = mkExplicitTuple (map nlHsVar xs)
 462       in
 463       dsPArrComp (map unLoc qs) res_expr undefined        `thenDs` \cqs     ->
 464       parStmts qss (mkTuplePat (map nlVarPat xs)) cqs
 465     ---
 466     parStmts []             pa cea = return (pa, cea)
 467     parStmts ((qs, xs):qss) pa cea =    -- subsequent statements (zip'ed)
 468       dsLookupGlobalId zipPName                           `thenDs` \zipP    ->
 469       let pa'      = mkTuplePat [pa, mkTuplePat (map nlVarPat xs)]
 470           ty'cea   = parrElemType cea
 471           res_expr = mkExplicitTuple (map nlHsVar xs)
 472       in
 473       dsPArrComp (map unLoc qs) res_expr undefined        `thenDs` \cqs     ->
 474       let ty'cqs = parrElemType cqs
 475           cea'   = mkApps (Var zipP) [Type ty'cea, Type ty'cqs, cea, cqs]
 476       in
 477       parStmts qss pa' cea'
 478
 479 -- generate Core corresponding to `\p -> e'
 480 --
 481 deLambda        :: Type                 -- type of the argument
 482                 -> LPat Id              -- argument pattern
 483                 -> LHsExpr Id           -- body
 484                 -> DsM (CoreExpr, Type)
 485 deLambda ty p e  =
 486   newSysLocalDs ty                                        `thenDs` \v       ->
 487   dsLExpr e                                               `thenDs` \ce      ->
 488   let errTy    = exprType ce
 489       errMsg   = "DsListComp.deLambda: internal error!"
 490   in
 491   mkErrorAppDs pAT_ERROR_ID errTy errMsg                  `thenDs` \cerr    ->
 492   matchSimply (Var v) (StmtCtxt PArrComp) p ce cerr       `thenDs` \res     ->
 493   returnDs (mkLams [v] res, errTy)
 494
 495 -- obtain the element type of the parallel array produced by the given Core
 496 -- expression
 497 --
 498 parrElemType   :: CoreExpr -> Type
 499 parrElemType e  =
 500   case splitTyConApp_maybe (exprType e) of
 501     Just (tycon, [ty]) | tycon == parrTyCon -> ty
 502     _                                                     -> panic
 503       "DsListComp.parrElemType: not a parallel array type"
 504
 505 -- Smart constructor for source tuple patterns
 506 --
 507 mkTuplePat :: [LPat Id] -> LPat Id
 508 mkTuplePat [lpat] = lpat
 509 mkTuplePat lpats  = noLoc $ mkVanillaTuplePat lpats Boxed
 510
 511 -- Smart constructor for source tuple expressions
 512 --
 513 mkExplicitTuple :: [LHsExpr id] -> LHsExpr id
 514 mkExplicitTuple [lexp] = lexp
 515 mkExplicitTuple lexps  = noLoc $ ExplicitTuple lexps Boxed
 516 \end{code}