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