From eb424bfc184132c0f8075e706ffb0494ef80b2b3 Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Fri, 22 Nov 2019 20:38:16 +0100
Subject: Deduplicate data table entries

---
 AST.hs       |  2 +-
 Optimiser.hs | 34 +++++++++++++++++++++++++++-------
 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
-- 
cgit v1.2.3-54-g00ecf