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