Really rough implementation of available expressions

Author: Isweet

ppa.cabal

@@ -17,10 +17,10 @@ extra-source-files:  README.md
 cabal-version:       >=1.10
 
 library
-  exposed-modules:     PPA.Lang.While PPA.Lang.While.Internal PPA.Lang.While.Util PPA.Analysis.Util PPA.Analysis.AvailableExpressions
+  exposed-modules:     PPA.Lang.While PPA.Lang.While.Internal PPA.Lang.While.Util PPA.Analysis.AvailableExpressions
 --  other-modules:
   other-extensions:    FlexibleContexts
-  build-depends:       base == 4.8.*, parsec == 3.1.*, containers == 0.5.*
+  build-depends:       base == 4.8.*, parsec == 3.1.*, containers == 0.5.*, array == 0.5.*
   hs-source-dirs:      src
   default-language:    Haskell2010
 

src/PPA/Analysis/AvailableExpressions.hs

@@ -1,10 +1,44 @@
 module PPA.Analysis.AvailableExpressions where
 
+import Prelude hiding (init)
+
 import qualified Data.Set as Set
+import qualified Data.List as List
+import qualified Data.Array.IArray as Array
 
 import PPA.Lang.While
 import PPA.Lang.While.Util
 
+type AE = Set.Set AExp
+
+type VecAE = Array.Array Integer AE
+type VecF = Array.Array Integer (Solution -> AE)
+
+data Solution = Solution {  entryAE :: VecAE
+                         ,  exitAE  :: VecAE
+                         } deriving (Show, Eq)
+
+data Solver = Solver {  entryF :: VecF
+                     ,  exitF  :: VecF
+                     }
+
+genIter :: Integer -> Solver -> Solution -> Solution
+genIter l s rd = Solution { entryAE = entries, exitAE = exits }
+    where
+        entries = Array.array (1, l) [ (i, ((entryF s) Array.! i) rd) | i <- [1..l]]
+        exits = Array.array (1, l) [ (i, ((exitF s) Array.! i) rd) | i <- [1..l]]
+
+-- compute fixpoint
+fix :: (Eq a) => a -> (a -> a) -> a
+fix start f =
+    if start == next then
+        start
+    else
+        fix next f
+    where
+        next = f start
+
+
 kill :: Stmt -> Lab -> Set.Set AExp
 kill s l =
     case bf l of
@@ -24,3 +58,25 @@ gen s l =
     where
         bf :: Lab -> Block
         bf = blockMap $ blocks s
+
+ae :: Stmt -> Solution
+ae s =
+    fix start $ genIter sz solver
+        where
+        start = Solution { entryAE = upper, exitAE = upper }
+            where
+            upper :: VecAE
+            upper = Array.array (1, sz) [(i, aExp s) | i <- [1..sz]]
+        solver = Solver { entryF = aeEntry, exitF = aeExit }
+            where
+            aeEntry :: VecF
+            aeEntry = Array.array (1, sz) [(i, (\ ae ->
+                if i == init s then 
+                    Set.empty 
+                else
+                    List.foldl Set.intersection (aExp s) [(exitAE ae) Array.! l' | (l', l) <- Set.toList $ flow s, l == i])) | i <- [1..sz]]
+            aeExit :: VecF
+            aeExit = Array.array (1, sz) [(i, (\ ae ->
+                Set.union (((entryAE ae) Array.! i) Set.\\ (kill s i)) (gen s i))) | i <- [1..sz]]
+        sz :: Integer 
+        sz = toInteger $ Set.size $ labels s