From eee7489ade3862519c1feb7dece04570469a1da3 Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Thu, 12 Dec 2019 20:17:13 +0100
Subject: General cleanup

---
 Intermediate.hs | 39 +++++++++++++++++++++++++++++++++++++--
 1 file changed, 37 insertions(+), 2 deletions(-)

(limited to 'Intermediate.hs')

diff --git a/Intermediate.hs b/Intermediate.hs
index 6a11bf0..7984176 100644
--- a/Intermediate.hs
+++ b/Intermediate.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase, FlexibleInstances #-}
 module Intermediate where
 
 import Data.List
@@ -65,6 +66,9 @@ instance AllRefs BB where
     allRefs (BB _ inss term) =
         sortUniq $ concatMap (allRefs . snd) inss ++ allRefs term
 
+instance AllRefs [BB] where
+    allRefs = sortUniq . concatMap allRefs
+
 instance AllRefs InsCode where
     allRefs (IAssign r) = [r]
     allRefs (IParam _) = []
@@ -93,6 +97,37 @@ outEdgesT (ITailC _ _) = []
 outEdgesT IExit = []
 outEdgesT IUnknown = []
 
+icReadTemps :: InsCode -> [Int]
+icReadTemps = \case
+    IAssign r -> onlyTemporaries [r]
+    IParam _ -> []
+    IClosure _ -> []
+    IData _ -> []
+    ICallC r rs -> onlyTemporaries (r : rs)
+    IAllocClo _ rs -> onlyTemporaries rs
+    IDiscard r -> onlyTemporaries [r]
+
+termReadTemps :: Terminator -> [Int]
+termReadTemps = \case
+    IBr r _ _ -> onlyTemporaries [r]
+    IJmp _ -> []
+    IRet r -> onlyTemporaries [r]
+    ITailC r rs -> onlyTemporaries (r : rs)
+    IExit -> []
+    IUnknown -> []
+
+bbReadTemps :: BB -> [Int]
+bbReadTemps (BB _ inss term) = onlyTemporaries (concatMap (allRefs . snd) inss ++ allRefs term)
+
+bbWrittenTemps :: BB -> [Int]
+bbWrittenTemps (BB _ inss _) = concatMap insWrittenTemps inss
+
+insWrittenTemps :: Instruction -> [Int]
+insWrittenTemps (d, _) = onlyTemporaries [d]
+
+onlyTemporaries :: [Ref] -> [Int]
+onlyTemporaries rs = [i | RTemp i <- rs]
+
 
 instance Show IRProgram where
     show (IRProgram bbs gfds datas) = intercalate "\n" $
@@ -115,9 +150,9 @@ instance Show IRProgram where
         bbannot bid = maybe "" ("entry point of " ++) (Map.lookup bid bidToName)
 
 instance Show GlobFuncDef where
-    show (GlobFuncDef bbid na []) = "BB " ++ show bbid ++ " (" ++ show na ++ ")"
+    show (GlobFuncDef bbid na []) = "GFD at BB " ++ show bbid ++ " (" ++ show na ++ ")"
     show (GlobFuncDef bbid na cs) =
-        "BB " ++ show bbid ++ " (" ++ show na ++ ") (closure slots: " ++ intercalate ", " cs ++ ")"
+        "GFD at BB " ++ show bbid ++ " (" ++ show na ++ ") (closure slots: " ++ intercalate ", " cs ++ ")"
 
 instance Show BB where
     show = genericShowBB (const "") show show
-- 
cgit v1.2.3-70-g09d2