parconc-examples 0.3 → 0.3.2
raw patch · 6 files changed
+127/−75 lines, 6 filesdep ~acceleratedep ~accelerate-cuda
Dependency ranges changed: accelerate, accelerate-cuda
Files
- AccelerateCompat.hs +13/−0
- dist/build/parinfer/parinfer-tmp/Lex.hs +29/−16
- dist/build/parinfer/parinfer-tmp/Parse.hs +70/−53
- fwaccel-gpu.hs +1/−0
- fwaccel.hs +3/−0
- parconc-examples.cabal +11/−6
+ AccelerateCompat.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}++#if MIN_VERSION_accelerate(0, 14, 0)++module AccelerateCompat (min, max) where++#else++module AccelerateCompat (A.min, A.max) where++import Data.Array.Accelerate as A++#endif
dist/build/parinfer/parinfer-tmp/Lex.hs view
@@ -67,11 +67,11 @@ {-# LINE 72 "templates/wrappers.hs" #-} -{-# LINE 89 "templates/wrappers.hs" #-}+{-# LINE 92 "templates/wrappers.hs" #-} -{-# LINE 103 "templates/wrappers.hs" #-}+{-# LINE 106 "templates/wrappers.hs" #-} -{-# LINE 118 "templates/wrappers.hs" #-}+{-# LINE 121 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Token positions@@ -83,18 +83,18 @@ -- `move_pos' calculates the new position after traversing a given character, -- assuming the usual eight character tab stops. -{-# LINE 141 "templates/wrappers.hs" #-}+{-# LINE 144 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Default monad -{-# LINE 231 "templates/wrappers.hs" #-}+{-# LINE 242 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Monad (with ByteString input) -{-# LINE 320 "templates/wrappers.hs" #-}+{-# LINE 333 "templates/wrappers.hs" #-} -- -----------------------------------------------------------------------------@@ -127,23 +127,23 @@ -- ----------------------------------------------------------------------------- -- Basic wrapper, ByteString version -{-# LINE 365 "templates/wrappers.hs" #-}- {-# LINE 378 "templates/wrappers.hs" #-} +{-# LINE 392 "templates/wrappers.hs" #-} + -- ----------------------------------------------------------------------------- -- Posn wrapper -- Adds text positions to the basic model. -{-# LINE 395 "templates/wrappers.hs" #-}+{-# LINE 409 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Posn wrapper, ByteString version -{-# LINE 410 "templates/wrappers.hs" #-}+{-# LINE 424 "templates/wrappers.hs" #-} -- -----------------------------------------------------------------------------@@ -198,13 +198,25 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} -data AlexAddr = AlexA# Addr# ++-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 51 "templates/GenericTemplate.hs" #-}+++data AlexAddr = AlexA# Addr#+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif@@ -247,6 +259,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else@@ -319,7 +332,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -335,7 +348,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -351,7 +364,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 242 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/parinfer/parinfer-tmp/Parse.hs view
@@ -6,7 +6,7 @@ import qualified Data.Array as Happy_Data_Array import qualified GHC.Exts as Happy_GHC_Exts --- parser produced by Happy Version 1.18.9+-- parser produced by Happy Version 1.19.3 newtype HappyAbsSyn t8 t9 t10 t11 = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607@@ -310,20 +310,36 @@ {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp -{-# LINE 30 "templates/GenericTemplate.hs" #-}+{-# LINE 13 "templates/GenericTemplate.hs" #-} ++++-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ > 706+#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool)+#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool)+#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool)+#else+#define LT(n,m) (n Happy_GHC_Exts.<# m)+#define GTE(n,m) (n Happy_GHC_Exts.>=# m)+#define EQ(n,m) (n Happy_GHC_Exts.==# m)+#endif+{-# LINE 46 "templates/GenericTemplate.hs" #-}++ data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList -{-# LINE 51 "templates/GenericTemplate.hs" #-}+{-# LINE 67 "templates/GenericTemplate.hs" #-} -{-# LINE 61 "templates/GenericTemplate.hs" #-}+{-# LINE 77 "templates/GenericTemplate.hs" #-} -{-# LINE 70 "templates/GenericTemplate.hs" #-}+{-# LINE 86 "templates/GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a)@@ -340,9 +356,9 @@ -- parse (a %partial parser). We must ignore the saved token on the top of -- the stack in this case. happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =- happyReturn1 ans+ happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = - (happyTcHack j (happyTcHack st)) (happyReturn1 ans)+ (happyTcHack j (happyTcHack st)) (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action@@ -350,37 +366,35 @@ happyDoAction i tk st- = {- nothing -}+ = {- nothing -} - case action of- 0# -> {- nothing -}- happyFail i tk st- -1# -> {- nothing -}- happyAccept i tk st- n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}+ case action of+ 0# -> {- nothing -}+ happyFail i tk st+ -1# -> {- nothing -}+ happyAccept i tk st+ n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} - (happyReduceArr Happy_Data_Array.! rule) i tk st- where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))- n -> {- nothing -}+ (happyReduceArr Happy_Data_Array.! rule) i tk st+ where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))+ n -> {- nothing -} - happyShift new_state i tk st- where (new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))- where (off) = indexShortOffAddr happyActOffsets st- (off_i) = (off Happy_GHC_Exts.+# i)- check = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#))- then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i)- else False- (action)+ happyShift new_state i tk st+ where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))+ where off = indexShortOffAddr happyActOffsets st+ off_i = (off Happy_GHC_Exts.+# i)+ check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))+ then EQ(indexShortOffAddr happyCheck off_i, i)+ else False+ action | check = indexShortOffAddr happyTable off_i | otherwise = indexShortOffAddr happyDefActions st -{-# LINE 130 "templates/GenericTemplate.hs" #-} - indexShortOffAddr (HappyA# arr) off =- Happy_GHC_Exts.narrow16Int# i+ Happy_GHC_Exts.narrow16Int# i where i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))@@ -399,13 +413,13 @@ ----------------------------------------------------------------------------- -- HappyState data type (not arrays) -{-# LINE 163 "templates/GenericTemplate.hs" #-}+{-# LINE 170 "templates/GenericTemplate.hs" #-} ----------------------------------------------------------------------------- -- Shifting a token happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =- let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in+ let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in -- trace "shifting the error token" $ happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) @@ -441,30 +455,33 @@ = happyFail 0# tk st sts stk happyReduce k nt fn j tk st sts stk = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of- sts1@((HappyCons (st1@(action)) (_))) ->- let r = fn stk in -- it doesn't hurt to always seq here...- happyDoSeq r (happyGoto nt j tk st1 sts1 r)+ sts1@((HappyCons (st1@(action)) (_))) ->+ let r = fn stk in -- it doesn't hurt to always seq here...+ happyDoSeq r (happyGoto nt j tk st1 sts1 r) happyMonadReduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonadReduce k nt fn j tk st sts stk =- happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))- where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts))- drop_stk = happyDropStk k stk+ case happyDrop k (HappyCons (st) (sts)) of+ sts1@((HappyCons (st1@(action)) (_))) ->+ let drop_stk = happyDropStk k stk in+ happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) happyMonad2Reduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonad2Reduce k nt fn j tk st sts stk =- happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))- where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts))- drop_stk = happyDropStk k stk+ case happyDrop k (HappyCons (st) (sts)) of+ sts1@((HappyCons (st1@(action)) (_))) ->+ let drop_stk = happyDropStk k stk - (off) = indexShortOffAddr happyGotoOffsets st1- (off_i) = (off Happy_GHC_Exts.+# nt)- (new_state) = indexShortOffAddr happyTable off_i+ off = indexShortOffAddr happyGotoOffsets st1+ off_i = (off Happy_GHC_Exts.+# nt)+ new_state = indexShortOffAddr happyTable off_i + in+ happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) happyDrop 0# l = l happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t@@ -479,9 +496,9 @@ happyGoto nt j tk st = {- nothing -} happyDoAction j tk new_state- where (off) = indexShortOffAddr happyGotoOffsets st- (off_i) = (off Happy_GHC_Exts.+# nt)- (new_state) = indexShortOffAddr happyTable off_i+ where off = indexShortOffAddr happyGotoOffsets st+ off_i = (off Happy_GHC_Exts.+# nt)+ new_state = indexShortOffAddr happyTable off_i @@ -491,8 +508,8 @@ -- parse error if we are in recovery and we fail again happyFail 0# tk old_st _ stk@(x `HappyStk` _) =- let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in--- trace "failing" $ + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in+-- trace "failing" $ happyError_ i tk {- We don't need state discarding for our restricted implementation of@@ -501,16 +518,16 @@ -- discard a state happyFail 0# tk old_st (HappyCons ((action)) (sts)) - (saved_tok `HappyStk` _ `HappyStk` stk) =--- trace ("discarding state, depth " ++ show (length stk)) $- happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))+ (saved_tok `HappyStk` _ `HappyStk` stk) =+-- trace ("discarding state, depth " ++ show (length stk)) $+ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) -} -- Enter error recovery: generate an error token, -- save the old token and carry on. happyFail i tk (action) sts stk = -- trace "entering error recovery" $- happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)+ happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) -- Internal happy errors: @@ -528,9 +545,9 @@ ----------------------------------------------------------------------------- -- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq+-- happySeq = happyDoSeq -- otherwise it emits--- happySeq = happyDontSeq+-- happySeq = happyDontSeq happyDoSeq, happyDontSeq :: a -> b -> b happyDoSeq a b = a `seq` b
fwaccel-gpu.hs view
@@ -7,6 +7,7 @@ import System.Environment import Data.Array.Accelerate as A import Data.Array.Accelerate.CUDA+import AccelerateCompat as A -- <<Graph type Weight = Int32
fwaccel.hs view
@@ -7,6 +7,7 @@ import System.Environment import Data.Array.Accelerate as A import Data.Array.Accelerate.Interpreter+import AccelerateCompat as A -- <<Graph type Weight = Int32@@ -94,3 +95,5 @@ A.fromIntegral i * constant (Prelude.fromIntegral n) in A.foldAll (+) (constant 0) (shortestPathsAcc n g)))++
parconc-examples.cabal view
@@ -1,5 +1,5 @@ name: parconc-examples-version: 0.3+version: 0.3.2 synopsis: Examples to accompany the book "Parallel and Concurrent Programming in Haskell" -- description: license: BSD3@@ -332,17 +332,18 @@ executable fwaccel main-is: fwaccel.hs+ other-modules: AccelerateCompat build-depends: base >= 4.5 && < 4.7- , accelerate >= 0.12+ , accelerate >= 0.12 && < 0.15 ghc-options: -O2 default-language: Haskell2010 executable fwaccel-gpu main-is: fwaccel-gpu.hs build-depends: base >= 4.5 && < 4.7- , accelerate >= 0.12+ , accelerate >= 0.12 && < 0.15 if flag(cuda)- build-depends: accelerate-cuda >= 0.12+ build-depends: accelerate-cuda >= 0.12 && < 0.15 else buildable: False ghc-options: -O2@@ -353,11 +354,11 @@ other-modules: Config hs-source-dirs: mandel build-depends: base >= 4.5 && < 4.7- , accelerate >= 0.12+ , accelerate >= 0.12 && < 0.15 , fclabels , accelerate-io if flag(cuda)- build-depends: accelerate-cuda >= 0.12+ build-depends: accelerate-cuda >= 0.12 && < 0.15 else buildable: False ghc-options: -O2@@ -642,6 +643,7 @@ executable findpar main-is: findpar.hs+ ghc-options: -threaded build-depends: base >= 4.5 && < 4.7 , filepath ==1.3.* , directory >= 1.1 && < 1.3@@ -650,6 +652,7 @@ executable findpar2 main-is: findpar2.hs+ ghc-options: -threaded build-depends: base >= 4.5 && < 4.7 , filepath ==1.3.* , directory >= 1.1 && < 1.3@@ -659,6 +662,7 @@ executable findpar3 main-is: findpar3.hs other-modules: CasIORef+ ghc-options: -threaded build-depends: base >= 4.5 && < 4.7 , filepath ==1.3.* , directory >= 1.1 && < 1.3@@ -668,6 +672,7 @@ executable findpar4 main-is: findpar4.hs+ ghc-options: -threaded build-depends: base >= 4.5 && < 4.7 , filepath ==1.3.* , directory >= 1.1 && < 1.3