From e8d69c2ae329e15ee4a4647058f61668ee0f7dff Mon Sep 17 00:00:00 2001
From: Harald Steinlechner <haraldsteinlechner@gmail.com>
Date: Tue, 27 Mar 2012 22:22:51 +0200
Subject: [PATCH] fixed broken Makefile (sry - forgot to check Makefile), added
 RegisterAllocation playground

---
 Makefile                  |  2 +-
 src/BasicBlocks.hs        | 35 +++++++++++++++++++++--------
 src/RegisterAllocation.hs | 46 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 73 insertions(+), 10 deletions(-)
 create mode 100644 src/RegisterAllocation.hs

diff --git a/Makefile b/Makefile
index 191b3cc..08f7d2b 100644
--- a/Makefile
+++ b/Makefile
@@ -4,7 +4,7 @@ all: mate Test.class
 %.class: %.java
 	javac $<
 
-mate: Mate.hs Utilities.hs trap.c
+mate: Mate.hs ./src/Utilities.hs trap.c
 	ghc --make -Wall -O2 $^ -o $@
 
 clean:
diff --git a/src/BasicBlocks.hs b/src/BasicBlocks.hs
index 4f84998..6bd26e4 100644
--- a/src/BasicBlocks.hs
+++ b/src/BasicBlocks.hs
@@ -10,20 +10,37 @@ import JVM.Common
 import JVM.ClassFile
 import JVM.Converter
 import JVM.Dump
+import JVM.Assembler
 
 import Utilities
 
 main = do
   args <- getArgs
   case args of
-    [clspath] -> do
-      clsFile <- decodeFile clspath
-      putStrLn $ showListIx $ M.assocs $ constsPool (clsFile :: Class Pointers)
-      cls <- parseClassFile clspath
-      dumpClass cls    
-      let mainmethod = lookupMethod "main" cls -- "main|([Ljava/lang/String;)V" cf
-      testCFG mainmethod
-      putStrLn "foo"
+    [clspath] -> parseFile clspath
     _ -> error "Synopsis: dump-class File.class"
 
-testCFG _ = undefined
+
+parseFile :: String -> IO ()
+parseFile clspath = do
+                     --clsFile <- decodeFile clspath
+                     --putStrLn $ showListIx $ M.assocs $ constsPool (clsFile :: Class Pointers)
+                     cls <- parseClassFile clspath
+                     --dumpClass cls    
+                     let mainmethod = lookupMethod "fib" cls -- "main|([Ljava/lang/String;)V" cf
+                     putStrLn $ show $ testCFG mainmethod
+
+test = parseFile "./tests/Fib.class"
+
+
+testCFG :: Maybe (Method Resolved) -> String
+testCFG (Just m) = case attrByName m "Code" of
+                     Nothing       -> error "no code"
+                     Just bytecode -> let code = decodeMethod bytecode
+                                          instructions = codeInstructions code
+                                      in show $ buildCFG instructions
+testCFG _        = error "no method to build cfg"
+
+
+buildCFG :: [Instruction] -> String
+buildCFG xs = concatMap show xs
diff --git a/src/RegisterAllocation.hs b/src/RegisterAllocation.hs
new file mode 100644
index 0000000..0e8dac8
--- /dev/null
+++ b/src/RegisterAllocation.hs
@@ -0,0 +1,46 @@
+import Data.List
+import Data.Maybe
+
+
+type Label a = a
+type IEdge a = (Label a, Label a)
+data IGraph a = IGraph [IEdge a] deriving (Show)
+
+-- TODO: make IEdge eq
+
+--data IArchitecture = Arch { regs :: Integer  }
+type IArchitecture = Int --number of regs
+
+
+type Assignment a = (a, Int)
+
+
+edgeEq (from,to) (from',to') = from == from' && to == to' 
+
+
+-- TODO: find combinator do match try semantics here
+-- Solution: use list because list is MonadPlus instance
+-- other solution add maybe monadplus implementation
+conflicts (IGraph xs) (label,anotherLabel) = let comparison  = edgeEq (label,anotherLabel)
+                                                 comparison' = edgeEq (anotherLabel,label) 
+                                             in isJust (find comparison xs) || isJust (find comparison' xs) 
+
+
+isParticipiant label (from,to) = from == label || to == label
+
+count p = length . filter p
+
+degree g@(IGraph xs) label = count (isParticipiant label) xs
+
+
+doChaitin81 :: (Eq a) => IArchitecture -> (IGraph a) -> [Assignment a]
+doChaitin81 numberOfRegisters graph = []
+
+type IState a = ([a],IGraph a)
+
+--chait81Simplification :: (Eq a) => IArchitecture -> SimplState
+--chait81Simplification regs = do (
+                              
+testGraph = IGraph [("a", "b"), ("a","c"), ("c", "b"), ("b","d"), ("d","c"),("b","e"),("d","e")]
+
+
-- 
2.25.1