1 module GRIP where
    2 
    3 import PSlib
    4 import StdLib
    5 import Parse
    6 
    7 
    8 
    9 akkumulate :: (state->a->(b,state)) -> state -> [a] -> ([b],state)
   10 akkumulate f st [] = ([],st)
   11 akkumulate f st (a:as) = (b:bs,st'')
   12         where
   13         (b,st') = f st a
   14         (bs,st'') = akkumulate f st' as
   15 
   16 getParameters :: [Line] -> ([PElement],Int,[Line])
   17 getParameters lines = (pe,ticks,lines')
   18         where
   19         (pe,ticks,lines') = f [] 0 lines
   20         f l m [] = ([],m,l)
   21         f l m (l'@(Ln _ (Act _ _ _ _ _ t) _):more) = f (insert l' l) (max m t) more
   22         f l m (PEs x:more) = (x:xs,t,l')       where (xs,t,l') = f l m more
   23         f l m (_:more) = f l m more
   24 
   25 getAct :: [PElement] -> [Line] -> [Activities]
   26 getAct [] = aux (\x->True)
   27 getAct pes = aux (\x->elem x pes) 
   28 
   29 aux _ [] = []
   30 aux f ((Ln pe a s):more) | f pe = a:aux f more
   31                          | otherwise = aux f more
   32 aux f (_:more) = aux f more
   33 
   34 getSp :: [PElement] -> [Line] -> [Sparks]
   35 getSp [] = aux' (\x->True)
   36 getSp pes = aux' (\x->elem x pes)
   37 
   38 aux' _ [] = []
   39 aux' f ((Ln pe a s):more) | f pe = s:aux' f more
   40                           | otherwise = aux' f more
   41 aux' f (_:more) = aux' f more
   42 
   43 
   44 scaleAct m a@(Act n i r g f t)  | m==t = a
   45                                 | otherwise = Act n (i*c) (r*c) (g*c) (f*c) (t*c)
   46                                         where      c = m `div` t
   47 
   48 data Sparks = Sp Int Int Int Int Int deriving (Show{-was:Text-},Eq)
   49         -- bucket sprkd sused resum lost 
   50 
   51 numberSp (Sp n _ _ _ _) = n
   52 created (Sp _ s _ _ _) = s
   53 used (Sp _ _ u _ _ ) = u
   54 resumed (Sp _ _ _ r _) = r
   55 lost (Sp _ _ _ _ l) = l
   56 
   57 data Activities = Act Int Int Int Int Int Int deriving (Show{-was:Text-},Eq)
   58         -- bucket idle redn gc flush/read total
   59 
   60 numberAct (Act b _ _ _ _ _) = b
   61 idle (Act _ i _ _ _ _) = i
   62 reduction (Act _ _ r _ _ _) = r
   63 gc (Act _ _ _ g _ _) = g
   64 flush (Act _ _ _ _ f _) = f
   65 total (Act _ _ _ _ _ t) = t
   66 
   67 data Line =  Ln PElement Activities Sparks | PEs PElement | BucketFull Int | Null deriving (Show{-was:Text-},Eq)
   68 
   69 instance Parse Line where
   70         parseType ('B':string) = 
   71                 ((Ln pe (Act bucket idle redn gc (flush+read) (idle+redn+gc+flush+read+io)) 
   72                                 (Sp bucket sprkd sused resum lost)),more)
   73                         where
   74                         (pe,':':p) = parse string   
   75                         (bucket,':':a) = parse p
   76                         (idle,b) = parse a
   77                         (redn,c) = parse b
   78                         (gc,d) = parse c
   79                         (flush,e) = parse d
   80                         (read,k) = parse e
   81                         (_,f) = span ((/=) ' ') (whiteSpace k)
   82                         (sprkd,g) = parse f
   83                         (sused,h) = parse g
   84                         (resum,i) = parse h
   85                         (lost,j) = parse i
   86                         (io,more) = parse j
   87         parseType ('P':'S':string) = (PEs pe,more)
   88                 where
   89                 (pe,more) = parse (tail (dropWhile ((/=) 'r') string))
   90 --      parseType ('S':' ':string) = test (reverse string) 
   91 --               where 
   92 --               test ('.':'m':_) = (BucketFull x,"")
   93 --               test _ = (Null,"")
   94 --               (x,_) = parse string
   95         parseType string = (Null,string)
   96 
   97 instance Ord Line where
   98         (<=) x@(Ln _ (Act b _ _ _ _ _) _) y@(Ln _ (Act b' _ _ _ _ _) _) = b<=b'
   99 
  100 data PElement = PE String Int deriving (Eq,Show{-was:Text-})
  101 
  102 instance Parse PElement where
  103         parseType string = (PE name no,more)
  104                 where
  105                 (name,'.':a) = span ((/=) '.') string
  106                 (no,more) = parse a
  107