compiler/deSugar/Desugar.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 The Desugarer: turning HsSyn into Core.
   7
   8 \begin{code}
   9 module Desugar ( deSugar, deSugarExpr ) where
  10
  11 import DynFlags
  12 import StaticFlags
  13 import HscTypes
  14 import HsSyn
  15 import TcRnTypes
  16 import MkIface
  17 import Id
  18 import Name
  19 import CoreSyn
  20 import CoreSubst
  21 import CoqPass ( coqPassCoreToString, coqPassCoreToCore )
  22 import PprCore
  23 import DsMonad
  24 import DsExpr
  25 import DsBinds
  26 import DsForeign
  27 import DsExpr           ()      -- Forces DsExpr to be compiled; DsBinds only
  28                                 -- depends on DsExpr.hi-boot.
  29 import Module
  30 import RdrName
  31 import NameSet
  32 import NameEnv
  33 import Rules
  34 import CoreMonad        ( endPass, CoreToDo(..) )
  35 import ErrUtils
  36 import Outputable
  37 import SrcLoc
  38 import Coverage
  39 import Util
  40 import MonadUtils
  41 import OrdList
  42 import Data.List
  43 import Data.IORef
  44 import PrelNames
  45 import UniqSupply
  46 \end{code}
  47
  48 %************************************************************************
  49 %*                                                                      *
  50 %*              The main function: deSugar
  51 %*                                                                      *
  52 %************************************************************************
  53
  54 \begin{code}
  55 -- | Main entry point to the desugarer.
  56 deSugar :: HscEnv -> ModLocation -> TcGblEnv -> IO (Messages, Maybe ModGuts)
  57 -- Can modify PCS by faulting in more declarations
  58
  59 deSugar hsc_env
  60         mod_loc
  61         tcg_env@(TcGblEnv { tcg_mod          = mod,
  62                             tcg_src          = hsc_src,
  63                             tcg_type_env     = type_env,
  64                             tcg_imports      = imports,
  65                             tcg_exports      = exports,
  66                             tcg_keep         = keep_var,
  67                             tcg_rdr_env      = rdr_env,
  68                             tcg_fix_env      = fix_env,
  69                             tcg_inst_env     = inst_env,
  70                             tcg_fam_inst_env = fam_inst_env,
  71                             tcg_warns        = warns,
  72                             tcg_anns         = anns,
  73                             tcg_binds        = binds,
  74                             tcg_imp_specs    = imp_specs,
  75                             tcg_ev_binds     = ev_binds,
  76                             tcg_fords        = fords,
  77                             tcg_rules        = rules,
  78                             tcg_vects        = vects,
  79                             tcg_insts        = insts,
  80                             tcg_fam_insts    = fam_insts,
  81                             tcg_hpc          = other_hpc_info })
  82
  83   = do  { let dflags = hsc_dflags hsc_env
  84         ; showPass dflags "Desugar"
  85
  86         -- Desugar the program
  87         ; let export_set = availsToNameSet exports
  88         ; let auto_scc = mkAutoScc dflags mod export_set
  89         ; let target = hscTarget dflags
  90         ; let hpcInfo = emptyHpcInfo other_hpc_info
  91         ; (msgs, mb_res)
  92               <- case target of
  93                    HscNothing ->
  94                        return (emptyMessages,
  95                                Just ([], nilOL, [], [], NoStubs, hpcInfo, emptyModBreaks, undefined, undefined
  96                                     , undefined
  97                                     , undefined
  98                                     , undefined
  99                                     , undefined
 100                                     , undefined
 101                                     , undefined
 102                                     , undefined
 103                                     , undefined
 104                                     , undefined
 105                                     , undefined
 106                                     , undefined
 107                                     , undefined
 108                                     , undefined
 109                                     , undefined
 110                                     , undefined
 111                                     , undefined
 112                                     , undefined
 113                                     , undefined
 114                                     , undefined
 115                                     , undefined
 116                                     , undefined
 117                                ))
 118                    _        -> do
 119                      (binds_cvr,ds_hpc_info, modBreaks)
 120                          <- if (opt_Hpc
 121                                   || target == HscInterpreted)
 122                                && (not (isHsBoot hsc_src))
 123                               then addCoverageTicksToBinds dflags mod mod_loc
 124                                                            (typeEnvTyCons type_env) binds
 125                               else return (binds, hpcInfo, emptyModBreaks)
 126                      initDs hsc_env mod rdr_env type_env $ do
 127                        do { ds_ev_binds <- dsEvBinds ev_binds
 128                           ; core_prs <- dsTopLHsBinds auto_scc binds_cvr
 129                           ; (spec_prs, spec_rules) <- dsImpSpecs imp_specs
 130                           ; (ds_fords, foreign_prs) <- dsForeigns fords
 131                           ; ds_rules <- mapMaybeM dsRule rules
 132                           ; ds_vects <- mapM dsVect vects
 133                           ; hetmet_brak <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_brak_name else return undefined
 134                           ; hetmet_esc  <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_esc_name  else return undefined
 135                           ; hetmet_flatten <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_flatten_name else return undefined
 136                           ; hetmet_unflatten <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_unflatten_name else return undefined
 137                           ; hetmet_flattened_id <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_flattened_id_name else return undefined
 138                           ; hetmet_PGArrow <- if dopt Opt_F_coqpass dflags then dsLookupTyCon hetmet_PGArrow_name else return undefined
 139                           ; hetmet_pga_id <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_id_name else return undefined
 140                           ; hetmet_pga_comp <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_comp_name else return undefined
 141                           ; hetmet_pga_first <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_first_name else return undefined
 142                           ; hetmet_pga_second <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_second_name else return undefined
 143                           ; hetmet_pga_cancell <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_cancell_name else return undefined
 144                           ; hetmet_pga_cancelr <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_cancelr_name else return undefined
 145                           ; hetmet_pga_uncancell <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_uncancell_name else return undefined
 146                           ; hetmet_pga_uncancelr <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_uncancelr_name else return undefined
 147                           ; hetmet_pga_assoc <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_assoc_name else return undefined
 148                           ; hetmet_pga_unassoc <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_unassoc_name else return undefined
 149                           ; hetmet_pga_copy <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_copy_name else return undefined
 150                           ; hetmet_pga_drop <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_drop_name else return undefined
 151                           ; hetmet_pga_swap <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_swap_name else return undefined
 152                           ; hetmet_pga_applyl <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_applyl_name else return undefined
 153                           ; hetmet_pga_applyr <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_applyr_name else return undefined
 154                           ; hetmet_pga_curryl <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_curryl_name else return undefined
 155                           ; hetmet_pga_curryr <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_curryr_name else return undefined
 156                           ; let hpc_init
 157                                   | opt_Hpc   = hpcInitCode mod ds_hpc_info
 158                                   | otherwise = empty
 159                           ; return ( ds_ev_binds
 160                                    , foreign_prs `appOL` core_prs `appOL` spec_prs
 161                                    , spec_rules ++ ds_rules, ds_vects
 162                                    , ds_fords `appendStubC` hpc_init
 163                                    , ds_hpc_info, modBreaks, hetmet_brak, hetmet_esc
 164                                    , hetmet_flatten
 165                                    , hetmet_unflatten
 166                                    , hetmet_flattened_id
 167                                    , hetmet_PGArrow
 168                                    , hetmet_pga_id
 169                                    , hetmet_pga_comp
 170                                    , hetmet_pga_first
 171                                    , hetmet_pga_second
 172                                    , hetmet_pga_cancell
 173                                    , hetmet_pga_cancelr
 174                                    , hetmet_pga_uncancell
 175                                    , hetmet_pga_uncancelr
 176                                    , hetmet_pga_assoc
 177                                    , hetmet_pga_unassoc
 178                                    , hetmet_pga_copy
 179                                    , hetmet_pga_drop
 180                                    , hetmet_pga_swap
 181                                    , hetmet_pga_applyl
 182                                    , hetmet_pga_applyr
 183                                    , hetmet_pga_curryl
 184                                    , hetmet_pga_curryr
 185                                    ) }
 186
 187         ; case mb_res of {
 188            Nothing -> return (msgs, Nothing) ;
 189            Just (ds_ev_binds, all_prs, all_rules, ds_vects, ds_fords,ds_hpc_info, modBreaks
 190                                    , hetmet_brak, hetmet_esc
 191                                    , hetmet_flatten
 192                                    , hetmet_unflatten
 193                                    , hetmet_flattened_id
 194                                    , hetmet_PGArrow
 195                                    , hetmet_pga_id
 196                                    , hetmet_pga_comp
 197                                    , hetmet_pga_first
 198                                    , hetmet_pga_second
 199                                    , hetmet_pga_cancell
 200                                    , hetmet_pga_cancelr
 201                                    , hetmet_pga_uncancell
 202                                    , hetmet_pga_uncancelr
 203                                    , hetmet_pga_assoc
 204                                    , hetmet_pga_unassoc
 205                                    , hetmet_pga_copy
 206                                    , hetmet_pga_drop
 207                                    , hetmet_pga_swap
 208                                    , hetmet_pga_applyl
 209                                    , hetmet_pga_applyr
 210                                    , hetmet_pga_curryl
 211                                    , hetmet_pga_curryr) -> do
 212
 213         {       -- Add export flags to bindings
 214           keep_alive <- readIORef keep_var
 215         ; let (rules_for_locals, rules_for_imps)
 216                    = partition isLocalRule all_rules
 217               final_prs = addExportFlagsAndRules target
 218                               export_set keep_alive rules_for_locals (fromOL all_prs)
 219
 220               final_pgm = combineEvBinds ds_ev_binds final_prs
 221         -- Notice that we put the whole lot in a big Rec, even the foreign binds
 222         -- When compiling PrelFloat, which defines data Float = F# Float#
 223         -- we want F# to be in scope in the foreign marshalling code!
 224         -- You might think it doesn't matter, but the simplifier brings all top-level
 225         -- things into the in-scope set before simplifying; so we get no unfolding for F#!
 226
 227         -- Lint result if necessary, and print
 228         ; dumpIfSet_dyn dflags Opt_D_dump_ds "Desugared, before opt" $
 229                (vcat [ pprCoreBindings final_pgm
 230                      , pprRules rules_for_imps ])
 231
 232         ; (ds_binds, ds_rules_for_imps) <- simpleOptPgm dflags final_pgm rules_for_imps
 233                          -- The simpleOptPgm gets rid of type
 234                          -- bindings plus any stupid dead code
 235
 236         ; ds_binds' <- if dopt Opt_F_coqpass dflags
 237                        then do { us <- mkSplitUniqSupply '~'
 238                                ; return (coqPassCoreToCore
 239                                              hetmet_brak
 240                                              hetmet_esc
 241                                              hetmet_flatten
 242                                              hetmet_unflatten
 243                                              hetmet_flattened_id
 244                                              us
 245                                              ds_binds
 246                                              hetmet_PGArrow
 247                                              hetmet_pga_id
 248                                              hetmet_pga_comp
 249                                              hetmet_pga_first
 250                                              hetmet_pga_second
 251                                              hetmet_pga_cancell
 252                                              hetmet_pga_cancelr
 253                                              hetmet_pga_uncancell
 254                                              hetmet_pga_uncancelr
 255                                              hetmet_pga_assoc
 256                                              hetmet_pga_unassoc
 257                                              hetmet_pga_copy
 258                                              hetmet_pga_drop
 259                                              hetmet_pga_swap
 260                                              hetmet_pga_applyl
 261                                              hetmet_pga_applyr
 262                                              hetmet_pga_curryl
 263                                              hetmet_pga_curryr)
 264                                }
 265                        else return ds_binds
 266
 267         ; dumpIfSet_dyn dflags Opt_D_coqpass "Coq Pass Output" $ text $ coqPassCoreToString ds_binds'
 268
 269         ; dumpIfSet_dyn dflags Opt_D_dump_coqpass "After Coq Pass" (text $ showSDoc $ pprCoreBindings ds_binds')
 270
 271         ; endPass dflags CoreDesugar ds_binds' ds_rules_for_imps
 272
 273         ; let used_names = mkUsedNames tcg_env
 274         ; deps <- mkDependencies tcg_env
 275
 276         ; let mod_guts = ModGuts {
 277                 mg_module       = mod,
 278                 mg_boot         = isHsBoot hsc_src,
 279                 mg_exports      = exports,
 280                 mg_deps         = deps,
 281                 mg_used_names   = used_names,
 282                 mg_dir_imps     = imp_mods imports,
 283                 mg_rdr_env      = rdr_env,
 284                 mg_fix_env      = fix_env,
 285                 mg_warns        = warns,
 286                 mg_anns         = anns,
 287                 mg_types        = type_env,
 288                 mg_insts        = insts,
 289                 mg_fam_insts    = fam_insts,
 290                 mg_inst_env     = inst_env,
 291                 mg_fam_inst_env = fam_inst_env,
 292                 mg_rules        = ds_rules_for_imps,
 293                 mg_binds        = ds_binds',
 294                 mg_foreign      = ds_fords,
 295                 mg_hpc_info     = ds_hpc_info,
 296                 mg_modBreaks    = modBreaks,
 297                 mg_vect_decls   = ds_vects,
 298                 mg_vect_info    = noVectInfo
 299               }
 300         ; return (msgs, Just mod_guts)
 301         }}}
 302
 303 dsImpSpecs :: [LTcSpecPrag] -> DsM (OrdList (Id,CoreExpr), [CoreRule])
 304 dsImpSpecs imp_specs
 305  = do { spec_prs <- mapMaybeM (dsSpec Nothing) imp_specs
 306       ; let (spec_binds, spec_rules) = unzip spec_prs
 307       ; return (concatOL spec_binds, spec_rules) }
 308
 309 combineEvBinds :: [DsEvBind] -> [(Id,CoreExpr)] -> [CoreBind]
 310 -- Top-level bindings can include coercion bindings, but not via superclasses
 311 -- See Note [Top-level evidence]
 312 combineEvBinds [] val_prs
 313   = [Rec val_prs]
 314 combineEvBinds (LetEvBind (NonRec b r) : bs) val_prs
 315   | isId b    = combineEvBinds bs ((b,r):val_prs)
 316   | otherwise = NonRec b r : combineEvBinds bs val_prs
 317 combineEvBinds (LetEvBind (Rec prs) : bs) val_prs
 318   = combineEvBinds bs (prs ++ val_prs)
 319 combineEvBinds (CaseEvBind x _ _ : _) _
 320   = pprPanic "topEvBindPairs" (ppr x)
 321 \end{code}
 322
 323 Note [Top-level evidence]
 324 ~~~~~~~~~~~~~~~~~~~~~~~~~
 325 Top-level evidence bindings may be mutually recursive with the top-level value
 326 bindings, so we must put those in a Rec.  But we can't put them *all* in a Rec
 327 because the occurrence analyser doesn't teke account of type/coercion variables
 328 when computing dependencies.
 329
 330 So we pull out the type/coercion variables (which are in dependency order),
 331 and Rec the rest.
 332
 333
 334 \begin{code}
 335 mkAutoScc :: DynFlags -> Module -> NameSet -> AutoScc
 336 mkAutoScc dflags mod exports
 337   | not opt_SccProfilingOn      -- No profiling
 338   = NoSccs
 339     -- Add auto-scc on all top-level things
 340   | dopt Opt_AutoSccsOnAllToplevs dflags
 341   = AddSccs mod (\id -> not $ isDerivedOccName $ getOccName id)
 342     -- See #1641.  This is pretty yucky, but I can't see a better way
 343     -- to identify compiler-generated Ids, and at least this should
 344     -- catch them all.
 345     -- Only on exported things
 346   | dopt Opt_AutoSccsOnExportedToplevs dflags
 347   = AddSccs mod (\id -> idName id `elemNameSet` exports)
 348   | otherwise
 349   = NoSccs
 350
 351 deSugarExpr :: HscEnv
 352             -> Module -> GlobalRdrEnv -> TypeEnv
 353             -> LHsExpr Id
 354             -> IO (Messages, Maybe CoreExpr)
 355 -- Prints its own errors; returns Nothing if error occurred
 356
 357 deSugarExpr hsc_env this_mod rdr_env type_env tc_expr = do
 358     let dflags = hsc_dflags hsc_env
 359     showPass dflags "Desugar"
 360
 361     -- Do desugaring
 362     (msgs, mb_core_expr) <- initDs hsc_env this_mod rdr_env type_env $
 363                                    dsLExpr tc_expr
 364
 365     case mb_core_expr of
 366       Nothing   -> return (msgs, Nothing)
 367       Just expr -> do
 368
 369         -- Dump output
 370         dumpIfSet_dyn dflags Opt_D_dump_ds "Desugared" (pprCoreExpr expr)
 371
 372         return (msgs, Just expr)
 373 \end{code}
 374
 375 %************************************************************************
 376 %*                                                                      *
 377 %*              Add rules and export flags to binders
 378 %*                                                                      *
 379 %************************************************************************
 380
 381 \begin{code}
 382 addExportFlagsAndRules
 383     :: HscTarget -> NameSet -> NameSet -> [CoreRule]
 384     -> [(Id, t)] -> [(Id, t)]
 385 addExportFlagsAndRules target exports keep_alive rules prs
 386   = mapFst add_one prs
 387   where
 388     add_one bndr = add_rules name (add_export name bndr)
 389        where
 390          name = idName bndr
 391
 392     ---------- Rules --------
 393         -- See Note [Attach rules to local ids]
 394         -- NB: the binder might have some existing rules,
 395         -- arising from specialisation pragmas
 396     add_rules name bndr
 397         | Just rules <- lookupNameEnv rule_base name
 398         = bndr `addIdSpecialisations` rules
 399         | otherwise
 400         = bndr
 401     rule_base = extendRuleBaseList emptyRuleBase rules
 402
 403     ---------- Export flag --------
 404     -- See Note [Adding export flags]
 405     add_export name bndr
 406         | dont_discard name = setIdExported bndr
 407         | otherwise         = bndr
 408
 409     dont_discard :: Name -> Bool
 410     dont_discard name = is_exported name
 411                      || name `elemNameSet` keep_alive
 412
 413         -- In interactive mode, we don't want to discard any top-level
 414         -- entities at all (eg. do not inline them away during
 415         -- simplification), and retain them all in the TypeEnv so they are
 416         -- available from the command line.
 417         --
 418         -- isExternalName separates the user-defined top-level names from those
 419         -- introduced by the type checker.
 420     is_exported :: Name -> Bool
 421     is_exported | target == HscInterpreted = isExternalName
 422                 | otherwise                = (`elemNameSet` exports)
 423 \end{code}
 424
 425
 426 Note [Adding export flags]
 427 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 428 Set the no-discard flag if either
 429         a) the Id is exported
 430         b) it's mentioned in the RHS of an orphan rule
 431         c) it's in the keep-alive set
 432
 433 It means that the binding won't be discarded EVEN if the binding
 434 ends up being trivial (v = w) -- the simplifier would usually just
 435 substitute w for v throughout, but we don't apply the substitution to
 436 the rules (maybe we should?), so this substitution would make the rule
 437 bogus.
 438
 439 You might wonder why exported Ids aren't already marked as such;
 440 it's just because the type checker is rather busy already and
 441 I didn't want to pass in yet another mapping.
 442
 443 Note [Attach rules to local ids]
 444 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 445 Find the rules for locally-defined Ids; then we can attach them
 446 to the binders in the top-level bindings
 447
 448 Reason
 449   - It makes the rules easier to look up
 450   - It means that transformation rules and specialisations for
 451     locally defined Ids are handled uniformly
 452   - It keeps alive things that are referred to only from a rule
 453     (the occurrence analyser knows about rules attached to Ids)
 454   - It makes sure that, when we apply a rule, the free vars
 455     of the RHS are more likely to be in scope
 456   - The imported rules are carried in the in-scope set
 457     which is extended on each iteration by the new wave of
 458     local binders; any rules which aren't on the binding will
 459     thereby get dropped
 460
 461
 462 %************************************************************************
 463 %*                                                                      *
 464 %*              Desugaring transformation rules
 465 %*                                                                      *
 466 %************************************************************************
 467
 468 \begin{code}
 469 dsRule :: LRuleDecl Id -> DsM (Maybe CoreRule)
 470 dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
 471   = putSrcSpanDs loc $
 472     do  { let bndrs' = [var | RuleBndr (L _ var) <- vars]
 473
 474         ; lhs' <- unsetOptM Opt_EnableRewriteRules $
 475                   unsetOptM Opt_WarnIdentities $
 476                   dsLExpr lhs   -- Note [Desugaring RULE left hand sides]
 477
 478         ; rhs' <- dsLExpr rhs
 479
 480         -- Substitute the dict bindings eagerly,
 481         -- and take the body apart into a (f args) form
 482         ; case decomposeRuleLhs bndrs' lhs' of {
 483                 Left msg -> do { warnDs msg; return Nothing } ;
 484                 Right (final_bndrs, fn_id, args) -> do
 485
 486         { let is_local = isLocalId fn_id
 487                 -- NB: isLocalId is False of implicit Ids.  This is good becuase
 488                 -- we don't want to attach rules to the bindings of implicit Ids,
 489                 -- because they don't show up in the bindings until just before code gen
 490               fn_name   = idName fn_id
 491               final_rhs = simpleOptExpr rhs'    -- De-crap it
 492               rule      = mkRule False {- Not auto -} is_local
 493                                  name act fn_name final_bndrs args final_rhs
 494         ; return (Just rule)
 495         } } }
 496 \end{code}
 497
 498 Note [Desugaring RULE left hand sides]
 499 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 500 For the LHS of a RULE we do *not* want to desugar
 501     [x]   to    build (\cn. x `c` n)
 502 We want to leave explicit lists simply as chains
 503 of cons's. We can achieve that slightly indirectly by
 504 switching off EnableRewriteRules.  See DsExpr.dsExplicitList.
 505
 506 That keeps the desugaring of list comprehensions simple too.
 507
 508 Nor do we want to warn of conversion identities on the LHS;
 509 the rule is precisly to optimise them:
 510   {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-}
 511
 512
 513 %************************************************************************
 514 %*                                                                      *
 515 %*              Desugaring vectorisation declarations
 516 %*                                                                      *
 517 %************************************************************************
 518
 519 \begin{code}
 520 dsVect :: LVectDecl Id -> DsM CoreVect
 521 dsVect (L loc (HsVect v rhs))
 522   = putSrcSpanDs loc $
 523     do { rhs' <- fmapMaybeM dsLExpr rhs
 524        ; return $ Vect (unLoc v) rhs'
 525            }
 526 -- dsVect (L loc (HsVect v Nothing))
 527 --   = return $ Vect v Nothing
 528 -- dsVect (L loc (HsVect v (Just rhs)))
 529 --   = putSrcSpanDs loc $
 530 --     do { rhs' <- dsLExpr rhs
 531 --        ; return $ Vect v (Just rhs')
 532 --       }
 533 \end{code}