Plan 9 from Bell Labs’s /usr/web/sources/contrib/fernan/nhc98/tests/nofib/real/anna/Apply.hs

Copyright © 2021 Plan 9 Foundation.
Distributed under the MIT License.
Download the Plan 9 distribution.



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

Bell Labs OSI certified Powered by Plan 9

(Return to Plan 9 Home Page)

Copyright © 2021 Plan 9 Foundation. All Rights Reserved.
Comments to [email protected].