--- /dev/null
+module Frontend where
+
+import Data.Int
+import Data.Word
+import Control.Monad.State
+import Data.Maybe
+import Data.List
+
+import JVM.ClassFile
+import JVM.Converter
+import JVM.Dump
+import JVM.Assembler
+
+import qualified JVM.Assembler as J
+import qualified Data.Heap as H
+import qualified Data.ByteString.Lazy as B
+import qualified Data.Map as M
+
+
+import Debug.Trace
+
+import Graph
+
+{- Thoughs on types and representations
+ - We start from constructing a CFG. What do we need here
+ - ** Fast traversal which is aware of cycles
+ - ** Fast successor, do we need predecessors?
+ - ** Find all paths to current node (including back references)
+ - ** Generic Node type in order to write mentioned operations
+ - generically. There should be no intermediate language "lock in"
+ - i.e. adding another IR should not kill CFG code
+ - Furthermore operations like SSA construction should
+ - not affect the CFG datastructure. Nodes contents should be
+ - interchangable in a way.
+ - ** Some form of unique naming - we would like to identify blocks
+ - and check whether code should be produced for this node
+ - ** Should be Haskell idiomatic - should be composed with
+ - standard haskell infrastructure
+ - ** Convinient printing
+ -
+ - From this a inductive type should be appropriate?
+ -
+ -}
+
+
+-- Means NumberedINSruction
+type Size = Int
+type NInst = (Source, Size, J.Instruction)
+-- Putting Source and Target in data types prevents from interchanging ;-)
+data Source = Source Int deriving (Eq, Ord, Show)
+data Target = Target Int deriving (Eq, Ord, Show)
+-- Source, Target Instruction id
+type SourceTarget = (Source,Target)
+-- State type for findContinuations
+type ContState = ([SourceTarget], H.MinPrioHeap Target Source)
+
+data Block = BB [NInst] deriving (Show)
+type CFG = G Block
+data BlockID = Id Int deriving (Show,Ord,Eq)
+
+type IndirectCFG = [([NInst],[Int],BlockID)]
+
+data FinalBlock = FinalBlock BlockID [NInst] deriving (Show)
+
+instance Eq FinalBlock where
+ FinalBlock (Id x) _ == FinalBlock (Id y) _ = x == y
+
+instance Ord FinalBlock where
+ FinalBlock (Id x) _ <= FinalBlock (Id y) _ = x <= y
+
+less :: Target -> Source -> Bool
+less (Target t) (Source s) = t < s
+
+addW16Signed :: Int -> Word16 -> Int
+addW16Signed i w16 = i + fromIntegral s16
+ where s16 = fromIntegral w16 :: Int16
+
+getInstOffsets :: [J.Instruction] -> [Int]
+getInstOffsets = map (\i -> fromIntegral $ B.length $ J.encodeInstructions [i])
+
+sumSeries'':: [Int] -> [Int]
+sumSeries'' = reverse . snd . foldl (\(s,xs) x -> (s+x,s : xs)) (0,[])
+
+splitBlocksBackRef :: [NInst] -> [Int]
+splitBlocksBackRef = concatMap checkSplit
+ where checkSplit inst = case inst of
+ (Source s, size, IF_ICMP _ t) -> []
+ (Source s, size, GOTO t) -> [addW16Signed s t]
+ _ -> []
+
+
+getInstructions :: [Instruction] -> [(Source, Int, Instruction)]
+getInstructions ins = zip3 (map Source $ sumSeries'' offsets) offsets ins
+ where offsets = getInstOffsets ins
+
+
+getBranch :: NInst -> [Int]
+getBranch (Source s, size, IF_ICMP _ t) = [addW16Signed s t, s+size]
+getBranch (Source s, size, GOTO t) = [addW16Signed s t]
+getBranch _ = []
+
+-- a version of Prelude.span whereby the first element
+-- which does not hold predicate f is also included in
+-- the first list
+spanPlus :: (a -> Bool) -> [a] -> ([a], [a])
+spanPlus _ [] = ([],[])
+spanPlus f (x:xs) = if f x then let (b, a) = spanPlus f xs
+ in (x:b, a)
+ else ([x],xs)
+
+fromNInst :: NInst -> Int
+fromNInst (Source s,_,_) = s
+
+ifJust :: b -> Maybe a -> [b]
+ifJust _ Nothing = []
+ifJust a (Just _) = [a]
+
+splitBlocks :: [Int] -> [NInst] -> IndirectCFG
+splitBlocks _ [] = []
+splitBlocks backRefs xs = (map fst block, block >>= snd, Id id) : splitBlocks backRefs (map fst rest)
+ where getBranchAndRef ins@(Source i,w,_) =
+ (ifJust (i+w) $ find (==i+w) backRefs) ++ getBranch ins
+ branches = zip xs $ map getBranchAndRef xs
+ (block,rest) = spanPlus (null . snd) branches
+ (Source id,_,_) = fst . head $ block -- block guarantted to be non empty
+
+getTransitions :: IndirectCFG -> (M.Map BlockID [BlockID])
+getTransitions = foldr (\(_,targets,id) s -> M.insert id (map Id targets) s) M.empty
+
+-- [([NInst],[Int],BlockID)]
+getNodes :: IndirectCFG -> [(BlockID,FinalBlock)]
+getNodes = map rearrange
+ where rearrange (insts,_,id) = (id,FinalBlock id insts)
+
+
+--indirectCFGToG :: IndirectCFG -> G [NInst]
+indirectCFGToG cfg = toG packNodes (M.toList $ getTransitions cfg) (Id 0) (getNodes cfg)
+
+{- DEPRECATED -}
+
+findContinuations :: [NInst] -> State ContState ()
+findContinuations = mapM_ addCont
+
+addCont :: NInst -> State ContState ()
+addCont (s, b, IF_ICMP _ w) = do add s (addTarget s w); jmpNext s b;
+addCont (s, _, GOTO w) = add s (addTarget s w);
+addCont (s, b, _ ) = return () --jmpNext s b
+
+jmpNext :: Source -> Int -> State ContState ()
+jmpNext s@(Source i) o = add s (Target $ i + o)
+
+
+addTarget :: Source -> Word16 -> Target
+addTarget (Source s) w16 = Target $ fromIntegral result
+ where result = s16 + fromIntegral w16 :: Int16
+ s16 = fromIntegral s :: Int16
+
+
+
+addBranch :: Source -> Target -> State ContState ()
+addBranch s t = do (branches,backRefs) <- get
+ put ( (s,t) : branches, backRefs)
+
+addBackRef :: Source -> Target -> State ContState ()
+addBackRef s t = do (branches,backRefs) <- get
+ put (branches, H.insert (t,s) backRefs)
+
+add :: Source -> Target -> State ContState ()
+add s t = do addBranch s t
+ -- if back branch - also add branch to back references
+ -- for faster access later on
+ if t `less` s then do trace ("jsadf") addBackRef s t;
+ else return ()
+
+
+
+-- Context of the Method to be compiled
+type Context = ([J.Instruction],Class Resolved)
+-- Maybe a context of the Method to be compiled
+type MContext = Maybe Context
+-- The state for CFG creation
+type CFGState = (ContState, M.Map Int CFG)
+
+type NodeState = ([(Source,Target)],[(Target,Source)])
+type IndirectGraph k a = ((M.Map k a),(M.Map k [k]))
+
+
+
+
+
+minNext :: Ord t => [t] -> [t] -> ([t], [t], Maybe t)
+minNext f@(x:xs) b@(y:ys) = if x < y then (xs, b, Just x)
+ else (f, ys, Just y)
+minNext (x:xs) [] = (xs, [], Just x )
+minNext [] (y:ys) = ([], ys, Just y )
+minNext [] [] = ([], [], Nothing)
+
+unpackst ((Source s), (Target t)) = (s,t)
+unpackts ((Target t), (Source s)) = (t,s)
+
+--createNodes :: [NInst] -> ContState -> IndirectGraph Int Block
+--createNodes xs (forwardRefs, backwardRefs) = evalState (createNodes' xs) (branches, bRefs)
+-- where branches = map reverse forwardRefs
+-- bRefs = map H.toAscList backwardRefs
+
+--createNodes' ::[NInst] -> State NodeState (IndirectGraph Int Block)
+{-createNodes' xs = do (st,ts) <- get
+ case (st,ts) of
+ -- there are back refs and forward refs
+ ((s,t):st', (t',s'):ts')
+ -> if t' `less` s
+ then do put (st,ts') -- back reference splits block
+ let (Target entry, Source source) = (t',s')
+ return (take entry xs, [])
+ else do put (st',ts)
+ let
+ _ -> undefined
+
+-}
+getCFG :: FilePath -> B.ByteString -> IO (Maybe CFG)
+getCFG file name = do context <- getMethodIO file name
+ return $ buildCFGContext context
+
+buildCFGContext :: MContext -> Maybe CFG
+buildCFGContext = liftM genCFGPure
+
+genCFGPure :: Context -> CFG
+genCFGPure (ins,cls) = let offsets = getInstOffsets ins
+ taggedInst = zip3 (map Source $ sumSeries'' offsets) offsets ins
+ cont = execState (findContinuations taggedInst) ([], H.empty)
+ in evalState (genCFGState taggedInst) (cont, M.empty)
+
+methodCodeM :: B.ByteString-> Maybe (Class Resolved)-> Maybe (Class Resolved, B.ByteString)
+methodCodeM name mcls = do cls <- mcls
+ ins <- methodCode cls name
+ return (cls,ins)
+
+getMethod :: FilePath-> B.ByteString-> IO (Maybe (B.ByteString, Class Resolved))
+getMethod file name = do cls <- parseClassFile file
+ return (methodCode cls name >>= \ins -> return (ins,cls))
+
+fullDecode :: (B.ByteString, t) -> ([J.Instruction], t)
+fullDecode (ins, cls) = (J.codeInstructions $ J.decodeMethod ins, cls)
+
+getMethodIO :: FilePath-> B.ByteString-> IO (Maybe ([J.Instruction], Class Resolved))
+getMethodIO file name = do context <- getMethod file name
+ return $ liftM fullDecode context
+
+
+genCFGState = undefined
+
+
--- /dev/null
+module Graph where
+
+import qualified Data.Set as S
+import qualified Data.Map as M
+import Data.Maybe
+import Control.Monad
+import Control.Monad.State
+
+data G a = Node a (G a) (G a)
+ | Leaf a
+ | Nil deriving (Show)
+
+type LoopCheck a = S.Set a
+
+
+{- Actually i am not sure about the cata and algebra definition.
+ -
+ - ** check: http://dl.acm.org/citation.cfm?id=128035
+ -}
+
+-- Represents an acumulator
+type TreeAlgebra a r = (a -> r, r -> r -> r)
+
+foldG :: TreeAlgebra a r -> r -> G a -> r
+foldG (f,g) s (Leaf val) = g (f val) s
+foldG (f,g) s (Node val l r) = g (f val) $ g (foldG (f,g) s l) (foldG (f,g) s r)
+
+printG = foldG ((: []), (++)) []
+
+loopCheck :: (Ord k) => G a -> (G a -> k) -> State (LoopCheck k) Bool
+loopCheck g f = do state <- get
+ return $ S.member (f g) state
+
+addNode :: (Ord k) => k -> State (LoopCheck k) ()
+addNode k = do s <- get
+ put $ S.insert k s
+ return ()
+
+foldGM :: (Ord k) => TreeAlgebra a r -> (G a -> k) -> r -> G a -> State (LoopCheck k) r
+foldGM _ _ s Nil = return s
+foldGM (f,g) c s k@(Leaf val) = loopCheck k c >>= \p -> if p then return s else return $ g (f val) s
+foldGM (f,g) c s k@(Node val l r) = loopCheck k c >>= \p -> if p then return s else continue
+ where t = foldGM (f,g) c s
+ self = g (f val)
+ continue = do addNode $ c k
+ left <- t l
+ right <- t r
+ return $ self $ g left right
+
+-- Generates a node from a list of children.
+packNodes :: [G a] -> a -> G a
+packNodes (x:y:[]) e = Node e x y -- full binary
+packNodes (x:[] ) e = Node e x Nil -- unary
+packNodes [] e = Leaf e -- leaf
+
+-- Generates a cyclic datastructure given edges and nodes
+-- TODO: remove lists with maps in inputs
+toG :: (Ord k) => ([r] -> a -> r) -> [(k,[k])] -> k -> [(k, a)] -> Maybe r
+toG g xs start pls = let nodeTable = M.fromList pls
+ payload s = case M.lookup s nodeTable of
+ Just x -> x
+ Nothing -> error "edge with no corresponding node"
+
+ conn = M.fromList $ map (
+ \(f,ts) -> let pl t = node f (payload t) t
+ succ = map pl ts
+ in (f, g succ (payload f))
+ ) xs
+
+ node f p t = case M.lookup t conn of
+ (Just x) -> x
+ Nothing -> error "illformed edge/node list in toG"
+ in M.lookup start conn
+
+
+
+testG = [(0,[1,2]),(1,[3]),(2,[0]),(3,[])]
+nodeLoads :: [(Int,String)]
+nodeLoads = [(0,"a"),(1,"b"),(2,"c"),(3,"d")]
+
+
+
module ScratchHS where
import Data.Maybe
-import qualified Data.Set as Set
-import Data.Set (Set)
-import qualified Data.Map as M
-import Data.Map (Map)
import Control.Monad.State
-import qualified Data.Heap as H
---import qualified Data.Heap as M
-
import Harpy hiding(fst,add)
import qualified Harpy.X86Disassembler as H
+import qualified Data.ByteString.Lazy as B
+import qualified Data.Set as S
+import qualified Data.Heap as H
import Foreign
-import Control.Monad
import Debug.Trace
import Data.Int
import JVM.Converter
import JVM.Dump
-import qualified JVM.Assembler as J
import JVM.Assembler
import Mate.Utilities
import Mate.BasicBlocks
-import qualified Data.ByteString.Lazy as B
-
+import Frontend
+import Graph
$(callDecl "callAsWord32" [t|Word32|])
return ()
-{- Thoughs on types and representations
- - We start from constructing a CFG. What do we need here
- - ** Fast traversal which is aware of cycles
- - ** Fast successor, do we need predecessors?
- - ** Find all paths to current node (including back references)
- - ** Generic Node type in order to write mentioned operations
- - generically. There should be no intermediate language "lock in"
- - i.e. adding another IR should not kill CFG code
- - Furthermore operations like SSA construction should
- - not affect the CFG datastructure. Nodes contents should be
- - interchangable in a way.
- - ** Some form of unique naming - we would like to identify blocks
- - and check whether code should be produced for this node
- - ** Should be Haskell idiomatic - should be composed with
- - standard haskell infrastructure
- - ** Convinient printing
- -
- - From this a inductive type should be appropriate?
- -
- -}
-
-data G a = Node a (G a) (G a)
- | Leaf a
- | Nil deriving(Show)
-
-
-testG = [(0,[1,2]),(1,[3]),(2,[0]),(3,[])]
-nodeLoads :: [(Int,String)]
-nodeLoads = [(0,"a"),(1,"b"),(2,"c"),(3,"d")]
-
-toG :: (Ord k, Show k) => [(k,[k])] -> k -> [(k, a)] -> Maybe (G a)
-toG xs start pls = let nodeTable = M.fromList pls
- payload s = fromJust $ M.lookup s nodeTable
-
- toBin xs pl = case xs of
- (x:y:[]) -> Node pl x y
- (x:[] ) -> Node pl x Nil
- ([] ) -> Leaf pl
-
- conn = M.fromList $ map (
- \(f,ts) -> let pl t = node f (payload t) t
- succ = map pl ts
- in (f, toBin succ (payload f))
- ) xs
-
- node f p t = case M.lookup t conn of
- (Just x) -> x
- in M.lookup start conn
-
-type LoopCheck a = Set a
-
-
-{- Actually i am not sure about the cata and algebra definition.
- -
- - check: http://dl.acm.org/citation.cfm?id=128035
- -}
-
-type TreeAlgebra a r = (a -> r, r -> r -> r)
-
-foldG :: TreeAlgebra a r -> r -> G a -> r
-foldG (f,g) s (Leaf val) = g (f val) s
-foldG (f,g) s (Node val l r) = g (f val) $ g (foldG (f,g) s l) (foldG (f,g) s r)
-
-printG = foldG ((: []), (++)) []
-
-loopCheck :: (Ord k) => G a -> (G a -> k) -> State (LoopCheck k) Bool
-loopCheck g f = do state <- get
- return $ Set.member (f g) state
-
-addNode :: (Ord k) => k -> State (LoopCheck k) ()
-addNode k = do s <- get
- put $ Set.insert k s
- return ()
-
-foldGM :: (Ord k) => TreeAlgebra a r -> (G a -> k) -> r -> G a -> State (LoopCheck k) r
-foldGM _ _ s Nil = return s
-foldGM (f,g) c s k@(Leaf val) = loopCheck k c >>= \p -> if p then return s else return $ g (f val) s
-foldGM (f,g) c s k@(Node val l r) = loopCheck k c >>= \p -> if p then return s else continue
- where t = foldGM (f,g) c s
- self = g (f val)
- continue = do addNode $ c k
- left <- t l
- right <- t r
- return $ self $ g left right
-
-methodCodeM :: B.ByteString-> Maybe (Class Resolved)-> Maybe (Class Resolved, B.ByteString)
-methodCodeM name mcls = do cls <- mcls
- ins <- methodCode cls name
- return (cls,ins)
-
-getMethod :: FilePath-> B.ByteString-> IO (Maybe (B.ByteString, Class Resolved))
-getMethod file name = do cls <- parseClassFile file
- return (methodCode cls name >>= \ins -> return (ins,cls))
-
-fullDecode :: (B.ByteString, t) -> ([J.Instruction], t)
-fullDecode (ins, cls) = (J.codeInstructions $ J.decodeMethod ins, cls)
-
-getMethodIO :: FilePath-> B.ByteString-> IO (Maybe ([J.Instruction], Class Resolved))
-getMethodIO file name = do context <- getMethod file name
- return $ liftM fullDecode context
-
-
-
-{- CFG generation
- - ......
- -}
-
--- Means NumberedINSruction
-type Size = Int
-type NInst = (Source, Size, J.Instruction)
--- Putting Source and Target in data types prevents from interchanging ;-)
-data Source = Source Int deriving (Eq, Ord, Show)
-data Target = Target Int deriving (Eq, Ord, Show)
--- Source, Target Instruction id
-type SourceTarget = (Source,Target)
--- State type for findContinuations
-type ContState = (H.MinPrioHeap Target Source, H.MinPrioHeap Source Target)
-
-findContinuations :: [NInst] -> State ContState ()
-findContinuations = mapM_ addCont
-
-addCont :: NInst -> State ContState ()
-addCont (s, b, IF_ICMP _ w) = do add s (addTarget s w); jmpNext s b;
-addCont (s, _, GOTO w) = add s (addTarget s w);
-addCont _ = return ();
-
-jmpNext :: Source -> Int -> State ContState ()
-jmpNext s@(Source i) o = add s (Target $ i + o)
-
-
-addTarget :: Source -> Word16 -> Target
-addTarget (Source s) w16 = Target $ fromIntegral result
- where result = s16 + fromIntegral w16 :: Int16
- s16 = fromIntegral s :: Int16
-
-
-addW16Signed :: Int -> Word16 -> Int
-addW16Signed i w16 = i + fromIntegral s16
- where s16 = fromIntegral w16 :: Int16
-
-
-add :: Source -> Target -> State ContState ()
-add s t = do (targetSource,sourceTarget) <- get
- put (H.insert (t, s) targetSource, H.insert (s,t) sourceTarget)
-
-getInstOffsets :: [J.Instruction] -> [Int]
-getInstOffsets = map (\i -> fromIntegral $ B.length $ J.encodeInstructions [i])
-
-sumSeries'':: [Int] -> [Int]
-sumSeries'' = reverse . snd . foldl (\(s,xs) x -> (s+x,s : xs)) (0,[])
-
-
-
-data Block = BB [NInst] deriving (Show)
-type CFG = G Block
-
--- Context of the Method to be compiled
-type Context = ([J.Instruction],Class Resolved)
--- Maybe a context of the Method to be compiled
-type MContext = Maybe Context
--- The state for CFG creation
-type CFGState = (ContState, M.Map Int CFG)
-
-
-getCFG :: FilePath -> B.ByteString -> IO (Maybe CFG)
-getCFG file name = do context <- getMethodIO file name
- return $ buildCFGContext context
-
-buildCFGContext :: MContext -> Maybe CFG
-buildCFGContext = liftM genCFGPure
-
-genCFGPure :: Context -> CFG
-genCFGPure (ins,cls) = let offsets = getInstOffsets ins
- taggedInst = zip3 (map Source $ sumSeries'' offsets) offsets ins
- cont = execState (findContinuations taggedInst) (H.empty,H.empty)
- in evalState (genCFGState taggedInst) (cont, M.empty)
-
-
-joinM :: Maybe a -> Maybe b -> Maybe (a,b)
-joinM Nothing _ = Nothing
-joinM _ Nothing = Nothing
-joinM (Just a) (Just b) = Just (a,b)
-
-joinM' = uncurry joinM
-
-leq :: Target -> Source -> Bool
-leq (Target t) (Source s) = t <= s
-
-getCont :: State CFGState ContState
-getCont = do ((ts,st),_) <- get
- return (ts,st)
-
-
-takeTill :: Int -> [NInst] -> ([NInst],[NInst])
-takeTill ref = span (\(Source loc,s,inst) -> loc < ref)
-
-
-writeBack :: ContState -> State CFGState ()
-writeBack s = do (_,cls) <- get
- put (s,cls)
-
-from :: Int -> [NInst] -> [NInst]
-from ref = dropWhile (\(Source loc,s,inst) -> loc < ref)
-
-
-data Branch = BackRef Target Source
- | ForwardRef Source [Target] deriving (Show)
-
-
-
-getForwardRef ts s' t' restForward restBack =
- do writeBack (ts, restForward) -- remove forward ref from state
- -- maybe this one is a twoRef
- anotherOne <- getNextBranch
- case anotherOne of
- Just (ForwardRef s'' t'')
- -- If the next reference has the same source concat them
- -> if s'' == s' then return $ Just $ ForwardRef s' (t' : t'')
- else return $ Just $ ForwardRef s' [t']
- Nothing -> --fail ("bahh" ++ show s' ++ show t')
- return $ Just $ ForwardRef s' [t']
-
-getNextBranch :: State CFGState (Maybe Branch)
-getNextBranch = do ((ts,st),m) <- get
- case joinM' (H.view ts, H.view st) of
- -- Here we found the next front and the next back reference.
- -- which one is earlier
- Just ( ( (t,s), restBack), ( (s',t'), restForward) )
- -> if t `leq` s
- then -- back reference
- do writeBack (restBack, st) -- remove back reference from ref state
- return $ Just $ BackRef t s
- else -- forward reference
- --getForwardRef ts s' t' restForward restBack
- do writeBack (ts,restForward)
- return $ Just $ ForwardRef s' [t']
- Nothing -> return Nothing
-
-
-genCFGState :: [NInst] -> State CFGState CFG
-genCFGState xs = do nextBranch <- getNextBranch
- case nextBranch of
- Nothing -> return $ Leaf $ BB xs
- Just (BackRef (Target t) (Source s))
- -> do
- let (previousBlock,rest) = takeTill t xs
- (refs,m) <- get
- let patched = let p = M.insert s c m
- c = evalState (genCFGState rest) (refs,p)
- in c
- return patched
- Just (ForwardRef _ _)
- -> do (_,m) <- get
- let t = 4
- fail "sjdf"
- case M.lookup t m of
- Nothing -> return $ Leaf $ BB xs
- Just b -> return (Node (BB xs) b Nil)
- _ -> fail (show nextBranch)
- -- return $ Leaf $ BB xs
-{-
-genCFGState :: [NInst] -> State CFGState (CFG, M.Map Source CFG)
-genCFGState xs = do (ts,st) <- getCont
- case joinM' (H.view ts, H.view st) of
- Just ( ( (t, s), backRef), ( (s', t'), sndBranch) )
- -> if t `leq` s then do writeBack (backRef,st);
- runUntilBackRef (t , s )
- else runUntilBranch (s', t') sndBranch ts
- Nothing
- -> runUntilExit
- where
- -- There is no back reference left. Run block until Control leaves.
- runUntilExit = fail "run until exit" --Nothing = return takeWhile (\(s,w,inst) -> undefined) undefined
-
- -- In the program future a goto lands at this instruction.
- runUntilBackRef (Target ref,_) =
- do
- let (block,rest) = takeTill ref xs
- (followUpBlock,_) <- genCFGState rest
- let cfg = Node (BB block) followUpBlock Nil
- return $ (cfg, M.empty)
-
- runUntilBranch (Source s,Target t) st ts =
- do
- let (block,rest) = takeTill (s+1) xs
- -- check wheter this instruction branches also to another location
- case H.view st of
- Just ((Source sndBr, Target t),restBranches)
- -> if sndBr == s then do writeBack (ts,restBranches)
- twoBranch sndBr t block
- else oneBranch block
- Nothing -> oneBranch block
- where twoBranch sndBranch t' block =
- do (left, _) <- genCFGState $ from t xs
- (right,_) <- genCFGState $ from t' xs
- return $ (Node (BB block) left right, M.empty)
- oneBranch block = return (Leaf (BB block), M.empty) --fail $ "oneBranch" ++ (show s) ++ " " ++ (show st)
--}
-
fib = do con@(Just (ins,cls)) <- getMethodIO "../tests/Fac.class" "facFor"
let offsets = getInstOffsets ins
let taggedInst = zip3 (map Source $ sumSeries'' offsets) offsets ins
mapM_ print taggedInst
- let continuations = execState (findContinuations taggedInst) (H.empty, H.empty)
+ let continuations = execState (findContinuations taggedInst) ([],H.empty)
print continuations
let cfg = buildCFGContext con
print cfg
return cfg
-
+
+fib' = do con@(Just (ins,cls)) <- getMethodIO "../tests/Fac.class" "facFor"
+ let tagged = getInstructions ins
+ print tagged
+ let backRefs = splitBlocksBackRef tagged
+ let splitted = splitBlocks backRefs tagged
+ print splitted
+ let transitions = getTransitions splitted
+ let nodes = getNodes splitted
+ print "nodes:"
+ print nodes
+ print "transitions"
+ print transitions
+ let (Just finalCyclicStructure) = indirectCFGToG splitted
+ print "Final result"
+ print $ printG' finalCyclicStructure
diamant :: G String
printG' :: Ord k => G k -> [k]
-printG' g = evalState (foldGM ((: []), (++)) (\node -> let (Just v) = value node in v) [] g) Set.empty
+printG' g = evalState (foldGM ((: []), (++)) (\node -> let (Just v) = value node in v) [] g) S.empty
projects / mate.git / commitdiff