1 
    2 -- ==========================================================--
    3 -- === Application of function points to                  ===--
    4 -- === argument points.                          Apply.hs ===--
    5 -- ==========================================================--
    6 
    7 module Apply where
    8 import BaseDefs
    9 import Utils
   10 import MyUtils
   11 import AbstractVals2
   12 
   13 -- ==========================================================--
   14 --
   15 apApply :: Route -> [Route] -> Route
   16 
   17 apApply (Rep func) args = apPapConst (apPap func args)
   18 
   19 
   20 -- ==========================================================--
   21 --
   22 apPap_2 :: Int -> Frontier -> [Route] -> Frontier
   23 
   24 apPap_2 argCount (Min1Max0 ar f1 f0) args
   25    = let newf1 
   26             = sort (avMinfrel 
   27                    [MkFrel (drop argCount fel) 
   28                    | MkFrel fel <- f1, 
   29                      myAndWith2 (<<) (take argCount fel) args
   30                    ])
   31          newf0 
   32             = sort (avMaxfrel 
   33                    [MkFrel (drop argCount fel) 
   34                    | MkFrel fel <- f0,
   35                      myAndWith2 (<<) args (take argCount fel)
   36                    ])
   37          result = Min1Max0 (ar-argCount) newf1 newf0
   38      in
   39          if argCount <= ar then result else panic "apPap_2"
   40 
   41 
   42 -- ==========================================================--
   43 --
   44 apPap :: Rep -> [Route] -> Rep
   45 
   46 apPap (RepTwo fr) args
   47    = let argCount = length args
   48      in
   49          RepTwo (apPap_2 argCount fr args)
   50                         
   51 apPap (Rep1 lf hfs) args
   52    = let argCount = length args
   53          new_lf = apPap_2 argCount lf args
   54          new_hfs = map (flip apPap args) hfs
   55      in
   56          Rep1 new_lf new_hfs
   57 
   58 apPap (Rep2 lf mf hfs) args
   59    = let argCount = length args
   60          new_lf = apPap_2 argCount lf args
   61          new_mf = apPap_2 argCount mf args
   62          new_hfs = map (flip apPap args) hfs
   63      in
   64          Rep2 new_lf new_mf new_hfs
   65 
   66 
   67 -- ==========================================================--
   68 --
   69 apPapConst :: Rep -> Route
   70 
   71 apPapConst rep@(RepTwo (Min1Max0 ar f1 f0))
   72    | ar > 0                           = Rep rep
   73    | null f1 && not (null f0)         = Zero
   74    | not (null f1) && null f0         = One
   75    | otherwise                        = panic "apPapConst(1)"
   76 
   77 apPapConst rep@(Rep1 (Min1Max0 lf_ar lf_f1 lf_f0) hfs)
   78    | lf_ar > 0 = Rep rep
   79    | null lf_f1 && not (null lf_f0)   = Stop1
   80    | not (null lf_f1) && null lf_f0   = Up1 (map apPapConst hfs)
   81    | otherwise                        = panic "apPapConst(2)"
   82 
   83 apPapConst rep@(Rep2 (Min1Max0 lf_ar lf_f1 lf_f0) (Min1Max0 mf_ar mf_f1 mf_f0) hfs)
   84    | lf_ar > 0 = Rep rep
   85    | null lf_f1 && not (null lf_f0)   = Stop2
   86    | null mf_f1 && not (null mf_f0)   = Up2
   87    | not (null mf_f1) && null mf_f0   = UpUp2 (map apPapConst hfs)
   88    | otherwise                        = panic "apPapConst(3)"
   89 
   90 
   91 -- ==========================================================--
   92 -- === end                                       Apply.hs ===--
   93 -- ==========================================================--