use lookup table for acc

tranma · Jun 26, 2013 · 99877a9 · 99877a9
1 parent 7b5a962
commit 99877a9
Show file tree

Hide file tree

Showing 10 changed files with 163 additions and 181 deletions.
diff --git a/Makefile b/Makefile
@@ -24,9 +24,12 @@ GHC_WARNINGS	:= \
 	-fwarn-unused-imports \
 	-fno-warn-missing-methods
 
-$(PROGNAME): accelerate/Main.hs
+accelerate: accelerate/Main.hs
 	ghc $(GHC_OPTS) $(GHC_WARNINGS) --make accelerate/Main.hs
 
+repa: repa/Main.hs
+	ghc $(GHC_OPTS) $(GHC_WARNINGS) --make repa/Main.hs
+
 clean:
-	rm -f *.hi *.o *_stub.c *_stub.h $(PROGNAME)
-.PHONY: clean
+	rm -f accelerate/*.{hi,o} repa/*.{hi,o} accelerate/Main repa/Main
+.PHONY: repa accelerate clean
diff --git a/accelerate/Alchemy.hs b/accelerate/Alchemy.hs
@@ -1,8 +1,8 @@
 module Accelerate.Alchemy where
 
 import Prelude as P
-import Data.Array.Accelerate
-
+import Data.Array.Accelerate as A
+import Repa.Alchemy(applyAlchemy')
 import Accelerate.World
 
 mkExp2
@@ -12,76 +12,20 @@ mkExp2
   -> Exp a -> Exp a -> Exp a                -- if then else expression
 mkExp2 (v1,v2) (p1,p2) = P.curry ((p1 v1 &&* p2 v2) ?)
 
-applyAlchemy :: Exp Int -> Exp Element -> Exp Element -> Exp (Element, Element)
-applyAlchemy r x y = foldr (P.uncurry $ mkExp2 (x,y)) (lift (x,y))
-        -- water + salt = salt_water + nothing
-       [((==* 7),(==* 10)) ~> lift (salt_water, nothing)
-       , ((==* 10),(==* 7)) ~> lift (nothing, salt_water)
-
-       -- steam condenses: <some wall> + steam = <wall> + condensed steam
-       , (isWall,(==* 1)) ~> lift (wall, steam_condensed)
-       , ((==* 1),isWall) ~> lift (steam_condensed, wall)
-
-       -- water evaporates: water/salt_water + <some fire> = steam + nothing
-       , ((==* 7),isFire) ~> lift (steam_water, nothing)
-       , (isFire,(==* 7)) ~> lift (nothing, steam_water)
-       , (isFire,(==* 8)) ~> lift (steam_water, salt)
-       , ((==* 8),isFire) ~> lift (steam_water, salt)
-
-       -- oil catches fire: oil + <some fire> = (==* 2) x new fire
-       , ((==* 6),isFire) ~> lift (fire, fire)
-       , (isFire,(==* 6)) ~> lift (fire, fire)
-
-       -- torch generates fire: torch + nothing = torch + fire
-       , ((==* 0),(==* 23)) ~> lift (fire, torch)
-       , ((==* 23),(==* 0)) ~> lift (torch, fire)
-
-       -- spout generates water: spout + nothing = spout + water
-       , ((==* 25),(==* 0)) ~> lift (spout, water)
-       , ((==* 0),(==* 25)) ~> lift (water, spout)
+alchemyTable :: Acc (Array DIM2 (Int, (Element, Element), (Element, Element)))
+alchemyTable = use $ A.fromList (Z :. P.fromIntegral wall + 1 :. P.fromIntegral wall + 1) 
+               [ case applyAlchemy' x y
+                  of Left (a,b) -> (0,(a,b),(a,b))
+                     Right x    -> x 
+               | x <- [0..wall] 
+               , y <- [0..wall]
+               ]
 
-       -- fire burns plant: <some fire> + plant = new fire + sand
-       , (isFire,(==* 24)) ~> ( r <* 20  ? (lift (sand, fire) , lift (fire, fire)))
-       , ((==* 24),isFire) ~> ( r <* 20  ? (lift (fire, sand) , lift (fire, fire)))
 
-       -- water grows plant: water + plant = (==* 2) x plant
-       , ((==* 7),(==* 24)) ~> lift (plant, plant)
-       , ((==* 24),(==* 7)) ~> lift (plant, plant)
 
-       -- water eroses metal: water/salt_water + metal = water/salt_water + sand
-       , ((==* 26),(==* 7)) ~> ( r <* 1  ? (lift (sand, water) , lift (metal, water)))
-       , ((==* 7),(==* 26)) ~> ( r <* 1  ? (lift (water, sand) , lift (water, metal)))
-       , ((==* 26),(==* 8)) ~> ( r <* 3  ? (lift (sand, salt_water) , lift (metal, salt_water)))
-       , ((==* 8),(==* 26)) ~> ( r <* 3  ? (lift (salt_water, sand) , lift (salt_water, metal)))
-
-       -- lava + stone = (==* 2) x lava
-       , ((==* 27),(==* 11)) ~> ( r <* 5 ? (lift (lava, lava) , lift (lava, stone)))
-       , ((==* 11),(==* 27)) ~> ( r <* 5 ? (lift (lava, lava) , lift (stone, lava)))
-
-       -- lava + metal/sand/salt = (==* 2) x lava
-       , ((==* 27),(==* 26)) ~> ( r <* 1  ? (lift (lava, lava) , lift (lava, metal)))
-       , ((==* 26),(==* 27)) ~> ( r <* 1  ? (lift (lava, lava) , lift (metal, lava)))
-       , ((==* 27),(==* 9)) ~> ( r <* 50  ? (lift (lava, lava) , lift (lava, sand)) )
-       , ((==* 9),(==* 27)) ~> ( r <* 50  ? (lift (lava, lava) , lift (sand, lava)) )
-       , ((==* 27),(==* 10)) ~> ( r <* 50  ? (lift (lava, lava) ,lift  (lava, salt)))
-       , ((==* 10),(==* 27)) ~> ( r <* 50  ? (lift (lava, lava) ,lift  (salt, lava)))
-
-       -- lava + oil/plant = lava + fire
-       , ((==* 27),(==* 6))  ~> ( r <* 80  ? (lift (lava, fire) , lift (lava, oil)))
-       , ((==* 6),(==* 27))  ~> ( r <* 80  ? (lift (fire, lava) , lift (oil, lava)))
-       , ((==* 27),(==* 24)) ~> ( r <* 80  ? (lift (lava, fire) , lift (lava, plant)))
-       , ((==* 24),(==* 27)) ~> ( r <* 80  ? (lift (fire, lava) , lift (plant, lava)))
-
-       -- water + lava = steam + stone
-       , ((==* 7),(==* 27)) ~> lift (steam_water, stone)
-       , ((==* 27),(==* 7)) ~> lift (stone, steam_water)
-
-       -- salt_water + lava = steam + stone OR steam + salt
-       , ((==* 8),(==* 27)) ~> ( r <* 20 ? (lift (steam_water, salt) , lift (steam_water, stone)))
-       , ((==* 27),(==* 8)) ~> ( r <* 20 ? (lift (salt, steam_water) , lift (stone, steam_water)))
-       ]
-  where (~>) :: a -> b -> (a,b)
-        (~>) = (,)
+applyAlchemy :: Exp Int -> Exp Element -> Exp Element -> Exp (Element, Element)
+applyAlchemy r x y =  let (i, t, e) = unlift $ alchemyTable ! lift (Z :. A.fromIntegral x :. A.fromIntegral y)
+                       in (r <* i) ? (t , e)
 
 
 
diff --git a/accelerate/Gravity.hs b/accelerate/Gravity.hs
@@ -3,11 +3,10 @@ module Accelerate.Gravity
       (applyGravity)
 where
 
-import Data.Bits
-import Language.Literals.Binary
 import Data.Array.Accelerate as A
 import Prelude as P
 import Common.World
+import Repa.Gravity(applyGravity')
 
 -- Black magic for gravity
 -- Possible values:
@@ -23,76 +22,11 @@ import Common.World
 --  ~ focused     01
 --
 
-mkExp
-  :: (Elt a, Elt v)
-  => (Exp v)                    -- input argument
-  -> (Exp v -> Exp Bool)        -- predicate on input argument
-  -> Exp a -> Exp a -> Exp a    -- if then else expression
-mkExp v1 p1 = P.curry (p1 v1 ?)
-
 {-# INLINE applyGravity #-}
 applyGravity :: Exp WeightEnv -> Exp MargPos -> Exp MargPos
-applyGravity x n = let (a,b,c,d) = unlift $ applyGravity' x
+applyGravity x n = let (a,b,c,d) = A.unlift $ gravityArray A.!! (A.fromIntegral x)
                     in (n ==* 0) ? (a , (n ==* 1) ? (b, (n ==* 2) ? (c,d)))
 
-{-# INLINE ignoreL #-}
-ignoreL :: Exp MargPos -> Exp WeightEnv -> Exp WeightEnv
-ignoreL n x = x .&. (A.rotateL [b|11 11 11 01|] (n * 2))
+gravityArray :: Acc (Array DIM1 (MargPos, MargPos, MargPos, MargPos))
+gravityArray = A.use $ fromList (Z :. 255) $ P.map applyGravity' [0..255]
 
-{-# INLINE applyGravity' #-}
-applyGravity' :: Exp WeightEnv -> Exp (MargPos, MargPos, MargPos, MargPos)
-applyGravity' wenv = foldr (P.uncurry $ mkExp wenv) (foldr (P.uncurry $ mkExp (wenv .&. [b|01010101|])) (lift' (0,1,2,3)) elseList) thenList
-  where (~>) a b = (a,b)
-        thenList :: [(Exp WeightEnv -> Exp Bool, Exp (MargPos, MargPos, MargPos, MargPos))]
-        elseList :: [(Exp WeightEnv -> Exp Bool, Exp (MargPos, MargPos, MargPos, MargPos))]
-        lift' :: (MargPos,MargPos,MargPos,MargPos) -> Exp (MargPos,MargPos,MargPos,MargPos) 
-        lift' = lift
-        thenList =
-                   -- L L --> L L
-                   -- L ~     ~ L
-                   [ ((==*[b|00 11 11 11|]) . ignoreL 3) ~> lift' (0,1,3,2)
-                   -- L L -~> L L
-                   -- ~ L     L ~
-                   , ((==*[b|11 00 11 11|]) . ignoreL 2) ~> lift' (0,1,3,2)
-                   -- L ~ -~> ~ L
-                   -- * *     * *
-                   , ((==*[b|01 01 00 11|]) . ignoreL 1 . ignoreL 2 . ignoreL 3) ~> lift' (1,0,2,3)
-                   -- ~ L -~> L ~
-                   -- * *     * *
-                   , ((==*[b|01 01 11 00|]) . ignoreL 0 . ignoreL 2 . ignoreL 3) ~> lift' (1,0,2,3)
-                   -- ~ ~ -~> ~ ~
-                   -- L ~     ~ L
-                   , ((==*[b|00 11 00 00|]) . ignoreL 0 . ignoreL 1 . ignoreL 3) ~> lift' (0,1,3,2)
-                   -- ~ ~ -~> ~ ~
-                   -- ~ L     L ~
-                   , ((==*[b|11 00 00 00|]) . ignoreL 0 . ignoreL 1 . ignoreL 2) ~> lift' (0,1,3,2)
-                   ]
-        elseList =
-                   -- * ~ -~> ~ ~
-                   -- ~ ~     * ~
-                   [ (==*[b|00 00 00 01|]) ~> lift' (2,1,0,3)
-                   -- * * -~> * ~
-                   -- * ~     * *
-                   , (==*[b|00 01 01 01|]) ~> lift' (0,3,2,1)
-                   -- * * -~> ~ ~
-                   -- ~ ~     * *
-                   , (==*[b|00 00 01 01|]) ~> lift' (2,3,0,1)
-                   -- ~ * -~> ~ ~
-                   -- * ~     * *
-                   , (==*[b|00 01 01 00|]) ~> lift' (0,3,2,1)
-                   -- ~ * -~> ~ ~
-                   -- ~ ~     ~ *
-                   , (==*[b|00 00 01 00|]) ~> lift' (0,3,2,1)
-                   -- * * -~> ~ *
-                   -- ~ *     * *
-                   , (==*[b|01 00 01 01|]) ~> lift' (2,1,0,3)
-                   -- * ~ -~> ~ ~
-                   -- ~ *     * *
-                   , (==*[b|01 00 00 01|]) ~> lift' (2,1,0,3)
-                   -- * ~ -~> ~ ~
-                   -- * ~     * *
-                   , (==*[b|00 01 00 01|]) ~> lift' (3,1,2,0)
-                   -- ~ * -~> ~ ~
-                   -- ~ *     * *
-                   , (==*[b|01 00 01 00|]) ~> lift' (0,2,1,3)
-                   ]
diff --git a/accelerate/Step.hs b/accelerate/Step.hs
@@ -18,6 +18,7 @@ import Accelerate.Alchemy
 --import Accelerate.World
 import Random.Array
 
+type Env4 = (Cell, Cell, Cell, Cell)
 
 step :: Int -> Acc (Matrix MargPos) -> Acc (Matrix Cell) -> Acc (Matrix Cell)
 step gen mask array
@@ -30,18 +31,21 @@ step gen mask array
       $ A.map weigh envs
     where -- Swap cell at position 'p' in the margolus block 'env' with
           --    the cell at 'pos' in the same block
-          mkCell :: Exp (Env, MargPos) -> Exp MargPos -> Exp Cell
+          mkCell :: Exp (Env4, MargPos) -> Exp MargPos -> Exp Cell
           mkCell x pos = margQuadrant pos $ A.fst x
 
 
 -- | Mask to extract cell at quadrant 'pos'
 
-margQuadrant :: Exp MargPos -> Exp Env -> Exp Cell
-margQuadrant pos = flip A.shiftR (8 * pos) . (.&. A.shiftL 0xff (8 * pos))
+margQuadrant :: Exp MargPos -> Exp (Cell, Cell, Cell, Cell) -> Exp Cell
+margQuadrant p (A.unlift -> (x0,x1,x2,x3)) = (p ==* 0) ? (x0
+                                           , (p ==* 1) ? (x1
+                                           , (p ==* 2) ? (x2
+                                           , x3)))
 
 
 -- | Break up the environment into its four components
-
+{-
 split :: Exp Env -> (Exp Cell, Exp Cell, Exp Cell, Exp Cell)
 split env
  = let ul = (env .&. eight1)
@@ -54,7 +58,7 @@ split env
           eight2 = A.shiftL eight1 8
           eight3 = A.shiftL eight2 8
           eight4 = A.shiftL eight3 8
-
+-}
 -- | Combine the lighter/heavier state of all 4 cells into an env
 --     32bits: | DR | DL | UR | UL |
 
@@ -71,10 +75,10 @@ combine' (ul, ur, dl, dr)
 -- | Apply gravity to the cell at quadrant 'pos' in 'env'
 --      returning the quadrant it should swap with
 
-weigh :: Exp (Env, MargPos) -> Exp MargPos
+weigh :: Exp (Env4, MargPos) -> Exp MargPos
 weigh (A.unlift -> (env, pos))
   = let current              = margQuadrant pos env
-        (ul', ur', dl', dr') = split env
+        (ul', ur', dl', dr') = A.unlift env
 
         -- The heaviest item in the environment
         heaviest = A.max (A.max (weight ul') (weight ur'))
@@ -90,7 +94,7 @@ weigh (A.unlift -> (env, pos))
         weighed1 = combine' (ul, ur, dl, dr)
 
         -- Apply gravity with respect to the heaviest
-        x' =  applyGravity weighed1 pos -- .|. shiftL 1 (8 * pos))
+        x' =  applyGravity weighed1 pos
 
         x  = isWall (margQuadrant x' env) ? (pos, x')
 
@@ -135,18 +139,20 @@ weigh (A.unlift -> (env, pos))
 
 -- | Perform alchemy on a margolus block, with randomised probability of succeeding
 
-alchemy :: Exp Int -> Exp Env -> Exp Env
+alchemy :: Exp Int -> Exp Env4 -> Exp Env4
 alchemy i env
- = let (ul0, ur0, dl0, dr0) = split env
+ = let (ul0, ur0, dl0, dr0) = A.unlift env
        -- Apply interaction among the components
-       (ul1, ur1) = A.unlift $ applyAlchemy i ul0 ur0
-       (ur , dr2) = A.unlift $ applyAlchemy i ur1 dr0
-       (dr , dl3) = A.unlift $ applyAlchemy i dr2 dl0
-       (dl , ul ) = A.unlift $ applyAlchemy i dl3 ul1
+       (ul1, ur1) = unlift' $ applyAlchemy i ul0 ur0
+       (ur , dr2) = unlift' $ applyAlchemy i ur1 dr0
+       (dr , dl3) = unlift' $ applyAlchemy i dr2 dl0
+       (dl , ul ) = unlift' $ applyAlchemy i dl3 ul1
    in  (ul0 ==* ur0 &&* ur0 ==* dl0 &&* dl0 ==* dr0)
        ? ( env
-         , combine (ul, ur, dl, dr)
+         , A.lift (ul, ur, dl, dr)
          )
+ where unlift' :: Exp (Cell, Cell) -> (Exp Cell, Exp Cell)
+       unlift' = A.unlift
 
 -- Margolus block --------------------------------------------------------------
 
@@ -169,15 +175,15 @@ margMaskOdd
 --    and encode it as a number, combined with the Margolus position for each cell
 --
 
-margStencil :: A.Stencil3x3 (Cell, MargPos) -> Exp (Cell, MargPos)
+margStencil :: A.Stencil3x3 (Cell, MargPos) -> Exp ((Cell, Cell, Cell, Cell), MargPos)
 margStencil ((y0x0,y0x1,y0x2)
             ,(y1x0,y1x1,y1x2)
             ,(y2x0,y2x1,y2x2))
             = A.lift $ flip (,) (A.snd y1x1) $
-            ( (A.snd y1x1 A.==* 0) A.? (combine (A.fst y1x1, A.fst y1x2, A.fst y2x1, A.fst y2x2)
-            , (A.snd y1x1 A.==* 1) A.? (combine (A.fst y1x0, A.fst y1x1, A.fst y2x0, A.fst y2x1)
-            , (A.snd y1x1 A.==* 2) A.? (combine (A.fst y0x1, A.fst y0x2, A.fst y1x1, A.fst y1x2)
-            ,                          (combine (A.fst y0x0, A.fst y0x1, A.fst y1x0, A.fst y1x1))))))
+            ( (A.snd y1x1 A.==* 0) A.? (A.lift (A.fst y1x1, A.fst y1x2, A.fst y2x1, A.fst y2x2)
+            , (A.snd y1x1 A.==* 1) A.? (A.lift (A.fst y1x0, A.fst y1x1, A.fst y2x0, A.fst y2x1)
+            , (A.snd y1x1 A.==* 2) A.? (A.lift (A.fst y0x1, A.fst y0x2, A.fst y1x1, A.fst y1x2)
+            ,                          (A.lift (A.fst y0x0, A.fst y0x1, A.fst y1x0, A.fst y1x1))))))
 
 
 
diff --git a/accelerate/World.hs b/accelerate/World.hs
@@ -5,18 +5,17 @@ module Accelerate.World
        , module Common.World)
 where
 
-import Data.Array.Accelerate (Acc, Array, Exp, DIM1, Z(..), (:.)(..), (?), lift, (>=*), (<=*), (<*), (&&*), (||*), (==*))
+import Data.Array.Accelerate (Acc, Array, Exp, DIM1, Z(..), (:.)(..), (?), (>=*), (<=*), (<*), (&&*), (||*), (==*))
 import qualified Data.Array.Accelerate as A
 
 import Common.World hiding (isFluid, isWall, isFire, weight, age)
+import qualified Common.World as C
+import Data.Word
 
 res = A.index2 (A.lift resY) (A.lift resX)
 
 -- Elements and properties -----------------------------------------------------
 
-elemsAcc :: Acc (Array DIM1 Element)
-elemsAcc = A.use $ A.fromList (Z:.(length elems)) elems
-
 {-# INLINE isWall #-}
 isWall :: Exp Element -> Exp Bool
 isWall x = (x >=* 23 &&* x <=* 26) ||* x ==* 127
@@ -25,16 +24,25 @@ isWall x = (x >=* 23 &&* x <=* 26) ||* x ==* 127
 isFire :: Exp Element -> Exp Bool
 isFire x = x >=* A.lift fire &&* x <=* A.lift fire_end
 
-{-# INLINE isFluid #-}
+fluidArray :: Acc (Array DIM1 Word8)
+fluidArray = A.use $ A.fromList (Z:. fromIntegral wall + 1) $ map C.isFluid [0..wall]
+
 isFluid :: Exp Element -> Exp Weight
-isFluid x = (x ==* 1 ||* x ==* 2 ||* x ==* 27 ||* (x >=* 6 &&* x <=* 8)) ? (2, 0)
+isFluid x = fluidArray A.!! A.fromIntegral x 
+
+
+weightArray :: Acc (Array DIM1 Weight)
+weightArray = A.use $ A.fromList (Z:. fromIntegral wall + 1) $ map C.weight [0..wall]
 
 {-# INLINE weight #-}
 weight :: Exp Element -> Exp Weight
-weight x = (x ==* 1 ||* x ==* 2) ? (0, (x ==* 0 ? (2, (x ==* 9) ? (lift' $ fromIntegral salt, (x ==* 27) ? (lift' $ fromIntegral water, isFire x ? (0, A.fromIntegral x))))))
-  where lift' :: Weight -> Exp Weight
-        lift' = lift
+weight x = weightArray A.!! A.fromIntegral x 
+
+
+ageArray :: Acc (Array DIM1 (Int, Element, Element))
+ageArray = A.use $ A.fromList (Z :. fromIntegral wall + 1) $ map age' [0..wall]
 
 {-# INLINE age #-}
 age :: Exp Int -> Exp Element -> Exp Element
-age r x = x ==* (lift fire_end) ? (lift nothing, isFire x ? (r <* 50 ? (x+1,x), x ==* (lift steam_water) ? (r <* 1 ? (lift water, lift steam_water), x ==* (lift steam_condensed) ? (r <* 5 ? (lift water, lift steam_condensed), x ==* (lift turnip) ? (elemsAcc A.! (A.index1 ((r * (lift $ length elems)) `div` 110)), x)))))
+age r x = let (i,t,e) = A.unlift $ ageArray A.!! A.fromIntegral x 
+           in (r <* i) ? (t,e)
diff --git a/common/.World.hs.swp b/common/.World.hs.swp