AbstractMisc.hs 5.12 KB
Newer Older
1
 
sof's avatar
sof committed
2 3 4 5
-- ==========================================================--
-- === Miscellaneous operations in the Abstract value     ===--
-- === world.                             AbstractMisc.hs ===--
-- ==========================================================--
6 7 8 9 10 11 12 13

module AbstractMisc where
import BaseDefs
import Utils
import MyUtils
import AbstractVals2
import SuccsAndPreds2

14
import List(nub) -- 1.3
15

sof's avatar
sof committed
16
-- ==========================================================--
17 18 19 20 21 22
--
amIAboves :: Domain -> Route -> [Route]

amIAboves d r = map (r \/) (spSuccsR d r)


sof's avatar
sof committed
23
-- ==========================================================--
24 25 26 27 28 29
--
amIBelows :: Domain -> Route -> [Route]

amIBelows d r = map (r /\) (spPredsR d r)


sof's avatar
sof committed
30
-- ==========================================================--
31 32 33 34 35 36 37
--
amPushUpFF :: Domain -> [Route] -> [Route]

amPushUpFF d [] = []
amPushUpFF d xs = nub (concat (map (amIAboves d) xs))


sof's avatar
sof committed
38
-- ==========================================================--
39 40 41 42 43 44 45
--
amPushDownFF :: Domain -> [Route] -> [Route]

amPushDownFF d [] = []
amPushDownFF d xs = nub (concat (map (amIBelows d) xs))


sof's avatar
sof committed
46
-- ==========================================================--
47 48 49 50 51 52 53
--
amAllUpSlices :: Domain -> [[Route]]

amAllUpSlices d
   = takeWhile (not.null) (iterate (amPushUpFF d) [avBottomR d])


sof's avatar
sof committed
54
-- ==========================================================--
55 56 57 58 59 60 61
--
amAllDownSlices :: Domain -> [[Route]]

amAllDownSlices d
   = takeWhile (not.null) (iterate (amPushDownFF d) [avTopR d])


sof's avatar
sof committed
62
-- ==========================================================--
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
--
amAllRoutes :: Domain -> [Route]

amAllRoutes Two 
   = [Zero, One]

amAllRoutes (Lift1 dss)
   = Stop1 : map Up1 (myCartesianProduct (map amAllRoutes dss))

amAllRoutes (Lift2 dss)
   = Stop2 : Up2 : map UpUp2 (myCartesianProduct (map amAllRoutes dss))

amAllRoutes (Func dss dt)
   = concat (amAllUpSlices (Func dss dt))


sof's avatar
sof committed
79
-- ==========================================================--
80 81 82 83 84 85 86 87 88 89
--
amUpCloseOfMinf :: Domain -> [Route] -> [Route]

amUpCloseOfMinf d [] 
   = []
amUpCloseOfMinf d q@(x:_) 
   = x : (amUpCloseOfMinf d 
            (avMinR [ y \/ z | y <- q, z <- spSuccsR d x ]))


sof's avatar
sof committed
90
-- ==========================================================--
91 92 93 94 95 96 97 98 99 100
--
amDownCloseOfMaxf :: Domain -> [Route] -> [Route]

amDownCloseOfMaxf d [] 
   = []
amDownCloseOfMaxf d q@(x:_) 
   = x : (amDownCloseOfMaxf d
            (avMaxR [ y /\ z | y <- q, z <- spPredsR d x ]))


sof's avatar
sof committed
101
-- ==========================================================--
102 103 104 105 106 107 108
--
amAllRoutesMinusTopJONES :: Domain -> [Route]

amAllRoutesMinusTopJONES d
   = amDownCloseOfMaxf d (spPredsR d (avTopR d))


sof's avatar
sof committed
109
-- ==========================================================--
110 111 112 113 114 115 116 117 118 119 120 121 122
--
--amAllRoutesMinusTopMINE :: Domain -> [Route]
--
--amAllRoutesMinusTopMINE d
--   = let sliceJustBelowTop 
--            = spPredsR d (avTopR d)
--         allSlices
--            = takeWhile (not.null) 
--                        (iterate (amPushDownFF d) sliceJustBelowTop)
--     in
--         concat allSlices


sof's avatar
sof committed
123
-- ==========================================================--
124 125 126 127 128 129 130 131 132
--
amEqualPoints :: Point -> Point -> Bool

amEqualPoints (d1, r1) (d2, r2)
   = if     d1 == d2 
     then   r1 == r2 
     else   panic "Comparing points in different domains."


sof's avatar
sof committed
133
-- ==========================================================--
134 135 136 137 138 139 140 141
--
amIsaHOF :: Domain -> Bool

amIsaHOF (Func dss dt) 
   = amContainsFunctionSpace dt ||
     myAny amContainsFunctionSpace dss


sof's avatar
sof committed
142
-- ==========================================================--
143 144 145 146 147 148 149 150 151
--
amContainsFunctionSpace :: Domain -> Bool

amContainsFunctionSpace Two           = False
amContainsFunctionSpace (Lift1 dss)   = myAny amContainsFunctionSpace dss
amContainsFunctionSpace (Lift2 dss)   = myAny amContainsFunctionSpace dss
amContainsFunctionSpace (Func _ _)    = True


sof's avatar
sof committed
152
-- ==========================================================--
153 154 155 156 157 158
--
amIsDataFn :: Domain -> Bool

amIsDataFn (Func _ dt) = not (amContainsFunctionSpace dt)


sof's avatar
sof committed
159
-- ==========================================================--
160 161 162 163 164 165 166 167
--
amRepArity :: Rep -> Int

amRepArity (RepTwo (Min1Max0 ar f1 f0))                 = ar
amRepArity (Rep1 (Min1Max0 lf_ar lf_f1 lf_f0) hfs)      = lf_ar
amRepArity (Rep2 (Min1Max0 lf_ar lf_f1 lf_f0) mf hfs)   = lf_ar


sof's avatar
sof committed
168
-- ==========================================================--
169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
--
amStrongNormalise :: Domain -> Domain

amStrongNormalise Two 
   = Two

amStrongNormalise (Lift1 ds)
   = Lift1 (map amStrongNormalise ds)

amStrongNormalise (Lift2 ds)
   = Lift2 (map amStrongNormalise ds)

amStrongNormalise (Func dss (Func dss2 dt))
   = amStrongNormalise (Func (dss++dss2) dt)

amStrongNormalise (Func dss non_func_res) 
   = Func (map amStrongNormalise dss) (amStrongNormalise non_func_res)


sof's avatar
sof committed
188
-- ==========================================================--
189 190 191 192 193 194 195 196 197 198 199 200 201 202
--
amMeetIRoutes :: Domain -> [Route]

amMeetIRoutes Two 
   = [Zero]
amMeetIRoutes (Lift1 ds)
   = Stop1 :
     map Up1 (myListVariants (map avTopR ds) (map amMeetIRoutes ds))
amMeetIRoutes (Lift2 ds)
   = Stop2 :
     Up2   :
     map UpUp2 (myListVariants (map avTopR ds) (map amMeetIRoutes ds))


sof's avatar
sof committed
203 204 205
-- ==========================================================--
-- === end                                AbstractMisc.hs ===--
-- ==========================================================--
206