--- /dev/null
+module Analysis where
+
+import Control.Monad.State
+
+type Addr = Int
+
+data StackIL = Dup | Ld Addr Type | Add Type | Store Addr Type
+
+type Target = (Int,Type)
+type Source = (Int,Type)
+
+tmpReg = 10
+
+data RegIL = RMov Target Source | RAdd Target Source Source
+ | RStore Addr Source | RLoad Source Addr deriving Show
+
+data Type = Int | Bottom deriving (Show,Eq)
+
+type StackElem = (Int,Type)
+
+type Stack = [StackElem]
+
+dup :: State Stack ()
+dup = modify (\(top@(i,t):x) -> (i+1,t) : top : xs)
+
+push :: Type -> State Stack Int
+push t = do tos <- get
+ case tos of
+ top@(i,_):xs -> put ((i + 1, t) : top : xs) >> return i
+ [] -> put [(0,t)] >> return 0
+
+pop :: State Stack StackElem
+pop = do x:xs <- get
+ put xs
+ return x
+
+nextElem :: State Stack Int
+nextElem = fmap ((+ 1) . fst . head) get
+
+aInterpret' :: StackIL -> State Stack [RegIL]
+aInterpret' Dup = dup >> return []
+aInterpret' (Ld addr t) = do s <- push t
+ return [RLoad (s,t) addr]
+aInterpret' (Store addr t) = do (xA,tA) <- pop
+ return [RStore addr (xA,tA)]
+aInterpret' (Add t) = do (iA,ta) <- pop
+ (iB,tb) <- pop
+ push ta
+ if ta /= t || tb /=t then error "type mismatch in add"
+ else return [ RAdd (tmpReg,ta) (iA,ta) (iB,tb),
+ RMov (iB,tb) (tmpReg,ta)]
+
+aInterpret :: [StackIL] -> State Stack [RegIL]
+aInterpret = foldr (liftM2 (++) . aInterpret') (return [])
+
+generateRegisterIR :: [StackIL] -> [RegIL]
+generateRegisterIR = (`evalState` []) . aInterpret
+
+--data StackIL = Dup | Ld Addr Type | Add Type | Store Addr Type
+testCase1 = [ Ld 0 Int, Ld 1 Int, Dup , Add Int, Add Int, Store 0 Int]
+++ /dev/null
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ExistentialQuantification #-}
-module GC where
-
-import Control.Monad
-
-import Foreign.Ptr
-import Foreign.Marshal.Alloc
-import Foreign.Storable
-import Foreign.C.Types
-import GHC.Int
-import Text.Printf
-
-class RefObject a where
- mem :: a -> IntPtr
- refs :: a -> [IntPtr]
-
-
-data RefObj = RefObj IntPtr [IntPtr] deriving Show
-
-instance RefObject RefObj where
- mem (RefObj mem _ ) = mem
- refs (RefObj _ refs) = refs
-
-data Succ = forall a. (RefObject a) => Succ (a -> [a])
-
-obj2 = do buffer <- mallocBytes 4
- pokeByteOff buffer 0 (0::Int32)
- return buffer
-
-obj3 = do buffer <- mallocBytes 4
- pokeByteOff buffer 0 (0::Int32)
- return buffer
-
-obj1 f g = do buffer <- mallocBytes 12
- pokeByteOff buffer 0 (2::Int32)
- pokeByteOff buffer 4 f
- pokeByteOff buffer 8 g
- return buffer
-
-ptrToRefObj ptr = do objCount <- peek ptr :: IO Int32
- let objsBase = ptr `plusPtr` 4
- objs <- mapM ((liftM ptrToIntPtr) . peekElemOff objsBase . fromIntegral) [0..objCount-1]
- return $ RefObj (ptrToIntPtr ptr) objs
-
-test1 = do f <- obj2
- g <- obj3
- (print . ptrToIntPtr) f
- (print . ptrToIntPtr) g
- ptrToRefObj =<< obj1 f g
-
-traverse :: (RefObject a) => (IntPtr -> IO a) -> a -> [a] -> IO [a]
-traverse dereference x ws = do children <- mapM dereference (refs x)
- undefined
-
-succMem :: Ptr a -> Succ
-succMem =undefined-- Succ (\_ -> obj1
-
-
-