ghc/tests/programs/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 -}