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 -- ==========================================================--