Ticket #4474: comparison.hs

File comparison.hs, 1.3 KB (added by claus, 3 years ago)

simple difference lists

Line 
1{-# LANGUAGE BangPatterns #-}
2
3module Main where
4import System.Environment
5
6data Tree = Leaf !Int | Fork !Tree !Tree deriving Show
7
8fullTree 0 = Leaf 1
9fullTree n = let t = fullTree (n-1) in Fork t t
10
11flatListNaive (Leaf n)   = [n]
12flatListNaive (Fork a b) = flatListNaive a ++ flatListNaive b
13
14flatListCons t = flat t []
15  where
16  flat (Leaf n)   ns = n:ns
17  flat (Fork a b) ns = flat a (flat b ns) 
18
19flatListCons2 t = flat t []
20  where
21  flat (Leaf n)   = \ns -> n:ns
22  flat (Fork a b) = \ns -> flat a (flat b ns) 
23
24flatListCons3 t = flat t []
25  where
26  flat (Leaf n)   = (n:)
27  flat (Fork a b) = flat a . flat b
28
29flatDList (Leaf n)   = (n:)
30flatDList (Fork a b) = flatDList a . flatDList b
31
32sumList l = loop 0 l
33  where loop !c [] = c
34        loop !c (h:t) = loop (c+h) t
35
36sumDList l = loop 0 (l [])
37  where loop !c []    = c
38        loop !c (h:t) = loop (c+h) t
39
40main = do
41  args <- getArgs
42  case args of
43    "n" :n:_ -> print $ sumList $ flatListNaive $ fullTree (read n)
44    "c" :n:_ -> print $ sumList $ flatListCons $ fullTree (read n)
45    "c2":n:_ -> print $ sumList $ flatListCons2 $ fullTree (read n)
46    "c3":n:_ -> print $ sumList $ flatListCons3 $ fullTree (read n)
47    "d" :n:_ -> print $ sumDList $ flatDList $ fullTree (read n)
48