-- ==========================================================--
-- === Application of function points to ===--
-- === argument points. Apply.hs ===--
-- ==========================================================--
module Apply where
import BaseDefs
import Utils
import MyUtils
import AbstractVals2
-- ==========================================================--
--
apApply :: Route -> [Route] -> Route
apApply (Rep func) args = apPapConst (apPap func args)
-- ==========================================================--
--
apPap_2 :: Int -> Frontier -> [Route] -> Frontier
apPap_2 argCount (Min1Max0 ar f1 f0) args
= let newf1
= sort (avMinfrel
[MkFrel (drop argCount fel)
| MkFrel fel <- f1,
myAndWith2 (<<) (take argCount fel) args
])
newf0
= sort (avMaxfrel
[MkFrel (drop argCount fel)
| MkFrel fel <- f0,
myAndWith2 (<<) args (take argCount fel)
])
result = Min1Max0 (ar-argCount) newf1 newf0
in
if argCount <= ar then result else panic "apPap_2"
-- ==========================================================--
--
apPap :: Rep -> [Route] -> Rep
apPap (RepTwo fr) args
= let argCount = length args
in
RepTwo (apPap_2 argCount fr args)
apPap (Rep1 lf hfs) args
= let argCount = length args
new_lf = apPap_2 argCount lf args
new_hfs = map (flip apPap args) hfs
in
Rep1 new_lf new_hfs
apPap (Rep2 lf mf hfs) args
= let argCount = length args
new_lf = apPap_2 argCount lf args
new_mf = apPap_2 argCount mf args
new_hfs = map (flip apPap args) hfs
in
Rep2 new_lf new_mf new_hfs
-- ==========================================================--
--
apPapConst :: Rep -> Route
apPapConst rep@(RepTwo (Min1Max0 ar f1 f0))
| ar > 0 = Rep rep
| null f1 && not (null f0) = Zero
| not (null f1) && null f0 = One
| otherwise = panic "apPapConst(1)"
apPapConst rep@(Rep1 (Min1Max0 lf_ar lf_f1 lf_f0) hfs)
| lf_ar > 0 = Rep rep
| null lf_f1 && not (null lf_f0) = Stop1
| not (null lf_f1) && null lf_f0 = Up1 (map apPapConst hfs)
| otherwise = panic "apPapConst(2)"
apPapConst rep@(Rep2 (Min1Max0 lf_ar lf_f1 lf_f0) (Min1Max0 mf_ar mf_f1 mf_f0) hfs)
| lf_ar > 0 = Rep rep
| null lf_f1 && not (null lf_f0) = Stop2
| null mf_f1 && not (null mf_f0) = Up2
| not (null mf_f1) && null mf_f0 = UpUp2 (map apPapConst hfs)
| otherwise = panic "apPapConst(3)"
-- ==========================================================--
-- === end Apply.hs ===--
-- ==========================================================--
|