splitAt_LazyMatch.hs

Dateiinhalt

{- Demonstration Lazy Pattern Match

Vergleiche:
  > ghc splitAt_LazyMatch -fforce-recomp -O0
  ./splitAt_LazyMatch
mit   
  > ghc splitAt_LazyMatch -fforce-recomp -O2 
  ./splitAt_LazyMatch
-}


import Data.Time


main1 = splitAt1 1000000 $ repeat 'a'
main2 = splitAt2 1000000 $ repeat 'a'


main = do
  let l = repeat 'x'
  let n = 95000000  -- Wert an Hardware anpassen!
  t <- printLocalTime
  print $ take 11 $ fst $ splitAt1 n l
  t <- printTimeDiff t  
  print $ take 11 $ fst $ splitAt2 n l
  t <- printTimeDiff t
  print $ take 11 $ fst $ splitAt3 n l
  t <- printTimeDiff t
  print $ take 11 $ fst $ splitAt4 n l
  t <- printTimeDiff t
  print $ take 11 $ fst $ splitAt5 n l
  t <- printTimeDiff t
  print $ take 11 $ fst $ splitAt n l
  t <- printTimeDiff t
  return () 
  
-- ohne lazy pattern  
splitAt1 :: Int -> [a] -> ([a], [a])
splitAt1 n ls
  | n <= 0        = ([], ls)
splitAt1 _ []     = ([], [])
splitAt1 n (y:ys) = 
    case splitAt1 (n-1) ys of
      (prefix, suffix) -> (y : prefix, suffix)

-- mit lazy pattern        
splitAt2 :: Int -> [a] -> ([a], [a])
splitAt2 n ls
  | n <= 0        = ([], ls)
splitAt2 _ []     = ([], [])
splitAt2 n (y:ys) = 
    case splitAt2 (n-1) ys of
      ~(prefix, suffix) -> (y : prefix, suffix)

-- mit let-Definition
splitAt3 :: Int -> [a] -> ([a], [a])
splitAt3 n ls
  | n <= 0        = ([], ls)
splitAt3 _ []     = ([], [])
splitAt3 n (y:ys) = 
    let (prefix,suffix) = splitAt3 (n-1) ys
    in  (y : prefix, suffix)
      
      
{- 
  splitAt4 kommt aus der GHC Dokumentation der Standard-Prelude 
  und verwendet kein ~-Pattern!
   
  Warum? Die nachgeschobene Definition ist ohnehin faul, 
  da wir ja zuerst ein Paar erzeugen, 
  in dessen sowieso Thunks stehen:
-}
splitAt4 n ls 
  | n <= 0 = ([], ls)
  | otherwise          = splitAt' n ls
    where
        splitAt' :: Int -> [a] -> ([a], [a])
        splitAt' _  []     = ([], [])
        splitAt' 1  (x:xs) = ([x], xs)
        splitAt' m  (x:xs) = (x:xs', xs'')
          where
            (xs', xs'') = splitAt' (m - 1) xs

-- kaum ein Unterschied zu splitAt4:            
splitAt5 n ls
  | n <= 0 = ([], ls)
  | otherwise          = splitAt' n ls
    where
        splitAt' :: Int -> [a] -> ([a], [a])
        splitAt' _  []     = ([], [])
        splitAt' 1  (x:xs) = ([x], xs)
        splitAt' m  (x:xs) = (x:xs', xs'')
          where
            ~(xs', xs'') = splitAt' (m - 1) xs
                 
                 
printTimeDiff :: UTCTime -> IO UTCTime -- Nicht sehr akkurat, aber hier gut genug.
printTimeDiff t1 = do
  putStr "Time elapsed: "
  t2 <- getCurrentTime
  print $ diffUTCTime t2 t1
  return t2

printLocalTime :: IO UTCTime
printLocalTime = do
  putStr "Time is: "
  time <- getZonedTime  
  print time
  return $ zonedTimeToUTC time