src: move files into a Mate package
authorBernhard Urban <lewurm@gmail.com>
Mon, 2 Apr 2012 19:40:00 +0000 (21:40 +0200)
committerBernhard Urban <lewurm@gmail.com>
Mon, 2 Apr 2012 19:40:00 +0000 (21:40 +0200)
hence, ghc(i) is able to figuring out the correct path

Makefile
Mate.hs
Mate/BasicBlocks.hs [new file with mode: 0644]
Mate/RegisterAllocation.hs [new file with mode: 0644]
Mate/Utilities.hs [new file with mode: 0644]
src/BasicBlocks.hs [deleted file]
src/RegisterAllocation.hs [deleted file]
src/Utilities.hs [deleted file]

index b82354ece3fabbe96e24543934509b37ca03fe29..3fcf204a6b523071d1ca73ee37eb1eb80d1880a8 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -10,13 +10,13 @@ test: mate
 %.class: %.java
        javac $<
 
-trap.o mate: Mate.hs ./src/Utilities.hs trap.c
+trap.o mate: Mate.hs trap.c
        ghc --make -Wall -O2 $^ -o mate
 
 clean:
        rm -f *.hi *.o mate src/*.class
 
-tags: Mate.hs src/Utilities.hs trap.o
+tags: Mate.hs Mate/Utilities.hs trap.o
        @# @-fforce-recomp, see
        @# http://stackoverflow.com/questions/7137414/how-do-i-force-interpretation-in-hint
        ghc -fforce-recomp -e :ctags $^
diff --git a/Mate.hs b/Mate.hs
index f659455066ae19f6fbd99328f0aace80d202500a..a8e18e4ff80ae155da1b462f73863b091683b019 100644 (file)
--- a/Mate.hs
+++ b/Mate.hs
@@ -27,7 +27,7 @@ import Foreign.C.Types
 import Harpy
 import Harpy.X86Disassembler
 
-import Utilities
+import Mate.Utilities
 
 foreign import ccall "dynamic"
    code_void :: FunPtr (CInt -> IO CInt) -> (CInt -> IO CInt)
diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
new file mode 100644 (file)
index 0000000..1db0710
--- /dev/null
@@ -0,0 +1,63 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Mate.BasicBlocks where
+
+import Data.Binary
+import System.Environment
+import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as B
+
+import JVM.Common
+import JVM.ClassFile
+import JVM.Converter
+import JVM.Dump
+import JVM.Assembler
+
+import Mate.Utilities
+
+type Name       = String -- use "virtual register id" instead?
+data Type       = JInt | JFloat -- add more
+type Variable   = (Type,Name)
+
+-- Represents a CFG node
+data BasicBlock = BasicBlock {
+                     inputs  :: [Variable],
+                     outputs :: [Variable],
+                     code    :: [Instruction] }
+
+-- Represents a Control-Flow-Graph as
+-- Adjacency list (add matrix representation if appropriate)
+type CFList     = [(BasicBlock, [BasicBlock])]
+
+
+main = do
+  args <- getArgs
+  case args of
+    [clspath] -> parseFile clspath "fib" -- TODO
+    _ -> error "Synopsis: dump-class File.class"
+
+
+parseFile :: String -> B.ByteString -> IO ()
+parseFile clspath method = do
+                     --clsFile <- decodeFile clspath
+                     --putStrLn $ showListIx $ M.assocs $ constsPool (clsFile :: Class Pointers)
+                     cls <- parseClassFile clspath
+                     --dumpClass cls    
+                     let mainmethod = lookupMethod method cls -- "main|([Ljava/lang/String;)V" cf
+                     mapM_ putStrLn (testCFG mainmethod)
+
+test_01 = parseFile "./tests/Fib.class" "fib"
+test_02 = parseFile "./tests/While.class" "f"
+test_03 = parseFile "./tests/While.class" "g"
+
+
+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 buildCFG instructions
+testCFG _        = error "no method to build cfg"
+
+
+buildCFG :: [Instruction] -> [String]
+buildCFG xs = map show xs
diff --git a/Mate/RegisterAllocation.hs b/Mate/RegisterAllocation.hs
new file mode 100644 (file)
index 0000000..9fc43ae
--- /dev/null
@@ -0,0 +1,48 @@
+module Mate.RegisterAllocation where
+
+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")]
+
+
diff --git a/Mate/Utilities.hs b/Mate/Utilities.hs
new file mode 100644 (file)
index 0000000..8733ca3
--- /dev/null
@@ -0,0 +1,18 @@
+module Mate.Utilities where
+
+import qualified Data.ByteString.Lazy as B
+
+import qualified JVM.Assembler as J
+import JVM.Assembler hiding (Instruction)
+import JVM.Common
+import JVM.ClassFile
+
+
+-- TODO: actually this function already exists in hs-java-0.3!
+lookupMethod :: B.ByteString -> Class Resolved -> Maybe (Method Resolved)
+lookupMethod name cls = look (classMethods cls)
+  where
+    look [] = Nothing
+    look (f:fs)
+      | methodName f == name = Just f
+      | otherwise  = look fs
diff --git a/src/BasicBlocks.hs b/src/BasicBlocks.hs
deleted file mode 100644 (file)
index e37979b..0000000
+++ /dev/null
@@ -1,63 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module BasicBlocks where
-
-import Data.Binary
-import System.Environment
-import qualified Data.Map as M
-import qualified Data.ByteString.Lazy as B
-
-import JVM.Common
-import JVM.ClassFile
-import JVM.Converter
-import JVM.Dump
-import JVM.Assembler
-
-import Utilities
-
-type Name       = String -- use "virtual register id" instead?
-data Type       = JInt | JFloat -- add more
-type Variable   = (Type,Name)
-
--- Represents a CFG node
-data BasicBlock = BasicBlock {
-                     inputs  :: [Variable],
-                     outputs :: [Variable],
-                     code    :: [Instruction] }
-
--- Represents a Control-Flow-Graph as
--- Adjacency list (add matrix representation if appropriate)
-type CFList     = [(BasicBlock, [BasicBlock])]
-
-
-main = do
-  args <- getArgs
-  case args of
-    [clspath] -> parseFile clspath "fib" -- TODO
-    _ -> error "Synopsis: dump-class File.class"
-
-
-parseFile :: String -> B.ByteString -> IO ()
-parseFile clspath method = do
-                     --clsFile <- decodeFile clspath
-                     --putStrLn $ showListIx $ M.assocs $ constsPool (clsFile :: Class Pointers)
-                     cls <- parseClassFile clspath
-                     --dumpClass cls    
-                     let mainmethod = lookupMethod method cls -- "main|([Ljava/lang/String;)V" cf
-                     mapM_ putStrLn (testCFG mainmethod)
-
-test_01 = parseFile "./tests/Fib.class" "fib"
-test_02 = parseFile "./tests/While.class" "f"
-test_03 = parseFile "./tests/While.class" "g"
-
-
-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 buildCFG instructions
-testCFG _        = error "no method to build cfg"
-
-
-buildCFG :: [Instruction] -> [String]
-buildCFG xs = map show xs
diff --git a/src/RegisterAllocation.hs b/src/RegisterAllocation.hs
deleted file mode 100644 (file)
index 0e8dac8..0000000
+++ /dev/null
@@ -1,46 +0,0 @@
-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")]
-
-
diff --git a/src/Utilities.hs b/src/Utilities.hs
deleted file mode 100644 (file)
index 540d054..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-module Utilities where
-
-import qualified Data.ByteString.Lazy as B
-
-import qualified JVM.Assembler as J
-import JVM.Assembler hiding (Instruction)
-import JVM.Common
-import JVM.ClassFile
-
-
--- TODO: actually this function already exists in hs-java-0.3!
-lookupMethod :: B.ByteString -> Class Resolved -> Maybe (Method Resolved)
-lookupMethod name cls = look (classMethods cls)
-  where
-    look [] = Nothing
-    look (f:fs)
-      | methodName f == name = Just f
-      | otherwise  = look fs