Specialise.lhs 76.6 KB
 partain committed Jan 08, 1996 1 %  simonm committed Dec 02, 1998 2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998  partain committed Jan 08, 1996 3 4 5 6 % \section[Specialise]{Stamping out overloading, and (optionally) polymorphism} \begin{code}  sof committed Apr 30, 1998 7 module Specialise ( specProgram ) where  partain committed Jan 08, 1996 8   simonm committed Jan 08, 1998 9 #include "HsVersions.h"  partain committed Jan 08, 1996 10   simonpj@microsoft.com committed Oct 23, 2009 11 12 import Id import TcType  13 import Type  simonpj@microsoft.com committed Oct 07, 2010 14 import CoreMonad  Ian Lynagh committed Jun 11, 2012 15 import CoreSubst  simonpj@microsoft.com committed Oct 07, 2010 16 import CoreUnfold  simonm committed Dec 02, 1998 17 18 import VarSet import VarEnv  simonpj committed Mar 08, 1998 19 import CoreSyn  simonpj@microsoft.com committed Aug 21, 2008 20 import Rules  Ian Lynagh committed Jun 11, 2012 21 22 import CoreUtils ( exprIsTrivial, applyTypeToArgs ) import CoreFVs ( exprFreeVars, exprsFreeVars, idFreeVars )  Ian Lynagh committed Jun 12, 2012 23 import UniqSupply  Simon Marlow committed May 11, 2007 24 import Name  Ian Lynagh committed Jun 11, 2012 25 26 27 import MkId ( voidArgId, realWorldPrimId ) import Maybes ( catMaybes, isJust ) import BasicTypes  simonpj@microsoft.com committed Oct 07, 2010 28 import HscTypes  simonpj committed Mar 06, 1998 29 import Bag  Ian Lynagh committed Jun 12, 2012 30 import DynFlags  Ian Lynagh committed Mar 29, 2008 31 import Util  simonm committed Jan 08, 1998 32 import Outputable  simonmar committed Apr 29, 2002 33 import FastString  Ian Lynagh committed Jun 12, 2012 34 import State  partain committed Apr 05, 1996 35   Ian Lynagh committed Jun 12, 2012 36 import Control.Monad  Ian Lynagh committed Sep 14, 2010 37 38 39 import Data.Map (Map) import qualified Data.Map as Map import qualified FiniteMap as Map  partain committed Jan 08, 1996 40 41 42 \end{code} %************************************************************************  Ian Lynagh committed Jun 11, 2012 43 %* *  partain committed Jan 08, 1996 44 \subsection[notes-Specialise]{Implementation notes [SLPJ, Aug 18 1993]}  Ian Lynagh committed Jun 11, 2012 45 %* *  partain committed Jan 08, 1996 46 47 48 %************************************************************************ These notes describe how we implement specialisation to eliminate  sof committed Apr 06, 1998 49 overloading.  partain committed Jan 08, 1996 50   sof committed Apr 06, 1998 51 The specialisation pass works on Core  partain committed Jan 08, 1996 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 syntax, complete with all the explicit dictionary application, abstraction and construction as added by the type checker. The existing type checker remains largely as it is. One important thought: the {\em types} passed to an overloaded function, and the {\em dictionaries} passed are mutually redundant. If the same function is applied to the same type(s) then it is sure to be applied to the same dictionary(s)---or rather to the same {\em values}. (The arguments might look different but they will evaluate to the same value.) Second important thought: we know that we can make progress by treating dictionary arguments as static and worth specialising on. So we can do without binding-time analysis, and instead specialise on dictionary arguments and no others. The basic idea ~~~~~~~~~~~~~~ Suppose we have  Ian Lynagh committed Jun 11, 2012 72 73  let f = in  partain committed Jan 08, 1996 74   partain committed Mar 19, 1996 75 and suppose f is overloaded.  partain committed Jan 08, 1996 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92  STEP 1: CALL-INSTANCE COLLECTION We traverse , accumulating all applications of f to types and dictionaries. (Might there be partial applications, to just some of its types and dictionaries? In principle yes, but in practice the type checker only builds applications of f to all its types and dictionaries, so partial applications could only arise as a result of transformation, and even then I think it's unlikely. In any case, we simply don't accumulate such partial applications.) STEP 2: EQUIVALENCES So now we have a collection of calls to f:  Ian Lynagh committed Jun 11, 2012 93 94 95  f t1 t2 d1 d2 f t3 t4 d3 d4 ...  partain committed Jan 08, 1996 96 97 98 99 100 101 102 103 104 105 106 Notice that f may take several type arguments. To avoid ambiguity, we say that f is called at type t1/t2 and t3/t4. We take equivalence classes using equality of the *types* (ignoring the dictionary args, which as mentioned previously are redundant). STEP 3: SPECIALISATION For each equivalence class, choose a representative (f t1 t2 d1 d2), and create a local instance of f, defined thus:  Ian Lynagh committed Jun 11, 2012 107  f@t1/t2 = t1 t2 d1 d2  partain committed Jan 08, 1996 108   sof committed Apr 06, 1998 109 110 111 112 113 114 f_rhs presumably has some big lambdas and dictionary lambdas, so lots of simplification will now result. However we don't actually *do* that simplification. Rather, we leave it for the simplifier to do. If we *did* do it, though, we'd get more call instances from the specialised RHS. We can work out what they are by instantiating the call-instance set from f's RHS with the types t1, t2.  partain committed Jan 08, 1996 115 116 117 118 119 120 121 122 123 124  Add this new id to f's IdInfo, to record that f has a specialised version. Before doing any of this, check that f's IdInfo doesn't already tell us about an existing instance of f at the required type/s. (This might happen if specialisation was applied more than once, or it might arise from user SPECIALIZE pragmas.) Recursion ~~~~~~~~~  partain committed Mar 19, 1996 125 Wait a minute! What if f is recursive? Then we can't just plug in  partain committed Jan 08, 1996 126 127 128 129 130 its right-hand side, can we? But it's ok. The type checker *always* creates non-recursive definitions for overloaded recursive functions. For example:  Ian Lynagh committed Jun 11, 2012 131  f x = f (x+x) -- Yes I know its silly  partain committed Jan 08, 1996 132 133 134  becomes  Ian Lynagh committed Jun 11, 2012 135 136 137 138 139  f a (d::Num a) = let p = +.sel a d in letrec fl (y::a) = fl (p y y) in fl  partain committed Jan 08, 1996 140   sof committed Apr 06, 1998 141 142 We still have recusion for non-overloaded functions which we speciailise, but the recursive call should get specialised to the  partain committed Jan 08, 1996 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 same recursive version. Polymorphism 1 ~~~~~~~~~~~~~~ All this is crystal clear when the function is applied to *constant types*; that is, types which have no type variables inside. But what if it is applied to non-constant types? Suppose we find a call of f at type t1/t2. There are two possibilities: (a) The free type variables of t1, t2 are in scope at the definition point of f. In this case there's no problem, we proceed just as before. A common example is as follows. Here's the Haskell:  Ian Lynagh committed Jun 11, 2012 158 159  g y = let f x = x+x in f y + f y  partain committed Jan 08, 1996 160 161 162  After typechecking we have  Ian Lynagh committed Jun 11, 2012 163 164  g a (d::Num a) (y::a) = let f b (d'::Num b) (x::b) = +.sel b d' x x in +.sel a d (f a d y) (f a d y)  partain committed Jan 08, 1996 165 166 167 168  Notice that the call to f is at type type "a"; a non-constant type. Both calls to f are at the same type, so we can specialise to give:  Ian Lynagh committed Jun 11, 2012 169 170  g a (d::Num a) (y::a) = let f@a (x::a) = +.sel a d x x in +.sel a d (f@a y) (f@a y)  partain committed Jan 08, 1996 171 172 173 174 175  (b) The other case is when the type variables in the instance types are *not* in scope at the definition point of f. The example we are working with above is a good case. There are two instances of (+.sel a d),  partain committed Mar 19, 1996 176 but "a" is not in scope at the definition of +.sel. Can we do anything?  partain committed Jan 08, 1996 177 178 179 Yes, we can "common them up", a sort of limited common sub-expression deal. This would give:  Ian Lynagh committed Jun 11, 2012 180 181 182  g a (d::Num a) (y::a) = let +.sel@a = +.sel a d f@a (x::a) = +.sel@a x x in +.sel@a (f@a y) (f@a y)  partain committed Jan 08, 1996 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200  This can save work, and can't be spotted by the type checker, because the two instances of +.sel weren't originally at the same type. Further notes on (b) * There are quite a few variations here. For example, the defn of +.sel could be floated ouside the \y, to attempt to gain laziness. It certainly mustn't be floated outside the \d because the d has to be in scope too. * We don't want to inline f_rhs in this case, because that will duplicate code. Just commoning up the call is the point. * Nothing gets added to +.sel's IdInfo. * Don't bother unless the equivalence class has more than one item!  partain committed Mar 19, 1996 201 Not clear whether this is all worth it. It is of course OK to  partain committed Jan 08, 1996 202 203 204 205 206 207 simply discard call-instances when passing a big lambda. Polymorphism 2 -- Overloading ~~~~~~~~~~~~~~ Consider a function whose most general type is  Ian Lynagh committed Jun 11, 2012 208  f :: forall a b. Ord a => [a] -> b -> b  partain committed Jan 08, 1996 209 210 211 212 213 214 215 216 217  There is really no point in making a version of g at Int/Int and another at Int/Bool, because it's only instancing the type variable "a" which buys us any efficiency. Since g is completely polymorphic in b there ain't much point in making separate versions of g for the different b types. That suggests that we should identify which of g's type variables are constrained (like "a") and which are unconstrained (like "b").  partain committed Mar 19, 1996 218 Then when taking equivalence classes in STEP 2, we ignore the type args  partain committed Jan 08, 1996 219 220 221 corresponding to unconstrained type variable. In STEP 3 we make polymorphic versions. Thus:  Ian Lynagh committed Jun 11, 2012 222  f@t1/ = /\b -> t1 b d1 d2  partain committed Jan 08, 1996 223   sof committed Apr 06, 1998 224 We do this.  partain committed Jan 08, 1996 225 226   sof committed Apr 06, 1998 227 228 229 Dictionary floating ~~~~~~~~~~~~~~~~~~~ Consider this  partain committed Jan 08, 1996 230   Ian Lynagh committed Jun 11, 2012 231 232 233  f a (d::Num a) = let g = ... in ...(let d1::Ord a = Num.Ord.sel a d in g a d1)...  partain committed Jan 08, 1996 234   sof committed Apr 06, 1998 235 236 237 238 239 Here, g is only called at one type, but the dictionary isn't in scope at the definition point for g. Usually the type checker would build a definition for d1 which enclosed g, but the transformation system might have moved d1's defn inward. Solution: float dictionary bindings outwards along with call instances.  partain committed Jan 08, 1996 240 241 242  Consider  Ian Lynagh committed Jun 11, 2012 243 244 245 246  f x = let g p q = p==q h r s = (r+s, g r s) in h x x  partain committed Jan 08, 1996 247 248 249 250  Before specialisation, leaving out type abstractions we have  Ian Lynagh committed Jun 11, 2012 251 252 253 254 255 256 257  f df x = let g :: Eq a => a -> a -> Bool g dg p q = == dg p q h :: Num a => a -> a -> (a, Bool) h dh r s = let deq = eqFromNum dh in (+ dh r s, g deq r s) in h df x x  partain committed Jan 08, 1996 258 259 260  After specialising h we get a specialised version of h, like this:  Ian Lynagh committed Jun 11, 2012 261 262  h' r s = let deq = eqFromNum df in (+ df r s, g deq r s)  partain committed Jan 08, 1996 263 264  But we can't naively make an instance for g from this, because deq is not in scope  partain committed Mar 19, 1996 265 at the defn of g. Instead, we have to float out the (new) defn of deq  partain committed Jan 08, 1996 266 267 268 269 270 271 272 273 to widen its scope. Notice that this floating can't be done in advance -- it only shows up when specialisation is done. User SPECIALIZE pragmas ~~~~~~~~~~~~~~~~~~~~~~~ Specialisation pragmas can be digested by the type checker, and implemented by adding extra definitions along with that of f, in the same way as before  Ian Lynagh committed Jun 11, 2012 274  f@t1/t2 = t1 t2 d1 d2  partain committed Jan 08, 1996 275 276 277 278  Indeed the pragmas *have* to be dealt with by the type checker, because only it knows how to build the dictionaries d1 and d2! For example  Ian Lynagh committed Jun 11, 2012 279 280  g :: Ord a => [a] -> [a] {-# SPECIALIZE f :: [Tree Int] -> [Tree Int] #-}  partain committed Jan 08, 1996 281 282 283 284 285 286 287 288 289 290 291  Here, the specialised version of g is an application of g's rhs to the Ord dictionary for (Tree Int), which only the type checker can conjure up. There might not even *be* one, if (Tree Int) is not an instance of Ord! (All the other specialision has suitable dictionaries to hand from actual calls.) Problem. The type checker doesn't have to hand a convenient , because it is buried in a complex (as-yet-un-desugared) binding group. Maybe we should say  Ian Lynagh committed Jun 11, 2012 292  f@t1/t2 = f* t1 t2 d1 d2  partain committed Jan 08, 1996 293 294 295 296 297 298 299 300 301  where f* is the Id f with an IdInfo which says "inline me regardless!". Indeed all the specialisation could be done in this way. That in turn means that the simplifier has to be prepared to inline absolutely any in-scope let-bound thing. Again, the pragma should permit polymorphism in unconstrained variables:  Ian Lynagh committed Jun 11, 2012 302 303  h :: Ord a => [a] -> b -> b {-# SPECIALIZE h :: [Int] -> b -> b #-}  partain committed Jan 08, 1996 304 305 306  We *insist* that all overloaded type variables are specialised to ground types, (and hence there can be no context inside a SPECIALIZE pragma).  partain committed Mar 19, 1996 307 We *permit* unconstrained type variables to be specialised to  Ian Lynagh committed Jun 11, 2012 308 309  - a ground type - or left as a polymorphic type variable  partain committed Jan 08, 1996 310 311 but nothing in between. So  Ian Lynagh committed Jun 11, 2012 312  {-# SPECIALIZE h :: [Int] -> [c] -> [c] #-}  partain committed Mar 19, 1996 313   partain committed Jan 08, 1996 314 315 316 317 318 319 320 321 is *illegal*. (It can be handled, but it adds complication, and gains the programmer nothing.) SPECIALISING INSTANCE DECLARATIONS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider  Ian Lynagh committed Jun 11, 2012 322 323 324  instance Foo a => Foo [a] where ... {-# SPECIALIZE instance Foo [Int] #-}  partain committed Jan 08, 1996 325 326 327 328  The original instance decl creates a dictionary-function definition:  Ian Lynagh committed Jun 11, 2012 329  dfun.Foo.List :: forall a. Foo a -> Foo [a]  partain committed Jan 08, 1996 330 331 332 333  The SPECIALIZE pragma just makes a specialised copy, just as for ordinary function definitions:  Ian Lynagh committed Jun 11, 2012 334 335  dfun.Foo.List@Int :: Foo [Int] dfun.Foo.List@Int = dfun.Foo.List Int dFooInt  partain committed Jan 08, 1996 336 337 338 339 340 341 342 343 344 345 346 347 348 349  The information about what instance of the dfun exist gets added to the dfun's IdInfo in the same way as a user-defined function too. Automatic instance decl specialisation? ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Can instance decls be specialised automatically? It's tricky. We could collect call-instance information for each dfun, but then when we specialised their bodies we'd get new call-instances for ordinary functions; and when we specialised their bodies, we might get new call-instances of the dfuns, and so on. This all arises because of the unrestricted mutual recursion between instance decls and value decls.  sof committed Apr 06, 1998 350 351 352 Still, there's no actual problem; it just means that we may not do all the specialisation we could theoretically do.  partain committed Jan 08, 1996 353 354 355 356 357 Furthermore, instance decls are usually exported and used non-locally, so we'll want to compile enough to get those specialisations done. Lastly, there's no such thing as a local instance decl, so we can survive solely by spitting out *usage* information, and then reading that  partain committed Mar 19, 1996 358 back in as a pragma when next compiling the file. So for now,  partain committed Jan 08, 1996 359 360 361 362 363 364 365 366 367 368 369 370 371 we only specialise instance decls in response to pragmas. SPITTING OUT USAGE INFORMATION ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To spit out usage information we need to traverse the code collecting call-instance information for all imported (non-prelude?) functions and data types. Then we equivalence-class it and spit it out. This is done at the top-level when all the call instances which escape must be for imported functions and data types.  sof committed Apr 06, 1998 372 373 *** Not currently done ***  partain committed Jan 08, 1996 374 375 376 377 378  Partial specialisation by pragmas ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ What about partial specialisation:  Ian Lynagh committed Jun 11, 2012 379 380  k :: (Ord a, Eq b) => [a] -> b -> b -> [a] {-# SPECIALIZE k :: Eq b => [Int] -> b -> b -> [a] #-}  partain committed Jan 08, 1996 381 382 383  or even  Ian Lynagh committed Jun 11, 2012 384  {-# SPECIALIZE k :: Eq b => [Int] -> [b] -> [b] -> [a] #-}  partain committed Jan 08, 1996 385 386 387  Seems quite reasonable. Similar things could be done with instance decls:  Ian Lynagh committed Jun 11, 2012 388 389 390 391  instance (Foo a, Foo b) => Foo (a,b) where ... {-# SPECIALIZE instance Foo a => Foo (a,Int) #-} {-# SPECIALIZE instance Foo b => Foo (Int,b) #-}  partain committed Jan 08, 1996 392 393 394 395 396 397 398 399 400 401 402  Ho hum. Things are complex enough without this. I pass. Requirements for the simplifer ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The simplifier has to be able to take advantage of the specialisation. * When the simplifier finds an application of a polymorphic f, it looks in f's IdInfo in case there is a suitable instance to call instead. This converts  Ian Lynagh committed Jun 11, 2012 403  f t1 t2 d1 d2 ===> f_t1_t2  partain committed Jan 08, 1996 404 405 406 407 408 409  Note that the dictionaries get eaten up too! * Dictionary selection operations on constant dictionaries must be short-circuited:  Ian Lynagh committed Jun 11, 2012 410  +.sel Int d ===> +Int  partain committed Jan 08, 1996 411 412 413 414 415 416 417 418 419 420 421  The obvious way to do this is in the same way as other specialised calls: +.sel has inside it some IdInfo which tells that if it's applied to the type Int then it should eat a dictionary and transform to +Int. In short, dictionary selectors need IdInfo inside them for constant methods. * Exactly the same applies if a superclass dictionary is being extracted:  Ian Lynagh committed Jun 11, 2012 422  Eq.sel Int d ===> dEqInt  partain committed Jan 08, 1996 423 424 425 426 427  * Something similar applies to dictionary construction too. Suppose dfun.Eq.List is the function taking a dictionary for (Eq a) to one for (Eq [a]). Then we want  Ian Lynagh committed Jun 11, 2012 428  dfun.Eq.List Int d ===> dEq.List_Int  partain committed Jan 08, 1996 429 430 431 432 433 434 435  Where does the Eq [Int] dictionary come from? It is built in response to a SPECIALIZE pragma on the Eq [a] instance decl. In short, dfun Ids need IdInfo with a specialisation for each constant instance of their instance declaration.  sof committed Apr 06, 1998 436 437 All this uses a single mechanism: the SpecEnv inside an Id  partain committed Jan 08, 1996 438 439 440 441  What does the specialisation IdInfo look like? ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  sof committed Apr 06, 1998 442 443 The SpecEnv of an Id maps a list of types (the template) to an expression  Ian Lynagh committed Jun 11, 2012 444  [Type] |-> Expr  partain committed Jan 08, 1996 445   partain committed Mar 19, 1996 446 For example, if f has this SpecInfo:  partain committed Jan 08, 1996 447   Ian Lynagh committed Jun 11, 2012 448  [Int, a] -> \d:Ord Int. f' a  partain committed Jan 08, 1996 449   sof committed Apr 06, 1998 450 it means that we can replace the call  partain committed Jan 08, 1996 451   Ian Lynagh committed Jun 11, 2012 452  f Int t ===> (\d. f' t)  sof committed Apr 06, 1998 453 454 455  This chucks one dictionary away and proceeds with the specialised version of f, namely f'.  partain committed Jan 08, 1996 456 457 458 459 460 461 462  What can't be done this way? ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There is no way, post-typechecker, to get a dictionary for (say) Eq a from a dictionary for Eq [a]. So if we find  Ian Lynagh committed Jun 11, 2012 463  ==.sel [t] d  partain committed Jan 08, 1996 464   partain committed Mar 19, 1996 465 we can't transform to  partain committed Jan 08, 1996 466   Ian Lynagh committed Jun 11, 2012 467  eqList (==.sel t d')  partain committed Jan 08, 1996 468   partain committed Mar 19, 1996 469 where  Ian Lynagh committed Jun 11, 2012 470  eqList :: (a->a->Bool) -> [a] -> [a] -> Bool  partain committed Jan 08, 1996 471 472 473 474 475 476 477 478 479  Of course, we currently have no way to automatically derive eqList, nor to connect it to the Eq [a] instance decl, but you can imagine that it might somehow be possible. Taking advantage of this is permanently ruled out. Still, this is no great hardship, because we intend to eliminate overloading altogether anyway!  sof committed May 18, 1997 480 481 482 483 A note about non-tyvar dictionaries ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Some Ids have types like  Ian Lynagh committed Jun 11, 2012 484  forall a,b,c. Eq a -> Ord [a] -> tau  sof committed May 18, 1997 485 486 487 488 489 490 491 492 493  This seems curious at first, because we usually only have dictionary args whose types are of the form (C a) where a is a type variable. But this doesn't hold for the functions arising from instance decls, which sometimes get arguements with types of form (C (T a)) for some type constructor T. Should we specialise wrt this compound-type dictionary? We used to say "no", saying:  Ian Lynagh committed Jun 11, 2012 494 495 496 497 498 499  "This is a heuristic judgement, as indeed is the fact that we specialise wrt only dictionaries. We choose *not* to specialise wrt compound dictionaries because at the moment the only place they show up is in instance decls, where they are simply plugged into a returned dictionary. So nothing is gained by specialising wrt them."  sof committed May 18, 1997 500 501  But it is simpler and more uniform to specialise wrt these dicts too;  Ian Lynagh committed Jun 11, 2012 502 and in future GHC is likely to support full fledged type signatures  sof committed May 18, 1997 503 like  Ian Lynagh committed Jun 11, 2012 504  f :: Eq [(a,b)] => ...  sof committed May 18, 1997 505   partain committed Jan 08, 1996 506   simonpj committed Feb 20, 1998 507 %************************************************************************  Ian Lynagh committed Jun 11, 2012 508 %* *  simonpj committed Feb 20, 1998 509 \subsubsection{The new specialiser}  Ian Lynagh committed Jun 11, 2012 510 %* *  simonpj committed Feb 20, 1998 511 512 513 %************************************************************************ Our basic game plan is this. For let(rec) bound function  Ian Lynagh committed Jun 11, 2012 514  f :: (C a, D c) => (a,b,c,d) -> Bool  simonpj committed Feb 20, 1998 515   Ian Lynagh committed Jun 11, 2012 516 * Find any specialised calls of f, (f ts ds), where  simonpj committed Feb 20, 1998 517 518 519 520 521  ts are the type arguments t1 .. t4, and ds are the dictionary arguments d1 .. d2. * Add a new definition for f1 (say):  Ian Lynagh committed Jun 11, 2012 522  f1 = /\ b d -> (..body of f..) t1 b t3 d d1 d2  simonpj committed Feb 20, 1998 523 524 525 526 527  Note that we abstract over the unconstrained type arguments. * Add the mapping  Ian Lynagh committed Jun 11, 2012 528  [t1,b,t3,d] |-> \d1 d2 -> f1 b d  simonpj committed Feb 20, 1998 529 530  to the specialisations of f. This will be used by the  Ian Lynagh committed Jun 11, 2012 531 532  simplifier to replace calls (f t1 t2 t3 t4) da db  simonpj committed Feb 20, 1998 533  by  Ian Lynagh committed Jun 11, 2012 534  (\d1 d1 -> f1 t2 t4) da db  simonpj committed Feb 20, 1998 535 536 537 538 539 540 541 542 543 544 545 546  All the stuff about how many dictionaries to discard, and what types to apply the specialised function to, are handled by the fact that the SpecEnv contains a template for the result of the specialisation. We don't build *partial* specialisations for f. For example: f :: Eq a => a -> a -> Bool {-# SPECIALISE f :: (Eq b, Eq c) => (b,c) -> (b,c) -> Bool #-} Here, little is gained by making a specialised copy of f. There's a distinct danger that the specialised version would  Ian Lynagh committed Jun 11, 2012 547 first build a dictionary for (Eq b, Eq c), and then select the (==)  simonpj committed Feb 20, 1998 548 549 550 551 552 553 554 method from it! Even if it didn't, not a great deal is saved. We do, however, generate polymorphic, but not overloaded, specialisations: f :: Eq a => [a] -> b -> b -> b {#- SPECIALISE f :: [Int] -> b -> b -> b #-}  Ian Lynagh committed Jun 11, 2012 555 Hence, the invariant is this:  simonpj committed Feb 20, 1998 556   Ian Lynagh committed Jun 11, 2012 557  *** no specialised version is overloaded ***  simonpj committed Feb 20, 1998 558 559   simonpj committed Mar 06, 1998 560 %************************************************************************  Ian Lynagh committed Jun 11, 2012 561 %* *  simonpj committed Mar 06, 1998 562 \subsubsection{The exported function}  Ian Lynagh committed Jun 11, 2012 563 %* *  simonpj committed Mar 06, 1998 564 565 566 %************************************************************************ \begin{code}  Ian Lynagh committed Jun 12, 2012 567 568 specProgram :: DynFlags -> ModGuts -> CoreM ModGuts specProgram dflags guts  simonpj@microsoft.com committed Oct 07, 2010 569 570 571 572  = do { hpt_rules <- getRuleBase ; let local_rules = mg_rules guts rule_base = extendRuleBaseList hpt_rules (mg_rules guts)  Ian Lynagh committed Jun 11, 2012 573  -- Specialise the bindings of this module  Ian Lynagh committed Jun 12, 2012 574  ; (binds', uds) <- runSpecM dflags (go (mg_binds guts))  simonpj@microsoft.com committed Oct 07, 2010 575   Ian Lynagh committed Jun 11, 2012 576  -- Specialise imported functions  Ian Lynagh committed Jun 12, 2012 577  ; (new_rules, spec_binds) <- specImports dflags emptyVarSet rule_base uds  simonpj@microsoft.com committed Oct 07, 2010 578   simonpj@microsoft.com committed Jan 26, 2011 579 580  ; let final_binds | null spec_binds = binds' | otherwise = Rec (flattenBinds spec_binds) : binds'  Ian Lynagh committed Jun 11, 2012 581  -- Note [Glom the bindings if imported functions are specialised]  simonpj@microsoft.com committed Jan 26, 2011 582 583 584  ; return (guts { mg_binds = final_binds , mg_rules = new_rules ++ local_rules }) }  simonpj committed Mar 06, 1998 585  where  Ian Lynagh committed Jun 11, 2012 586 587 588 589 590 591  -- We need to start with a Subst that knows all the things -- that are in scope, so that the substitution engine doesn't -- accidentally re-use a unique that's already in use -- Easiest thing is to do it all at once, as if all the top-level -- decls were mutually recursive top_subst = mkEmptySubst $mkInScopeSet$ mkVarSet $ simonpj@microsoft.com committed Oct 07, 2010 592  bindersOfBinds$ mg_binds guts  simonpj committed May 25, 2000 593   594 595 596 597  go [] = return ([], emptyUDs) go (bind:binds) = do (binds', uds) <- go binds (bind', uds') <- specBind top_subst bind uds return (bind' ++ binds', uds')  simonpj@microsoft.com committed Oct 07, 2010 598   Ian Lynagh committed Jun 12, 2012 599 600 specImports :: DynFlags -> VarSet -- Don't specialise these ones  Ian Lynagh committed Jun 11, 2012 601 602 603 604  -- See Note [Avoiding recursive specialisation] -> RuleBase -- Rules from this module and the home package -- (but not external packages, which can change) -> UsageDetails -- Calls for imported things, and floating bindings  simonpj@microsoft.com committed Oct 07, 2010 605 606  -> CoreM ( [CoreRule] -- New rules , [CoreBind] ) -- Specialised bindings and floating bindings  simonpj@microsoft.com committed Jan 26, 2011 607 -- See Note [Specialise imported INLINABLE things]  Ian Lynagh committed Jun 12, 2012 608 specImports dflags done rb uds  simonpj@microsoft.com committed Oct 07, 2010 609 610 611 612 613 614  = do { let import_calls = varEnvElts (ud_calls uds) ; (rules, spec_binds) <- go rb import_calls ; return (rules, wrapDictBinds (ud_binds uds) spec_binds) } where go _ [] = return ([], []) go rb (CIS fn calls_for_fn : other_calls)  Ian Lynagh committed Jun 12, 2012 615  = do { (rules1, spec_binds1) <- specImport dflags done rb fn (Map.toList calls_for_fn)  simonpj@microsoft.com committed Oct 07, 2010 616 617 618  ; (rules2, spec_binds2) <- go (extendRuleBaseList rb rules1) other_calls ; return (rules1 ++ rules2, spec_binds1 ++ spec_binds2) }  Ian Lynagh committed Jun 12, 2012 619 620 specImport :: DynFlags -> VarSet -- Don't specialise these  Ian Lynagh committed Jun 11, 2012 621 622 623  -- See Note [Avoiding recursive specialisation] -> RuleBase -- Rules from this module -> Id -> [CallInfo] -- Imported function and calls for it  simonpj@microsoft.com committed Oct 07, 2010 624 625  -> CoreM ( [CoreRule] -- New rules , [CoreBind] ) -- Specialised bindings  Ian Lynagh committed Jun 12, 2012 626 specImport dflags done rb fn calls_for_fn  simonpj@microsoft.com committed Jan 26, 2011 627 628  | fn elemVarSet done = return ([], []) -- No warning. This actually happens all the time  Gabor Greif committed Jan 30, 2013 629  -- when specialising a recursive function, because  Ian Lynagh committed Jun 11, 2012 630 631  -- the RHS of the specialised function contains a recursive -- call to the original function  simonpj@microsoft.com committed Jan 26, 2011 632 633  | isInlinablePragma (idInlinePragma fn)  simonpj@microsoft.com committed Oct 07, 2010 634 635  , Just rhs <- maybeUnfoldingTemplate (realIdUnfolding fn) = do { -- Get rules from the external package state  Ian Lynagh committed Jun 11, 2012 636 637  -- We keep doing this in case we "page-fault in" -- more rules as we go along  simonpj@microsoft.com committed Oct 07, 2010 638  ; hsc_env <- getHscEnv  Ian Lynagh committed Jun 11, 2012 639  ; eps <- liftIO $hscEPS hsc_env  simonpj@microsoft.com committed Oct 07, 2010 640  ; let full_rb = unionRuleBase rb (eps_rule_base eps)  Ian Lynagh committed Jun 11, 2012 641  rules_for_fn = getRules full_rb fn  simonpj@microsoft.com committed Oct 07, 2010 642   Ian Lynagh committed Jun 12, 2012 643  ; (rules1, spec_pairs, uds) <- runSpecM dflags$  simonpj@microsoft.com committed Oct 07, 2010 644 645  specCalls emptySubst rules_for_fn calls_for_fn fn rhs ; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs]  Ian Lynagh committed Jun 11, 2012 646 647  -- After the rules kick in we may get recursion, but -- we rely on a global GlomBinds to sort that out later  simonpj@microsoft.com committed Jan 26, 2011 648  -- See Note [Glom the bindings if imported functions are specialised]  Ian Lynagh committed Jun 11, 2012 649 650  -- Now specialise any cascaded calls  Ian Lynagh committed Jun 12, 2012 651 652 653  ; (rules2, spec_binds2) <- specImports dflags (extendVarSet done fn) (extendRuleBaseList rb rules1) uds  simonpj@microsoft.com committed Oct 07, 2010 654 655 656 657 658  ; return (rules2 ++ rules1, spec_binds2 ++ spec_binds1) } | otherwise = WARN( True, ptext (sLit "specImport discard") <+> ppr fn <+> ppr calls_for_fn )  Ian Lynagh committed Jun 11, 2012 659  return ([], [])  simonpj committed Mar 06, 1998 660 661 \end{code}  simonpj@microsoft.com committed Jan 26, 2011 662 663 664 665 666 667 668 669 Note [Specialise imported INLINABLE things] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We specialise INLINABLE things but not INLINE things. The latter should be inlined bodily, so not much point in specialising them. Moreover, we risk lots of orphan modules from vigorous specialisation. Note [Glom the bindings if imported functions are specialised] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  Ian Lynagh committed Jun 11, 2012 670 Suppose we have an imported, *recursive*, INLINABLE function  simonpj@microsoft.com committed Jan 26, 2011 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690  f :: Eq a => a -> a f = /\a \d x. ...(f a d)... In the module being compiled we have g x = f (x::Int) Now we'll make a specialised function f_spec :: Int -> Int f_spec = \x -> ...(f Int dInt)... {-# RULE f Int _ = f_spec #-} g = \x. f Int dInt x Note that f_spec doesn't look recursive After rewriting with the RULE, we get f_spec = \x -> ...(f_spec)... BUT since f_spec was non-recursive before it'll *stay* non-recursive. The occurrence analyser never turns a NonRec into a Rec. So we must make sure that f_spec is recursive. Easiest thing is to make all the specialisations for imported bindings recursive. Note [Avoiding recursive specialisation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  simonpj@microsoft.com committed Oct 07, 2010 691 692 693 694 695 When we specialise 'f' we may find new overloaded calls to 'g', 'h' in 'f's RHS. So we want to specialise g,h. But we don't want to specialise f any more! It's possible that f's RHS might have a recursive yet-more-specialised call, so we'd diverge in that case. And if the call is to the same type, one specialisation is enough.  Ian Lynagh committed Jun 11, 2012 696 Avoiding this recursive specialisation loop is the reason for the  simonpj@microsoft.com committed Oct 07, 2010 697 698 'done' VarSet passed to specImports and specImport.  simonpj committed Mar 06, 1998 699 %************************************************************************  Ian Lynagh committed Jun 11, 2012 700 %* *  simonpj committed Mar 06, 1998 701 \subsubsection{@specExpr@: the main function}  Ian Lynagh committed Jun 11, 2012 702 %* *  simonpj committed Mar 06, 1998 703 704 %************************************************************************  simonpj committed Feb 20, 1998 705 \begin{code}  simonpj committed May 18, 1999 706 specVar :: Subst -> Id -> CoreExpr  simonpj@microsoft.com committed Dec 24, 2009 707 specVar subst v = lookupIdSubst (text "specVar") subst v  simonpj committed May 18, 1999 708 709 710  specExpr :: Subst -> CoreExpr -> SpecM (CoreExpr, UsageDetails) -- We carry a substitution down:  Ian Lynagh committed Jun 11, 2012 711 712 713 714 -- a) we must clone any binding that might float outwards, -- to avoid name clashes -- b) we carry a type substitution to use when analysing -- the RHS of specialised bindings (no type-let!)  simonpj committed Feb 20, 1998 715 716  ---------------- First the easy cases --------------------  simonpj@microsoft.com committed Oct 23, 2009 717 specExpr subst (Type ty) = return (Type (CoreSubst.substTy subst ty), emptyUDs)  718 specExpr subst (Coercion co) = return (Coercion (CoreSubst.substCo subst co), emptyUDs)  719 specExpr subst (Var v) = return (specVar subst v, emptyUDs)  simonpj@microsoft.com committed Apr 28, 2008 720 specExpr _ (Lit lit) = return (Lit lit, emptyUDs)  721 722 specExpr subst (Cast e co) = do (e', uds) <- specExpr subst e  723  return ((Cast e' (CoreSubst.substCo subst co)), uds)  Simon Marlow committed Nov 02, 2011 724 specExpr subst (Tick tickish body) = do  725  (body', uds) <- specExpr subst body  Simon Marlow committed Nov 02, 2011 726  return (Tick (specTickish subst tickish) body', uds)  simonpj committed Feb 20, 1998 727 728 729  ---------------- Applications might generate a call instance --------------------  simonpj@microsoft.com committed Apr 28, 2008 730 specExpr subst expr@(App {})  simonm committed Dec 02, 1998 731  = go expr []  simonpj committed Feb 20, 1998 732  where  733 734 735  go (App fun arg) args = do (arg', uds_arg) <- specExpr subst arg (fun', uds_app) <- go fun (arg':args) return (App fun' arg', uds_arg plusUDs uds_app)  simonm committed Dec 02, 1998 736   simonpj committed May 18, 1999 737  go (Var f) args = case specVar subst f of  simonpj@microsoft.com committed Sep 03, 2008 738  Var f' -> return (Var f', mkCallUDs f' args)  Ian Lynagh committed Jun 11, 2012 739 740  e' -> return (e', emptyUDs) -- I don't expect this! go other _ = specExpr subst other  simonpj committed Feb 20, 1998 741 742  ---------------- Lambda/case require dumping of usage details --------------------  743 744 specExpr subst e@(Lam _ _) = do (body', uds) <- specExpr subst' body  Ian Lynagh committed Jun 11, 2012 745  let (free_uds, dumped_dbs) = dumpUDs bndrs' uds  simonpj@microsoft.com committed Oct 23, 2009 746  return (mkLams bndrs' (wrapDictBindsE dumped_dbs body'), free_uds)  simonpj committed Feb 20, 1998 747  where  simonpj committed May 18, 1999 748  (bndrs, body) = collectBinders e  simonpj committed Dec 24, 2004 749  (subst', bndrs') = substBndrs subst bndrs  Ian Lynagh committed Jun 11, 2012 750 751  -- More efficient to collect a group of binders together all at once -- and we don't want to split a lambda group with dumped bindings  simonpj committed Feb 20, 1998 752   Ian Lynagh committed Jun 11, 2012 753 specExpr subst (Case scrut case_bndr ty alts)  simonpj@microsoft.com committed Aug 12, 2010 754  = do { (scrut', scrut_uds) <- specExpr subst scrut  Ian Lynagh committed Jun 11, 2012 755 756  ; (scrut'', case_bndr', alts', alts_uds) <- specCase subst scrut' case_bndr alts  simonpj@microsoft.com committed Aug 12, 2010 757 758  ; return (Case scrut'' case_bndr' (CoreSubst.substTy subst ty) alts' , scrut_uds plusUDs alts_uds) }  simonpj committed Feb 20, 1998 759 760  ---------------- Finally, let is the interesting case --------------------  761 specExpr subst (Let bind body) = do  Ian Lynagh committed Jun 11, 2012 762  -- Clone binders  763  (rhs_subst, body_subst, bind') <- cloneBindSM subst bind  simonpj committed Feb 23, 1998 764   765 766  -- Deal with the body (body', body_uds) <- specExpr body_subst body  simonpj committed Mar 06, 1998 767   768 769 770 771 772  -- Deal with the bindings (binds', uds) <- specBind rhs_subst bind' body_uds -- All done return (foldr Let body' binds', uds)  simonpj committed May 18, 1999 773   Simon Marlow committed Nov 02, 2011 774 775 776 777 778 779 specTickish :: Subst -> Tickish Id -> Tickish Id specTickish subst (Breakpoint ix ids) = Breakpoint ix [ id' | id <- ids, Var id' <- [specVar subst id]] -- drop vars from the list if they have a non-variable substitution. -- should never happen, but it's harmless to drop them anyway. specTickish _ other_tickish = other_tickish  simonpj@microsoft.com committed Aug 12, 2010 780   Ian Lynagh committed Jun 11, 2012 781 782 specCase :: Subst -> CoreExpr -- Scrutinee, already done  simonpj@microsoft.com committed Aug 12, 2010 783  -> Id -> [CoreAlt]  Ian Lynagh committed Jun 11, 2012 784 785 786  -> SpecM ( CoreExpr -- New scrutinee , Id , [CoreAlt]  simonpj@microsoft.com committed Aug 12, 2010 787 788  , UsageDetails) specCase subst scrut' case_bndr [(con, args, rhs)]  Ian Lynagh committed Jun 11, 2012 789  | isDictId case_bndr -- See Note [Floating dictionaries out of cases]  simonpj@microsoft.com committed Aug 12, 2010 790 791  , interestingDict scrut' , not (isDeadBinder case_bndr && null sc_args')  ian@well-typed.com committed Oct 09, 2012 792 793 794  = do { dflags <- getDynFlags ; (case_bndr_flt : sc_args_flt) <- mapM clone_me (case_bndr' : sc_args')  simonpj@microsoft.com committed Aug 12, 2010 795 796 797 798 799  ; let sc_rhss = [ Case (Var case_bndr_flt) case_bndr' (idType sc_arg') [(con, args', Var sc_arg')] | sc_arg' <- sc_args' ]  Ian Lynagh committed Jun 11, 2012 800 801 802 803  -- Extend the substitution for RHS to map the *original* binders -- to their floated verions. Attach an unfolding to these floated -- binders so they look interesting to interestingDict mb_sc_flts :: [Maybe DictId]  simonpj@microsoft.com committed Aug 12, 2010 804  mb_sc_flts = map (lookupVarEnv clone_env) args'  ian@well-typed.com committed Oct 09, 2012 805 806  clone_env = zipVarEnv sc_args' (zipWith (add_unf dflags) sc_args_flt sc_rhss) subst_prs = (case_bndr, Var (add_unf dflags case_bndr_flt scrut'))  Ian Lynagh committed Jun 11, 2012 807  : [ (arg, Var sc_flt)  simonpj@microsoft.com committed Aug 12, 2010 808 809  | (arg, Just sc_flt) <- args zip mb_sc_flts ] subst_rhs' = extendIdSubstList subst_rhs subst_prs  Ian Lynagh committed Jun 11, 2012 810   simonpj@microsoft.com committed Aug 12, 2010 811 812 813 814 815 816 817 818 819 820 821 822 823  ; (rhs', rhs_uds) <- specExpr subst_rhs' rhs ; let scrut_bind = mkDB (NonRec case_bndr_flt scrut') case_bndr_set = unitVarSet case_bndr_flt sc_binds = [(NonRec sc_arg_flt sc_rhs, case_bndr_set) | (sc_arg_flt, sc_rhs) <- sc_args_flt zip sc_rhss ] flt_binds = scrut_bind : sc_binds (free_uds, dumped_dbs) = dumpUDs (case_bndr':args') rhs_uds all_uds = flt_binds addDictBinds free_uds alt' = (con, args', wrapDictBindsE dumped_dbs rhs') ; return (Var case_bndr_flt, case_bndr', [alt'], all_uds) } where (subst_rhs, (case_bndr':args')) = substBndrs subst (case_bndr:args) sc_args' = filter is_flt_sc_arg args'  Ian Lynagh committed Jun 11, 2012 824   simonpj@microsoft.com committed Aug 12, 2010 825 826 827 828 829 830 831 832  clone_me bndr = do { uniq <- getUniqueM ; return (mkUserLocal occ uniq ty loc) } where name = idName bndr ty = idType bndr occ = nameOccName name loc = getSrcSpan name  ian@well-typed.com committed Oct 09, 2012 833 834  add_unf dflags sc_flt sc_rhs -- Sole purpose: make sc_flt respond True to interestingDictId = setIdUnfolding sc_flt (mkSimpleUnfolding dflags sc_rhs)  simonpj@microsoft.com committed Aug 12, 2010 835 836 837 838  arg_set = mkVarSet args' is_flt_sc_arg var = isId var && not (isDeadBinder var)  Ian Lynagh committed Jun 11, 2012 839  && isDictTy var_ty  simonpj@microsoft.com committed Aug 12, 2010 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855  && not (tyVarsOfType var_ty intersectsVarSet arg_set) where var_ty = idType var specCase subst scrut case_bndr alts = do { (alts', uds_alts) <- mapAndCombineSM spec_alt alts ; return (scrut, case_bndr', alts', uds_alts) } where (subst_alt, case_bndr') = substBndr subst case_bndr spec_alt (con, args, rhs) = do (rhs', uds) <- specExpr subst_rhs rhs let (free_uds, dumped_dbs) = dumpUDs (case_bndr' : args') uds return ((con, args', wrapDictBindsE dumped_dbs rhs'), free_uds) where (subst_rhs, args') = substBndrs subst_alt args  simonpj committed Mar 06, 1998 856 \end{code}  simonpj committed Feb 20, 1998 857   simonpj@microsoft.com committed Aug 12, 2010 858 859 860 861 862 863 Note [Floating dictionaries out of cases] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider g = \d. case d of { MkD sc ... -> ...(f sc)... } Naively we can't float d2's binding out of the case expression, because 'sc' is bound by the case, and that in turn means we can't  Ian Lynagh committed Jun 11, 2012 864 specialise f, which seems a pity.  simonpj@microsoft.com committed Aug 12, 2010 865   Ian Lynagh committed Jun 11, 2012 866 So we invert the case, by floating out a binding  simonpj@microsoft.com committed Aug 12, 2010 867 868 869 870 871 872 873 874 for 'sc_flt' thus: sc_flt = case d of { MkD sc ... -> sc } Now we can float the call instance for 'f'. Indeed this is just what'll happen if 'sc' was originally bound with a let binding, but case is more efficient, and necessary with equalities. So it's good to work with both. You might think that this won't make any difference, because the  Ian Lynagh committed Jun 11, 2012 875 call instance will only get nuked by the \d. BUT if 'g' itself is  simonpj@microsoft.com committed Aug 12, 2010 876 877 878 879 880 881 882 883 884 885 886 887 888 specialised, then transitively we should be able to specialise f. In general, given case e of cb { MkD sc ... -> ...(f sc)... } we transform to let cb_flt = e sc_flt = case cb_flt of { MkD sc ... -> sc } in case cb_flt of bg { MkD sc ... -> ....(f sc_flt)... } The "_flt" things are the floated binds; we use the current substitution to substitute sc -> sc_flt in the RHS  simonpj committed Mar 06, 1998 889 %************************************************************************  Ian Lynagh committed Jun 11, 2012 890 %* *  simonpj@microsoft.com committed Oct 07, 2010 891  Dealing with a binding  Ian Lynagh committed Jun 11, 2012 892 %* *  simonpj committed Mar 06, 1998 893 894 895 %************************************************************************ \begin{code}  Ian Lynagh committed Jun 11, 2012 896 897 898 899 900 specBind :: Subst -- Use this for RHSs -> CoreBind -> UsageDetails -- Info on how the scope of the binding -> SpecM ([CoreBind], -- New bindings UsageDetails) -- And info to pass upstream  simonpj committed Mar 06, 1998 901   simonpj@microsoft.com committed Oct 23, 2009 902 903 904 905 906 -- Returned UsageDetails: -- No calls for binders of this bind specBind rhs_subst (NonRec fn rhs) body_uds = do { (rhs', rhs_uds) <- specExpr rhs_subst rhs ; (fn', spec_defns, body_uds1) <- specDefn rhs_subst body_uds fn rhs  simonm committed Dec 02, 1998 907   simonpj@microsoft.com committed Oct 23, 2009 908  ; let pairs = spec_defns ++ [(fn', rhs')]  Ian Lynagh committed Jun 11, 2012 909 910  -- fn' mentions the spec_defns in its rules, -- so put the latter first  simonm committed Dec 02, 1998 911   simonpj@microsoft.com committed Oct 23, 2009 912  combined_uds = body_uds1 plusUDs rhs_uds  Ian Lynagh committed Jun 11, 2012 913 914 915 916  -- This way round a call in rhs_uds of a function f -- at type T will override a call of f at T in body_uds1; and -- that is good because it'll tend to keep "earlier" calls -- See Note [Specialisation of dictionary functions]  simonm committed Dec 02, 1998 917   Ian Lynagh committed Jun 11, 2012 918 919  (free_uds, dump_dbs, float_all) = dumpBindUDs [fn] combined_uds -- See Note [From non-recursive to recursive]  simonpj@microsoft.com committed Oct 23, 2009 920 921 922 923  final_binds | isEmptyBag dump_dbs = [NonRec b r | (b,r) <- pairs] | otherwise = [Rec (flattenDictBinds dump_dbs pairs)]  Ian Lynagh committed Jun 11, 2012 924 925 926 927  ; if float_all then -- Rather than discard the calls mentioning the bound variables -- we float this binding along with the others return ([], free_uds snocDictBinds final_binds)  simonpj@microsoft.com committed Oct 23, 2009 928  else  Ian Lynagh committed Jun 11, 2012 929 930 931  -- No call in final_uds mentions bound variables, -- so we can just leave the binding here return (final_binds, free_uds) }  simonpj@microsoft.com committed Oct 23, 2009 932 933 934  specBind rhs_subst (Rec pairs) body_uds  simonpj@microsoft.com committed Sep 03, 2008 935 936 937  -- Note [Specialising a recursive group] = do { let (bndrs,rhss) = unzip pairs ; (rhss', rhs_uds) <- mapAndCombineSM (specExpr rhs_subst) rhss  simonpj@microsoft.com committed Oct 23, 2009 938  ; let scope_uds = body_uds plusUDs rhs_uds  Ian Lynagh committed Jun 11, 2012 939  -- Includes binds and calls arising from rhss  simonpj@microsoft.com committed Oct 23, 2009 940 941 942 943 944  ; (bndrs1, spec_defns1, uds1) <- specDefns rhs_subst scope_uds pairs ; (bndrs3, spec_defns3, uds3) <- if null spec_defns1 -- Common case: no specialisation  Ian Lynagh committed Jun 11, 2012 945 946  then return (bndrs1, [], uds1) else do { -- Specialisation occurred; do it again  simonpj@microsoft.com committed Oct 23, 2009 947 948 949 950 951 952 953  (bndrs2, spec_defns2, uds2) <- specDefns rhs_subst uds1 (bndrs1 zip rhss) ; return (bndrs2, spec_defns2 ++ spec_defns1, uds2) } ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs bndrs uds3 bind = Rec (flattenDictBinds dumped_dbs $spec_defns3 ++ zip bndrs3 rhss')  Ian Lynagh committed Jun 11, 2012 954   simonpj@microsoft.com committed Oct 23, 2009 955  ; if float_all then  Ian Lynagh committed Jun 11, 2012 956  return ([], final_uds snocDictBind bind)  simonpj@microsoft.com committed Oct 23, 2009 957  else  Ian Lynagh committed Jun 11, 2012 958  return ([bind], final_uds) }  simonpj@microsoft.com committed Sep 03, 2008 959 960 961 962  --------------------------- specDefns :: Subst  Ian Lynagh committed Jun 11, 2012 963 964 965 966 967  -> UsageDetails -- Info on how it is used in its scope -> [(Id,CoreExpr)] -- The things being bound and their un-processed RHS -> SpecM ([Id], -- Original Ids with RULES added [(Id,CoreExpr)], -- Extra, specialised bindings UsageDetails) -- Stuff to fling upwards from the specialised versions  simonpj@microsoft.com committed Sep 03, 2008 968 969 970 971 972 973 974  -- Specialise a list of bindings (the contents of a Rec), but flowing usages -- upwards binding by binding. Example: { f = ...g ...; g = ...f .... } -- Then if the input CallDetails has a specialised call for 'g', whose specialisation -- in turn generates a specialised call for 'f', we catch that in this one sweep. -- But not vice versa (it's a fixpoint problem).  simonpj@microsoft.com committed Oct 23, 2009 975 976 977 978 979 980 specDefns _subst uds [] = return ([], [], uds) specDefns subst uds ((bndr,rhs):pairs) = do { (bndrs1, spec_defns1, uds1) <- specDefns subst uds pairs ; (bndr1, spec_defns2, uds2) <- specDefn subst uds1 bndr rhs ; return (bndr1 : bndrs1, spec_defns1 ++ spec_defns2, uds2) }  simonpj@microsoft.com committed Sep 03, 2008 981 982 983  --------------------------- specDefn :: Subst  Ian Lynagh committed Jun 11, 2012 984 985 986 987 988  -> UsageDetails -- Info on how it is used in its scope -> Id -> CoreExpr -- The thing being bound and its un-processed RHS -> SpecM (Id, -- Original Id with added RULES [(Id,CoreExpr)], -- Extra, specialised bindings UsageDetails) -- Stuff to fling upwards from the specialised versions  simonpj committed Feb 20, 1998 989   simonpj@microsoft.com committed Oct 23, 2009 990 specDefn subst body_uds fn rhs  simonpj@microsoft.com committed Oct 07, 2010 991 992  = do { let (body_uds_without_me, calls_for_me) = callsForMe fn body_uds rules_for_me = idCoreRules fn  Ian Lynagh committed Jun 11, 2012 993  ; (rules, spec_defns, spec_uds) <- specCalls subst rules_for_me  simonpj@microsoft.com committed Oct 07, 2010 994 995 996 997  calls_for_me fn rhs ; return ( fn addIdSpecialisations rules , spec_defns , body_uds_without_me plusUDs spec_uds) }  Ian Lynagh committed Jun 11, 2012 998 999 1000 1001 1002 1003  -- It's important that the plusUDs is this way -- round, because body_uds_without_me may bind -- dictionaries that are used in calls_for_me passed -- to specDefn. So the dictionary bindings in -- spec_uds may mention dictionaries bound in -- body_uds_without_me  simonpj@microsoft.com committed Oct 07, 2010 1004 1005 1006  --------------------------- specCalls :: Subst  Ian Lynagh committed Jun 11, 2012 1007 1008 1009 1010 1011 1012  -> [CoreRule] -- Existing RULES for the fn -> [CallInfo] -> Id -> CoreExpr -> SpecM ([CoreRule], -- New RULES for the fn [(Id,CoreExpr)], -- Extra, specialised bindings UsageDetails) -- New usage details from the specialised RHSs  simonpj@microsoft.com committed Oct 07, 2010 1013 1014  -- This function checks existing rules, and does not create  simonpj@microsoft.com committed Jan 26, 2011 1015 -- duplicate ones. So the caller does not need to do this filtering.  simonpj@microsoft.com committed Oct 07, 2010 1016 1017 1018 -- See 'already_covered' specCalls subst rules_for_me calls_for_me fn rhs  Ian Lynagh committed Jun 11, 2012 1019  -- The first case is the interesting one  David Himmelstrup committed Jun 07, 2007 1020  | rhs_tyvars lengthIs n_tyvars -- Rhs of fn's defn has right number of big lambdas  Ian Lynagh committed Jun 11, 2012 1021 1022  && rhs_ids lengthAtLeast n_dicts -- and enough dict args && notNull calls_for_me -- And there are some calls to specialise  1023  && not (isNeverActive (idInlineActivation fn))  Ian Lynagh committed Jun 11, 2012 1024 1025  -- Don't specialise NOINLINE things -- See Note [Auto-specialisation and RULES]  simonpj committed Sep 26, 2001 1026   Ian Lynagh committed Jun 11, 2012 1027 1028 1029 -- && not (certainlyWillInline (idUnfolding fn)) -- And it's not small -- See Note [Inline specialisation] for why we do not -- switch off specialisation for inline functions  simonpj committed Feb 23, 1998 1030   simonpj@microsoft.com committed Oct 07, 2010 1031 1032  = -- pprTrace "specDefn: some" (ppr fn $$ppr calls_for_me$$ ppr rules_for_me)$ do { stuff <- mapM spec_call calls_for_me  simonpj@microsoft.com committed Sep 03, 2008 1033  ; let (spec_defns, spec_uds, spec_rules) = unzip3 (catMaybes stuff)  simonpj@microsoft.com committed Oct 07, 2010 1034  ; return (spec_rules, spec_defns, plusUDList spec_uds) }  simonpj committed Feb 20, 1998 1035   Ian Lynagh committed Jun 11, 2012 1036 1037  | otherwise -- No calls or RHS doesn't fit our preconceptions = WARN( notNull calls_for_me, ptext (sLit "Missed specialisation opportunity for")  simonpj@microsoft.com committed Jan 26, 2011 1038  <+> ppr fn  _trace_doc )  Ian Lynagh committed Jun 11, 2012 1039  -- Note [Specialisation shape]