Stabilise benchmarks wrt. GC
[nofib.git] / spectral / cichelli / Prog.hs
1 module Prog(prog) where
2
3 -- ************** SeqSer *************
4
5 -- strictly serial search
6 -- sequential
7
8 --partain:import Libfuns
9 import Auxil
10 import Key
11 import Data.List (intersperse)
12
13 prog :: Int -> String
14 prog n = show (cichelli n)
15
16 data Status a = NotEver Int | YesIts Int a deriving ()
17 instance (Show a) => Show (Status a) where
18 showsPrec d (NotEver i) = showParen (d >= 10) showStr
19 where
20 showStr = showString "NotEver" . showChar ' ' . showsPrec 10 i
21
22 showsPrec d (YesIts i a) = showParen (d >= 10) showStr
23 where
24 showStr = showString "YesIts" . showChar ' ' . showsPrec 10 i
25 . showChar ' ' . showsPrec 10 a
26
27 -- readsPrec p = error "no readsPrec for Statuses"
28 -- readList = error "no readList for Statuses"
29 showList [] = showString "[]"
30 showList (x:xs)
31 = showChar '[' . shows x . showl xs
32 where showl [] = showChar ']'
33 showl (x:xs) = showChar ',' . shows x . showl xs
34
35 type FeedBack = Status HashFun
36
37 cichelli :: Int -> FeedBack
38 cichelli n = findhash hashkeys
39 where
40 -- #ifdef SORTED
41 attribkeys' = attribkeys (keys ++ take (n `mod` 2) keys)
42 hashkeys = (blocked.freqsorted) attribkeys'
43 -- #else
44 -- hashkeys = blocked attribkeys
45 -- #endif
46
47
48 findhash :: [Key] -> FeedBack
49 findhash = findhash' (H Nothing Nothing []) []
50
51
52 findhash' :: HashSet -> HashFun -> [Key] -> FeedBack
53 findhash' keyHashSet charAssocs [] = (YesIts 1 charAssocs)
54 findhash' keyHashSet charAssocs (k@(K s a z n):ks) =
55 ( case (assocm a charAssocs, assocm z charAssocs) of
56 (Nothing,Nothing) -> if a==z then
57 firstSuccess (\m->try [(a,m)]) [0..maxval]
58 else
59 firstSuccess (\(m,n)->try [(a,m),(z,n)])
60 [(m,n) | m<-[0..maxval], n<-[0..maxval]]
61 (Nothing,Just zc) -> firstSuccess (\m->try [(a,m)]) [0..maxval]
62 (Just ac,Nothing) -> firstSuccess (\n->try [(z,n)]) [0..maxval]
63 (Just ac,Just zc) -> try [] )
64 where
65 try newAssocs = ( case hinsert (hash newCharAssocs k) keyHashSet of
66 Nothing -> (NotEver 1)
67 Just newKeyHashSet -> findhash' newKeyHashSet newCharAssocs ks )
68 where
69 newCharAssocs = newAssocs ++ charAssocs
70
71 -- Returns the first successful `working' function on a list of possible arguments
72 firstSuccess :: (a -> FeedBack) -> [a] -> FeedBack
73 firstSuccess f possibles = first 0 (map f possibles)
74
75 first :: Int -> [FeedBack] -> FeedBack
76 first k [] = NotEver k
77 first k (a:l) = case a of
78 (YesIts leaves y) -> YesIts (k+leaves) y
79 (NotEver leaves) -> first (k+leaves) l