Improve Simplifier and SpecConstr behaviour
[ghc-hetmet.git] / compiler / specialise / SpecConstr.lhs
index e6dba2d..3388bb4 100644 (file)
@@ -1,3 +1,8 @@
+ToDo [Nov 2010]
+~~~~~~~~~~~~~~~
+1. Use a library type rather than an annotation for ForceSpecConstr
+2. Nuke NoSpecConstr
+
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
@@ -436,14 +441,20 @@ foldl_loop. Note that
   * And lastly, the SPEC argument is ultimately eliminated by
     SpecConstr itself so there is no runtime overhead.
 
-This is all quite ugly; we ought to come
-up with a better design.
+This is all quite ugly; we ought to come up with a better design.
 
 ForceSpecConstr arguments are spotted in scExpr' and scTopBinds which then set
-sc_force to True when calling specLoop. This flag makes specLoop and
-specialise ignore specConstrCount and specConstrThreshold when deciding
-whether to specialise a function. It also specialises even for arguments that
-aren't inspected in the loop.
+sc_force to True when calling specLoop. This flag does three things:
+  * Ignore specConstrThreshold, to specialise functions of arbitrary size
+        (see scTopBind)
+  * Ignore specConstrCount, to make arbitrary numbers of specialisations
+        (see specialise)
+  * Specialise even for arguments that are not scrutinised in the loop
+        (see argToPat; Trac #4488)
+
+This flag is inherited for nested non-recursive bindings (which are likely to
+be join points and hence should be fully specialised) but reset for nested
+recursive bindings.
 
 What alternatives did I consider? Annotating the loop itself doesn't
 work because (a) it is local and (b) it will be w/w'ed and I having
@@ -451,13 +462,19 @@ w/w propagating annotation somehow doesn't seem like a good idea. The
 types of the loop arguments really seem to be the most persistent
 thing.
 
-Annotating the types that make up the loop state s doesn't work,
+Annotating the types that make up the loop state doesn't work,
 either, because (a) it would prevent us from using types like Either
 or tuples here, (b) we don't want to restrict the set of types that
 can be used in Stream states and (c) some types are fixed by the user
 (e.g., the accumulator here) but we still want to specialise as much
 as possible.
 
+ForceSpecConstr is done by way of an annotation:
+  data SPEC = SPEC | SPEC2
+  {-# ANN type SPEC ForceSpecConstr #-}
+But SPEC is the *only* type so annotated, so it'd be better to
+use a particular library type.
+
 Alternatives to ForceSpecConstr
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Instead of giving the loop an extra argument of type SPEC, we
@@ -481,6 +498,16 @@ Without the SPEC, if 'loop' was strict, the case would move out
 and we'd see loop applied to a pair. But if 'loop' isn' strict
 this doesn't look like a specialisable call.
 
+Note [NoSpecConstr]
+~~~~~~~~~~~~~~~~~~~
+The ignoreAltCon stuff allows you to say
+    {-# ANN type T NoSpecConstr #-}
+to mean "don't specialise on arguments of this type.  It was added
+before we had ForceSpecConstr.  Lacking ForceSpecConstr we specialised
+regardless of size; and then we needed a way to turn that *off*.  Now
+that we have ForceSpecConstr, this NoSpecConstr is probably redundant.
+(Used only for PArray.)
+
 -----------------------------------------------------
                Stuff not yet handled
 -----------------------------------------------------
@@ -709,7 +736,7 @@ extendValEnv :: ScEnv -> Id -> Maybe Value -> ScEnv
 extendValEnv env _  Nothing   = env
 extendValEnv env id (Just cv) = env { sc_vals = extendVarEnv (sc_vals env) id cv }
 
-extendCaseBndrs :: ScEnv -> Id -> AltCon -> [Var] -> (ScEnv, [Var])
+extendCaseBndrs :: ScEnv -> OutExpr -> OutId -> AltCon -> [Var] -> (ScEnv, [Var])
 -- When we encounter
 --     case scrut of b
 --         C x y -> ...
@@ -717,21 +744,20 @@ extendCaseBndrs :: ScEnv -> Id -> AltCon -> [Var] -> (ScEnv, [Var])
 -- NB1: Extends only the sc_vals part of the envt
 -- NB2: Kill the dead-ness info on the pattern binders x,y, since
 --      they are potentially made alive by the [b -> C x y] binding
-extendCaseBndrs env case_bndr con alt_bndrs
-  | isDeadBinder case_bndr
-  = (env, alt_bndrs)
-  | otherwise
-  = (env1, map zap alt_bndrs)
-       -- NB: We used to bind v too, if scrut = (Var v); but
-        --     the simplifer has already done this so it seems
-        --     redundant to do so here
-       -- case scrut of
-       --      Var v  -> extendValEnv env1 v cval
-       --      _other -> env1
+extendCaseBndrs env scrut case_bndr con alt_bndrs
+   = (env2, alt_bndrs')
  where
-   zap v | isTyCoVar v = v             -- See NB2 above
-         | otherwise = zapIdOccInfo v
-   env1 = extendValEnv env case_bndr cval
+   live_case_bndr = not (isDeadBinder case_bndr)
+   env1 | Var v <- scrut = extendValEnv env v cval
+        | otherwise      = env -- See Note [Add scrutinee to ValueEnv too]
+   env2 | live_case_bndr = extendValEnv env case_bndr cval
+        | otherwise      = env1
+
+   alt_bndrs' | case scrut of { Var {} -> True; _ -> live_case_bndr }
+              = map zap alt_bndrs
+              | otherwise
+              = alt_bndrs
+
    cval = case con of
                DEFAULT    -> Nothing
                LitAlt {}  -> Just (ConVal con [])
@@ -740,6 +766,9 @@ extendCaseBndrs env case_bndr con alt_bndrs
                        vanilla_args = map Type (tyConAppArgs (idType case_bndr)) ++
                                       varsToCoreExprs alt_bndrs
 
+   zap v | isTyCoVar v = v             -- See NB2 above
+         | otherwise = zapIdOccInfo v
+
 
 decreaseSpecCount :: ScEnv -> Int -> ScEnv
 -- See Note [Avoiding exponential blowup]
@@ -794,6 +823,25 @@ forceSpecArgTy _ _ = False
 #endif /* GHCI */
 \end{code}
 
+Note [Add scrutinee to ValueEnv too]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this:
+   case x of y
+     (a,b) -> case b of c
+                I# v -> ...(f y)...
+By the time we get to the call (f y), the ValueEnv
+will have a binding for y, and for c
+    y -> (a,b)
+    c -> I# v
+BUT that's not enough!  Looking at the call (f y) we
+see that y is pair (a,b), but we also need to know what 'b' is.
+So in extendCaseBndrs we must *also* add the binding 
+   b -> I# v
+else we lose a useful specialisation for f.  This is necessary even
+though the simplifier has systematically replaced uses of 'x' with 'y'
+and 'b' with 'c' in the code.  The use of 'b' in the ValueEnv came
+from outside the case.  See Trac #4908 for the live example.
+
 Note [Avoiding exponential blowup]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The sc_count field of the ScEnv says how many times we are prepared to
@@ -993,9 +1041,9 @@ scExpr' env (Case scrut b ty alts)
          ; return (alt_usg `combineUsage` scrut_usg',
                    Case scrut' b' (scSubstTy env ty) alts') }
 
-    sc_alt env _scrut' b' (con,bs,rhs)
-      = do { let (env1, bs1)  = extendBndrsWith RecArg env bs
-                (env2, bs2) = extendCaseBndrs env1 b' con bs1
+    sc_alt env scrut' b' (con,bs,rhs)
+      = do { let (env1, bs1) = extendBndrsWith RecArg env bs
+                (env2, bs2) = extendCaseBndrs env1 scrut' b' con bs1
           ; (usg,rhs') <- scExpr env2 rhs
           ; let (usg', arg_occs) = lookupOccs usg bs2
                 scrut_occ = case con of
@@ -1018,11 +1066,9 @@ scExpr' env (Let (NonRec bndr rhs) body)
 
        ; (body_usg, body') <- scExpr body_env3 body
 
-          -- NB: We don't use the ForceSpecConstr mechanism (see
-          -- Note [Forcing specialisation]) for non-recursive bindings
-          -- at the moment. I'm not sure if this is the right thing to do.
-       ; let env' = scForce env False
-       ; (spec_usg, specs) <- specialise env'
+          -- NB: For non-recursive bindings we inherit sc_force flag from
+          -- the parent function (see Note [Forcing specialisation])
+       ; (spec_usg, specs) <- specialise env
                                           (scu_calls body_usg) 
                                          rhs_info
                                           (SI [] 0 (Just rhs_usg))
@@ -1526,6 +1572,9 @@ argToPat env in_scope val_env (Case scrut _ _ [(_, _, rhs)]) arg_occ
 -}
 
 argToPat env in_scope val_env (Cast arg co) arg_occ
+  | isIdentityCoercion co     -- Substitution in the SpecConstr itself
+                              -- can lead to identity coercions
+  = argToPat env in_scope val_env arg arg_occ
   | not (ignoreType env ty2)
   = do { (interesting, arg') <- argToPat env in_scope val_env arg arg_occ
        ; if not interesting then 
@@ -1557,7 +1606,7 @@ argToPat in_scope val_env arg arg_occ
   -- NB: this *precedes* the Var case, so that we catch nullary constrs
 argToPat env in_scope val_env arg arg_occ
   | Just (ConVal dc args) <- isValue val_env arg
-  , not (ignoreAltCon env dc)
+  , not (ignoreAltCon env dc)        -- See Note [NoSpecConstr]
   , sc_force env || scrutinised
   = do { args' <- argsToPats env in_scope val_env (args `zip` conArgOccs arg_occ dc)
        ; return (True, mk_con_app dc (map snd args')) }