hoopl 3.10.2.1 → 3.10.2.2

raw patch · 9 files changed

+78/−88 lines, 9 filesdep ~basedep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, containers

API changes (from Hackage documentation)

Files

• README.md +18/−8
• changelog.md +14/−0
• hoopl.cabal +8/−17
• hoopl.pdf binary
• src/Compiler/Hoopl/Combinators.hs +0/−6
• src/Compiler/Hoopl/Dataflow.hs +15/−42
• src/Compiler/Hoopl/Label.hs +7/−1
• src/Compiler/Hoopl/Passes/Dominator.hs +6/−10
• src/Compiler/Hoopl/Unique.hs +10/−4

@@ -3,35 +3,45 @@  ## Hoopl: A Higher-Order OPtimization Library -API documentation can be found on [Hackage](https://hackage.haskell.org/package/hoopl).+API documentation can be found on+[Hackage](https://hackage.haskell.org/package/hoopl).  For detailed explanation+of the library design see paper ["Hoopl: A Modular, Reusable Library for+Dataflow Analysis and+Transformation"](http://research.microsoft.com/en-us/um/people/simonpj/Papers/c--/hoopl-haskell10.pdf)  | Directory      | Contents | -------------- | ----------| `paper/`       | A paper about Hoopl-| `prototypes/`  | A sampling of prototypes and early designs | `src/`         | The current official sources to the Cabal package | `testing/`     | Tests, including a sample client.  See [`testing/README`](testing/README)  ### Development Notes -To build the library, change to the src directory and run+#### Building and testing -    cabal configure --prefix=$HOME --user   # we have no idea what this means+To build the library run:++    cabal configure     cabal build     cabal install --enable-documentation -To run the tests in the folder testing/, change to the src directory and run +To run the tests in the `testing/` folder run:      cabal configure --enable-tests     cabal test -To run the tests with the test coverage report, change to the src directory and run +To run the tests with the test coverage report run: -    cabal configure --enable-tests -f testcoverage+    cabal configure --enable-tests --enable-coverage     cabal test  You'll need a Haskell Platform, which should include appropriate versions of Cabal and GHC.++#### Coding style++Please follow Johan Tibell's+[Haskell Style Guide](https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md)+for all new/modified code.  ### Checklist for Making Releases 

@@ -1,5 +1,19 @@ # Changelog for [`hoopl` package](http://hackage.haskell.org/package/hoopl) +## 3.10.2.2 *Feb 2017*+  This release includes non-API changes.++ - Use cabal builtin options to enable test coverage++ - Move up the constraints of base and containers++ - Refactor the references of the fold family functions to their equivalant foldr functions.++ - Drop the support for 7.0.1++ - Fix a bug that drops out dominators when joined DPATHs have non-shared nodes in the middle.++ ## 3.10.2.1 *Dec 2015*   This release includes only non-functional changes. 

@@ -1,5 +1,5 @@ Name:                hoopl-Version:             3.10.2.1+Version:             3.10.2.2 -- NOTE: Don't forget to update ./changelog.md Description:   Higher-order optimization library@@ -10,25 +10,20 @@ License:             BSD3 License-File:        LICENSE Author:              Norman Ramsey, Joao Dias, Simon Marlow and Simon Peyton Jones-Maintainer:          nr@cs.tufts.edu, andreas.voellmy@gmail.com, email@ningwang.org-Homepage:            http://ghc.cs.tufts.edu/hoopl/+Maintainer:          Ning Wang <email@ningwang.org>, Michal Terepeta <michal.terepeta@gmail.com>, Norman Ramsey <nr@cs.tufts.edu>+Homepage:            https://github.com/haskell/hoopl Bug-Reports:         https://github.com/haskell/hoopl/issues/ Build-Type:          Simple Cabal-Version:       >=1.10 Synopsis:            A library to support dataflow analysis and optimization Category:            Compilers/Interpreters Tested-With:         GHC>=7.0.1-Extra-Source-Files:  README.md, hoopl.pdf, changelog.md+Extra-Source-Files:  README.md, changelog.md  Source-repository head   Type:       git   Location:   http://git.haskell.org/packages/hoopl.git -flag testcoverage -  description: Enable test coverage report-  default: False-- Library   Default-Language:  Haskell2010   Other-Extensions:  CPP@@ -45,14 +40,13 @@     Other-Extensions: Safe Trustworthy    Hs-Source-Dirs:    src-  Build-Depends:     base >= 4.3 && < 4.10, containers >= 0.4 && < 0.6+  Build-Depends:     base >= 4.3 && < 4.11,+                     containers >= 0.5 && < 0.6   Exposed-Modules:   Compiler.Hoopl,                      Compiler.Hoopl.Internals,                      Compiler.Hoopl.Wrappers,                      Compiler.Hoopl.Passes.Dominator,                      Compiler.Hoopl.Passes.DList---                     Compiler.Hoopl.DataflowFold,---                     Compiler.Hoopl.OldDataflow,    -- The remaining modules are hidden *provisionally*   Other-modules:     Compiler.Hoopl.Checkpoint,@@ -78,14 +72,11 @@   Type:              exitcode-stdio-1.0   Main-Is:           Main.hs   Hs-Source-Dirs:    testing src-  Build-Depends:     base >= 4.3 && < 4.10, -                     containers >= 0.4 && < 0.6,+  Build-Depends:     base >= 4.3 && < 4.10,+                     containers >= 0.5 && < 0.6,                      filepath,                      mtl >= 2.1.3.1,                      parsec >= 3.1.7,                      test-framework < 0.9,                      test-framework-hunit < 0.4,                      mtl >= 2.1.3.1--  if flag(testcoverage) -    Ghc-Options: -fhpc

binary file changed (279781 → absent bytes)

@@ -37,12 +37,10 @@  -- N.B. rw3, rw3', and rw3a are triples of functions. -- But rw and rw' are single functions.--- @ start comb1.tex thenFwdRw :: forall m n f. Monad m            => FwdRewrite m n f            -> FwdRewrite m n f            -> FwdRewrite m n f--- @ end comb1.tex thenFwdRw rw3 rw3' = wrapFR2 thenrw rw3 rw3'  where   thenrw :: forall m1 e x t t1.@@ -56,11 +54,9 @@      where fwdRes Nothing   = rw' n f            fwdRes (Just gr) = return $ Just $ fadd_rw rw3' gr --- @ start iterf.tex iterFwdRw :: forall m n f. Monad m            => FwdRewrite m n f            -> FwdRewrite m n f--- @ end iterf.tex iterFwdRw rw3 = wrapFR iter rw3  where iter :: forall a m1 m2 e x t.                (Monad m2, Monad m1) =>@@ -141,12 +137,10 @@ badd_rw rw2 (g, rw1) = (g, rw1 `thenBwdRw` rw2)  --- @ start pairf.tex pairFwd :: forall m n f f'. Monad m         => FwdPass m n f         -> FwdPass m n f'          -> FwdPass m n (f, f')--- @ end pairf.tex pairFwd pass1 pass2 = FwdPass lattice transfer rewrite   where     lattice = pairLattice (fp_lattice pass1) (fp_lattice pass2)

@@ -212,27 +212,16 @@     type ARFX thing = forall e x . thing e x -> Fact e f -> m (DG f n e x, Fact x f)     -}     graph ::              Graph n e x -> Fact e f -> m (DG f n e x, Fact x f)--- @ start block.tex -2-    block :: forall e x . -             Block n e x -> f -> m (DG f n e x, Fact x f)--- @ end block.tex--- @ start node.tex -4-    node :: forall e x . (ShapeLifter e x) -         => n e x -> f -> m (DG f n e x, Fact x f)--- @ end node.tex--- @ start bodyfun.tex-    body  :: [Label] -> LabelMap (Block n C C)-          -> Fact C f -> m (DG f n C C, Fact C f)--- @ end bodyfun.tex-                    -- Outgoing factbase is restricted to Labels *not* in-                    -- in the Body; the facts for Labels *in*-                    -- the Body are in the 'DG f n C C'--- @ start cat.tex -2+    block :: forall e x . Block n e x -> f -> m (DG f n e x, Fact x f)+    node :: forall e x . (ShapeLifter e x) => n e x -> f -> m (DG f n e x, Fact x f)+    body  :: [Label] -> LabelMap (Block n C C) -> Fact C f -> m (DG f n C C, Fact C f)+     -- Outgoing factbase is restricted to Labels *not* in+     -- in the Body; the facts for Labels *in*+     -- the Body are in the 'DG f n C C'     cat :: forall e a x f1 f2 f3.             (f1 -> m (DG f n e a, f2))         -> (f2 -> m (DG f n a x, f3))         -> (f1 -> m (DG f n e x, f3))--- @ end cat.tex      graph GNil            = \f -> return (dgnil, f)     graph (GUnit blk)     = block blk@@ -252,7 +241,6 @@ #endif      -- Lift from nodes to blocks--- @ start block.tex -2     block BNil          = \f -> return (dgnil, f)     block (BlockCO l b)   = node l `cat` block b     block (BlockCC l b n) = node l `cat` block b `cat` node n@@ -260,11 +248,9 @@      block (BMiddle n)  = node n     block (BCat b1 b2) = block b1 `cat` block b2--- @ end block.tex     block (BSnoc h n)  = block h  `cat` node n     block (BCons n t)  = node  n  `cat` block t --- @ start node.tex -4     node n f      = do { grw <- frewrite rewrite n f           ; case grw of@@ -275,16 +261,12 @@                       f'    = fwdEntryFact n f                   in  arfGraph pass' (fwdEntryLabel n) g f' } --- @ end node.tex-     -- | Compose fact transformers and concatenate the resulting     -- rewritten graphs.     {-# INLINE cat #-} --- @ start cat.tex -2     cat ft1 ft2 f = do { (g1,f1) <- ft1 f                        ; (g2,f2) <- ft2 f1                        ; return (g1 `dgSplice` g2, f2) }--- @ end cat.tex     arfx :: forall thing x .             NonLocal thing          => (thing C x ->        f -> m (DG f n C x, Fact x f))@@ -294,10 +276,9 @@      -- joinInFacts adds debugging information  -                    -- Outgoing factbase is restricted to Labels *not* in-                    -- in the Body; the facts for Labels *in*-                    -- the Body are in the 'DG f n C C'--- @ start bodyfun.tex+     -- Outgoing factbase is restricted to Labels *not* in+     -- in the Body; the facts for Labels *in*+     -- the Body are in the 'DG f n C C'     body entries blockmap init_fbase       = fixpoint Fwd lattice do_block entries blockmap init_fbase       where@@ -305,9 +286,7 @@                  -> m (DG f n C x, Fact x f)         do_block b fb = block b entryFact           where entryFact = getFact lattice (entryLabel b) fb--- @ end bodyfun.tex - -- Join all the incoming facts with bottom. -- We know the results _shouldn't change_, but the transfer -- functions might, for example, generate some debugging traces.@@ -484,9 +463,9 @@                           ; return (rg, fb) }      -- joinInFacts adds debugging information -                    -- Outgoing factbase is restricted to Labels *not* in-                    -- in the Body; the facts for Labels *in*-                    -- the Body are in the 'DG f n C C'+     -- Outgoing factbase is restricted to Labels *not* in+     -- in the Body; the facts for Labels *in*+     -- the Body are in the 'DG f n C C'     body entries blockmap init_fbase       = fixpoint Bwd lattice do_block (map entryLabel (backwardBlockList entries blockmap)) blockmap init_fbase       where@@ -568,7 +547,6 @@   observeChangedFactBase :: m (Maybe (FactBase f)) -> Maybe (FactBase f) -} --- @ start fptype.tex data Direction = Fwd | Bwd fixpoint :: forall m n f. (CheckpointMonad m, NonLocal n)  => Direction@@ -577,8 +555,7 @@  -> [Label]  -> LabelMap (Block n C C)  -> (Fact C f -> m (DG f n C C, Fact C f))--- @ end fptype.tex--- @ start fpimp.tex+ fixpoint direction lat do_block entries blockmap init_fbase   = do         -- trace ("fixpoint: " ++ show (case direction of Fwd -> True; Bwd -> False) ++ " " ++ show (mapKeys blockmap) ++ show entries ++ " " ++ show (mapKeys init_fbase)) $ return()@@ -705,11 +682,10 @@ --          TOTALLY internal to Hoopl; each block is decorated with a fact ----------------------------------------------------------------------------- --- @ start dg.tex type Graph = Graph' Block type DG f  = Graph' (DBlock f) data DBlock f n e x = DBlock f (Block n e x) -- ^ block decorated with fact--- @ end dg.tex+ instance NonLocal n => NonLocal (DBlock f n) where   entryLabel (DBlock _ b) = entryLabel b   successors (DBlock _ b) = successors b@@ -762,15 +738,12 @@ -- Lowering back: --  - from fact-like things to facts -- Note that the latter two functions depend only on the entry shape.--- @ start node.tex class ShapeLifter e x where  singletonDG   :: f -> n e x -> DG f n e x  fwdEntryFact  :: NonLocal n => n e x -> f -> Fact e f  fwdEntryLabel :: NonLocal n => n e x -> MaybeC e [Label]  ftransfer :: FwdTransfer n f -> n e x -> f -> Fact x f- frewrite  :: FwdRewrite m n f -> n e x-           -> f -> m (Maybe (Graph n e x, FwdRewrite m n f))--- @ end node.tex+ frewrite  :: FwdRewrite m n f -> n e x -> f -> m (Maybe (Graph n e x, FwdRewrite m n f))  bwdEntryFact :: NonLocal n => DataflowLattice f -> n e x -> Fact e f -> f  btransfer    :: BwdTransfer n f -> n e x -> Fact x f -> f  brewrite     :: BwdRewrite m n f -> n e x

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP, TypeFamilies #-}+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Safe #-} #endif@@ -17,6 +18,10 @@  import Compiler.Hoopl.Collections import Compiler.Hoopl.Unique+#if !MIN_VERSION_base(4,8,0)+import Data.Traversable (Traversable)+import Data.Foldable (Foldable)+#endif  ----------------------------------------------------------------------------- --		Label@@ -64,7 +69,8 @@ ----------------------------------------------------------------------------- -- LabelMap -newtype LabelMap v = LM (UniqueMap v) deriving (Eq, Ord, Show)+newtype LabelMap v = LM (UniqueMap v)+  deriving (Eq, Ord, Show, Functor, Foldable, Traversable)  instance IsMap LabelMap where   type KeyOf LabelMap = Label

@@ -1,6 +1,6 @@ {-# LANGUAGE CPP, GADTs #-} {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}-#if __GLASGOW_HASKELL__ >= 701+#if __GLASGOW_HASKELL__ >= 723 {-# LANGUAGE Safe #-} #endif @@ -13,6 +13,7 @@ where  import Data.Maybe+import qualified Data.Set as Set  import Compiler.Hoopl @@ -47,15 +48,10 @@ extend :: JoinFun DPath extend _ (OldFact (DPath l)) (NewFact (DPath l')) =                                 (changeIf (l `lengthDiffers` j), DPath j)-    where j = lcs l l'-          lcs :: [Label] -> [Label] -> [Label] -- longest common suffix-          lcs l l' | length l > length l' = lcs (drop (length l - length l') l) l'-                   | length l < length l' = lcs l' l-                   | otherwise = dropUnlike l l' l-          dropUnlike [] [] maybe_like = maybe_like-          dropUnlike (x:xs) (y:ys) maybe_like =-              dropUnlike xs ys (if x == y then maybe_like else xs)-          dropUnlike _ _ _ = error "this can't happen"+    where lx = filter (\elem -> Set.member elem common) l+          rx = filter (\elem -> Set.member elem common) l'+          common = Set.intersection (Set.fromList l) (Set.fromList l')+          j = [x | (x, y) <- zip lx rx, x == y]            lengthDiffers [] [] = False           lengthDiffers (_:xs) (_:ys) = lengthDiffers xs ys

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP, TypeFamilies #-}+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 701@@ -26,6 +27,10 @@  import Control.Applicative as AP import Control.Monad (ap,liftM)+#if !MIN_VERSION_base(4,8,0)+import Data.Traversable (Traversable)+import Data.Foldable (Foldable)+#endif  ----------------------------------------------------------------------------- --		Unique@@ -61,7 +66,7 @@   setIntersection (US x) (US y) = US (S.intersection x y)   setIsSubsetOf (US x) (US y) = S.isSubsetOf x y -  setFold k z (US s) = S.fold k z s+  setFold k z (US s) = S.foldr k z s    setElems (US s) = S.elems s   setFromList ks = US (S.fromList ks)@@ -69,7 +74,8 @@ ----------------------------------------------------------------------------- -- UniqueMap -newtype UniqueMap v = UM (M.IntMap v) deriving (Eq, Ord, Show)+newtype UniqueMap v = UM (M.IntMap v)+  deriving (Eq, Ord, Show, Functor, Foldable, Traversable)  instance IsMap UniqueMap where   type KeyOf UniqueMap = Unique@@ -94,8 +100,8 @@    mapMap f (UM m) = UM (M.map f m)   mapMapWithKey f (UM m) = UM (M.mapWithKey (f . intToUnique) m)-  mapFold k z (UM m) = M.fold k z m-  mapFoldWithKey k z (UM m) = M.foldWithKey (k . intToUnique) z m+  mapFold k z (UM m) = M.foldr k z m+  mapFoldWithKey k z (UM m) = M.foldrWithKey (k . intToUnique) z m   mapFilter f (UM m) = UM (M.filter f m)    mapElems (UM m) = M.elems m