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