content: {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE NoMonomorphismRestriction #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  -- Purpose of this file is just do test some Intermediate representations and stuff ;-)
  
  {- Some important material:
   - 
   - Java HotSpot™ Client Compiler: www.cdl.uni-saarland.de/ssasem/talks/Christian.Wimmer.pdf
   - http://www.complang.tuwien.ac.at/andi/185A50
   - 
   - [Poletto:1999] http://dl.acm.org/citation.cfm?doid=330249.330250
   - [Wimmer:2010] http://dl.acm.org/citation.cfm?id=1772954.1772979
   -
   -}
  
  
  module ScratchHS where
  
  import Data.Maybe
  import Control.Monad.State
  
  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 Debug.Trace
  import Data.Int
  
  import JVM.ClassFile
  import JVM.Converter
  import JVM.Dump
  
  import JVM.Assembler 
  
  import Mate.Utilities
  import Mate.BasicBlocks
  
  import Frontend
  import Graph
  
  $(callDecl "callAsWord32" [t|Word32|])
  
  data SimpleStack = PushLit Int
                   | Mul
                   | Add
                   | Ld String
                   | Print
  
  testP = [PushLit 3, PushLit 2, Mul]
  
  type Reg = Int 
  data ROp = RMul | RAdd
  
  data RegIL = RMov Reg Reg
             | RLoad Reg String 
             | RBin  Reg Reg Reg ROp
  
  data MateState = MateState String
  
  compileRegIL :: RegIL -> CodeGen (Ptr Int32) MateState ()
  compileRegIL (RMov t s) = do 
                             mateState <- getState
                             let (mt,ms) = (eax,eax)
                             mov mt ms
  
  
  entryCode :: CodeGen e s ()
  entryCode = do push ebp
                 mov ebp esp
  
  exitCode :: CodeGen e s ()
  exitCode = do mov esp ebp
                pop ebp 
                ret
  
  
  
  run :: [RegIL] -> Ptr Int32 -> IO (MateState, Either ErrMsg [H.Instruction])
  run program env = let compileAndFeedback = mapM_ compileRegIL program >> disassemble
                    in runCodeGen compileAndFeedback env (MateState "none")
  
  
  -- Allocates a buffer with size n. All zero.
  emptyMemory ::  (Storable a, Num a) => Int -> IO (Ptr a)
  emptyMemory n = mallocArray n 
                    >>= (\ptr -> pokeArray ptr (replicate n 0) >> return ptr)
  
  
  testEnv p' = do 
                ptr <- emptyMemory 26
                (_, Right code) <- run p' ptr
                return $ map H.showIntel code
  
  
  simpleTest ::  [RegIL]
  simpleTest = [RMov 0 1]
  
  
  -- Just some class file sand
  loadMethod methodName classFile = do cls <- parseClassFile classFile
                                       dumpClass cls
                                       return (cls, lookupMethod methodName cls)
  
  
  getFib = do (cls, Just m) <- loadMethod "fac" "../tests/Fac.class"
              return (cls, m)
  
  fibBasicBlocks = do (cls,m) <- getFib
                      hmap <- parseMethod cls "facFor"
                      printMapBB hmap
                      return ()
  
  
  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)
           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
  
  main = do con@(Just (ins,cls)) <- getMethodIO "../tests/AbsurdlyHuge.class" "absurdlyHuge"
            let tagged = getInstructions ins
            let backRefs = splitBlocksBackRef tagged
            let splitted = splitBlocks backRefs tagged
            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
  diamant = let start = Node "a" left right
                left  = Node "l" end Nil
                right = Node "r" end Nil
                end   = Node "g" start Nil
            in start
  
  dag = Node "a" (Node "b" (Leaf "c") (Leaf "d")) (Node "b" (Leaf "c") (Leaf "d"))
  
  
  value (Node val _ _) = Just val
  value (Leaf val    ) = Just val
  value Nil            = Nothing
                                            
  
  printG' ::  Ord k => G k -> [k]
  printG' g = evalState (foldGM ((: []), (++)) (\node -> let (Just v) = value node in v) [] g) S.empty
  