linearscan-hoopl 0.5.0.0 → 0.5.1.0

raw patch · 5 files changed

+58/−55 lines, 5 filesdep ~hoopldep ~linearscandep ~linearscan-hooplPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: hoopl, linearscan, linearscan-hoopl

API changes (from Hackage documentation)

Files

• LinearScan/Hoopl.hs +33/−1
• LinearScan/Hoopl/DSL.hs +3/−3
• linearscan-hoopl.cabal +4/−4
• test/AsmTest.hs +17/−46
• test/Assembly.hs +1/−1

@@ -11,12 +11,14 @@ import           Control.Applicative import           Control.Arrow import           Control.Monad.Trans.Class-import           Control.Monad.Trans.State (State, get, put, modify)+import           Control.Monad.Trans.State (evalStateT, modify)+import           Data.Foldable import qualified Data.Map as M import           Data.Monoid import           Debug.Trace import           LinearScan import           LinearScan.Hoopl.DSL+import           Unsafe.Coerce  class HooplNode (n v) => NodeAlloc n v r | n -> v, n -> r where     fromVar :: v -> Either PhysReg VarId@@ -106,3 +108,33 @@            NodeOO n -> op1ToString n            NodeOC n -> op1ToString n     }++newtype SimpleUniqueMonad' a = SUM' { unSUM' :: [Int] -> (a, [Int]) }++runSimpleUniqueMonad' :: Int -> SimpleUniqueMonad a -> a+runSimpleUniqueMonad' start m = fst (unSUM' (unsafeCoerce m) [start..])++allocateHoopl :: (NonLocal (n v), NonLocal (n r), NodeAlloc n v r)+              => Int             -- ^ Number of machine registers+              -> Int             -- ^ Offset of the spill stack+              -> Int             -- ^ Size of spilled register in bytes+              -> Label           -- ^ Label of graph entry block+              -> Graph (n v) C C -- ^ Program graph+              -> Either String (Graph (n r) C C)+allocateHoopl regs offset slotSize entry graph =+    newGraph <$> runSimpleUniqueMonad' (1 + length blocks) go+  where+    newGraph xs = GMany NothingO (newBody xs) NothingO+      where+        newBody = Data.Foldable.foldl' (flip addBlock) emptyBody++    blocks = postorder_dfs_from body entry+      where+        GMany NothingO body NothingO = graph++    go = evalStateT alloc (newEnvState offset slotSize)+      where+        alloc = allocate regs (blockInfo getBlockId) opInfo blocks+          where+            getBlockId :: Hoopl.Label -> Env Int+            getBlockId = return . unsafeCoerce

@@ -39,11 +39,11 @@     , stackSlots    = mempty     } -newEnvState :: EnvState-newEnvState = EnvState+newEnvState :: Int -> Int -> EnvState+newEnvState offset slotSize = EnvState     { envLabels      = mempty     , envBlockIds    = mempty-    , envSpillStack  = newSpillStack 0 8+    , envSpillStack  = newSpillStack offset slotSize     , envAssignments = mempty     } 

@@ -1,5 +1,5 @@ name:          linearscan-hoopl-version:       0.5.0.0+version:       0.5.1.0 synopsis:      Makes it easy to use the linearscan register allocator with Hoopl homepage:      http://github.com/jwiegley/linearscan-hoopl license:       BSD3@@ -45,9 +45,9 @@       , linearscan       , hspec              >= 1.4.4       , hspec-expectations >= 0.3-      , hoopl              >= 3.10.0.1-      , linearscan         >= 0.4.0.0-      , linearscan-hoopl+      , hoopl              >= 3.10.0.1 && < 3.11+      , linearscan         >= 0.5.0.0+      , linearscan-hoopl   >= 0.5.0.0       , containers         >= 0.5.5       , transformers       >= 0.3.0.0       , lens-family-core

@@ -2,65 +2,36 @@  module AsmTest where -import           Assembly-import           Compiler.Hoopl as Hoopl hiding ((<*>))-import           Control.DeepSeq-import           Control.Exception-import           Control.Monad.Trans.State (evalStateT, gets)-import           Data.Foldable-import qualified Data.Map as M-import           Data.Maybe (fromMaybe)-import           LinearScan-import           LinearScan.Hoopl-import           LinearScan.Hoopl.DSL-import           Normal ()-import           Test.Hspec+import Assembly+import Compiler.Hoopl as Hoopl hiding ((<*>))+import Control.Exception+import LinearScan+import LinearScan.Hoopl+import LinearScan.Hoopl.DSL+import Normal ()+import Test.Hspec  asmTestLiteral :: Int -> Program (Node IRVar) -> String -> Expectation asmTestLiteral regs program expected = do-    let eres = runSimpleUniqueMonad $ do-            x <- compile "entry" program-            uncurry runTest x-    case eres of+    let (graph, entry) = runSimpleUniqueMonad $ compile "entry" program+    case allocateHoopl regs 0 8 entry graph of         Left err -> error $ "Allocation failed: " ++ err-        Right blks -> do-            let graph' = newGraph $!! blks+        Right graph' -> do             let g = showGraph show graph'             catch (g `shouldBe` expected) $ \e -> do-                let input = runSimpleUniqueMonad $ compile "entry" program-                putStrLn $ "---- Parsed ----\n" ++ showGraph show (fst input)+                putStrLn $ "---- Parsed ----\n" ++ showGraph show graph                 putStrLn $ "---- Expecting ----\n" ++ expected                 putStrLn $ "---- Compiled  ----\n" ++ g                 putStrLn "-------------------"                 throwIO (e :: SomeException)-  where-    runTest prog entry =-        go $ M.fromList $ zip (Prelude.map entryLabel blocks) [(0 :: Int)..]-      where-        GMany NothingO body NothingO = prog-        blocks = postorder_dfs_from body entry -        alloc = allocate regs (blockInfo getBlockId) opInfo $!! blocks-          where-            getBlockId :: Hoopl.Label -> Env Int-            getBlockId lbl = do-                bids <- gets envBlockIds-                return $ fromMaybe-                    (error $ "Unable to find block at label " ++ show lbl)-                    (M.lookup lbl bids)--        go blockIds = evalStateT alloc (newEnvState { envBlockIds = blockIds })--    newBody = Data.Foldable.foldl' (flip addBlock) emptyBody-    newGraph xs = GMany NothingO (newBody xs) NothingO- asmTest :: Int         -> Program (Node IRVar)         -> Program (Node (Assign VarId PhysReg))         -> Expectation-asmTest regs program expected+asmTest regs program     = asmTestLiteral regs program-    $ showGraph show-    $ fst-    $ runSimpleUniqueMonad-    $ compile "entry" expected+    . showGraph show+    . fst+    . runSimpleUniqueMonad+    . compile "entry"

@@ -157,7 +157,7 @@ instance Show a => Show (Assign a PhysReg) where     show (Assign v (-1)) = "<<v" ++ show v ++ ">>"     -- show (Assign v r)    = "r" ++ show r ++ "|v" ++ show v-    show (Assign v r)    = show r+    show (Assign _ r)    = show r  data IRVar = PhysicalIV PhysReg | VirtualIV Int deriving Eq