ghc/compiler/simplStg/UpdAnal.lhs

   1 \section{Update Avoidance Analyser}                     -*-haskell-literate-*-
   2
   3 (c) Simon Marlow, Andre Santos 1992-1993
   4 (c) The AQUA Project, Glasgow University, 1995-1996
   5
   6 %-----------------------------------------------------------------------------
   7 \subsection{Module Interface}
   8
   9 \begin{code}
  10 #include  "HsVersions.h"
  11 \end{code}
  12
  13 > module UpdAnal ( updateAnalyse ) where
  14 >
  15 > IMP_Ubiq(){-uitous-}
  16 >
  17 > import Prelude hiding ( lookup )
  18 >
  19 > import StgSyn
  20 > import Id             ( SYN_IE(IdEnv), growIdEnv, addOneToIdEnv, combineIdEnvs, nullIdEnv,
  21 >                         unitIdEnv, mkIdEnv, rngIdEnv, lookupIdEnv,
  22 >                         SYN_IE(IdSet),
  23 >                         getIdUpdateInfo, addIdUpdateInfo, mkSysLocal, idType, isImportedId,
  24 >                         externallyVisibleId,
  25 >                         SYN_IE(Id), GenId
  26 >                       )
  27 > import IdInfo         ( UpdateInfo, SYN_IE(UpdateSpec), mkUpdateInfo, updateInfoMaybe )
  28 > import Type           ( splitFunTy, splitSigmaTy )
  29 > import UniqSet
  30 > import Unique         ( getBuiltinUniques )
  31 > import SrcLoc         ( noSrcLoc )
  32 > import Util           ( panic )
  33 >
  34
  35 %-----------------------------------------------------------------------------
  36 \subsection{Reverse application}
  37
  38 This is used instead of lazy pattern bindings to avoid space leaks.
  39
  40 > infixr 3 =:
  41 > a =: k = k a
  42
  43 %-----------------------------------------------------------------------------
  44 \subsection{Types}
  45
  46 List of closure references
  47
  48 > type Refs = IdSet
  49 > x `notInRefs` y = not (x `elementOfUniqSet` y)
  50
  51 A closure value: environment of closures that are evaluated on entry,
  52 a list of closures that are referenced from the result, and an
  53 abstract value for the evaluated closure.
  54
  55 An IdEnv is used for the reference counts, as these environments are
  56 combined often. A generic environment is used for the main environment
  57 mapping closure names to values; as a common operation is extension of
  58 this environment, this representation should be efficient.
  59
  60 > -- partain: funny synonyms to cope w/ the fact
  61 > -- that IdEnvs know longer know what their keys are
  62 > -- (94/05)  ToDo: improve
  63 > type IdEnvInt     = IdEnv (Id, Int)
  64 > type IdEnvClosure = IdEnv (Id, Closure)
  65
  66 > -- backward-compat functions
  67 > null_IdEnv :: IdEnv (Id, a)
  68 > null_IdEnv = nullIdEnv
  69 >
  70 > unit_IdEnv :: Id -> a -> IdEnv (Id, a)
  71 > unit_IdEnv k v = unitIdEnv k (k, v)
  72 >
  73 > mk_IdEnv :: [(Id, a)] -> IdEnv (Id, a)
  74 > mk_IdEnv pairs = mkIdEnv [ (k, (k,v)) | (k,v) <- pairs ]
  75 >
  76 > grow_IdEnv :: IdEnv (Id, a) -> IdEnv (Id, a) -> IdEnv (Id, a)
  77 > grow_IdEnv env1 env2 = growIdEnv env1 env2
  78 >
  79 > addOneTo_IdEnv :: IdEnv (Id, a) -> Id -> a -> IdEnv (Id, a)
  80 > addOneTo_IdEnv env k v = addOneToIdEnv env k (k, v)
  81 >
  82 > combine_IdEnvs :: (a->a->a) -> IdEnv (Id, a) -> IdEnv (Id, a) -> IdEnv (Id, a)
  83 > combine_IdEnvs combiner env1 env2 = combineIdEnvs new_combiner env1 env2
  84 >   where
  85 >     new_combiner (id, x) (_, y) = (id, combiner x y)
  86 >
  87 > dom_IdEnv :: IdEnv (Id, a) -> Refs
  88 > dom_IdEnv env = mkUniqSet [ i | (i,_) <- rngIdEnv env ]
  89 >
  90 > lookup_IdEnv :: IdEnv (Id, a) -> Id -> Maybe a
  91 > lookup_IdEnv env key = case lookupIdEnv env key of
  92 >                          Nothing    -> Nothing
  93 >                          Just (_,a) -> Just a
  94 > -- end backward compat stuff
  95
  96 > type Closure = (IdEnvInt, Refs, AbFun)
  97
  98 > type AbVal = IdEnvClosure -> Closure
  99 > data AbFun = Fun (Closure -> Closure)
 100
 101 > -- partain: speeding-up stuff
 102 >
 103 > type CaseBoundVars = IdSet
 104 > noCaseBound   = emptyUniqSet
 105 > isCaseBound   = elementOfUniqSet
 106 > x `notCaseBound` y = not (isCaseBound x y)
 107 > moreCaseBound :: CaseBoundVars -> [Id] -> CaseBoundVars
 108 > moreCaseBound old new = old `unionUniqSets` mkUniqSet new
 109 >
 110 > -- end speeding-up
 111
 112 %----------------------------------------------------------------------------
 113 \subsection{Environment lookup}
 114
 115 If the requested value is not in the environment, we return an unknown
 116 value.  Lookup is designed to be partially applied to a variable, and
 117 repeatedly applied to different environments after that.
 118
 119 > lookup v
 120 >   | isImportedId v
 121 >   = const (case updateInfoMaybe (getIdUpdateInfo v) of
 122 >               Nothing   -> unknownClosure
 123 >               Just spec -> convertUpdateSpec spec)
 124 >   | otherwise
 125 >   = \p -> case lookup_IdEnv p v of
 126 >               Just b  -> b
 127 >               Nothing -> unknownClosure
 128
 129 %-----------------------------------------------------------------------------
 130 Represent a list of references as an ordered list.
 131
 132 > mkRefs :: [Id] -> Refs
 133 > mkRefs = mkUniqSet
 134
 135 > noRefs :: Refs
 136 > noRefs = emptyUniqSet
 137
 138 > elemRefs = elementOfUniqSet
 139
 140 > merge :: [Refs] -> Refs
 141 > merge xs = foldr merge2 emptyUniqSet xs
 142
 143 > merge2 :: Refs -> Refs -> Refs
 144 > merge2 = unionUniqSets
 145
 146 %-----------------------------------------------------------------------------
 147 \subsection{Some non-interesting values}
 148
 149 bottom will be used for abstract values that are not functions.
 150 Hopefully its value will never be required!
 151
 152 > bottom                :: AbFun
 153 > bottom                = panic "Internal: (Update Analyser) bottom"
 154
 155 noClosure is a value that is definitely not a function (i.e. primitive
 156 values and constructor applications).  unknownClosure is a value about
 157 which we have no information at all.  This should occur rarely, but
 158 could happen when an id is imported and the exporting module was not
 159 compiled with the update analyser.
 160
 161 > noClosure, unknownClosure :: Closure
 162 > noClosure             = (null_IdEnv, noRefs, bottom)
 163 > unknownClosure        = (null_IdEnv, noRefs, dont_know noRefs)
 164
 165 dont_know is a black hole: it is something we know nothing about.
 166 Applying dont_know to anything will generate a new dont_know that simply
 167 contains more buried references.
 168
 169 > dont_know :: Refs -> AbFun
 170 > dont_know b'
 171 >       = Fun (\(c,b,f) -> let b'' = dom_IdEnv c `merge2` b `merge2` b'
 172 >                          in (null_IdEnv, b'', dont_know b''))
 173
 174 %-----------------------------------------------------------------------------
 175
 176 > getrefs :: IdEnvClosure -> [AbVal] -> Refs -> Refs
 177 > getrefs p vs rest = foldr merge2 rest  (getrefs' (map ($ p) vs))
 178 >       where
 179 >               getrefs' []           = []
 180 >               getrefs' ((c,b,_):rs) = dom_IdEnv c : b : getrefs' rs
 181
 182 %-----------------------------------------------------------------------------
 183
 184 udData is used when we are putting a list of closure references into a
 185 data structure, or something else that we know nothing about.
 186
 187 > udData :: [StgArg] -> CaseBoundVars -> AbVal
 188 > udData vs cvs
 189 >       = \p -> (null_IdEnv, getrefs p local_ids noRefs, bottom)
 190 >       where local_ids = [ lookup v | (StgVarArg v) <- vs, v `notCaseBound` cvs ]
 191
 192 %-----------------------------------------------------------------------------
 193 \subsection{Analysing an atom}
 194
 195 > udAtom :: CaseBoundVars -> StgArg -> AbVal
 196 > udAtom cvs (StgVarArg v)
 197 >       | v `isCaseBound` cvs = const unknownClosure
 198 >       | otherwise           = lookup v
 199 >
 200 > udAtom cvs _                = const noClosure
 201
 202 %-----------------------------------------------------------------------------
 203 \subsection{Analysing an STG expression}
 204
 205 > ud :: StgExpr                 -- Expression to be analysed
 206 >    -> CaseBoundVars                   -- List of case-bound vars
 207 >    -> IdEnvClosure                    -- Current environment
 208 >    -> (StgExpr, AbVal)                -- (New expression, abstract value)
 209 >
 210 > ud e@(StgPrim _ vs _) cvs p = (e, udData vs cvs)
 211 > ud e@(StgCon  _ vs _) cvs p = (e, udData vs cvs)
 212 > ud e@(StgSCC ty lab a)   cvs p = ud a cvs p =: \(a', abval_a) ->
 213 >                                  (StgSCC ty lab a', abval_a)
 214
 215 Here is application. The first thing to do is analyse the head, and
 216 get an abstract function. Multiple applications are performed by using
 217 a foldl with the function doApp. Closures are actually passed to the
 218 abstract function iff the atom is a local variable.
 219
 220 I've left the type signature for doApp in to make things a bit clearer.
 221
 222 > ud e@(StgApp a atoms lvs) cvs p
 223 >   = (e, abval_app)
 224 >   where
 225 >     abval_atoms = map (udAtom cvs) atoms
 226 >     abval_a     = udAtom cvs a
 227 >     abval_app = \p ->
 228 >       let doApp :: Closure -> AbVal -> Closure
 229 >           doApp (c, b, Fun f) abval_atom =
 230 >                 abval_atom p          =: \e@(_,_,_)    ->
 231 >                 f e                   =: \(c', b', f') ->
 232 >                 (combine_IdEnvs (+) c' c, b', f')
 233 >       in foldl doApp (abval_a p) abval_atoms
 234
 235 > ud (StgCase expr lve lva uniq alts) cvs p
 236 >   = ud expr cvs p                     =: \(expr', abval_selector)  ->
 237 >     udAlt alts p                      =: \(alts', abval_alts) ->
 238 >     let
 239 >       abval_case = \p ->
 240 >         abval_selector p              =: \(c, b, abfun_selector) ->
 241 >         abval_alts p                  =: \(cs, bs, abfun_alts)   ->
 242 >         let bs' = b `merge2` bs in
 243 >         (combine_IdEnvs (+) c cs, bs', dont_know bs')
 244 >     in
 245 >     (StgCase expr' lve lva uniq alts', abval_case)
 246 >   where
 247 >
 248 >     udAlt :: StgCaseAlts
 249 >           -> IdEnvClosure
 250 >           -> (StgCaseAlts, AbVal)
 251 >
 252 >     udAlt (StgAlgAlts ty [alt] StgNoDefault) p
 253 >         = udAlgAlt p alt              =: \(alt', abval) ->
 254 >           (StgAlgAlts ty [alt'] StgNoDefault, abval)
 255 >     udAlt (StgAlgAlts ty [] def) p
 256 >         = udDef def p                 =: \(def', abval) ->
 257 >           (StgAlgAlts ty [] def', abval)
 258 >     udAlt (StgAlgAlts ty alts def) p
 259 >         = udManyAlts alts def udAlgAlt (StgAlgAlts ty) p
 260 >     udAlt (StgPrimAlts ty [alt] StgNoDefault) p
 261 >         = udPrimAlt p alt             =: \(alt', abval) ->
 262 >           (StgPrimAlts ty [alt'] StgNoDefault, abval)
 263 >     udAlt (StgPrimAlts ty [] def) p
 264 >         = udDef def p                 =: \(def', abval) ->
 265 >           (StgPrimAlts ty [] def', abval)
 266 >     udAlt (StgPrimAlts ty alts def) p
 267 >         = udManyAlts alts def udPrimAlt (StgPrimAlts ty) p
 268 >
 269 >     udPrimAlt p (l, e)
 270 >       = ud e cvs p            =: \(e', v) -> ((l, e'), v)
 271 >
 272 >     udAlgAlt p (id, vs, use_mask, e)
 273 >       = ud e (moreCaseBound cvs vs) p =: \(e', v) -> ((id, vs, use_mask, e'), v)
 274 >
 275 >     udDef :: StgCaseDefault
 276 >           -> IdEnvClosure
 277 >           -> (StgCaseDefault, AbVal)
 278 >
 279 >     udDef StgNoDefault p
 280 >       = (StgNoDefault, \p -> (null_IdEnv, noRefs, dont_know noRefs))
 281 >     udDef (StgBindDefault v is_used expr) p
 282 >       = ud expr (moreCaseBound cvs [v]) p     =: \(expr', abval) ->
 283 >         (StgBindDefault v is_used expr', abval)
 284 >
 285 >     udManyAlts alts def udalt stgalts p
 286 >       = udDef def p                           =: \(def', abval_def) ->
 287 >         unzip (map (udalt p) alts)            =: \(alts', abvals_alts) ->
 288 >         let
 289 >               abval_alts = \p ->
 290 >                 abval_def p                    =: \(cd, bd, _) ->
 291 >                 unzip3 (map ($ p) abvals_alts) =: \(cs, bs, _) ->
 292 >                 let bs' = merge (bd:bs) in
 293 >                 (foldr (combine_IdEnvs max) cd cs, bs', dont_know bs')
 294 >         in (stgalts alts' def', abval_alts)
 295
 296 The heart of the analysis: here we decide whether to make a specific
 297 closure updatable or not, based on the results of analysing the body.
 298
 299 > ud (StgLet binds body) cvs p
 300 >  = udBinding binds cvs p              =: \(binds', vs, abval1, abval2) ->
 301 >    abval1 p                           =: \(cs, p') ->
 302 >    grow_IdEnv p p'                    =: \p ->
 303 >    ud body cvs p                      =: \(body', abval_body) ->
 304 >    abval_body p                       =: \(c, b, abfun) ->
 305 >    tag b (combine_IdEnvs (+) cs c) binds' =: \tagged_binds ->
 306 >    let
 307 >       abval p
 308 >         = abval2 p                            =: \(c1, p')       ->
 309 >           abval_body (grow_IdEnv p p')        =: \(c2, b, abfun) ->
 310 >           (combine_IdEnvs (+) c1 c2, b, abfun)
 311 >    in
 312 >    (StgLet tagged_binds body', abval)
 313
 314 %-----------------------------------------------------------------------------
 315 \subsection{Analysing bindings}
 316
 317 For recursive sets of bindings we perform one iteration of a fixed
 318 point algorithm, using (dont_know fv) as a safe approximation to the
 319 real fixed point, where fv are the (mappings in the environment of
 320 the) free variables of the function.
 321
 322 We'll return two new environments, one with the new closures in and
 323 one without. There's no point in carrying around closures when their
 324 respective bindings have already been analysed.
 325
 326 We don't need to find anything out about closures with arguments,
 327 constructor closures etc.
 328
 329 > udBinding :: StgBinding
 330 >           -> CaseBoundVars
 331 >           -> IdEnvClosure
 332 >           -> (StgBinding,
 333 >               [Id],
 334 >               IdEnvClosure -> (IdEnvInt, IdEnvClosure),
 335 >               IdEnvClosure -> (IdEnvInt, IdEnvClosure))
 336 >
 337 > udBinding (StgNonRec v rhs) cvs p
 338 >   = udRhs rhs cvs p                   =: \(rhs', abval) ->
 339 >     abval p                           =: \(c, b, abfun) ->
 340 >     let
 341 >       abval_rhs a = \p ->
 342 >          abval p                      =: \(c, b, abfun) ->
 343 >          (c, unit_IdEnv v (a, b, abfun))
 344 >       a = case rhs of
 345 >               StgRhsClosure _ _ _ Updatable [] _ -> unit_IdEnv v 1
 346 >               _                                  -> null_IdEnv
 347 >     in (StgNonRec v rhs', [v],  abval_rhs a, abval_rhs null_IdEnv)
 348 >
 349 > udBinding (StgRec ve) cvs p
 350 >   = (StgRec ve', [], abval_rhs, abval_rhs)
 351 >   where
 352 >     (vs, ve', abvals) = unzip3 (map udBind ve)
 353 >     fv = (map lookup . filter (`notCaseBound` cvs) . concat . map collectfv) ve
 354 >     vs' = mkRefs vs
 355 >     abval_rhs = \p ->
 356 >       let
 357 >         p' = grow_IdEnv (mk_IdEnv (vs `zip` (repeat closure))) p
 358 >         closure = (null_IdEnv, fv', dont_know fv')
 359 >         fv' =  getrefs p fv vs'
 360 >         (cs, ps) = unzip (doRec vs abvals)
 361 >
 362 >         doRec [] _ = []
 363 >         doRec (v:vs) (abval:as)
 364 >               = abval p'      =: \(c,b,abfun) ->
 365 >                 (c, (v,(null_IdEnv, b, abfun))) : doRec vs as
 366 >
 367 >       in
 368 >       (foldr (combine_IdEnvs (+)) null_IdEnv cs, mk_IdEnv ps)
 369 >
 370 >     udBind (v,rhs)
 371 >       = udRhs rhs cvs p               =: \(rhs', abval) ->
 372 >         (v,(v,rhs'), abval)
 373 >
 374 >     collectfv (_, StgRhsClosure _ _ fv _ _ _) = fv
 375 >     collectfv (_, StgRhsCon _ con args)       = [ v | (StgVarArg v) <- args ]
 376
 377 %-----------------------------------------------------------------------------
 378 \subsection{Analysing Right-Hand Sides}
 379
 380 > udRhs e@(StgRhsCon _ _ vs) cvs p = (e, udData vs cvs)
 381 >
 382 > udRhs (StgRhsClosure cc bi fv u [] body) cvs p
 383 >   = ud body cvs p                     =: \(body', abval_body) ->
 384 >     (StgRhsClosure cc bi fv u [] body', abval_body)
 385
 386 Here is the code for closures with arguments.  A closure has a number
 387 of arguments, which correspond to a set of nested lambda expressions.
 388 We build up the analysis using foldr with the function doLam to
 389 analyse each lambda expression.
 390
 391 > udRhs (StgRhsClosure cc bi fv u args body) cvs p
 392 >   = ud body cvs p                     =: \(body', abval_body) ->
 393 >     let
 394 >       fv' = map lookup (filter (`notCaseBound` cvs) fv)
 395 >       abval_rhs = \p ->
 396 >            foldr doLam (\b -> abval_body) args (getrefs p fv' noRefs) p
 397 >     in
 398 >     (StgRhsClosure cc bi fv u args body', abval_rhs)
 399 >     where
 400 >
 401 >       doLam :: Id -> (Refs -> AbVal) -> Refs -> AbVal
 402 >       doLam i f b p
 403 >               = (null_IdEnv, b,
 404 >                  Fun (\x@(c',b',_) ->
 405 >                       let b'' = dom_IdEnv c' `merge2` b' `merge2` b in
 406 >                       f b'' (addOneTo_IdEnv p i x)))
 407
 408 %-----------------------------------------------------------------------------
 409 \subsection{Adjusting Update flags}
 410
 411 The closure is tagged single entry iff it is used at most once, it is
 412 not referenced from inside a data structure or function, and it has no
 413 arguments (closures with arguments are re-entrant).
 414
 415 > tag :: Refs -> IdEnvInt -> StgBinding -> StgBinding
 416 >
 417 > tag b c r@(StgNonRec v (StgRhsClosure cc bi fv Updatable [] body))
 418 >   = if (v `notInRefs` b) && (lookupc c v <= 1)
 419 >     then -- trace "One!" (
 420 >          StgNonRec v (StgRhsClosure cc bi fv SingleEntry [] body)
 421 >          -- )
 422 >     else r
 423 > tag b c other = other
 424 >
 425 > lookupc c v = case lookup_IdEnv c v of
 426 >                 Just n -> n
 427 >                 Nothing -> 0
 428
 429 %-----------------------------------------------------------------------------
 430 \subsection{Top Level analysis}
 431
 432 Should we tag top level closures? This could have good implications
 433 for CAFs (i.e. they could be made non-updateable if only used once,
 434 thus preventing a space leak).
 435
 436 > updateAnalyse :: [StgBinding] -> [StgBinding] {- Exported -}
 437 > updateAnalyse bs
 438 >  = udProgram bs null_IdEnv
 439
 440 > udProgram :: [StgBinding] -> IdEnvClosure -> [StgBinding]
 441 > udProgram [] p = []
 442 > udProgram (d:ds) p
 443 >  = udBinding d noCaseBound p          =: \(d', vs, _, abval_bind) ->
 444 >    abval_bind p                       =: \(_, p') ->
 445 >    grow_IdEnv p p'                    =: \p'' ->
 446 >    attachUpdateInfoToBinds d' p''     =: \d'' ->
 447 >    d'' : udProgram ds p''
 448
 449 %-----------------------------------------------------------------------------
 450 \subsection{Exporting Update Information}
 451
 452 Convert the exported representation of a function's update function
 453 into a real Closure value.
 454
 455 > convertUpdateSpec :: UpdateSpec -> Closure
 456 > convertUpdateSpec = mkClosure null_IdEnv noRefs noRefs
 457
 458 > mkClosure :: IdEnvInt -> Refs -> Refs -> UpdateSpec -> Closure
 459 >
 460 > mkClosure c b b' []       = (c, b', dont_know b')
 461 > mkClosure c b b' (0 : ns) = (null_IdEnv, b, Fun (\ _ -> mkClosure c b b' ns))
 462 > mkClosure c b b' (1 : ns) = (null_IdEnv, b, Fun (\ (c',b'',f) ->
 463 >     mkClosure
 464 >             (combine_IdEnvs (+) c c')
 465 >             (dom_IdEnv c' `merge2` b'' `merge2` b)
 466 >             (b'' `merge2` b')
 467 >             ns ))
 468 > mkClosure c b b' (n : ns) = (null_IdEnv, b, Fun (\ (c',b'',f) ->
 469 >     mkClosure c
 470 >             (dom_IdEnv c' `merge2` b'' `merge2` b)
 471 >             (dom_IdEnv c' `merge2` b'' `merge2` b')
 472 >             ns ))
 473
 474 Convert a Closure into a representation that can be placed in a .hi file.
 475
 476 > mkUpdateSpec :: Id -> Closure -> UpdateSpec
 477 > mkUpdateSpec v f = {- removeSuperfluous2s -} (map countUses ids)
 478 >           where
 479 >               (c,b,_)     = foldl doApp f ids
 480 >               ids         = map mkid (getBuiltinUniques arity)
 481 >               mkid u      = mkSysLocal SLIT("upd") u noType noSrcLoc
 482 >               countUses u = if u `elemRefs` b then 2 else min (lookupc c u) 2
 483 >               noType      = panic "UpdAnal: no type!"
 484 >
 485 >               doApp (c,b,Fun f) i
 486 >                       = f (unit_IdEnv i 1, noRefs, dont_know noRefs)  =: \(c',b',f') ->
 487 >                         (combine_IdEnvs (+) c' c, b', f')
 488 >
 489 >               (_,dict_tys,tau_ty) = (splitSigmaTy . idType) v
 490 >               (reg_arg_tys, _)    = splitFunTy tau_ty
 491 >               arity               = length dict_tys + length reg_arg_tys
 492
 493   removeSuperfluous2s = reverse . dropWhile (> 1) . reverse
 494
 495 %-----------------------------------------------------------------------------
 496 \subsection{Attaching the update information to top-level bindings}
 497
 498 This is so that the information can later be retrieved for printing
 499 out in the .hi file.  This is not an ideal solution, however it will
 500 suffice for now.
 501
 502 > attachUpdateInfoToBinds b p
 503 >   = case b of
 504 >       StgNonRec v rhs -> StgNonRec (attachOne v) rhs
 505 >       StgRec bs       -> StgRec [ (attachOne v, rhs) | (v, rhs) <- bs ]
 506 >
 507 >   where attachOne v
 508 >               | externallyVisibleId v
 509 >                       = let c = lookup v p in
 510 >                               addIdUpdateInfo v
 511 >                                       (mkUpdateInfo (mkUpdateSpec v c))
 512 >               | otherwise    = v
 513
 514 %-----------------------------------------------------------------------------