[project @ 1996-07-25 21:02:03 by partain]
[nofib.git] / GHC_ONLY / bugs / jules_xref / Main.hs
1 --!!! a performance-problem test from Jules.
2 -- further comment at the end
3 --
4 module Main where
5
6 import Char -- 1.3
7
8 --1.3:data Maybe a = Nothing | Just a
9
10 data ATree a b = ALeaf
11 | ABranch (ATree a b) a [b] (ATree a b) Int
12 -- deriving (Eq)
13
14 type SymTable = ATree String Int
15
16
17 pp_tree :: SymTable -> String
18 pp_tree ALeaf = ""
19 pp_tree (ABranch l k vs r h)
20 = pp_tree l ++ show (k,reverse vs) ++ "\n" ++ pp_tree r
21
22 {-
23 avAdd :: Ord a => ATree a b ->
24 a ->
25 b ->
26 ATree a b
27 -}
28 avAdd ALeaf xk xv = ABranch ALeaf xk [xv] ALeaf 1
29
30 avAdd (ABranch l yk yv r hy) xk xv
31 | yk > xk = let (ABranch l1 zk zv l2 _) = avAdd l xk xv
32 in avCombine l1 (f l1) l2 (f l2) r (f r) zk zv yk yv
33 | xk > yk = let (ABranch r1 zk zv r2 _) = avAdd r xk xv
34 in avCombine l (f l) r1 (f r1) r2 (f r2) yk yv zk zv
35 | otherwise = ABranch l yk (xv:yv) r hy
36 where
37 f :: ATree a b -> Int
38 f ALeaf = 0
39 f (ABranch _ _ _ _ d) = d
40
41
42
43 --==========================================================--
44 --
45 {-
46 avLookup :: Ord a => ATree a b ->
47 a ->
48 Maybe b
49 -}
50 avLookup ALeaf _ = Nothing
51
52 avLookup (ABranch l k v r _) kk
53 | kk < k = avLookup l kk
54 | kk > k = avLookup r kk
55 | otherwise = Just v
56
57
58
59 --==========================================================--
60 --
61 avCombine :: ATree a b ->
62 Int ->
63 ATree a b ->
64 Int ->
65 ATree a b ->
66 Int ->
67 a ->
68 [b] ->
69 a ->
70 [b] ->
71 ATree a b
72
73 avCombine t1 h1 t2 h2 t3 h3 ak av ck cv
74 | h2 > h1 && h2 > h3
75 = ABranch (ABranch t1 ak av t21 (h1+1)) bk bv
76 (ABranch t22 ck cv t3 (h3+1)) (h1+2)
77 | h1 >= h2 && h1 >= h3
78 = ABranch t1 ak av (ABranch t2 ck cv t3 (max1 h2 h3))
79 (max1 h1 (max1 h2 h3))
80 | h3 >= h2 && h3 >= h1
81 = ABranch (ABranch t1 ak av t2 (max1 h1 h2)) ck cv t3
82 (max1 (max1 h1 h2) h3)
83 where
84 (ABranch t21 bk bv t22 _) = t2
85 max1 :: Int -> Int -> Int
86 max1 n m = 1 + (if n > m then n else m)
87
88
89 --==========================================================--
90 --=== end AVLTree.hs ===--
91 --==========================================================--
92
93
94
95
96 xref :: SymTable -> Int -> String -> SymTable
97
98 xref stab lineno [] = stab
99 xref stab lineno ('\n':cs) = xref stab (lineno+1) cs
100 xref stab lineno (c:cs)
101 = if isAlpha c then
102 let (word, rest) = span isAlphanum cs
103 in xref (avAdd stab (c:word) lineno) lineno rest
104 else xref stab lineno cs
105
106 main = do
107 s <- getContents
108 putStr (pp_tree (xref ALeaf 1 s))
109
110 {-
111 Date: Thu, 29 Oct 92 19:38:31 GMT
112 From: Julian Seward (DRL PhD) <sewardj@uk.ac.man.cs>
113 Message-Id: <9210291938.AA27685@r6b.cs.man.ac.uk>
114 To: partain@uk.ac.glasgow.dcs
115 Subject: More ghc vs hbc fiddling (OR: nofib ephemeral contribution (unsolicited :-))
116
117 Will,
118
119 There are still some very simple programs for which ghc's performance
120 falls far behind that of hbc's -- even with ghc using a better
121 GC. The stat files below are from a
122 crude cross reference program we hacked together for the purposes
123 of an internal "what-language-to-teach-first-year-undergrads" debate.
124
125 Is this something to do with dictionary zapping?
126
127 Program included below. Use as a pipe. Suggest you feed it any
128 large Haskell source file (I used TypeCheck5.hs from Anna).
129
130 Jules
131
132 ---------------------------------------------------------
133
134 a.out -H9000000 -S
135 Nw Heap Tt Heap Stk GC(real) GC acc (real) tot (real) newheap in -dupl -new -del +stk out mcode
136 99192 99192 20 0.06 0.1 0.06 0.1 0.16 0.4 396768 0 0 0 0 0 0
137 247752 247752 14 0.13 0.1 0.19 0.2 0.44 0.8 991008 0 0 0 0 0 0
138 623104 623104 34 0.32 0.3 0.51 0.5 1.08 1.5 2492416 0 0 0 0 0 0
139 1433968 1433968 15879 0.62 0.8 1.13 1.4 2.66 3.6 5735872 0 0 0 0 0 0
140 3009700 3009700 2382 1.56 1.6 2.69 3.0 6.88 8.6 9000000 0 0 0 0 0 0
141 5 GCs,
142 8.69 (13.1) seconds total time,
143 2.69 (3.0) seconds GC time (31.0(23.1)% of total time)
144 0.00 (0.0) seconds major GC time ( 0.0( 0.0)% of total time)
145 9303816 bytes allocated from the heap.
146
147 ------------------------------------------------
148
149 xref +RTS -H9M -S -K200k
150
151 Collector: APPEL HeapSize: 9,437,184 (bytes)
152
153 Alloc Live Live Astk Bstk OldGen GC GC TOT TOT Page Flts Collec Resid
154 bytes bytes % bytes bytes roots user elap user elap GC TOT tion %heap
155 4718580 786672 16.7 40 220 424 0.37 0.52 3.67 4.68 0 0 Minor
156 4325248 808804 18.7 62724 62820 564968 0.50 0.60 6.63 8.05 0 0 Minor
157 3920848 743508 19.0 47512 47600 743220 0.47 0.60 8.60 10.17 0 0 Minor
158 3549096 681464 19.2 34644 34892 680820 0.46 0.53 10.43 12.13 0 0 Minor
159 3208348 604892 18.9 23564 23676 604512 0.41 0.48 12.07 13.89 0 0 Minor
160 2905900 528584 18.2 14164 14396 527952 0.35 0.41 13.53 15.42 0 0 Minor
161 2641592 490812 18.6 5228 5388 490476 0.30 0.37 14.85 16.82 0 0 Minor
162 2396204 534400 22.3 16 40 534380 0.28 0.32 16.41 18.75 0 0 Minor
163 2129016 691708 32.5 36 144 691420 0.33 0.39 18.38 21.68 0 0 Minor
164 1090480
165
166 30,885,312 bytes allocated in the heap
167 9 garbage collections performed
168
169 Total time 19.29s (23.06s elapsed)
170 GC time 3.47s (4.22s elapsed)
171 %GC time 18.0%
172
173 --------------------------------------------------
174 -}