author Norman Ramsey Wed, 28 Apr 2010 22:33:35 +0000 (18:33 -0400) committer Norman Ramsey Wed, 28 Apr 2010 22:33:35 +0000 (18:33 -0400)

index 24e77ab..d977151 100644 (file)
@@ -154,11 +154,11 @@ type instance Fact O f = f
analyzeAndRewriteFwd
:: forall n f e x entries. (Edges n, LabelsPtr entries)
=> FwdPass n f
-   -> entries
+   -> MaybeC e entries
-> Graph n e x -> Fact e f
-> FuelMonad (Graph n e x, FactBase f, MaybeO x f)
analyzeAndRewriteFwd pass entries g f =
-  do (rg, fout) <- arfGraph pass (targetLabels entries) g f
+  do (rg, fout) <- arfGraph pass (fmap targetLabels entries) g f
let (g', fb) = normalizeGraph rg
return (g', fb, distinguishedExitFact g' fout)

@@ -176,22 +176,29 @@ distinguishedExitFact g f = maybe g

-type Entries = [Label]
+--type Entries e = [Label]
+type Entries e = MaybeC e [Label]
+
+{-
+instance LabelsPtr a => LabelsPtr (MaybeC e a) where
+  targetLabels (JustC a) = targetLabels a
+  targetLabels NothingC  = []
+-}

arfGraph :: forall n f e x .
(Edges n) => FwdPass n f ->
-            Entries -> Graph n e x -> Fact e f -> FM (RG f n e x, Fact x f)
+            Entries -> Graph n e x -> Fact e f -> FM (RG f n e x, Fact x f)
arfGraph pass entries = graph
where
{- nested type synonyms would be so lovely here
type ARF  thing = forall e x . thing e x -> f        -> FM (RG f n e x, Fact x f)
type ARFX thing = forall e x . thing e x -> Fact e f -> FM (RG f n e x, Fact x f)
-}
-    graph :: forall e x . Graph n e x -> Fact e f -> FM (RG f n e x, Fact x f)
+    graph ::              Graph n e x -> Fact e f -> FM (RG f n e x, Fact x f)
block :: forall e x . Block n e x -> f        -> FM (RG f n e x, Fact x f)
node  :: forall e x . (ShapeLifter e x)
=> n e x       -> f        -> FM (RG f n e x, Fact x f)
-    body  :: Entries -> Body n -> Fact C f -> FuelMonad (RG f n C C, Fact C f)
+    body  :: [Label] -> Body n -> Fact C f -> FuelMonad (RG 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 'RG f n C C'
@@ -200,14 +207,17 @@ arfGraph pass entries = graph
-> (info' -> FuelMonad (RG f n a x, info''))
-> (info  -> FuelMonad (RG f n e x, info''))

-    graph GNil                              = \f -> return (rgnil, f)
-    graph (GUnit blk)                       = block blk
-    graph (GMany NothingO bdy NothingO)     = body entries bdy
-    graph (GMany NothingO bdy (JustO exit)) = body entries bdy `cat` arfx block exit
-    graph (GMany (JustO entry) bdy NothingO)
-      = block entry `cat` body (successors entry) bdy
-    graph (GMany (JustO entry) bdy (JustO exit))
-      = (block entry `cat` body (successors entry) bdy) `cat` arfx block exit
+    graph GNil                           = \f -> return (rgnil, f)
+    graph (GUnit blk)                    = block blk
+    graph (GMany entry bdy NothingO)     = (entry `ebcat` bdy)
+    graph (GMany entry bdy (JustO exit)) = (entry `ebcat` bdy) `cat` arfx block exit
+
+    ebcat :: MaybeO e (Block n O C) -> Body n -> Fact e f -> FM (RG f n e C, Fact C f)
+    ebcat entry bdy = c entries entry
+     where c :: MaybeC e [Label] -> MaybeO e (Block n O C)
+             -> Fact e f -> FM (RG f n e C, Fact C f)
+           c NothingC (JustO entry)   = block entry `cat` body (successors entry) bdy
+           c (JustC entries) NothingO = body entries bdy

-- Lift from nodes to blocks
block (BFirst  n)  = node n
@@ -315,9 +325,13 @@ mkBRewrite' f = BwdRewrites (f, f, f)
--             Backward implementation
-----------------------------------------------------------------------------

+arbGraph = error "urk!"
+
+{-
+
arbGraph :: forall n f e x .
(Edges n) => BwdPass n f ->
-            Entries -> Graph n e x -> Fact x f -> FM (RG f n e x, Fact e f)
+            Entries -> Graph n e x -> Fact x f -> FM (RG f n e x, Fact e f)
arbGraph pass entries = graph
where
{- nested type synonyms would be so lovely here
@@ -328,7 +342,7 @@ arbGraph pass entries = graph
block :: forall e x . Block n e x -> Fact x f -> FM (RG f n e x, f)
node  :: forall e x . (ShapeLifter e x)
=> n e x       -> Fact x f -> FM (RG f n e x, f)
-    body  :: Entries -> Body n -> Fact C f -> FuelMonad (RG f n C C, Fact C f)
+    body  :: [Label] -> Body n -> Fact C f -> FuelMonad (RG f n C C, Fact C f)
cat :: forall e a x info info' info''.
(info' -> FuelMonad (RG f n e a, info''))
-> (info  -> FuelMonad (RG f n a x, info'))
@@ -391,6 +405,8 @@ arbGraph pass entries = graph
do_block b f = do (g, f) <- block b f
return (g, [(entryLabel b, f)])

+-}
+
{-

@@ -492,10 +508,10 @@ effects.)
analyzeAndRewriteBwd
:: (Edges n, LabelsPtr entries)
=> BwdPass n f
-   -> entries -> Graph n e x -> Fact x f
+   -> MaybeC e entries -> Graph n e x -> Fact x f
-> FuelMonad (Graph n e x, FactBase f, MaybeO e f)
analyzeAndRewriteBwd pass entries g f =
-  do (rg, fout) <- arbGraph pass (targetLabels entries) g f
+  do (rg, fout) <- arbGraph pass (fmap targetLabels entries) g f
let (g', fb) = normalizeGraph rg
return (g', fb, distinguishedEntryFact g' fout)

@@ -697,7 +713,7 @@ class ShapeLifter e x where
btransfer :: BwdPass n f -> n e x -> Fact x f -> f
frewrite  :: FwdPass n f -> n e x -> f        -> Maybe (FwdRes n f e x)
brewrite  :: BwdPass n f -> n e x -> Fact x f -> Maybe (BwdRes n f e x)
-  entry     :: Edges n => n e x -> [Label]
+  entry     :: Edges n => n e x -> Entries e

instance ShapeLifter C O where
unit            = BFirst
@@ -707,7 +723,7 @@ instance ShapeLifter C O where
btransfer (BwdPass {bp_transfer = BwdTransfers (bt, _, _)}) n f = bt n f
frewrite  (FwdPass {fp_rewrite  = FwdRewrites  (fr, _, _)}) n f = fr n f
brewrite  (BwdPass {bp_rewrite  = BwdRewrites  (br, _, _)}) n f = br n f
-  entry n = [entryLabel n]
+  entry n = JustC [entryLabel n]

instance ShapeLifter O O where
unit         = BMiddle
@@ -717,7 +733,7 @@ instance ShapeLifter O O where
btransfer (BwdPass {bp_transfer = BwdTransfers (_, bt, _)}) n f = bt n f
frewrite  (FwdPass {fp_rewrite  = FwdRewrites  (_, fr, _)}) n f = fr n f
brewrite  (BwdPass {bp_rewrite  = BwdRewrites  (_, br, _)}) n f = br n f
-  entry _ = []
+  entry _ = NothingC

instance ShapeLifter O C where
unit         = BLast
@@ -727,7 +743,7 @@ instance ShapeLifter O C where
btransfer (BwdPass {bp_transfer = BwdTransfers (_, _, bt)}) n f = bt n f
frewrite  (FwdPass {fp_rewrite  = FwdRewrites  (_, _, fr)}) n f = fr n f
brewrite  (BwdPass {bp_rewrite  = BwdRewrites  (_, _, br)}) n f = br n f
-  entry _ = []
+  entry _ = NothingC

-- Fact lookup: the fact `orelse` bottom
lookupF :: FwdPass n f -> Label -> FactBase f -> f
index c06aaaa..0b2a990 100644 (file)
@@ -39,8 +39,8 @@ analyzeAndRewriteBwdBody
-> entries -> Body n -> FactBase f
-> FuelMonad (Body n, FactBase f)

-analyzeAndRewriteFwdBody pass ent = mapBodyFacts (analyzeAndRewriteFwd pass ent)
-analyzeAndRewriteBwdBody pass ent = mapBodyFacts (analyzeAndRewriteBwd pass ent)
+analyzeAndRewriteFwdBody pass en = mapBodyFacts (analyzeAndRewriteFwd pass (JustC en))
+analyzeAndRewriteBwdBody pass en = mapBodyFacts (analyzeAndRewriteBwd pass (JustC en))

mapBodyFacts
:: (Graph n C C -> Fact C f   -> FuelMonad (Graph n C C, Fact C f, MaybeO C f))