hoopl 3.7.7.0 → 3.7.8.0

raw patch · 7 files changed

+113/−92 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGES +4/−0
• Compiler/Hoopl/Dataflow.hs +3/−13
• Compiler/Hoopl/GraphUtil.hs +9/−34
• Compiler/Hoopl/MkGraph.hs +81/−43
• README +8/−0
• hoopl.cabal +8/−2
• hoopl.pdf binary

@@ -1,3 +1,7 @@+3.7.8.0++  - Rationalized AGraph splicing functions.+ 3.7.7.0    - Restrict clients so they see much less, including hiding

@@ -58,9 +58,9 @@ module Compiler.Hoopl.Dataflow    ( DataflowLattice(..), JoinFun, OldFact(..), NewFact(..)   , ChangeFlag(..), changeIf-  , FwdPass(..),  FwdTransfer, FwdRewrite, SimpleFwdRewrite+  , FwdPass(..),  FwdTransfer, FwdRewrite, SimpleFwdRewrite, FwdRes(..)   , noFwdRewrite, thenFwdRw, shallowFwdRw, deepFwdRw, iterFwdRw-  , BwdPass(..), BwdTransfer, BwdRewrite, SimpleBwdRewrite+  , BwdPass(..), BwdTransfer, BwdRewrite, SimpleBwdRewrite, BwdRes(..)   , noBwdRewrite, thenBwdRw, shallowBwdRw, deepBwdRw, iterBwdRw   , Fact   , analyzeAndRewriteFwd, analyzeAndRewriteBwd@@ -497,7 +497,7 @@ gwfCat :: Edges n => GraphWithFacts n f e a                   -> GraphWithFacts n f a x                    -> GraphWithFacts n f e x-gwfCat (g1, fb1) (g2, fb2) = (g1 `gCat` g2, fb1 `unionFactBase` fb2)+gwfCat (g1, fb1) (g2, fb2) = (g1 `U.gSplice` g2, fb1 `unionFactBase` fb2)  {- bwfUnion :: BodyWithFacts n f -> BodyWithFacts n f -> BodyWithFacts n f@@ -508,14 +508,4 @@  graphOfAGraph :: AGraph node e x -> FuelMonad (Graph node e x) graphOfAGraph ag = ag---gCat :: Graph n e a -> Graph n a x -> Graph n e x-gCat = U.gCatAny--{- Not sure why the following does not work!  ---NR-gCat g@(GMany _ _ NothingO) g' = U.gCatClosed g g'-gCat g g'@(GMany NothingO _ _) = U.gCatClosed g g'-gCat g g' = U.gCat g g'--} 

@@ -4,9 +4,7 @@ -- N.B. addBasicBlocks won't work on OO without a Node (branch/label) constraint  module Compiler.Hoopl.GraphUtil-  ( gCat, addEntrySeq, addExitSeq -- , addBasicBlocks-  , gCatClosed-  , gCatAny+  ( gSplice   , bodyGraph   ) @@ -18,46 +16,23 @@ bodyGraph b = GMany NothingO b NothingO  -gCatAny        :: Graph n e a -> Graph n a x -> Graph n e x-gCat           :: Graph n e O -> Graph n O x -> Graph n e x-addEntrySeq    :: Graph n O C -> Graph n C x -> Graph n O x-addExitSeq     :: Graph n e C -> Graph n C O -> Graph n e O---addBasicBlocks :: Graph n e x -> Graph n C C -> Graph n e x-gCatClosed     :: Graph n e C -> Graph n C x -> Graph n e x+gSplice :: Graph n e a -> Graph n a x -> Graph n e x -gCatAny GNil g2 = g2-gCatAny g1 GNil = g1+gSplice GNil g2 = g2+gSplice g1 GNil = g1 -gCatAny (GUnit b1) (GUnit b2)             +gSplice (GUnit b1) (GUnit b2)                = GUnit (b1 `BCat` b2) -gCatAny (GUnit b) (GMany (JustO e) bs x) +gSplice (GUnit b) (GMany (JustO e) bs x)    = GMany (JustO (b `BCat` e)) bs x -gCatAny (GMany e bs (JustO x)) (GUnit b2) +gSplice (GMany e bs (JustO x)) (GUnit b2)    = GMany e bs (JustO (x `BCat` b2)) -gCatAny (GMany e1 bs1 (JustO x1)) (GMany (JustO e2) bs2 x2)+gSplice (GMany e1 bs1 (JustO x1)) (GMany (JustO e2) bs2 x2)   = GMany e1 (addBlock (x1 `BCat` e2) bs1 `BodyCat` bs2) x2 -gCatAny (GMany e1 bs1 NothingO) (GMany NothingO bs2 x2)+gSplice (GMany e1 bs1 NothingO) (GMany NothingO bs2 x2)    = GMany e1 (bs1 `BodyCat` bs2) x2 -gCat = gCatAny-addEntrySeq = gCatAny-addExitSeq = gCatAny-gCatClosed = gCatAny--{--addEntrySeq (GMany entry body NothingO) (GMany NothingO body' exit) -  = GMany entry (body `BodyCat` body') exit-  -addExitSeq  (GMany entry body NothingO) (GMany NothingO body' exit) -  = GMany entry (body `BodyCat` body') exit-  ---addBasicBlocks GNil g2 = g2---gCatClosed (GMany e1 bs1 NothingO) (GMany NothingO bs2 x2)-   = GMany e1 (bs1 `BodyCat` bs2) x2--}

@@ -1,11 +1,11 @@-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables, GADTs #-} module Compiler.Hoopl.MkGraph-    ( AGraph, (<*>), gCatClosed+    ( AGraph, (<*>), catAGraphs, addEntrySeq, addExitSeq, addBlocks, unionBlocks     , emptyAGraph, emptyClosedAGraph, withFreshLabels-    , mkFirst, mkMiddle, mkMiddles, mkLast, mkEntry, mkBranch, mkLabel, mkWhileDo-    , addEntrySeq, addExitSeq, catAGraphs+    , mkFirst, mkMiddle, mkMiddles, mkLast, mkBranch, mkLabel, mkWhileDo     , IfThenElseable(mkIfThenElse)-    , Node(mkLabelNode, mkBranchNode)+    , mkEntry, mkExit+    , HooplNode(mkLabelNode, mkBranchNode)     ) where @@ -18,9 +18,6 @@  type AGraph n e x = FuelMonad (Graph n e x) -infixr 3 <*>-(<*>) :: AGraph n e O -> AGraph n O x -> AGraph n e x- class Labels l where   withFreshLabels :: (l -> AGraph n e x) -> AGraph n e x @@ -30,33 +27,87 @@ emptyClosedAGraph :: AGraph n C C emptyClosedAGraph = return $ GMany NothingO BodyEmpty NothingO +{-|+As noted in the paper, we can define a single, polymorphic type of +splicing operation with the very polymorphic type+@+  AGraph n e a -> AGraph n a x -> AGraph n e x+@+However, we feel that this operation is a bit /too/ polymorphic,+and that it's too easy for clients to use it blindly without +thinking.  We therfore split it into several operations:++  * The '<*>' operator is true concatenation, for connecting open graphs.++  * The operators 'addEntrySeq' or 'addExitSeq' allow a client to add+    an entry or exit sequence to a graph that is closed at the entry or +    exit.++  * The operator 'addBlocks' adds a set of basic blocks (represented as+    a closed/closed 'AGraph' to an existing graph, without changing the shape+    of the existing graph.  In some cases, it's necessary to introduce +    a branch and a label to 'get around' the blocks added, so this operator, +    and other functions based on it, requires a 'HooplNode' type-class constraint.+    (In GHC 6.12 this operator was called 'outOfLine'.)++  * The operator 'unionBlocks' takes the union of two sets of basic blocks,+    each of which is represented as a closed/closed 'AGraph'.  It is not +    redundant with 'addBlocks', because 'addBlocks' requires a 'HooplNode'+    constraint but 'unionBlocks' does not.++There is some redundancy in this representation (any instance of+'addEntrySeq' is also an instance of either 'addExitSeq' or 'addBlocks'),+but because the different operators restrict polymorphism in different ways, +we felt some redundancy would be appropriate.++-}++++infixl 3 <*>+(<*>) :: AGraph n e O -> AGraph n O x -> AGraph n e x++ addEntrySeq    :: AGraph n O C -> AGraph n C x -> AGraph n O x addExitSeq     :: AGraph n e C -> AGraph n C O -> AGraph n e O-gCatClosed     :: AGraph n e C -> AGraph n C x -> AGraph n e x+addBlocks      :: HooplNode n+               => AGraph n e x -> AGraph n C C -> AGraph n e x+unionBlocks    :: AGraph n C C -> AGraph n C C -> AGraph n C C -addEntrySeq = liftM2 U.addEntrySeq-addExitSeq  = liftM2 U.addExitSeq-gCatClosed  = liftM2 U.gCatClosed+addEntrySeq = liftM2 U.gSplice+addExitSeq  = liftM2 U.gSplice+unionBlocks = liftM2 U.gSplice +addBlocks g blocks = g >>= \g -> blocks >>= add g+  where add :: HooplNode n => Graph n e x -> Graph n C C -> AGraph n e x+        add (GMany e body x) (GMany NothingO body' NothingO) =+          return $ GMany e (body `BodyCat` body') x+        add g@GNil      blocks = spliceOO g blocks+        add g@(GUnit _) blocks = spliceOO g blocks+        spliceOO :: HooplNode n => Graph n O O -> Graph n C C -> AGraph n O O+        spliceOO g blocks = withFreshLabels $ \l ->+          return g <*> mkBranch l `addEntrySeq` return blocks `addExitSeq` mkLabel l++ mkFirst  :: n C O -> AGraph n C O mkMiddle :: n O O -> AGraph n O O mkLast   :: n O C -> AGraph n O C -mkLabel :: (Node n) => Label -> AGraph n C O -- graph contains the label+mkLabel :: HooplNode n => Label -> AGraph n C O -- graph contains the label  -- below for convenience mkMiddles :: [n O O] -> AGraph n O O mkEntry   :: Block n O C -> AGraph n O C mkExit    :: Block n C O -> AGraph n C O -class Edges n => Node n where+class Edges n => HooplNode n where   mkBranchNode :: Label -> n O C   mkLabelNode  :: Label -> n C O -mkBranch :: (Node n) => Label -> AGraph n O C+mkBranch :: HooplNode n => Label -> AGraph n O C  class IfThenElseable x where-  mkIfThenElse :: Node n+  mkIfThenElse :: HooplNode n                => (Label -> Label -> AGraph n O C) -- branch condition                -> AGraph n O x   -- code in the 'then' branch                -> AGraph n O x   -- code in the 'else' branch @@ -66,20 +117,20 @@                 => Label -> AGraph n e x -> AGraph n e C -} -mkWhileDo    :: (Node n)-                => (Label -> Label -> AGraph n O C) -- loop condition-                -> AGraph n O O  -- body of the bloop-                -> AGraph n O O -- the final while loop+mkWhileDo    :: HooplNode n+             => (Label -> Label -> AGraph n O C) -- loop condition+             -> AGraph n O O  -- body of the bloop+             -> AGraph n O O -- the final while loop  -- ================================================================ --                          IMPLEMENTATION -- ================================================================ -(<*>) = liftM2 U.gCat -+(<*>) = liftM2 U.gSplice  catAGraphs :: [AGraph n O O] -> AGraph n O O catAGraphs = foldr (<*>) emptyAGraph + ------------------------------------- -- constructors @@ -87,27 +138,14 @@ mkBranch target = mkLast  $ mkBranchNode target mkMiddles ms = foldr (<*>) (return GNil) (map mkMiddle ms) --{--outOfLine (AGraph g :: AGraph n C C) = AGraph g'-  where g' :: UniqSM (Graph n O O)-        g' = do zgraph <- g-                case zgraph of-                  GF (Z.ZE_C _) _ Z.ZX_C ->-                      do id <- freshLabel "outOfLine"-                         return $ Z.mkLast (mkBranchNode id) <**> zgraph <**>-                                  Z.mkLabel id-                  _ -> panic "tried to outOfLine a graph open at one or both ends"--}- instance IfThenElseable O where   mkIfThenElse cbranch tbranch fbranch = do     endif  <- freshLabel     ltrue  <- freshLabel     lfalse <- freshLabel     cbranch ltrue lfalse `addEntrySeq`-      (mkLabel ltrue  <*> tbranch <*> mkBranch endif) `gCatClosed`-      (mkLabel lfalse <*> fbranch <*> mkBranch endif) `gCatClosed`+      (mkLabel ltrue  <*> tbranch <*> mkBranch endif) `addBlocks`+      (mkLabel lfalse <*> fbranch <*> mkBranch endif) `addExitSeq`       mkLabel endif  {-@@ -118,9 +156,9 @@   mkIfThenElse cbranch tbranch fbranch = do     ltrue  <- freshLabel     lfalse <- freshLabel-    cbranch ltrue lfalse `gCatClosed`-       mkLabel ltrue  <*> tbranch `gCatClosed`-       mkLabel lfalse <*> fbranch+    cbranch ltrue lfalse `addEntrySeq`+       (mkLabel ltrue  <*> tbranch) `addBlocks`+       (mkLabel lfalse <*> fbranch) {-   fallThroughTo _ g = g -}@@ -130,9 +168,9 @@   head <- freshLabel   endwhile <- freshLabel      -- Forrest Baskett's while-loop layout-  mkBranch test `gCatClosed`-    mkLabel head <*> body <*> mkBranch test `gCatClosed`-    mkLabel test <*> cbranch head endwhile  `gCatClosed`+  mkBranch test `addEntrySeq`+    (mkLabel head <*> body <*> mkBranch test) `addBlocks`+    (mkLabel test <*> cbranch head endwhile)  `addExitSeq`     mkLabel endwhile  -------------------------------------

@@ -16,3 +16,11 @@  Version 3.7.3.3 has fixed known bugs. +Version 3.7.8.0 will be the last version uploaded to Hackage for some time.+This library is undergoing *very* rapid development, and we ask that you+get the most recent version from our public git repository:++  git clone -o tufts git://ghc.cs.tufts.edu/hoopl/hoopl.git++If you are not familiar with git, we recommend the tutorial 'Git Magic'+by Ben Lynn.

@@ -1,12 +1,13 @@ Name:                hoopl-Version:             3.7.7.0+Version:             3.7.8.0 Description:         Higher-order optimization library License:             BSD3 License-file:        LICENSE Author:              Norman Ramsey, João Dias, and Simon Peyton Jones Maintainer:          nr@cs.tufts.edu+Homepage:            http://ghc.cs.tufts.edu/hoopl/ Build-Type:          Simple-Cabal-Version:       >=1.2+Cabal-Version:       >=1.6 Stability:           alpha Synopsis:            A library to support dataflow analysis and optimization Category:            Compilers/Interpreters@@ -23,3 +24,8 @@                        Compiler.Hoopl.Fuel, Compiler.Hoopl.Label,                        Compiler.Hoopl.Util   ghc-options:       -Wall -fno-warn-name-shadowing+++Source-repository head+  Type:       git+  Location:   git://ghc.cs.tufts.edu/hoopl/hoopl.git

binary file changed (256322 → 256581 bytes)