Skip to content

Instantly share code, notes, and snippets.

@CnrLwlss
Last active August 29, 2015 14:10
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save CnrLwlss/0855c1bb113f40589618 to your computer and use it in GitHub Desktop.
Save CnrLwlss/0855c1bb113f40589618 to your computer and use it in GitHub Desktop.
Demo Haskell code for a SO question.
import Control.Parallel (par, pseq)
import Control.DeepSeq
import System.Environment (getArgs)
import Data.Time.Clock (diffUTCTime, getCurrentTime)
data Tree x = Empty | Node x (Tree x) (Tree x) deriving (Show, Read, Eq)
-- Create instance of NFData for Tree data type (defining "normal form")
instance NFData a => NFData (Tree a) where
rnf Empty = ()
rnf (Node x l r) = rnf x `seq` rnf l `seq` rnf r
-- Recursive function to build a tree using multiple processors simultaneously
copyBoxPar :: Int -> Tree Int
copyBoxPar x
| x <= 0 = Empty
| x > 0 = force left `par` (force right `pseq` (Node x (left)(right)))
where
left = copyBoxPar (x-1)
right = copyBoxPar (x-1)
-- Serial recursive function to count leaves in tree
countBoxes :: Tree x -> Int
countBoxes Empty = 0
countBoxes (Node x left right) = 1 + countBoxes (left) + countBoxes (right)
main = do
-- Get tree depth from command line argument if specified
args <- getArgs
let depth | null args = 5
| otherwise = read (head args) :: Int
-- Timings for parallel building and serial traversing of tree
startp <- getCurrentTime
let newtreepar = copyBoxPar depth
let nboxespar = countBoxes newtreepar
endp <- getCurrentTime
putStrLn $ "Parallel Result: " ++ show (nboxespar)
endp <- getCurrentTime
putStrLn $ "Time elapsed: "++ show (endp `diffUTCTime` startp)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment