module Prog(prog) where
-- ************** SeqSer *************
-- strictly serial search
-- sequential
--partain:import Libfuns
import Auxil
import Key
prog :: String -> String
prog _ = show cichelli
data Status a = NotEver Int | YesIts Int a -- deriving ()
instance (Show a) => Show (Status a) where
showsPrec d (NotEver i) = showParen (d >= 10) showStr
where
showStr = showString "NotEver" . showChar ' ' . showsPrec 10 i
showsPrec d (YesIts i a) = showParen (d >= 10) showStr
where
showStr = showString "YesIts" . showChar ' ' . showsPrec 10 i
. showChar ' ' . showsPrec 10 a
-- readsPrec p = error "no readsPrec for Statuses"
-- readList = error "no readList for Statuses"
showList [] = showString "[]"
showList (x:xs)
= showChar '[' . shows x . showl xs
where showl [] = showChar ']'
showl (x:xs) = showChar ',' . shows x . showl xs
type FeedBack = Status HashFun
cichelli :: FeedBack
cichelli = findhash hashkeys
where
-- #ifdef SORTED
hashkeys = (blocked.freqsorted) attribkeys
-- #else
-- hashkeys = blocked attribkeys
-- #endif
findhash :: [Key] -> FeedBack
findhash = findhash' (H Nothing Nothing []) []
findhash' :: HashSet -> HashFun -> [Key] -> FeedBack
findhash' keyHashSet charAssocs [] = (YesIts 1 charAssocs)
findhash' keyHashSet charAssocs (k@(K s a z n):ks) =
( case (assocm a charAssocs, assocm z charAssocs) of
(Nothing,Nothing) -> if a==z then
firstSuccess (\m->try [(a,m)]) [0..maxval]
else
firstSuccess (\(m,n)->try [(a,m),(z,n)])
[(m,n) | m<-[0..maxval], n<-[0..maxval]]
(Nothing,Just zc) -> firstSuccess (\m->try [(a,m)]) [0..maxval]
(Just ac,Nothing) -> firstSuccess (\n->try [(z,n)]) [0..maxval]
(Just ac,Just zc) -> try [] )
where
try newAssocs = ( case hinsert (hash newCharAssocs k) keyHashSet of
Nothing -> (NotEver 1)
Just newKeyHashSet -> findhash' newKeyHashSet newCharAssocs ks )
where
newCharAssocs = newAssocs ++ charAssocs
-- Returns the first successful `working' function on a list of possible arguments
firstSuccess :: (a -> FeedBack) -> [a] -> FeedBack
firstSuccess f possibles = first 0 (map f possibles)
first :: Int -> [FeedBack] -> FeedBack
first k [] = NotEver k
first k (a:l) = case a of
(YesIts leaves y) -> YesIts (k+leaves) y
(NotEver leaves) -> first (k+leaves) l
|