Deduplicate data table entries

2 files changed, 28 insertions, 8 deletions

diff --git a/AST.hs b/AST.hs
index a096227..5fd2518 100644
--- a/AST.hs
+++ b/AST.hs
@@ -19,7 +19,7 @@ data Value
     | VLet [(Name, Value)] Value
     | VBuiltin String
     | VEllipsis
-  deriving (Eq)
+  deriving (Eq, Ord)
 
 
 instance Show Program where
diff --git a/Optimiser.hs b/Optimiser.hs
index a6c5e10..b6dd902 100644
--- a/Optimiser.hs
+++ b/Optimiser.hs
@@ -11,13 +11,17 @@ import Intermediate
 
 
 optimise :: IRProgram -> IRProgram
-optimise (IRProgram bbs gfds datas) =
-    let optf = foldl (.) id
-                     [ tailCallIntro
-                     , deadBBElim gfds, mergeRets
-                     , deadStoreElim, deadBBElim gfds
-                     , map propAssigns
-                     , mergeRets, mergeBlocks]
+optimise prog =
+    let progoptf = foldl (.) id . reverse $
+            [ dedupDatas ]
+        optf = foldl (.) id . reverse $
+            [ mergeBlocks, mergeRets
+            , map propAssigns
+            , deadBBElim gfds, deadStoreElim
+            , mergeRets, deadBBElim gfds
+            , tailCallIntro ]
+
+        IRProgram bbs gfds datas = progoptf prog
     in IRProgram (optf bbs) gfds datas
 
 mergeBlocks :: [BB] -> [BB]
@@ -119,6 +123,17 @@ tailCallIntro bbs = map introduce bbs
                     BB bid (init inss) (ITailC cl as)
             _ -> orig
 
+dedupDatas :: IRProgram -> IRProgram
+dedupDatas (IRProgram origbbs gfds datatbl) = IRProgram (map goBB origbbs) gfds values
+  where
+    values = uniq (sort datatbl)
+    valueIdx = Map.fromList (zip values [0..])
+
+    goBB (BB bid inss term) = BB bid (map goI inss) term
+
+    goI (ref, IData i) = (ref, IData (valueIdx Map.! (datatbl !! i)))
+    goI ins = ins
+
 outEdges :: BB -> [Int]
 outEdges (BB _ _ term) = outEdgesT term
 
@@ -161,3 +176,8 @@ readTempsR RNone = []
 
 mapFoldl :: (s -> a -> (s, b)) -> s -> [a] -> (s, [b])
 mapFoldl f s = fmap reverse . foldl' (\(s', yet) x -> fmap (: yet) (f s' x)) (s, [])
+
+uniq :: Eq a => [a] -> [a]
+uniq (x:y:zs) | x == y = uniq (y:zs)
+              | otherwise = x : uniq (y:zs)
+uniq l = l