/export/starexec/sandbox/solver/bin/starexec_run_standard /export/starexec/sandbox/benchmark/theBenchmark.hs /export/starexec/sandbox/output/output_files -------------------------------------------------------------------------------- MAYBE proof of /export/starexec/sandbox/benchmark/theBenchmark.hs # AProVE Commit ID: 794c25de1cacf0d048858bcd21c9a779e1221865 marcel 20200619 unpublished dirty H-Termination with start terms of the given HASKELL could not be shown: (0) HASKELL (1) LR [EQUIVALENT, 0 ms] (2) HASKELL (3) CR [EQUIVALENT, 0 ms] (4) HASKELL (5) IFR [EQUIVALENT, 0 ms] (6) HASKELL (7) BR [EQUIVALENT, 0 ms] (8) HASKELL (9) COR [EQUIVALENT, 0 ms] (10) HASKELL (11) LetRed [EQUIVALENT, 0 ms] (12) HASKELL (13) NumRed [SOUND, 7 ms] (14) HASKELL ---------------------------------------- (0) Obligation: mainModule Main module FiniteMap where { import qualified Main; import qualified Maybe; import qualified Prelude; data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b) ; instance (Eq a, Eq b) => Eq FiniteMap a b where { (==) fm_1 fm_2 = sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2; } addToFM :: Ord b => FiniteMap b a -> b -> a -> FiniteMap b a; addToFM fm key elt = addToFM_C (\old new ->new) fm key elt; addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a; addToFM_C combiner EmptyFM key elt = unitFM key elt; addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt | new_key < key = mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r | new_key > key = mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) | otherwise = Branch new_key (combiner elt new_elt) size fm_l fm_r; deleteMax :: Ord b => FiniteMap b a -> FiniteMap b a; deleteMax (Branch key elt _ fm_l EmptyFM) = fm_l; deleteMax (Branch key elt _ fm_l fm_r) = mkBalBranch key elt fm_l (deleteMax fm_r); deleteMin :: Ord b => FiniteMap b a -> FiniteMap b a; deleteMin (Branch key elt _ EmptyFM fm_r) = fm_r; deleteMin (Branch key elt _ fm_l fm_r) = mkBalBranch key elt (deleteMin fm_l) fm_r; emptyFM :: FiniteMap a b; emptyFM = EmptyFM; findMax :: FiniteMap b a -> (b,a); findMax (Branch key elt _ _ EmptyFM) = (key,elt); findMax (Branch key elt _ _ fm_r) = findMax fm_r; findMin :: FiniteMap a b -> (a,b); findMin (Branch key elt _ EmptyFM _) = (key,elt); findMin (Branch key elt _ fm_l _) = findMin fm_l; fmToList :: FiniteMap a b -> [(a,b)]; fmToList fm = foldFM (\key elt rest ->(key,elt) : rest) [] fm; foldFM :: (a -> c -> b -> b) -> b -> FiniteMap a c -> b; foldFM k z EmptyFM = z; foldFM k z (Branch key elt _ fm_l fm_r) = foldFM k (k key elt (foldFM k z fm_r)) fm_l; glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b; glueBal EmptyFM fm2 = fm2; glueBal fm1 EmptyFM = fm1; glueBal fm1 fm2 | sizeFM fm2 > sizeFM fm1 = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) | otherwise = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 where { mid_elt1 = (\(_,mid_elt1) ->mid_elt1) vv2; mid_elt2 = (\(_,mid_elt2) ->mid_elt2) vv3; mid_key1 = (\(mid_key1,_) ->mid_key1) vv2; mid_key2 = (\(mid_key2,_) ->mid_key2) vv3; vv2 = findMax fm1; vv3 = findMin fm2; }; glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b; glueVBal EmptyFM fm2 = fm2; glueVBal fm1 EmptyFM = fm1; glueVBal fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | sIZE_RATIO * size_l < size_r = mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr | sIZE_RATIO * size_r < size_l = mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) | otherwise = glueBal fm_l fm_r where { size_l = sizeFM fm_l; size_r = sizeFM fm_r; }; intersectFM_C :: Ord a => (b -> d -> c) -> FiniteMap a b -> FiniteMap a d -> FiniteMap a c; intersectFM_C combiner fm1 EmptyFM = emptyFM; intersectFM_C combiner EmptyFM fm2 = emptyFM; intersectFM_C combiner fm1 (Branch split_key elt2 _ left right) | Maybe.isJust maybe_elt1 = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) | otherwise = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) where { elt1 = (\(Just elt1) ->elt1) vv1; gts = splitGT fm1 split_key; lts = splitLT fm1 split_key; maybe_elt1 = lookupFM fm1 split_key; vv1 = maybe_elt1; }; lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b; lookupFM EmptyFM key = Nothing; lookupFM (Branch key elt _ fm_l fm_r) key_to_find | key_to_find < key = lookupFM fm_l key_to_find | key_to_find > key = lookupFM fm_r key_to_find | otherwise = Just elt; mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkBalBranch key elt fm_L fm_R | size_l + size_r < 2 = mkBranch 1 key elt fm_L fm_R | size_r > sIZE_RATIO * size_l = case fm_R of { Branch _ _ _ fm_rl fm_rr | sizeFM fm_rl < 2 * sizeFM fm_rr -> single_L fm_L fm_R | otherwise -> double_L fm_L fm_R; } | size_l > sIZE_RATIO * size_r = case fm_L of { Branch _ _ _ fm_ll fm_lr | sizeFM fm_lr < 2 * sizeFM fm_ll -> single_R fm_L fm_R | otherwise -> double_R fm_L fm_R; } | otherwise = mkBranch 2 key elt fm_L fm_R where { double_L fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); double_R (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r); single_L fm_l (Branch key_r elt_r _ fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr; single_R (Branch key_l elt_l _ fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r); size_l = sizeFM fm_L; size_r = sizeFM fm_R; }; mkBranch :: Ord a => Int -> a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkBranch which key elt fm_l fm_r = let { result = Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r; } in result where { balance_ok = True; left_ok = case fm_l of { EmptyFM-> True; Branch left_key _ _ _ _-> let { biggest_left_key = fst (findMax fm_l); } in biggest_left_key < key; } ; left_size = sizeFM fm_l; right_ok = case fm_r of { EmptyFM-> True; Branch right_key _ _ _ _-> let { smallest_right_key = fst (findMin fm_r); } in key < smallest_right_key; } ; right_size = sizeFM fm_r; unbox :: Int -> Int; unbox x = x; }; mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkVBalBranch key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | sIZE_RATIO * size_l < size_r = mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr | sIZE_RATIO * size_r < size_l = mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) | otherwise = mkBranch 13 key elt fm_l fm_r where { size_l = sizeFM fm_l; size_r = sizeFM fm_r; }; sIZE_RATIO :: Int; sIZE_RATIO = 5; sizeFM :: FiniteMap a b -> Int; sizeFM EmptyFM = 0; sizeFM (Branch _ _ size _ _) = size; splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitGT EmptyFM split_key = emptyFM; splitGT (Branch key elt _ fm_l fm_r) split_key | split_key > key = splitGT fm_r split_key | split_key < key = mkVBalBranch key elt (splitGT fm_l split_key) fm_r | otherwise = fm_r; splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitLT EmptyFM split_key = emptyFM; splitLT (Branch key elt _ fm_l fm_r) split_key | split_key < key = splitLT fm_l split_key | split_key > key = mkVBalBranch key elt fm_l (splitLT fm_r split_key) | otherwise = fm_l; unitFM :: b -> a -> FiniteMap b a; unitFM key elt = Branch key elt 1 emptyFM emptyFM; } module Maybe where { import qualified FiniteMap; import qualified Main; import qualified Prelude; isJust :: Maybe a -> Bool; isJust Nothing = False; isJust _ = True; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (1) LR (EQUIVALENT) Lambda Reductions: The following Lambda expression "\oldnew->new" is transformed to "addToFM0 old new = new; " The following Lambda expression "\(_,mid_elt2)->mid_elt2" is transformed to "mid_elt20 (_,mid_elt2) = mid_elt2; " The following Lambda expression "\(mid_key2,_)->mid_key2" is transformed to "mid_key20 (mid_key2,_) = mid_key2; " The following Lambda expression "\(mid_key1,_)->mid_key1" is transformed to "mid_key10 (mid_key1,_) = mid_key1; " The following Lambda expression "\(_,mid_elt1)->mid_elt1" is transformed to "mid_elt10 (_,mid_elt1) = mid_elt1; " The following Lambda expression "\keyeltrest->(key,elt) : rest" is transformed to "fmToList0 key elt rest = (key,elt) : rest; " The following Lambda expression "\(Just elt1)->elt1" is transformed to "elt10 (Just elt1) = elt1; " ---------------------------------------- (2) Obligation: mainModule Main module FiniteMap where { import qualified Main; import qualified Maybe; import qualified Prelude; data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b) ; instance (Eq a, Eq b) => Eq FiniteMap a b where { (==) fm_1 fm_2 = sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2; } addToFM :: Ord b => FiniteMap b a -> b -> a -> FiniteMap b a; addToFM fm key elt = addToFM_C addToFM0 fm key elt; addToFM0 old new = new; addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a; addToFM_C combiner EmptyFM key elt = unitFM key elt; addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt | new_key < key = mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r | new_key > key = mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) | otherwise = Branch new_key (combiner elt new_elt) size fm_l fm_r; deleteMax :: Ord b => FiniteMap b a -> FiniteMap b a; deleteMax (Branch key elt _ fm_l EmptyFM) = fm_l; deleteMax (Branch key elt _ fm_l fm_r) = mkBalBranch key elt fm_l (deleteMax fm_r); deleteMin :: Ord b => FiniteMap b a -> FiniteMap b a; deleteMin (Branch key elt _ EmptyFM fm_r) = fm_r; deleteMin (Branch key elt _ fm_l fm_r) = mkBalBranch key elt (deleteMin fm_l) fm_r; emptyFM :: FiniteMap b a; emptyFM = EmptyFM; findMax :: FiniteMap b a -> (b,a); findMax (Branch key elt _ _ EmptyFM) = (key,elt); findMax (Branch key elt _ _ fm_r) = findMax fm_r; findMin :: FiniteMap a b -> (a,b); findMin (Branch key elt _ EmptyFM _) = (key,elt); findMin (Branch key elt _ fm_l _) = findMin fm_l; fmToList :: FiniteMap b a -> [(b,a)]; fmToList fm = foldFM fmToList0 [] fm; fmToList0 key elt rest = (key,elt) : rest; foldFM :: (c -> a -> b -> b) -> b -> FiniteMap c a -> b; foldFM k z EmptyFM = z; foldFM k z (Branch key elt _ fm_l fm_r) = foldFM k (k key elt (foldFM k z fm_r)) fm_l; glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b; glueBal EmptyFM fm2 = fm2; glueBal fm1 EmptyFM = fm1; glueBal fm1 fm2 | sizeFM fm2 > sizeFM fm1 = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) | otherwise = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 where { mid_elt1 = mid_elt10 vv2; mid_elt10 (_,mid_elt1) = mid_elt1; mid_elt2 = mid_elt20 vv3; mid_elt20 (_,mid_elt2) = mid_elt2; mid_key1 = mid_key10 vv2; mid_key10 (mid_key1,_) = mid_key1; mid_key2 = mid_key20 vv3; mid_key20 (mid_key2,_) = mid_key2; vv2 = findMax fm1; vv3 = findMin fm2; }; glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a; glueVBal EmptyFM fm2 = fm2; glueVBal fm1 EmptyFM = fm1; glueVBal fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | sIZE_RATIO * size_l < size_r = mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr | sIZE_RATIO * size_r < size_l = mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) | otherwise = glueBal fm_l fm_r where { size_l = sizeFM fm_l; size_r = sizeFM fm_r; }; intersectFM_C :: Ord b => (d -> c -> a) -> FiniteMap b d -> FiniteMap b c -> FiniteMap b a; intersectFM_C combiner fm1 EmptyFM = emptyFM; intersectFM_C combiner EmptyFM fm2 = emptyFM; intersectFM_C combiner fm1 (Branch split_key elt2 _ left right) | Maybe.isJust maybe_elt1 = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) | otherwise = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) where { elt1 = elt10 vv1; elt10 (Just elt1) = elt1; gts = splitGT fm1 split_key; lts = splitLT fm1 split_key; maybe_elt1 = lookupFM fm1 split_key; vv1 = maybe_elt1; }; lookupFM :: Ord b => FiniteMap b a -> b -> Maybe a; lookupFM EmptyFM key = Nothing; lookupFM (Branch key elt _ fm_l fm_r) key_to_find | key_to_find < key = lookupFM fm_l key_to_find | key_to_find > key = lookupFM fm_r key_to_find | otherwise = Just elt; mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkBalBranch key elt fm_L fm_R | size_l + size_r < 2 = mkBranch 1 key elt fm_L fm_R | size_r > sIZE_RATIO * size_l = case fm_R of { Branch _ _ _ fm_rl fm_rr | sizeFM fm_rl < 2 * sizeFM fm_rr -> single_L fm_L fm_R | otherwise -> double_L fm_L fm_R; } | size_l > sIZE_RATIO * size_r = case fm_L of { Branch _ _ _ fm_ll fm_lr | sizeFM fm_lr < 2 * sizeFM fm_ll -> single_R fm_L fm_R | otherwise -> double_R fm_L fm_R; } | otherwise = mkBranch 2 key elt fm_L fm_R where { double_L fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); double_R (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r); single_L fm_l (Branch key_r elt_r _ fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr; single_R (Branch key_l elt_l _ fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r); size_l = sizeFM fm_L; size_r = sizeFM fm_R; }; mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkBranch which key elt fm_l fm_r = let { result = Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r; } in result where { balance_ok = True; left_ok = case fm_l of { EmptyFM-> True; Branch left_key _ _ _ _-> let { biggest_left_key = fst (findMax fm_l); } in biggest_left_key < key; } ; left_size = sizeFM fm_l; right_ok = case fm_r of { EmptyFM-> True; Branch right_key _ _ _ _-> let { smallest_right_key = fst (findMin fm_r); } in key < smallest_right_key; } ; right_size = sizeFM fm_r; unbox :: Int -> Int; unbox x = x; }; mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkVBalBranch key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | sIZE_RATIO * size_l < size_r = mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr | sIZE_RATIO * size_r < size_l = mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) | otherwise = mkBranch 13 key elt fm_l fm_r where { size_l = sizeFM fm_l; size_r = sizeFM fm_r; }; sIZE_RATIO :: Int; sIZE_RATIO = 5; sizeFM :: FiniteMap a b -> Int; sizeFM EmptyFM = 0; sizeFM (Branch _ _ size _ _) = size; splitGT :: Ord a => FiniteMap a b -> a -> FiniteMap a b; splitGT EmptyFM split_key = emptyFM; splitGT (Branch key elt _ fm_l fm_r) split_key | split_key > key = splitGT fm_r split_key | split_key < key = mkVBalBranch key elt (splitGT fm_l split_key) fm_r | otherwise = fm_r; splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitLT EmptyFM split_key = emptyFM; splitLT (Branch key elt _ fm_l fm_r) split_key | split_key < key = splitLT fm_l split_key | split_key > key = mkVBalBranch key elt fm_l (splitLT fm_r split_key) | otherwise = fm_l; unitFM :: a -> b -> FiniteMap a b; unitFM key elt = Branch key elt 1 emptyFM emptyFM; } module Maybe where { import qualified FiniteMap; import qualified Main; import qualified Prelude; isJust :: Maybe a -> Bool; isJust Nothing = False; isJust _ = True; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (3) CR (EQUIVALENT) Case Reductions: The following Case expression "case compare x y of { EQ -> o; LT -> LT; GT -> GT} " is transformed to "primCompAux0 o EQ = o; primCompAux0 o LT = LT; primCompAux0 o GT = GT; " The following Case expression "case fm_r of { EmptyFM -> True; Branch right_key _ _ _ _ -> let { smallest_right_key = fst (findMin fm_r); } in key < smallest_right_key} " is transformed to "right_ok0 fm_r key EmptyFM = True; right_ok0 fm_r key (Branch right_key _ _ _ _) = let { smallest_right_key = fst (findMin fm_r); } in key < smallest_right_key; " The following Case expression "case fm_l of { EmptyFM -> True; Branch left_key _ _ _ _ -> let { biggest_left_key = fst (findMax fm_l); } in biggest_left_key < key} " is transformed to "left_ok0 fm_l key EmptyFM = True; left_ok0 fm_l key (Branch left_key _ _ _ _) = let { biggest_left_key = fst (findMax fm_l); } in biggest_left_key < key; " The following Case expression "case fm_R of { Branch _ _ _ fm_rl fm_rr |sizeFM fm_rl < 2 * sizeFM fm_rrsingle_L fm_L fm_R|otherwisedouble_L fm_L fm_R} " is transformed to "mkBalBranch0 fm_L fm_R (Branch _ _ _ fm_rl fm_rr)|sizeFM fm_rl < 2 * sizeFM fm_rrsingle_L fm_L fm_R|otherwisedouble_L fm_L fm_R; " The following Case expression "case fm_L of { Branch _ _ _ fm_ll fm_lr |sizeFM fm_lr < 2 * sizeFM fm_llsingle_R fm_L fm_R|otherwisedouble_R fm_L fm_R} " is transformed to "mkBalBranch1 fm_L fm_R (Branch _ _ _ fm_ll fm_lr)|sizeFM fm_lr < 2 * sizeFM fm_llsingle_R fm_L fm_R|otherwisedouble_R fm_L fm_R; " ---------------------------------------- (4) Obligation: mainModule Main module FiniteMap where { import qualified Main; import qualified Maybe; import qualified Prelude; data FiniteMap b a = EmptyFM | Branch b a Int (FiniteMap b a) (FiniteMap b a) ; instance (Eq a, Eq b) => Eq FiniteMap b a where { (==) fm_1 fm_2 = sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2; } addToFM :: Ord b => FiniteMap b a -> b -> a -> FiniteMap b a; addToFM fm key elt = addToFM_C addToFM0 fm key elt; addToFM0 old new = new; addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a; addToFM_C combiner EmptyFM key elt = unitFM key elt; addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt | new_key < key = mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r | new_key > key = mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) | otherwise = Branch new_key (combiner elt new_elt) size fm_l fm_r; deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMax (Branch key elt _ fm_l EmptyFM) = fm_l; deleteMax (Branch key elt _ fm_l fm_r) = mkBalBranch key elt fm_l (deleteMax fm_r); deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMin (Branch key elt _ EmptyFM fm_r) = fm_r; deleteMin (Branch key elt _ fm_l fm_r) = mkBalBranch key elt (deleteMin fm_l) fm_r; emptyFM :: FiniteMap b a; emptyFM = EmptyFM; findMax :: FiniteMap a b -> (a,b); findMax (Branch key elt _ _ EmptyFM) = (key,elt); findMax (Branch key elt _ _ fm_r) = findMax fm_r; findMin :: FiniteMap a b -> (a,b); findMin (Branch key elt _ EmptyFM _) = (key,elt); findMin (Branch key elt _ fm_l _) = findMin fm_l; fmToList :: FiniteMap b a -> [(b,a)]; fmToList fm = foldFM fmToList0 [] fm; fmToList0 key elt rest = (key,elt) : rest; foldFM :: (c -> a -> b -> b) -> b -> FiniteMap c a -> b; foldFM k z EmptyFM = z; foldFM k z (Branch key elt _ fm_l fm_r) = foldFM k (k key elt (foldFM k z fm_r)) fm_l; glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a; glueBal EmptyFM fm2 = fm2; glueBal fm1 EmptyFM = fm1; glueBal fm1 fm2 | sizeFM fm2 > sizeFM fm1 = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) | otherwise = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 where { mid_elt1 = mid_elt10 vv2; mid_elt10 (_,mid_elt1) = mid_elt1; mid_elt2 = mid_elt20 vv3; mid_elt20 (_,mid_elt2) = mid_elt2; mid_key1 = mid_key10 vv2; mid_key10 (mid_key1,_) = mid_key1; mid_key2 = mid_key20 vv3; mid_key20 (mid_key2,_) = mid_key2; vv2 = findMax fm1; vv3 = findMin fm2; }; glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a; glueVBal EmptyFM fm2 = fm2; glueVBal fm1 EmptyFM = fm1; glueVBal fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | sIZE_RATIO * size_l < size_r = mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr | sIZE_RATIO * size_r < size_l = mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) | otherwise = glueBal fm_l fm_r where { size_l = sizeFM fm_l; size_r = sizeFM fm_r; }; intersectFM_C :: Ord c => (b -> d -> a) -> FiniteMap c b -> FiniteMap c d -> FiniteMap c a; intersectFM_C combiner fm1 EmptyFM = emptyFM; intersectFM_C combiner EmptyFM fm2 = emptyFM; intersectFM_C combiner fm1 (Branch split_key elt2 _ left right) | Maybe.isJust maybe_elt1 = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) | otherwise = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) where { elt1 = elt10 vv1; elt10 (Just elt1) = elt1; gts = splitGT fm1 split_key; lts = splitLT fm1 split_key; maybe_elt1 = lookupFM fm1 split_key; vv1 = maybe_elt1; }; lookupFM :: Ord b => FiniteMap b a -> b -> Maybe a; lookupFM EmptyFM key = Nothing; lookupFM (Branch key elt _ fm_l fm_r) key_to_find | key_to_find < key = lookupFM fm_l key_to_find | key_to_find > key = lookupFM fm_r key_to_find | otherwise = Just elt; mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkBalBranch key elt fm_L fm_R | size_l + size_r < 2 = mkBranch 1 key elt fm_L fm_R | size_r > sIZE_RATIO * size_l = mkBalBranch0 fm_L fm_R fm_R | size_l > sIZE_RATIO * size_r = mkBalBranch1 fm_L fm_R fm_L | otherwise = mkBranch 2 key elt fm_L fm_R where { double_L fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); double_R (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r); mkBalBranch0 fm_L fm_R (Branch _ _ _ fm_rl fm_rr) | sizeFM fm_rl < 2 * sizeFM fm_rr = single_L fm_L fm_R | otherwise = double_L fm_L fm_R; mkBalBranch1 fm_L fm_R (Branch _ _ _ fm_ll fm_lr) | sizeFM fm_lr < 2 * sizeFM fm_ll = single_R fm_L fm_R | otherwise = double_R fm_L fm_R; single_L fm_l (Branch key_r elt_r _ fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr; single_R (Branch key_l elt_l _ fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r); size_l = sizeFM fm_L; size_r = sizeFM fm_R; }; mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkBranch which key elt fm_l fm_r = let { result = Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r; } in result where { balance_ok = True; left_ok = left_ok0 fm_l key fm_l; left_ok0 fm_l key EmptyFM = True; left_ok0 fm_l key (Branch left_key _ _ _ _) = let { biggest_left_key = fst (findMax fm_l); } in biggest_left_key < key; left_size = sizeFM fm_l; right_ok = right_ok0 fm_r key fm_r; right_ok0 fm_r key EmptyFM = True; right_ok0 fm_r key (Branch right_key _ _ _ _) = let { smallest_right_key = fst (findMin fm_r); } in key < smallest_right_key; right_size = sizeFM fm_r; unbox :: Int -> Int; unbox x = x; }; mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkVBalBranch key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | sIZE_RATIO * size_l < size_r = mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr | sIZE_RATIO * size_r < size_l = mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) | otherwise = mkBranch 13 key elt fm_l fm_r where { size_l = sizeFM fm_l; size_r = sizeFM fm_r; }; sIZE_RATIO :: Int; sIZE_RATIO = 5; sizeFM :: FiniteMap a b -> Int; sizeFM EmptyFM = 0; sizeFM (Branch _ _ size _ _) = size; splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitGT EmptyFM split_key = emptyFM; splitGT (Branch key elt _ fm_l fm_r) split_key | split_key > key = splitGT fm_r split_key | split_key < key = mkVBalBranch key elt (splitGT fm_l split_key) fm_r | otherwise = fm_r; splitLT :: Ord a => FiniteMap a b -> a -> FiniteMap a b; splitLT EmptyFM split_key = emptyFM; splitLT (Branch key elt _ fm_l fm_r) split_key | split_key < key = splitLT fm_l split_key | split_key > key = mkVBalBranch key elt fm_l (splitLT fm_r split_key) | otherwise = fm_l; unitFM :: a -> b -> FiniteMap a b; unitFM key elt = Branch key elt 1 emptyFM emptyFM; } module Maybe where { import qualified FiniteMap; import qualified Main; import qualified Prelude; isJust :: Maybe a -> Bool; isJust Nothing = False; isJust _ = True; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (5) IFR (EQUIVALENT) If Reductions: The following If expression "if primGEqNatS x y then Succ (primDivNatS (primMinusNatS x y) (Succ y)) else Zero" is transformed to "primDivNatS0 x y True = Succ (primDivNatS (primMinusNatS x y) (Succ y)); primDivNatS0 x y False = Zero; " The following If expression "if primGEqNatS x y then primModNatS (primMinusNatS x y) (Succ y) else Succ x" is transformed to "primModNatS0 x y True = primModNatS (primMinusNatS x y) (Succ y); primModNatS0 x y False = Succ x; " ---------------------------------------- (6) Obligation: mainModule Main module FiniteMap where { import qualified Main; import qualified Maybe; import qualified Prelude; data FiniteMap b a = EmptyFM | Branch b a Int (FiniteMap b a) (FiniteMap b a) ; instance (Eq a, Eq b) => Eq FiniteMap a b where { (==) fm_1 fm_2 = sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2; } addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b; addToFM fm key elt = addToFM_C addToFM0 fm key elt; addToFM0 old new = new; addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a; addToFM_C combiner EmptyFM key elt = unitFM key elt; addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt | new_key < key = mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r | new_key > key = mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) | otherwise = Branch new_key (combiner elt new_elt) size fm_l fm_r; deleteMax :: Ord b => FiniteMap b a -> FiniteMap b a; deleteMax (Branch key elt _ fm_l EmptyFM) = fm_l; deleteMax (Branch key elt _ fm_l fm_r) = mkBalBranch key elt fm_l (deleteMax fm_r); deleteMin :: Ord b => FiniteMap b a -> FiniteMap b a; deleteMin (Branch key elt _ EmptyFM fm_r) = fm_r; deleteMin (Branch key elt _ fm_l fm_r) = mkBalBranch key elt (deleteMin fm_l) fm_r; emptyFM :: FiniteMap a b; emptyFM = EmptyFM; findMax :: FiniteMap a b -> (a,b); findMax (Branch key elt _ _ EmptyFM) = (key,elt); findMax (Branch key elt _ _ fm_r) = findMax fm_r; findMin :: FiniteMap a b -> (a,b); findMin (Branch key elt _ EmptyFM _) = (key,elt); findMin (Branch key elt _ fm_l _) = findMin fm_l; fmToList :: FiniteMap a b -> [(a,b)]; fmToList fm = foldFM fmToList0 [] fm; fmToList0 key elt rest = (key,elt) : rest; foldFM :: (c -> b -> a -> a) -> a -> FiniteMap c b -> a; foldFM k z EmptyFM = z; foldFM k z (Branch key elt _ fm_l fm_r) = foldFM k (k key elt (foldFM k z fm_r)) fm_l; glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a; glueBal EmptyFM fm2 = fm2; glueBal fm1 EmptyFM = fm1; glueBal fm1 fm2 | sizeFM fm2 > sizeFM fm1 = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) | otherwise = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 where { mid_elt1 = mid_elt10 vv2; mid_elt10 (_,mid_elt1) = mid_elt1; mid_elt2 = mid_elt20 vv3; mid_elt20 (_,mid_elt2) = mid_elt2; mid_key1 = mid_key10 vv2; mid_key10 (mid_key1,_) = mid_key1; mid_key2 = mid_key20 vv3; mid_key20 (mid_key2,_) = mid_key2; vv2 = findMax fm1; vv3 = findMin fm2; }; glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b; glueVBal EmptyFM fm2 = fm2; glueVBal fm1 EmptyFM = fm1; glueVBal fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | sIZE_RATIO * size_l < size_r = mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr | sIZE_RATIO * size_r < size_l = mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) | otherwise = glueBal fm_l fm_r where { size_l = sizeFM fm_l; size_r = sizeFM fm_r; }; intersectFM_C :: Ord b => (c -> a -> d) -> FiniteMap b c -> FiniteMap b a -> FiniteMap b d; intersectFM_C combiner fm1 EmptyFM = emptyFM; intersectFM_C combiner EmptyFM fm2 = emptyFM; intersectFM_C combiner fm1 (Branch split_key elt2 _ left right) | Maybe.isJust maybe_elt1 = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) | otherwise = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) where { elt1 = elt10 vv1; elt10 (Just elt1) = elt1; gts = splitGT fm1 split_key; lts = splitLT fm1 split_key; maybe_elt1 = lookupFM fm1 split_key; vv1 = maybe_elt1; }; lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b; lookupFM EmptyFM key = Nothing; lookupFM (Branch key elt _ fm_l fm_r) key_to_find | key_to_find < key = lookupFM fm_l key_to_find | key_to_find > key = lookupFM fm_r key_to_find | otherwise = Just elt; mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkBalBranch key elt fm_L fm_R | size_l + size_r < 2 = mkBranch 1 key elt fm_L fm_R | size_r > sIZE_RATIO * size_l = mkBalBranch0 fm_L fm_R fm_R | size_l > sIZE_RATIO * size_r = mkBalBranch1 fm_L fm_R fm_L | otherwise = mkBranch 2 key elt fm_L fm_R where { double_L fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); double_R (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r); mkBalBranch0 fm_L fm_R (Branch _ _ _ fm_rl fm_rr) | sizeFM fm_rl < 2 * sizeFM fm_rr = single_L fm_L fm_R | otherwise = double_L fm_L fm_R; mkBalBranch1 fm_L fm_R (Branch _ _ _ fm_ll fm_lr) | sizeFM fm_lr < 2 * sizeFM fm_ll = single_R fm_L fm_R | otherwise = double_R fm_L fm_R; single_L fm_l (Branch key_r elt_r _ fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr; single_R (Branch key_l elt_l _ fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r); size_l = sizeFM fm_L; size_r = sizeFM fm_R; }; mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkBranch which key elt fm_l fm_r = let { result = Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r; } in result where { balance_ok = True; left_ok = left_ok0 fm_l key fm_l; left_ok0 fm_l key EmptyFM = True; left_ok0 fm_l key (Branch left_key _ _ _ _) = let { biggest_left_key = fst (findMax fm_l); } in biggest_left_key < key; left_size = sizeFM fm_l; right_ok = right_ok0 fm_r key fm_r; right_ok0 fm_r key EmptyFM = True; right_ok0 fm_r key (Branch right_key _ _ _ _) = let { smallest_right_key = fst (findMin fm_r); } in key < smallest_right_key; right_size = sizeFM fm_r; unbox :: Int -> Int; unbox x = x; }; mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkVBalBranch key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | sIZE_RATIO * size_l < size_r = mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr | sIZE_RATIO * size_r < size_l = mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) | otherwise = mkBranch 13 key elt fm_l fm_r where { size_l = sizeFM fm_l; size_r = sizeFM fm_r; }; sIZE_RATIO :: Int; sIZE_RATIO = 5; sizeFM :: FiniteMap a b -> Int; sizeFM EmptyFM = 0; sizeFM (Branch _ _ size _ _) = size; splitGT :: Ord a => FiniteMap a b -> a -> FiniteMap a b; splitGT EmptyFM split_key = emptyFM; splitGT (Branch key elt _ fm_l fm_r) split_key | split_key > key = splitGT fm_r split_key | split_key < key = mkVBalBranch key elt (splitGT fm_l split_key) fm_r | otherwise = fm_r; splitLT :: Ord a => FiniteMap a b -> a -> FiniteMap a b; splitLT EmptyFM split_key = emptyFM; splitLT (Branch key elt _ fm_l fm_r) split_key | split_key < key = splitLT fm_l split_key | split_key > key = mkVBalBranch key elt fm_l (splitLT fm_r split_key) | otherwise = fm_l; unitFM :: a -> b -> FiniteMap a b; unitFM key elt = Branch key elt 1 emptyFM emptyFM; } module Maybe where { import qualified FiniteMap; import qualified Main; import qualified Prelude; isJust :: Maybe a -> Bool; isJust Nothing = False; isJust _ = True; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (7) BR (EQUIVALENT) Replaced joker patterns by fresh variables and removed binding patterns. Binding Reductions: The bind variable of the following binding Pattern "fm_l@(Branch vuu vuv vuw vux vuy)" is replaced by the following term "Branch vuu vuv vuw vux vuy" The bind variable of the following binding Pattern "fm_r@(Branch vvu vvv vvw vvx vvy)" is replaced by the following term "Branch vvu vvv vvw vvx vvy" The bind variable of the following binding Pattern "fm_l@(Branch wvw wvx wvy wvz wwu)" is replaced by the following term "Branch wvw wvx wvy wvz wwu" The bind variable of the following binding Pattern "fm_r@(Branch www wwx wwy wwz wxu)" is replaced by the following term "Branch www wwx wwy wwz wxu" ---------------------------------------- (8) Obligation: mainModule Main module FiniteMap where { import qualified Main; import qualified Maybe; import qualified Prelude; data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b) ; instance (Eq a, Eq b) => Eq FiniteMap a b where { (==) fm_1 fm_2 = sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2; } addToFM :: Ord b => FiniteMap b a -> b -> a -> FiniteMap b a; addToFM fm key elt = addToFM_C addToFM0 fm key elt; addToFM0 old new = new; addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a; addToFM_C combiner EmptyFM key elt = unitFM key elt; addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt | new_key < key = mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r | new_key > key = mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) | otherwise = Branch new_key (combiner elt new_elt) size fm_l fm_r; deleteMax :: Ord b => FiniteMap b a -> FiniteMap b a; deleteMax (Branch key elt vvz fm_l EmptyFM) = fm_l; deleteMax (Branch key elt vwu fm_l fm_r) = mkBalBranch key elt fm_l (deleteMax fm_r); deleteMin :: Ord b => FiniteMap b a -> FiniteMap b a; deleteMin (Branch key elt wyv EmptyFM fm_r) = fm_r; deleteMin (Branch key elt wyw fm_l fm_r) = mkBalBranch key elt (deleteMin fm_l) fm_r; emptyFM :: FiniteMap a b; emptyFM = EmptyFM; findMax :: FiniteMap b a -> (b,a); findMax (Branch key elt vxz vyu EmptyFM) = (key,elt); findMax (Branch key elt vyv vyw fm_r) = findMax fm_r; findMin :: FiniteMap a b -> (a,b); findMin (Branch key elt wyy EmptyFM wyz) = (key,elt); findMin (Branch key elt wzu fm_l wzv) = findMin fm_l; fmToList :: FiniteMap b a -> [(b,a)]; fmToList fm = foldFM fmToList0 [] fm; fmToList0 key elt rest = (key,elt) : rest; foldFM :: (b -> a -> c -> c) -> c -> FiniteMap b a -> c; foldFM k z EmptyFM = z; foldFM k z (Branch key elt wxv fm_l fm_r) = foldFM k (k key elt (foldFM k z fm_r)) fm_l; glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a; glueBal EmptyFM fm2 = fm2; glueBal fm1 EmptyFM = fm1; glueBal fm1 fm2 | sizeFM fm2 > sizeFM fm1 = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) | otherwise = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 where { mid_elt1 = mid_elt10 vv2; mid_elt10 (wuy,mid_elt1) = mid_elt1; mid_elt2 = mid_elt20 vv3; mid_elt20 (wux,mid_elt2) = mid_elt2; mid_key1 = mid_key10 vv2; mid_key10 (mid_key1,wuz) = mid_key1; mid_key2 = mid_key20 vv3; mid_key20 (mid_key2,wvu) = mid_key2; vv2 = findMax fm1; vv3 = findMin fm2; }; glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a; glueVBal EmptyFM fm2 = fm2; glueVBal fm1 EmptyFM = fm1; glueVBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) | sIZE_RATIO * size_l < size_r = mkBalBranch www wwx (glueVBal (Branch wvw wvx wvy wvz wwu) wwz) wxu | sIZE_RATIO * size_r < size_l = mkBalBranch wvw wvx wvz (glueVBal wwu (Branch www wwx wwy wwz wxu)) | otherwise = glueBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) where { size_l = sizeFM (Branch wvw wvx wvy wvz wwu); size_r = sizeFM (Branch www wwx wwy wwz wxu); }; intersectFM_C :: Ord d => (c -> b -> a) -> FiniteMap d c -> FiniteMap d b -> FiniteMap d a; intersectFM_C combiner fm1 EmptyFM = emptyFM; intersectFM_C combiner EmptyFM fm2 = emptyFM; intersectFM_C combiner fm1 (Branch split_key elt2 wyx left right) | Maybe.isJust maybe_elt1 = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) | otherwise = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) where { elt1 = elt10 vv1; elt10 (Just elt1) = elt1; gts = splitGT fm1 split_key; lts = splitLT fm1 split_key; maybe_elt1 = lookupFM fm1 split_key; vv1 = maybe_elt1; }; lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b; lookupFM EmptyFM key = Nothing; lookupFM (Branch key elt wyu fm_l fm_r) key_to_find | key_to_find < key = lookupFM fm_l key_to_find | key_to_find > key = lookupFM fm_r key_to_find | otherwise = Just elt; mkBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkBalBranch key elt fm_L fm_R | size_l + size_r < 2 = mkBranch 1 key elt fm_L fm_R | size_r > sIZE_RATIO * size_l = mkBalBranch0 fm_L fm_R fm_R | size_l > sIZE_RATIO * size_r = mkBalBranch1 fm_L fm_R fm_L | otherwise = mkBranch 2 key elt fm_L fm_R where { double_L fm_l (Branch key_r elt_r vzx (Branch key_rl elt_rl vzy fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); double_R (Branch key_l elt_l vyy fm_ll (Branch key_lr elt_lr vyz fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r); mkBalBranch0 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) | sizeFM fm_rl < 2 * sizeFM fm_rr = single_L fm_L fm_R | otherwise = double_L fm_L fm_R; mkBalBranch1 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) | sizeFM fm_lr < 2 * sizeFM fm_ll = single_R fm_L fm_R | otherwise = double_R fm_L fm_R; single_L fm_l (Branch key_r elt_r wuw fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr; single_R (Branch key_l elt_l vyx fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r); size_l = sizeFM fm_L; size_r = sizeFM fm_R; }; mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkBranch which key elt fm_l fm_r = let { result = Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r; } in result where { balance_ok = True; left_ok = left_ok0 fm_l key fm_l; left_ok0 fm_l key EmptyFM = True; left_ok0 fm_l key (Branch left_key vwx vwy vwz vxu) = let { biggest_left_key = fst (findMax fm_l); } in biggest_left_key < key; left_size = sizeFM fm_l; right_ok = right_ok0 fm_r key fm_r; right_ok0 fm_r key EmptyFM = True; right_ok0 fm_r key (Branch right_key vxv vxw vxx vxy) = let { smallest_right_key = fst (findMin fm_r); } in key < smallest_right_key; right_size = sizeFM fm_r; unbox :: Int -> Int; unbox x = x; }; mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkVBalBranch key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) | sIZE_RATIO * size_l < size_r = mkBalBranch vvu vvv (mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) vvx) vvy | sIZE_RATIO * size_r < size_l = mkBalBranch vuu vuv vux (mkVBalBranch key elt vuy (Branch vvu vvv vvw vvx vvy)) | otherwise = mkBranch 13 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) where { size_l = sizeFM (Branch vuu vuv vuw vux vuy); size_r = sizeFM (Branch vvu vvv vvw vvx vvy); }; sIZE_RATIO :: Int; sIZE_RATIO = 5; sizeFM :: FiniteMap a b -> Int; sizeFM EmptyFM = 0; sizeFM (Branch wxw wxx size wxy wxz) = size; splitGT :: Ord a => FiniteMap a b -> a -> FiniteMap a b; splitGT EmptyFM split_key = emptyFM; splitGT (Branch key elt vwv fm_l fm_r) split_key | split_key > key = splitGT fm_r split_key | split_key < key = mkVBalBranch key elt (splitGT fm_l split_key) fm_r | otherwise = fm_r; splitLT :: Ord a => FiniteMap a b -> a -> FiniteMap a b; splitLT EmptyFM split_key = emptyFM; splitLT (Branch key elt vww fm_l fm_r) split_key | split_key < key = splitLT fm_l split_key | split_key > key = mkVBalBranch key elt fm_l (splitLT fm_r split_key) | otherwise = fm_l; unitFM :: b -> a -> FiniteMap b a; unitFM key elt = Branch key elt 1 emptyFM emptyFM; } module Maybe where { import qualified FiniteMap; import qualified Main; import qualified Prelude; isJust :: Maybe a -> Bool; isJust Nothing = False; isJust wzw = True; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (9) COR (EQUIVALENT) Cond Reductions: The following Function with conditions "absReal x|x >= 0x|otherwise`negate` x; " is transformed to "absReal x = absReal2 x; " "absReal0 x True = `negate` x; " "absReal1 x True = x; absReal1 x False = absReal0 x otherwise; " "absReal2 x = absReal1 x (x >= 0); " The following Function with conditions "gcd' x 0 = x; gcd' x y = gcd' y (x `rem` y); " is transformed to "gcd' x wzx = gcd'2 x wzx; gcd' x y = gcd'0 x y; " "gcd'0 x y = gcd' y (x `rem` y); " "gcd'1 True x wzx = x; gcd'1 wzy wzz xuu = gcd'0 wzz xuu; " "gcd'2 x wzx = gcd'1 (wzx == 0) x wzx; gcd'2 xuv xuw = gcd'0 xuv xuw; " The following Function with conditions "gcd 0 0 = error []; gcd x y = gcd' (abs x) (abs y) where { gcd' x 0 = x; gcd' x y = gcd' y (x `rem` y); } ; " is transformed to "gcd xux xuy = gcd3 xux xuy; gcd x y = gcd0 x y; " "gcd0 x y = gcd' (abs x) (abs y) where { gcd' x wzx = gcd'2 x wzx; gcd' x y = gcd'0 x y; ; gcd'0 x y = gcd' y (x `rem` y); ; gcd'1 True x wzx = x; gcd'1 wzy wzz xuu = gcd'0 wzz xuu; ; gcd'2 x wzx = gcd'1 (wzx == 0) x wzx; gcd'2 xuv xuw = gcd'0 xuv xuw; } ; " "gcd1 True xux xuy = error []; gcd1 xuz xvu xvv = gcd0 xvu xvv; " "gcd2 True xux xuy = gcd1 (xuy == 0) xux xuy; gcd2 xvw xvx xvy = gcd0 xvx xvy; " "gcd3 xux xuy = gcd2 (xux == 0) xux xuy; gcd3 xvz xwu = gcd0 xvz xwu; " The following Function with conditions "undefined |Falseundefined; " is transformed to "undefined = undefined1; " "undefined0 True = undefined; " "undefined1 = undefined0 False; " The following Function with conditions "reduce x y|y == 0error []|otherwisex `quot` d :% (y `quot` d) where { d = gcd x y; } ; " is transformed to "reduce x y = reduce2 x y; " "reduce2 x y = reduce1 x y (y == 0) where { d = gcd x y; ; reduce0 x y True = x `quot` d :% (y `quot` d); ; reduce1 x y True = error []; reduce1 x y False = reduce0 x y otherwise; } ; " The following Function with conditions "compare x y|x == yEQ|x <= yLT|otherwiseGT; " is transformed to "compare x y = compare3 x y; " "compare2 x y True = EQ; compare2 x y False = compare1 x y (x <= y); " "compare0 x y True = GT; " "compare1 x y True = LT; compare1 x y False = compare0 x y otherwise; " "compare3 x y = compare2 x y (x == y); " The following Function with conditions "addToFM_C combiner EmptyFM key elt = unitFM key elt; addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt|new_key < keymkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r|new_key > keymkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt)|otherwiseBranch new_key (combiner elt new_elt) size fm_l fm_r; " is transformed to "addToFM_C combiner EmptyFM key elt = addToFM_C4 combiner EmptyFM key elt; addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt = addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt; " "addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt True = mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r; addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt False = addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt (new_key > key); " "addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt True = Branch new_key (combiner elt new_elt) size fm_l fm_r; " "addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt True = mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt); addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt False = addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt otherwise; " "addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt = addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt (new_key < key); " "addToFM_C4 combiner EmptyFM key elt = unitFM key elt; addToFM_C4 xwx xwy xwz xxu = addToFM_C3 xwx xwy xwz xxu; " The following Function with conditions "mkVBalBranch key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy)|sIZE_RATIO * size_l < size_rmkBalBranch vvu vvv (mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) vvx) vvy|sIZE_RATIO * size_r < size_lmkBalBranch vuu vuv vux (mkVBalBranch key elt vuy (Branch vvu vvv vvw vvx vvy))|otherwisemkBranch 13 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) where { size_l = sizeFM (Branch vuu vuv vuw vux vuy); ; size_r = sizeFM (Branch vvu vvv vvw vvx vvy); } ; " is transformed to "mkVBalBranch key elt EmptyFM fm_r = mkVBalBranch5 key elt EmptyFM fm_r; mkVBalBranch key elt fm_l EmptyFM = mkVBalBranch4 key elt fm_l EmptyFM; mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) = mkVBalBranch3 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy); " "mkVBalBranch3 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) = mkVBalBranch2 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * size_l < size_r) where { mkVBalBranch0 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBranch 13 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy); ; mkVBalBranch1 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vuu vuv vux (mkVBalBranch key elt vuy (Branch vvu vvv vvw vvx vvy)); mkVBalBranch1 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch0 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy otherwise; ; mkVBalBranch2 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vvu vvv (mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) vvx) vvy; mkVBalBranch2 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch1 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * size_r < size_l); ; size_l = sizeFM (Branch vuu vuv vuw vux vuy); ; size_r = sizeFM (Branch vvu vvv vvw vvx vvy); } ; " "mkVBalBranch4 key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch4 xxy xxz xyu xyv = mkVBalBranch3 xxy xxz xyu xyv; " "mkVBalBranch5 key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch5 xyx xyy xyz xzu = mkVBalBranch4 xyx xyy xyz xzu; " The following Function with conditions "splitGT EmptyFM split_key = emptyFM; splitGT (Branch key elt vwv fm_l fm_r) split_key|split_key > keysplitGT fm_r split_key|split_key < keymkVBalBranch key elt (splitGT fm_l split_key) fm_r|otherwisefm_r; " is transformed to "splitGT EmptyFM split_key = splitGT4 EmptyFM split_key; splitGT (Branch key elt vwv fm_l fm_r) split_key = splitGT3 (Branch key elt vwv fm_l fm_r) split_key; " "splitGT1 key elt vwv fm_l fm_r split_key True = mkVBalBranch key elt (splitGT fm_l split_key) fm_r; splitGT1 key elt vwv fm_l fm_r split_key False = splitGT0 key elt vwv fm_l fm_r split_key otherwise; " "splitGT2 key elt vwv fm_l fm_r split_key True = splitGT fm_r split_key; splitGT2 key elt vwv fm_l fm_r split_key False = splitGT1 key elt vwv fm_l fm_r split_key (split_key < key); " "splitGT0 key elt vwv fm_l fm_r split_key True = fm_r; " "splitGT3 (Branch key elt vwv fm_l fm_r) split_key = splitGT2 key elt vwv fm_l fm_r split_key (split_key > key); " "splitGT4 EmptyFM split_key = emptyFM; splitGT4 xzx xzy = splitGT3 xzx xzy; " The following Function with conditions "splitLT EmptyFM split_key = emptyFM; splitLT (Branch key elt vww fm_l fm_r) split_key|split_key < keysplitLT fm_l split_key|split_key > keymkVBalBranch key elt fm_l (splitLT fm_r split_key)|otherwisefm_l; " is transformed to "splitLT EmptyFM split_key = splitLT4 EmptyFM split_key; splitLT (Branch key elt vww fm_l fm_r) split_key = splitLT3 (Branch key elt vww fm_l fm_r) split_key; " "splitLT0 key elt vww fm_l fm_r split_key True = fm_l; " "splitLT1 key elt vww fm_l fm_r split_key True = mkVBalBranch key elt fm_l (splitLT fm_r split_key); splitLT1 key elt vww fm_l fm_r split_key False = splitLT0 key elt vww fm_l fm_r split_key otherwise; " "splitLT2 key elt vww fm_l fm_r split_key True = splitLT fm_l split_key; splitLT2 key elt vww fm_l fm_r split_key False = splitLT1 key elt vww fm_l fm_r split_key (split_key > key); " "splitLT3 (Branch key elt vww fm_l fm_r) split_key = splitLT2 key elt vww fm_l fm_r split_key (split_key < key); " "splitLT4 EmptyFM split_key = emptyFM; splitLT4 yuv yuw = splitLT3 yuv yuw; " The following Function with conditions "mkBalBranch1 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr)|sizeFM fm_lr < 2 * sizeFM fm_llsingle_R fm_L fm_R|otherwisedouble_R fm_L fm_R; " is transformed to "mkBalBranch1 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch12 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr); " "mkBalBranch10 fm_L fm_R vzu vzv vzw fm_ll fm_lr True = double_R fm_L fm_R; " "mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr True = single_R fm_L fm_R; mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr False = mkBalBranch10 fm_L fm_R vzu vzv vzw fm_ll fm_lr otherwise; " "mkBalBranch12 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll); " The following Function with conditions "mkBalBranch0 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr)|sizeFM fm_rl < 2 * sizeFM fm_rrsingle_L fm_L fm_R|otherwisedouble_L fm_L fm_R; " is transformed to "mkBalBranch0 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch02 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr); " "mkBalBranch00 fm_L fm_R vzz wuu wuv fm_rl fm_rr True = double_L fm_L fm_R; " "mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr True = single_L fm_L fm_R; mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr False = mkBalBranch00 fm_L fm_R vzz wuu wuv fm_rl fm_rr otherwise; " "mkBalBranch02 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); " The following Function with conditions "mkBalBranch key elt fm_L fm_R|size_l + size_r < 2mkBranch 1 key elt fm_L fm_R|size_r > sIZE_RATIO * size_lmkBalBranch0 fm_L fm_R fm_R|size_l > sIZE_RATIO * size_rmkBalBranch1 fm_L fm_R fm_L|otherwisemkBranch 2 key elt fm_L fm_R where { double_L fm_l (Branch key_r elt_r vzx (Branch key_rl elt_rl vzy fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); ; double_R (Branch key_l elt_l vyy fm_ll (Branch key_lr elt_lr vyz fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r); ; mkBalBranch0 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr)|sizeFM fm_rl < 2 * sizeFM fm_rrsingle_L fm_L fm_R|otherwisedouble_L fm_L fm_R; ; mkBalBranch1 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr)|sizeFM fm_lr < 2 * sizeFM fm_llsingle_R fm_L fm_R|otherwisedouble_R fm_L fm_R; ; single_L fm_l (Branch key_r elt_r wuw fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr; ; single_R (Branch key_l elt_l vyx fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r); ; size_l = sizeFM fm_L; ; size_r = sizeFM fm_R; } ; " is transformed to "mkBalBranch key elt fm_L fm_R = mkBalBranch6 key elt fm_L fm_R; " "mkBalBranch6 key elt fm_L fm_R = mkBalBranch5 key elt fm_L fm_R (size_l + size_r < 2) where { double_L fm_l (Branch key_r elt_r vzx (Branch key_rl elt_rl vzy fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); ; double_R (Branch key_l elt_l vyy fm_ll (Branch key_lr elt_lr vyz fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r); ; mkBalBranch0 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch02 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr); ; mkBalBranch00 fm_L fm_R vzz wuu wuv fm_rl fm_rr True = double_L fm_L fm_R; ; mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr True = single_L fm_L fm_R; mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr False = mkBalBranch00 fm_L fm_R vzz wuu wuv fm_rl fm_rr otherwise; ; mkBalBranch02 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); ; mkBalBranch1 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch12 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr); ; mkBalBranch10 fm_L fm_R vzu vzv vzw fm_ll fm_lr True = double_R fm_L fm_R; ; mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr True = single_R fm_L fm_R; mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr False = mkBalBranch10 fm_L fm_R vzu vzv vzw fm_ll fm_lr otherwise; ; mkBalBranch12 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll); ; mkBalBranch2 key elt fm_L fm_R True = mkBranch 2 key elt fm_L fm_R; ; mkBalBranch3 key elt fm_L fm_R True = mkBalBranch1 fm_L fm_R fm_L; mkBalBranch3 key elt fm_L fm_R False = mkBalBranch2 key elt fm_L fm_R otherwise; ; mkBalBranch4 key elt fm_L fm_R True = mkBalBranch0 fm_L fm_R fm_R; mkBalBranch4 key elt fm_L fm_R False = mkBalBranch3 key elt fm_L fm_R (size_l > sIZE_RATIO * size_r); ; mkBalBranch5 key elt fm_L fm_R True = mkBranch 1 key elt fm_L fm_R; mkBalBranch5 key elt fm_L fm_R False = mkBalBranch4 key elt fm_L fm_R (size_r > sIZE_RATIO * size_l); ; single_L fm_l (Branch key_r elt_r wuw fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr; ; single_R (Branch key_l elt_l vyx fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r); ; size_l = sizeFM fm_L; ; size_r = sizeFM fm_R; } ; " The following Function with conditions "glueBal EmptyFM fm2 = fm2; glueBal fm1 EmptyFM = fm1; glueBal fm1 fm2|sizeFM fm2 > sizeFM fm1mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2)|otherwisemkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 where { mid_elt1 = mid_elt10 vv2; ; mid_elt10 (wuy,mid_elt1) = mid_elt1; ; mid_elt2 = mid_elt20 vv3; ; mid_elt20 (wux,mid_elt2) = mid_elt2; ; mid_key1 = mid_key10 vv2; ; mid_key10 (mid_key1,wuz) = mid_key1; ; mid_key2 = mid_key20 vv3; ; mid_key20 (mid_key2,wvu) = mid_key2; ; vv2 = findMax fm1; ; vv3 = findMin fm2; } ; " is transformed to "glueBal EmptyFM fm2 = glueBal4 EmptyFM fm2; glueBal fm1 EmptyFM = glueBal3 fm1 EmptyFM; glueBal fm1 fm2 = glueBal2 fm1 fm2; " "glueBal2 fm1 fm2 = glueBal1 fm1 fm2 (sizeFM fm2 > sizeFM fm1) where { glueBal0 fm1 fm2 True = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2; ; glueBal1 fm1 fm2 True = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2); glueBal1 fm1 fm2 False = glueBal0 fm1 fm2 otherwise; ; mid_elt1 = mid_elt10 vv2; ; mid_elt10 (wuy,mid_elt1) = mid_elt1; ; mid_elt2 = mid_elt20 vv3; ; mid_elt20 (wux,mid_elt2) = mid_elt2; ; mid_key1 = mid_key10 vv2; ; mid_key10 (mid_key1,wuz) = mid_key1; ; mid_key2 = mid_key20 vv3; ; mid_key20 (mid_key2,wvu) = mid_key2; ; vv2 = findMax fm1; ; vv3 = findMin fm2; } ; " "glueBal3 fm1 EmptyFM = fm1; glueBal3 yvu yvv = glueBal2 yvu yvv; " "glueBal4 EmptyFM fm2 = fm2; glueBal4 yvx yvy = glueBal3 yvx yvy; " The following Function with conditions "glueVBal EmptyFM fm2 = fm2; glueVBal fm1 EmptyFM = fm1; glueVBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu)|sIZE_RATIO * size_l < size_rmkBalBranch www wwx (glueVBal (Branch wvw wvx wvy wvz wwu) wwz) wxu|sIZE_RATIO * size_r < size_lmkBalBranch wvw wvx wvz (glueVBal wwu (Branch www wwx wwy wwz wxu))|otherwiseglueBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) where { size_l = sizeFM (Branch wvw wvx wvy wvz wwu); ; size_r = sizeFM (Branch www wwx wwy wwz wxu); } ; " is transformed to "glueVBal EmptyFM fm2 = glueVBal5 EmptyFM fm2; glueVBal fm1 EmptyFM = glueVBal4 fm1 EmptyFM; glueVBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) = glueVBal3 (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu); " "glueVBal3 (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) = glueVBal2 wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * size_l < size_r) where { glueVBal0 wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = glueBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu); ; glueVBal1 wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch wvw wvx wvz (glueVBal wwu (Branch www wwx wwy wwz wxu)); glueVBal1 wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal0 wvw wvx wvy wvz wwu www wwx wwy wwz wxu otherwise; ; glueVBal2 wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch www wwx (glueVBal (Branch wvw wvx wvy wvz wwu) wwz) wxu; glueVBal2 wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal1 wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * size_r < size_l); ; size_l = sizeFM (Branch wvw wvx wvy wvz wwu); ; size_r = sizeFM (Branch www wwx wwy wwz wxu); } ; " "glueVBal4 fm1 EmptyFM = fm1; glueVBal4 yww ywx = glueVBal3 yww ywx; " "glueVBal5 EmptyFM fm2 = fm2; glueVBal5 ywz yxu = glueVBal4 ywz yxu; " The following Function with conditions "lookupFM EmptyFM key = Nothing; lookupFM (Branch key elt wyu fm_l fm_r) key_to_find|key_to_find < keylookupFM fm_l key_to_find|key_to_find > keylookupFM fm_r key_to_find|otherwiseJust elt; " is transformed to "lookupFM EmptyFM key = lookupFM4 EmptyFM key; lookupFM (Branch key elt wyu fm_l fm_r) key_to_find = lookupFM3 (Branch key elt wyu fm_l fm_r) key_to_find; " "lookupFM2 key elt wyu fm_l fm_r key_to_find True = lookupFM fm_l key_to_find; lookupFM2 key elt wyu fm_l fm_r key_to_find False = lookupFM1 key elt wyu fm_l fm_r key_to_find (key_to_find > key); " "lookupFM1 key elt wyu fm_l fm_r key_to_find True = lookupFM fm_r key_to_find; lookupFM1 key elt wyu fm_l fm_r key_to_find False = lookupFM0 key elt wyu fm_l fm_r key_to_find otherwise; " "lookupFM0 key elt wyu fm_l fm_r key_to_find True = Just elt; " "lookupFM3 (Branch key elt wyu fm_l fm_r) key_to_find = lookupFM2 key elt wyu fm_l fm_r key_to_find (key_to_find < key); " "lookupFM4 EmptyFM key = Nothing; lookupFM4 yxx yxy = lookupFM3 yxx yxy; " The following Function with conditions "intersectFM_C combiner fm1 EmptyFM = emptyFM; intersectFM_C combiner EmptyFM fm2 = emptyFM; intersectFM_C combiner fm1 (Branch split_key elt2 wyx left right)|Maybe.isJust maybe_elt1mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right)|otherwiseglueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) where { elt1 = elt10 vv1; ; elt10 (Just elt1) = elt1; ; gts = splitGT fm1 split_key; ; lts = splitLT fm1 split_key; ; maybe_elt1 = lookupFM fm1 split_key; ; vv1 = maybe_elt1; } ; " is transformed to "intersectFM_C combiner fm1 EmptyFM = intersectFM_C4 combiner fm1 EmptyFM; intersectFM_C combiner EmptyFM fm2 = intersectFM_C3 combiner EmptyFM fm2; intersectFM_C combiner fm1 (Branch split_key elt2 wyx left right) = intersectFM_C2 combiner fm1 (Branch split_key elt2 wyx left right); " "intersectFM_C2 combiner fm1 (Branch split_key elt2 wyx left right) = intersectFM_C1 combiner fm1 split_key elt2 wyx left right (Maybe.isJust maybe_elt1) where { elt1 = elt10 vv1; ; elt10 (Just elt1) = elt1; ; gts = splitGT fm1 split_key; ; intersectFM_C0 combiner fm1 split_key elt2 wyx left right True = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right); ; intersectFM_C1 combiner fm1 split_key elt2 wyx left right True = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right); intersectFM_C1 combiner fm1 split_key elt2 wyx left right False = intersectFM_C0 combiner fm1 split_key elt2 wyx left right otherwise; ; lts = splitLT fm1 split_key; ; maybe_elt1 = lookupFM fm1 split_key; ; vv1 = maybe_elt1; } ; " "intersectFM_C3 combiner EmptyFM fm2 = emptyFM; intersectFM_C3 yyv yyw yyx = intersectFM_C2 yyv yyw yyx; " "intersectFM_C4 combiner fm1 EmptyFM = emptyFM; intersectFM_C4 yyz yzu yzv = intersectFM_C3 yyz yzu yzv; " ---------------------------------------- (10) Obligation: mainModule Main module FiniteMap where { import qualified Main; import qualified Maybe; import qualified Prelude; data FiniteMap b a = EmptyFM | Branch b a Int (FiniteMap b a) (FiniteMap b a) ; instance (Eq a, Eq b) => Eq FiniteMap a b where { (==) fm_1 fm_2 = sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2; } addToFM :: Ord b => FiniteMap b a -> b -> a -> FiniteMap b a; addToFM fm key elt = addToFM_C addToFM0 fm key elt; addToFM0 old new = new; addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b; addToFM_C combiner EmptyFM key elt = addToFM_C4 combiner EmptyFM key elt; addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt = addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt; addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt True = Branch new_key (combiner elt new_elt) size fm_l fm_r; addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt True = mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt); addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt False = addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt otherwise; addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt True = mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r; addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt False = addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt (new_key > key); addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt = addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt (new_key < key); addToFM_C4 combiner EmptyFM key elt = unitFM key elt; addToFM_C4 xwx xwy xwz xxu = addToFM_C3 xwx xwy xwz xxu; deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMax (Branch key elt vvz fm_l EmptyFM) = fm_l; deleteMax (Branch key elt vwu fm_l fm_r) = mkBalBranch key elt fm_l (deleteMax fm_r); deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMin (Branch key elt wyv EmptyFM fm_r) = fm_r; deleteMin (Branch key elt wyw fm_l fm_r) = mkBalBranch key elt (deleteMin fm_l) fm_r; emptyFM :: FiniteMap a b; emptyFM = EmptyFM; findMax :: FiniteMap a b -> (a,b); findMax (Branch key elt vxz vyu EmptyFM) = (key,elt); findMax (Branch key elt vyv vyw fm_r) = findMax fm_r; findMin :: FiniteMap a b -> (a,b); findMin (Branch key elt wyy EmptyFM wyz) = (key,elt); findMin (Branch key elt wzu fm_l wzv) = findMin fm_l; fmToList :: FiniteMap b a -> [(b,a)]; fmToList fm = foldFM fmToList0 [] fm; fmToList0 key elt rest = (key,elt) : rest; foldFM :: (a -> b -> c -> c) -> c -> FiniteMap a b -> c; foldFM k z EmptyFM = z; foldFM k z (Branch key elt wxv fm_l fm_r) = foldFM k (k key elt (foldFM k z fm_r)) fm_l; glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b; glueBal EmptyFM fm2 = glueBal4 EmptyFM fm2; glueBal fm1 EmptyFM = glueBal3 fm1 EmptyFM; glueBal fm1 fm2 = glueBal2 fm1 fm2; glueBal2 fm1 fm2 = glueBal1 fm1 fm2 (sizeFM fm2 > sizeFM fm1) where { glueBal0 fm1 fm2 True = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2; glueBal1 fm1 fm2 True = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2); glueBal1 fm1 fm2 False = glueBal0 fm1 fm2 otherwise; mid_elt1 = mid_elt10 vv2; mid_elt10 (wuy,mid_elt1) = mid_elt1; mid_elt2 = mid_elt20 vv3; mid_elt20 (wux,mid_elt2) = mid_elt2; mid_key1 = mid_key10 vv2; mid_key10 (mid_key1,wuz) = mid_key1; mid_key2 = mid_key20 vv3; mid_key20 (mid_key2,wvu) = mid_key2; vv2 = findMax fm1; vv3 = findMin fm2; }; glueBal3 fm1 EmptyFM = fm1; glueBal3 yvu yvv = glueBal2 yvu yvv; glueBal4 EmptyFM fm2 = fm2; glueBal4 yvx yvy = glueBal3 yvx yvy; glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a; glueVBal EmptyFM fm2 = glueVBal5 EmptyFM fm2; glueVBal fm1 EmptyFM = glueVBal4 fm1 EmptyFM; glueVBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) = glueVBal3 (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu); glueVBal3 (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) = glueVBal2 wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * size_l < size_r) where { glueVBal0 wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = glueBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu); glueVBal1 wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch wvw wvx wvz (glueVBal wwu (Branch www wwx wwy wwz wxu)); glueVBal1 wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal0 wvw wvx wvy wvz wwu www wwx wwy wwz wxu otherwise; glueVBal2 wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch www wwx (glueVBal (Branch wvw wvx wvy wvz wwu) wwz) wxu; glueVBal2 wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal1 wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * size_r < size_l); size_l = sizeFM (Branch wvw wvx wvy wvz wwu); size_r = sizeFM (Branch www wwx wwy wwz wxu); }; glueVBal4 fm1 EmptyFM = fm1; glueVBal4 yww ywx = glueVBal3 yww ywx; glueVBal5 EmptyFM fm2 = fm2; glueVBal5 ywz yxu = glueVBal4 ywz yxu; intersectFM_C :: Ord d => (a -> c -> b) -> FiniteMap d a -> FiniteMap d c -> FiniteMap d b; intersectFM_C combiner fm1 EmptyFM = intersectFM_C4 combiner fm1 EmptyFM; intersectFM_C combiner EmptyFM fm2 = intersectFM_C3 combiner EmptyFM fm2; intersectFM_C combiner fm1 (Branch split_key elt2 wyx left right) = intersectFM_C2 combiner fm1 (Branch split_key elt2 wyx left right); intersectFM_C2 combiner fm1 (Branch split_key elt2 wyx left right) = intersectFM_C1 combiner fm1 split_key elt2 wyx left right (Maybe.isJust maybe_elt1) where { elt1 = elt10 vv1; elt10 (Just elt1) = elt1; gts = splitGT fm1 split_key; intersectFM_C0 combiner fm1 split_key elt2 wyx left right True = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right); intersectFM_C1 combiner fm1 split_key elt2 wyx left right True = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right); intersectFM_C1 combiner fm1 split_key elt2 wyx left right False = intersectFM_C0 combiner fm1 split_key elt2 wyx left right otherwise; lts = splitLT fm1 split_key; maybe_elt1 = lookupFM fm1 split_key; vv1 = maybe_elt1; }; intersectFM_C3 combiner EmptyFM fm2 = emptyFM; intersectFM_C3 yyv yyw yyx = intersectFM_C2 yyv yyw yyx; intersectFM_C4 combiner fm1 EmptyFM = emptyFM; intersectFM_C4 yyz yzu yzv = intersectFM_C3 yyz yzu yzv; lookupFM :: Ord b => FiniteMap b a -> b -> Maybe a; lookupFM EmptyFM key = lookupFM4 EmptyFM key; lookupFM (Branch key elt wyu fm_l fm_r) key_to_find = lookupFM3 (Branch key elt wyu fm_l fm_r) key_to_find; lookupFM0 key elt wyu fm_l fm_r key_to_find True = Just elt; lookupFM1 key elt wyu fm_l fm_r key_to_find True = lookupFM fm_r key_to_find; lookupFM1 key elt wyu fm_l fm_r key_to_find False = lookupFM0 key elt wyu fm_l fm_r key_to_find otherwise; lookupFM2 key elt wyu fm_l fm_r key_to_find True = lookupFM fm_l key_to_find; lookupFM2 key elt wyu fm_l fm_r key_to_find False = lookupFM1 key elt wyu fm_l fm_r key_to_find (key_to_find > key); lookupFM3 (Branch key elt wyu fm_l fm_r) key_to_find = lookupFM2 key elt wyu fm_l fm_r key_to_find (key_to_find < key); lookupFM4 EmptyFM key = Nothing; lookupFM4 yxx yxy = lookupFM3 yxx yxy; mkBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkBalBranch key elt fm_L fm_R = mkBalBranch6 key elt fm_L fm_R; mkBalBranch6 key elt fm_L fm_R = mkBalBranch5 key elt fm_L fm_R (size_l + size_r < 2) where { double_L fm_l (Branch key_r elt_r vzx (Branch key_rl elt_rl vzy fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); double_R (Branch key_l elt_l vyy fm_ll (Branch key_lr elt_lr vyz fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r); mkBalBranch0 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch02 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr); mkBalBranch00 fm_L fm_R vzz wuu wuv fm_rl fm_rr True = double_L fm_L fm_R; mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr True = single_L fm_L fm_R; mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr False = mkBalBranch00 fm_L fm_R vzz wuu wuv fm_rl fm_rr otherwise; mkBalBranch02 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); mkBalBranch1 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch12 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr); mkBalBranch10 fm_L fm_R vzu vzv vzw fm_ll fm_lr True = double_R fm_L fm_R; mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr True = single_R fm_L fm_R; mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr False = mkBalBranch10 fm_L fm_R vzu vzv vzw fm_ll fm_lr otherwise; mkBalBranch12 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll); mkBalBranch2 key elt fm_L fm_R True = mkBranch 2 key elt fm_L fm_R; mkBalBranch3 key elt fm_L fm_R True = mkBalBranch1 fm_L fm_R fm_L; mkBalBranch3 key elt fm_L fm_R False = mkBalBranch2 key elt fm_L fm_R otherwise; mkBalBranch4 key elt fm_L fm_R True = mkBalBranch0 fm_L fm_R fm_R; mkBalBranch4 key elt fm_L fm_R False = mkBalBranch3 key elt fm_L fm_R (size_l > sIZE_RATIO * size_r); mkBalBranch5 key elt fm_L fm_R True = mkBranch 1 key elt fm_L fm_R; mkBalBranch5 key elt fm_L fm_R False = mkBalBranch4 key elt fm_L fm_R (size_r > sIZE_RATIO * size_l); single_L fm_l (Branch key_r elt_r wuw fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr; single_R (Branch key_l elt_l vyx fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r); size_l = sizeFM fm_L; size_r = sizeFM fm_R; }; mkBranch :: Ord a => Int -> a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkBranch which key elt fm_l fm_r = let { result = Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r; } in result where { balance_ok = True; left_ok = left_ok0 fm_l key fm_l; left_ok0 fm_l key EmptyFM = True; left_ok0 fm_l key (Branch left_key vwx vwy vwz vxu) = let { biggest_left_key = fst (findMax fm_l); } in biggest_left_key < key; left_size = sizeFM fm_l; right_ok = right_ok0 fm_r key fm_r; right_ok0 fm_r key EmptyFM = True; right_ok0 fm_r key (Branch right_key vxv vxw vxx vxy) = let { smallest_right_key = fst (findMin fm_r); } in key < smallest_right_key; right_size = sizeFM fm_r; unbox :: Int -> Int; unbox x = x; }; mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkVBalBranch key elt EmptyFM fm_r = mkVBalBranch5 key elt EmptyFM fm_r; mkVBalBranch key elt fm_l EmptyFM = mkVBalBranch4 key elt fm_l EmptyFM; mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) = mkVBalBranch3 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy); mkVBalBranch3 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) = mkVBalBranch2 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * size_l < size_r) where { mkVBalBranch0 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBranch 13 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy); mkVBalBranch1 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vuu vuv vux (mkVBalBranch key elt vuy (Branch vvu vvv vvw vvx vvy)); mkVBalBranch1 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch0 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy otherwise; mkVBalBranch2 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vvu vvv (mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) vvx) vvy; mkVBalBranch2 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch1 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * size_r < size_l); size_l = sizeFM (Branch vuu vuv vuw vux vuy); size_r = sizeFM (Branch vvu vvv vvw vvx vvy); }; mkVBalBranch4 key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch4 xxy xxz xyu xyv = mkVBalBranch3 xxy xxz xyu xyv; mkVBalBranch5 key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch5 xyx xyy xyz xzu = mkVBalBranch4 xyx xyy xyz xzu; sIZE_RATIO :: Int; sIZE_RATIO = 5; sizeFM :: FiniteMap b a -> Int; sizeFM EmptyFM = 0; sizeFM (Branch wxw wxx size wxy wxz) = size; splitGT :: Ord a => FiniteMap a b -> a -> FiniteMap a b; splitGT EmptyFM split_key = splitGT4 EmptyFM split_key; splitGT (Branch key elt vwv fm_l fm_r) split_key = splitGT3 (Branch key elt vwv fm_l fm_r) split_key; splitGT0 key elt vwv fm_l fm_r split_key True = fm_r; splitGT1 key elt vwv fm_l fm_r split_key True = mkVBalBranch key elt (splitGT fm_l split_key) fm_r; splitGT1 key elt vwv fm_l fm_r split_key False = splitGT0 key elt vwv fm_l fm_r split_key otherwise; splitGT2 key elt vwv fm_l fm_r split_key True = splitGT fm_r split_key; splitGT2 key elt vwv fm_l fm_r split_key False = splitGT1 key elt vwv fm_l fm_r split_key (split_key < key); splitGT3 (Branch key elt vwv fm_l fm_r) split_key = splitGT2 key elt vwv fm_l fm_r split_key (split_key > key); splitGT4 EmptyFM split_key = emptyFM; splitGT4 xzx xzy = splitGT3 xzx xzy; splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitLT EmptyFM split_key = splitLT4 EmptyFM split_key; splitLT (Branch key elt vww fm_l fm_r) split_key = splitLT3 (Branch key elt vww fm_l fm_r) split_key; splitLT0 key elt vww fm_l fm_r split_key True = fm_l; splitLT1 key elt vww fm_l fm_r split_key True = mkVBalBranch key elt fm_l (splitLT fm_r split_key); splitLT1 key elt vww fm_l fm_r split_key False = splitLT0 key elt vww fm_l fm_r split_key otherwise; splitLT2 key elt vww fm_l fm_r split_key True = splitLT fm_l split_key; splitLT2 key elt vww fm_l fm_r split_key False = splitLT1 key elt vww fm_l fm_r split_key (split_key > key); splitLT3 (Branch key elt vww fm_l fm_r) split_key = splitLT2 key elt vww fm_l fm_r split_key (split_key < key); splitLT4 EmptyFM split_key = emptyFM; splitLT4 yuv yuw = splitLT3 yuv yuw; unitFM :: b -> a -> FiniteMap b a; unitFM key elt = Branch key elt 1 emptyFM emptyFM; } module Maybe where { import qualified FiniteMap; import qualified Main; import qualified Prelude; isJust :: Maybe a -> Bool; isJust Nothing = False; isJust wzw = True; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (11) LetRed (EQUIVALENT) Let/Where Reductions: The bindings of the following Let/Where expression "gcd' (abs x) (abs y) where { gcd' x wzx = gcd'2 x wzx; gcd' x y = gcd'0 x y; ; gcd'0 x y = gcd' y (x `rem` y); ; gcd'1 True x wzx = x; gcd'1 wzy wzz xuu = gcd'0 wzz xuu; ; gcd'2 x wzx = gcd'1 (wzx == 0) x wzx; gcd'2 xuv xuw = gcd'0 xuv xuw; } " are unpacked to the following functions on top level "gcd0Gcd'1 True x wzx = x; gcd0Gcd'1 wzy wzz xuu = gcd0Gcd'0 wzz xuu; " "gcd0Gcd'0 x y = gcd0Gcd' y (x `rem` y); " "gcd0Gcd' x wzx = gcd0Gcd'2 x wzx; gcd0Gcd' x y = gcd0Gcd'0 x y; " "gcd0Gcd'2 x wzx = gcd0Gcd'1 (wzx == 0) x wzx; gcd0Gcd'2 xuv xuw = gcd0Gcd'0 xuv xuw; " The bindings of the following Let/Where expression "reduce1 x y (y == 0) where { d = gcd x y; ; reduce0 x y True = x `quot` d :% (y `quot` d); ; reduce1 x y True = error []; reduce1 x y False = reduce0 x y otherwise; } " are unpacked to the following functions on top level "reduce2Reduce1 yzw yzx x y True = error []; reduce2Reduce1 yzw yzx x y False = reduce2Reduce0 yzw yzx x y otherwise; " "reduce2Reduce0 yzw yzx x y True = x `quot` reduce2D yzw yzx :% (y `quot` reduce2D yzw yzx); " "reduce2D yzw yzx = gcd yzw yzx; " The bindings of the following Let/Where expression "glueBal1 fm1 fm2 (sizeFM fm2 > sizeFM fm1) where { glueBal0 fm1 fm2 True = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2; ; glueBal1 fm1 fm2 True = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2); glueBal1 fm1 fm2 False = glueBal0 fm1 fm2 otherwise; ; mid_elt1 = mid_elt10 vv2; ; mid_elt10 (wuy,mid_elt1) = mid_elt1; ; mid_elt2 = mid_elt20 vv3; ; mid_elt20 (wux,mid_elt2) = mid_elt2; ; mid_key1 = mid_key10 vv2; ; mid_key10 (mid_key1,wuz) = mid_key1; ; mid_key2 = mid_key20 vv3; ; mid_key20 (mid_key2,wvu) = mid_key2; ; vv2 = findMax fm1; ; vv3 = findMin fm2; } " are unpacked to the following functions on top level "glueBal2Mid_elt10 yzy yzz (wuy,mid_elt1) = mid_elt1; " "glueBal2Mid_key10 yzy yzz (mid_key1,wuz) = mid_key1; " "glueBal2Mid_key20 yzy yzz (mid_key2,wvu) = mid_key2; " "glueBal2Mid_key2 yzy yzz = glueBal2Mid_key20 yzy yzz (glueBal2Vv3 yzy yzz); " "glueBal2Mid_key1 yzy yzz = glueBal2Mid_key10 yzy yzz (glueBal2Vv2 yzy yzz); " "glueBal2Mid_elt20 yzy yzz (wux,mid_elt2) = mid_elt2; " "glueBal2Vv2 yzy yzz = findMax yzy; " "glueBal2GlueBal1 yzy yzz fm1 fm2 True = mkBalBranch (glueBal2Mid_key2 yzy yzz) (glueBal2Mid_elt2 yzy yzz) fm1 (deleteMin fm2); glueBal2GlueBal1 yzy yzz fm1 fm2 False = glueBal2GlueBal0 yzy yzz fm1 fm2 otherwise; " "glueBal2Mid_elt1 yzy yzz = glueBal2Mid_elt10 yzy yzz (glueBal2Vv2 yzy yzz); " "glueBal2Mid_elt2 yzy yzz = glueBal2Mid_elt20 yzy yzz (glueBal2Vv3 yzy yzz); " "glueBal2Vv3 yzy yzz = findMin yzz; " "glueBal2GlueBal0 yzy yzz fm1 fm2 True = mkBalBranch (glueBal2Mid_key1 yzy yzz) (glueBal2Mid_elt1 yzy yzz) (deleteMax fm1) fm2; " The bindings of the following Let/Where expression "mkVBalBranch2 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * size_l < size_r) where { mkVBalBranch0 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBranch 13 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy); ; mkVBalBranch1 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vuu vuv vux (mkVBalBranch key elt vuy (Branch vvu vvv vvw vvx vvy)); mkVBalBranch1 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch0 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy otherwise; ; mkVBalBranch2 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vvu vvv (mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) vvx) vvy; mkVBalBranch2 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch1 key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * size_r < size_l); ; size_l = sizeFM (Branch vuu vuv vuw vux vuy); ; size_r = sizeFM (Branch vvu vvv vvw vvx vvy); } " are unpacked to the following functions on top level "mkVBalBranch3MkVBalBranch0 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBranch 13 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy); " "mkVBalBranch3Size_r zuu zuv zuw zux zuy zuz zvu zvv zvw zvx = sizeFM (Branch zuu zuv zuw zux zuy); " "mkVBalBranch3MkVBalBranch2 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vvu vvv (mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) vvx) vvy; mkVBalBranch3MkVBalBranch2 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch3MkVBalBranch1 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * mkVBalBranch3Size_r zuu zuv zuw zux zuy zuz zvu zvv zvw zvx < mkVBalBranch3Size_l zuu zuv zuw zux zuy zuz zvu zvv zvw zvx); " "mkVBalBranch3Size_l zuu zuv zuw zux zuy zuz zvu zvv zvw zvx = sizeFM (Branch zuz zvu zvv zvw zvx); " "mkVBalBranch3MkVBalBranch1 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vuu vuv vux (mkVBalBranch key elt vuy (Branch vvu vvv vvw vvx vvy)); mkVBalBranch3MkVBalBranch1 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch3MkVBalBranch0 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy otherwise; " The bindings of the following Let/Where expression "mkBalBranch5 key elt fm_L fm_R (size_l + size_r < 2) where { double_L fm_l (Branch key_r elt_r vzx (Branch key_rl elt_rl vzy fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); ; double_R (Branch key_l elt_l vyy fm_ll (Branch key_lr elt_lr vyz fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r); ; mkBalBranch0 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch02 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr); ; mkBalBranch00 fm_L fm_R vzz wuu wuv fm_rl fm_rr True = double_L fm_L fm_R; ; mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr True = single_L fm_L fm_R; mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr False = mkBalBranch00 fm_L fm_R vzz wuu wuv fm_rl fm_rr otherwise; ; mkBalBranch02 fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch01 fm_L fm_R vzz wuu wuv fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); ; mkBalBranch1 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch12 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr); ; mkBalBranch10 fm_L fm_R vzu vzv vzw fm_ll fm_lr True = double_R fm_L fm_R; ; mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr True = single_R fm_L fm_R; mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr False = mkBalBranch10 fm_L fm_R vzu vzv vzw fm_ll fm_lr otherwise; ; mkBalBranch12 fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch11 fm_L fm_R vzu vzv vzw fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll); ; mkBalBranch2 key elt fm_L fm_R True = mkBranch 2 key elt fm_L fm_R; ; mkBalBranch3 key elt fm_L fm_R True = mkBalBranch1 fm_L fm_R fm_L; mkBalBranch3 key elt fm_L fm_R False = mkBalBranch2 key elt fm_L fm_R otherwise; ; mkBalBranch4 key elt fm_L fm_R True = mkBalBranch0 fm_L fm_R fm_R; mkBalBranch4 key elt fm_L fm_R False = mkBalBranch3 key elt fm_L fm_R (size_l > sIZE_RATIO * size_r); ; mkBalBranch5 key elt fm_L fm_R True = mkBranch 1 key elt fm_L fm_R; mkBalBranch5 key elt fm_L fm_R False = mkBalBranch4 key elt fm_L fm_R (size_r > sIZE_RATIO * size_l); ; single_L fm_l (Branch key_r elt_r wuw fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr; ; single_R (Branch key_l elt_l vyx fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r); ; size_l = sizeFM fm_L; ; size_r = sizeFM fm_R; } " are unpacked to the following functions on top level "mkBalBranch6MkBalBranch1 zvy zvz zwu zwv fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch6MkBalBranch12 zvy zvz zwu zwv fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr); " "mkBalBranch6Size_l zvy zvz zwu zwv = sizeFM zvy; " "mkBalBranch6Single_R zvy zvz zwu zwv (Branch key_l elt_l vyx fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 zvz zwu fm_lr fm_r); " "mkBalBranch6Double_R zvy zvz zwu zwv (Branch key_l elt_l vyy fm_ll (Branch key_lr elt_lr vyz fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 zvz zwu fm_lrr fm_r); " "mkBalBranch6MkBalBranch02 zvy zvz zwu zwv fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch6MkBalBranch01 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); " "mkBalBranch6MkBalBranch5 zvy zvz zwu zwv key elt fm_L fm_R True = mkBranch 1 key elt fm_L fm_R; mkBalBranch6MkBalBranch5 zvy zvz zwu zwv key elt fm_L fm_R False = mkBalBranch6MkBalBranch4 zvy zvz zwu zwv key elt fm_L fm_R (mkBalBranch6Size_r zvy zvz zwu zwv > sIZE_RATIO * mkBalBranch6Size_l zvy zvz zwu zwv); " "mkBalBranch6MkBalBranch4 zvy zvz zwu zwv key elt fm_L fm_R True = mkBalBranch6MkBalBranch0 zvy zvz zwu zwv fm_L fm_R fm_R; mkBalBranch6MkBalBranch4 zvy zvz zwu zwv key elt fm_L fm_R False = mkBalBranch6MkBalBranch3 zvy zvz zwu zwv key elt fm_L fm_R (mkBalBranch6Size_l zvy zvz zwu zwv > sIZE_RATIO * mkBalBranch6Size_r zvy zvz zwu zwv); " "mkBalBranch6MkBalBranch3 zvy zvz zwu zwv key elt fm_L fm_R True = mkBalBranch6MkBalBranch1 zvy zvz zwu zwv fm_L fm_R fm_L; mkBalBranch6MkBalBranch3 zvy zvz zwu zwv key elt fm_L fm_R False = mkBalBranch6MkBalBranch2 zvy zvz zwu zwv key elt fm_L fm_R otherwise; " "mkBalBranch6Double_L zvy zvz zwu zwv fm_l (Branch key_r elt_r vzx (Branch key_rl elt_rl vzy fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 zvz zwu fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); " "mkBalBranch6MkBalBranch11 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr True = mkBalBranch6Single_R zvy zvz zwu zwv fm_L fm_R; mkBalBranch6MkBalBranch11 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr False = mkBalBranch6MkBalBranch10 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr otherwise; " "mkBalBranch6MkBalBranch0 zvy zvz zwu zwv fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch6MkBalBranch02 zvy zvz zwu zwv fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr); " "mkBalBranch6MkBalBranch10 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr True = mkBalBranch6Double_R zvy zvz zwu zwv fm_L fm_R; " "mkBalBranch6MkBalBranch00 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr True = mkBalBranch6Double_L zvy zvz zwu zwv fm_L fm_R; " "mkBalBranch6Size_r zvy zvz zwu zwv = sizeFM zwv; " "mkBalBranch6MkBalBranch2 zvy zvz zwu zwv key elt fm_L fm_R True = mkBranch 2 key elt fm_L fm_R; " "mkBalBranch6MkBalBranch01 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr True = mkBalBranch6Single_L zvy zvz zwu zwv fm_L fm_R; mkBalBranch6MkBalBranch01 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr False = mkBalBranch6MkBalBranch00 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr otherwise; " "mkBalBranch6MkBalBranch12 zvy zvz zwu zwv fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch6MkBalBranch11 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll); " "mkBalBranch6Single_L zvy zvz zwu zwv fm_l (Branch key_r elt_r wuw fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 zvz zwu fm_l fm_rl) fm_rr; " The bindings of the following Let/Where expression "intersectFM_C1 combiner fm1 split_key elt2 wyx left right (Maybe.isJust maybe_elt1) where { elt1 = elt10 vv1; ; elt10 (Just elt1) = elt1; ; gts = splitGT fm1 split_key; ; intersectFM_C0 combiner fm1 split_key elt2 wyx left right True = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right); ; intersectFM_C1 combiner fm1 split_key elt2 wyx left right True = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right); intersectFM_C1 combiner fm1 split_key elt2 wyx left right False = intersectFM_C0 combiner fm1 split_key elt2 wyx left right otherwise; ; lts = splitLT fm1 split_key; ; maybe_elt1 = lookupFM fm1 split_key; ; vv1 = maybe_elt1; } " are unpacked to the following functions on top level "intersectFM_C2IntersectFM_C1 zww zwx combiner fm1 split_key elt2 wyx left right True = mkVBalBranch split_key (combiner (intersectFM_C2Elt1 zww zwx) elt2) (intersectFM_C combiner (intersectFM_C2Lts zww zwx) left) (intersectFM_C combiner (intersectFM_C2Gts zww zwx) right); intersectFM_C2IntersectFM_C1 zww zwx combiner fm1 split_key elt2 wyx left right False = intersectFM_C2IntersectFM_C0 zww zwx combiner fm1 split_key elt2 wyx left right otherwise; " "intersectFM_C2Lts zww zwx = splitLT zww zwx; " "intersectFM_C2Gts zww zwx = splitGT zww zwx; " "intersectFM_C2Elt10 zww zwx (Just elt1) = elt1; " "intersectFM_C2Vv1 zww zwx = intersectFM_C2Maybe_elt1 zww zwx; " "intersectFM_C2Maybe_elt1 zww zwx = lookupFM zww zwx; " "intersectFM_C2IntersectFM_C0 zww zwx combiner fm1 split_key elt2 wyx left right True = glueVBal (intersectFM_C combiner (intersectFM_C2Lts zww zwx) left) (intersectFM_C combiner (intersectFM_C2Gts zww zwx) right); " "intersectFM_C2Elt1 zww zwx = intersectFM_C2Elt10 zww zwx (intersectFM_C2Vv1 zww zwx); " The bindings of the following Let/Where expression "let { result = Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r; } in result where { balance_ok = True; ; left_ok = left_ok0 fm_l key fm_l; ; left_ok0 fm_l key EmptyFM = True; left_ok0 fm_l key (Branch left_key vwx vwy vwz vxu) = let { biggest_left_key = fst (findMax fm_l); } in biggest_left_key < key; ; left_size = sizeFM fm_l; ; right_ok = right_ok0 fm_r key fm_r; ; right_ok0 fm_r key EmptyFM = True; right_ok0 fm_r key (Branch right_key vxv vxw vxx vxy) = let { smallest_right_key = fst (findMin fm_r); } in key < smallest_right_key; ; right_size = sizeFM fm_r; ; unbox x = x; } " are unpacked to the following functions on top level "mkBranchLeft_ok zwy zwz zxu = mkBranchLeft_ok0 zwy zwz zxu zwy zwz zwy; " "mkBranchUnbox zwy zwz zxu x = x; " "mkBranchLeft_ok0 zwy zwz zxu fm_l key EmptyFM = True; mkBranchLeft_ok0 zwy zwz zxu fm_l key (Branch left_key vwx vwy vwz vxu) = mkBranchLeft_ok0Biggest_left_key fm_l < key; " "mkBranchRight_ok zwy zwz zxu = mkBranchRight_ok0 zwy zwz zxu zxu zwz zxu; " "mkBranchLeft_size zwy zwz zxu = sizeFM zwy; " "mkBranchBalance_ok zwy zwz zxu = True; " "mkBranchRight_size zwy zwz zxu = sizeFM zxu; " "mkBranchRight_ok0 zwy zwz zxu fm_r key EmptyFM = True; mkBranchRight_ok0 zwy zwz zxu fm_r key (Branch right_key vxv vxw vxx vxy) = key < mkBranchRight_ok0Smallest_right_key fm_r; " The bindings of the following Let/Where expression "let { result = Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r; } in result" are unpacked to the following functions on top level "mkBranchResult zxv zxw zxx zxy = Branch zxv zxw (mkBranchUnbox zxx zxv zxy (1 + mkBranchLeft_size zxx zxv zxy + mkBranchRight_size zxx zxv zxy)) zxx zxy; " The bindings of the following Let/Where expression "glueVBal2 wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * size_l < size_r) where { glueVBal0 wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = glueBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu); ; glueVBal1 wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch wvw wvx wvz (glueVBal wwu (Branch www wwx wwy wwz wxu)); glueVBal1 wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal0 wvw wvx wvy wvz wwu www wwx wwy wwz wxu otherwise; ; glueVBal2 wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch www wwx (glueVBal (Branch wvw wvx wvy wvz wwu) wwz) wxu; glueVBal2 wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal1 wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * size_r < size_l); ; size_l = sizeFM (Branch wvw wvx wvy wvz wwu); ; size_r = sizeFM (Branch www wwx wwy wwz wxu); } " are unpacked to the following functions on top level "glueVBal3Size_r zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw = sizeFM (Branch zxz zyu zyv zyw zyx); " "glueVBal3GlueVBal0 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = glueBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu); " "glueVBal3Size_l zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw = sizeFM (Branch zyy zyz zzu zzv zzw); " "glueVBal3GlueVBal2 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch www wwx (glueVBal (Branch wvw wvx wvy wvz wwu) wwz) wxu; glueVBal3GlueVBal2 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal3GlueVBal1 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * glueVBal3Size_r zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw < glueVBal3Size_l zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw); " "glueVBal3GlueVBal1 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch wvw wvx wvz (glueVBal wwu (Branch www wwx wwy wwz wxu)); glueVBal3GlueVBal1 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal3GlueVBal0 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu otherwise; " The bindings of the following Let/Where expression "let { biggest_left_key = fst (findMax fm_l); } in biggest_left_key < key" are unpacked to the following functions on top level "mkBranchLeft_ok0Biggest_left_key zzx = fst (findMax zzx); " The bindings of the following Let/Where expression "let { smallest_right_key = fst (findMin fm_r); } in key < smallest_right_key" are unpacked to the following functions on top level "mkBranchRight_ok0Smallest_right_key zzy = fst (findMin zzy); " ---------------------------------------- (12) Obligation: mainModule Main module FiniteMap where { import qualified Main; import qualified Maybe; import qualified Prelude; data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b) ; instance (Eq a, Eq b) => Eq FiniteMap a b where { (==) fm_1 fm_2 = sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2; } addToFM :: Ord b => FiniteMap b a -> b -> a -> FiniteMap b a; addToFM fm key elt = addToFM_C addToFM0 fm key elt; addToFM0 old new = new; addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a; addToFM_C combiner EmptyFM key elt = addToFM_C4 combiner EmptyFM key elt; addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt = addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt; addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt True = Branch new_key (combiner elt new_elt) size fm_l fm_r; addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt True = mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt); addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt False = addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt otherwise; addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt True = mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r; addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt False = addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt (new_key > key); addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt = addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt (new_key < key); addToFM_C4 combiner EmptyFM key elt = unitFM key elt; addToFM_C4 xwx xwy xwz xxu = addToFM_C3 xwx xwy xwz xxu; deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMax (Branch key elt vvz fm_l EmptyFM) = fm_l; deleteMax (Branch key elt vwu fm_l fm_r) = mkBalBranch key elt fm_l (deleteMax fm_r); deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMin (Branch key elt wyv EmptyFM fm_r) = fm_r; deleteMin (Branch key elt wyw fm_l fm_r) = mkBalBranch key elt (deleteMin fm_l) fm_r; emptyFM :: FiniteMap a b; emptyFM = EmptyFM; findMax :: FiniteMap b a -> (b,a); findMax (Branch key elt vxz vyu EmptyFM) = (key,elt); findMax (Branch key elt vyv vyw fm_r) = findMax fm_r; findMin :: FiniteMap a b -> (a,b); findMin (Branch key elt wyy EmptyFM wyz) = (key,elt); findMin (Branch key elt wzu fm_l wzv) = findMin fm_l; fmToList :: FiniteMap a b -> [(a,b)]; fmToList fm = foldFM fmToList0 [] fm; fmToList0 key elt rest = (key,elt) : rest; foldFM :: (b -> a -> c -> c) -> c -> FiniteMap b a -> c; foldFM k z EmptyFM = z; foldFM k z (Branch key elt wxv fm_l fm_r) = foldFM k (k key elt (foldFM k z fm_r)) fm_l; glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b; glueBal EmptyFM fm2 = glueBal4 EmptyFM fm2; glueBal fm1 EmptyFM = glueBal3 fm1 EmptyFM; glueBal fm1 fm2 = glueBal2 fm1 fm2; glueBal2 fm1 fm2 = glueBal2GlueBal1 fm1 fm2 fm1 fm2 (sizeFM fm2 > sizeFM fm1); glueBal2GlueBal0 yzy yzz fm1 fm2 True = mkBalBranch (glueBal2Mid_key1 yzy yzz) (glueBal2Mid_elt1 yzy yzz) (deleteMax fm1) fm2; glueBal2GlueBal1 yzy yzz fm1 fm2 True = mkBalBranch (glueBal2Mid_key2 yzy yzz) (glueBal2Mid_elt2 yzy yzz) fm1 (deleteMin fm2); glueBal2GlueBal1 yzy yzz fm1 fm2 False = glueBal2GlueBal0 yzy yzz fm1 fm2 otherwise; glueBal2Mid_elt1 yzy yzz = glueBal2Mid_elt10 yzy yzz (glueBal2Vv2 yzy yzz); glueBal2Mid_elt10 yzy yzz (wuy,mid_elt1) = mid_elt1; glueBal2Mid_elt2 yzy yzz = glueBal2Mid_elt20 yzy yzz (glueBal2Vv3 yzy yzz); glueBal2Mid_elt20 yzy yzz (wux,mid_elt2) = mid_elt2; glueBal2Mid_key1 yzy yzz = glueBal2Mid_key10 yzy yzz (glueBal2Vv2 yzy yzz); glueBal2Mid_key10 yzy yzz (mid_key1,wuz) = mid_key1; glueBal2Mid_key2 yzy yzz = glueBal2Mid_key20 yzy yzz (glueBal2Vv3 yzy yzz); glueBal2Mid_key20 yzy yzz (mid_key2,wvu) = mid_key2; glueBal2Vv2 yzy yzz = findMax yzy; glueBal2Vv3 yzy yzz = findMin yzz; glueBal3 fm1 EmptyFM = fm1; glueBal3 yvu yvv = glueBal2 yvu yvv; glueBal4 EmptyFM fm2 = fm2; glueBal4 yvx yvy = glueBal3 yvx yvy; glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b; glueVBal EmptyFM fm2 = glueVBal5 EmptyFM fm2; glueVBal fm1 EmptyFM = glueVBal4 fm1 EmptyFM; glueVBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) = glueVBal3 (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu); glueVBal3 (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) = glueVBal3GlueVBal2 www wwx wwy wwz wxu wvw wvx wvy wvz wwu wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * glueVBal3Size_l www wwx wwy wwz wxu wvw wvx wvy wvz wwu < glueVBal3Size_r www wwx wwy wwz wxu wvw wvx wvy wvz wwu); glueVBal3GlueVBal0 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = glueBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu); glueVBal3GlueVBal1 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch wvw wvx wvz (glueVBal wwu (Branch www wwx wwy wwz wxu)); glueVBal3GlueVBal1 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal3GlueVBal0 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu otherwise; glueVBal3GlueVBal2 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch www wwx (glueVBal (Branch wvw wvx wvy wvz wwu) wwz) wxu; glueVBal3GlueVBal2 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal3GlueVBal1 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * glueVBal3Size_r zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw < glueVBal3Size_l zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw); glueVBal3Size_l zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw = sizeFM (Branch zyy zyz zzu zzv zzw); glueVBal3Size_r zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw = sizeFM (Branch zxz zyu zyv zyw zyx); glueVBal4 fm1 EmptyFM = fm1; glueVBal4 yww ywx = glueVBal3 yww ywx; glueVBal5 EmptyFM fm2 = fm2; glueVBal5 ywz yxu = glueVBal4 ywz yxu; intersectFM_C :: Ord a => (c -> d -> b) -> FiniteMap a c -> FiniteMap a d -> FiniteMap a b; intersectFM_C combiner fm1 EmptyFM = intersectFM_C4 combiner fm1 EmptyFM; intersectFM_C combiner EmptyFM fm2 = intersectFM_C3 combiner EmptyFM fm2; intersectFM_C combiner fm1 (Branch split_key elt2 wyx left right) = intersectFM_C2 combiner fm1 (Branch split_key elt2 wyx left right); intersectFM_C2 combiner fm1 (Branch split_key elt2 wyx left right) = intersectFM_C2IntersectFM_C1 fm1 split_key combiner fm1 split_key elt2 wyx left right (Maybe.isJust (intersectFM_C2Maybe_elt1 fm1 split_key)); intersectFM_C2Elt1 zww zwx = intersectFM_C2Elt10 zww zwx (intersectFM_C2Vv1 zww zwx); intersectFM_C2Elt10 zww zwx (Just elt1) = elt1; intersectFM_C2Gts zww zwx = splitGT zww zwx; intersectFM_C2IntersectFM_C0 zww zwx combiner fm1 split_key elt2 wyx left right True = glueVBal (intersectFM_C combiner (intersectFM_C2Lts zww zwx) left) (intersectFM_C combiner (intersectFM_C2Gts zww zwx) right); intersectFM_C2IntersectFM_C1 zww zwx combiner fm1 split_key elt2 wyx left right True = mkVBalBranch split_key (combiner (intersectFM_C2Elt1 zww zwx) elt2) (intersectFM_C combiner (intersectFM_C2Lts zww zwx) left) (intersectFM_C combiner (intersectFM_C2Gts zww zwx) right); intersectFM_C2IntersectFM_C1 zww zwx combiner fm1 split_key elt2 wyx left right False = intersectFM_C2IntersectFM_C0 zww zwx combiner fm1 split_key elt2 wyx left right otherwise; intersectFM_C2Lts zww zwx = splitLT zww zwx; intersectFM_C2Maybe_elt1 zww zwx = lookupFM zww zwx; intersectFM_C2Vv1 zww zwx = intersectFM_C2Maybe_elt1 zww zwx; intersectFM_C3 combiner EmptyFM fm2 = emptyFM; intersectFM_C3 yyv yyw yyx = intersectFM_C2 yyv yyw yyx; intersectFM_C4 combiner fm1 EmptyFM = emptyFM; intersectFM_C4 yyz yzu yzv = intersectFM_C3 yyz yzu yzv; lookupFM :: Ord b => FiniteMap b a -> b -> Maybe a; lookupFM EmptyFM key = lookupFM4 EmptyFM key; lookupFM (Branch key elt wyu fm_l fm_r) key_to_find = lookupFM3 (Branch key elt wyu fm_l fm_r) key_to_find; lookupFM0 key elt wyu fm_l fm_r key_to_find True = Just elt; lookupFM1 key elt wyu fm_l fm_r key_to_find True = lookupFM fm_r key_to_find; lookupFM1 key elt wyu fm_l fm_r key_to_find False = lookupFM0 key elt wyu fm_l fm_r key_to_find otherwise; lookupFM2 key elt wyu fm_l fm_r key_to_find True = lookupFM fm_l key_to_find; lookupFM2 key elt wyu fm_l fm_r key_to_find False = lookupFM1 key elt wyu fm_l fm_r key_to_find (key_to_find > key); lookupFM3 (Branch key elt wyu fm_l fm_r) key_to_find = lookupFM2 key elt wyu fm_l fm_r key_to_find (key_to_find < key); lookupFM4 EmptyFM key = Nothing; lookupFM4 yxx yxy = lookupFM3 yxx yxy; mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkBalBranch key elt fm_L fm_R = mkBalBranch6 key elt fm_L fm_R; mkBalBranch6 key elt fm_L fm_R = mkBalBranch6MkBalBranch5 fm_L key elt fm_R key elt fm_L fm_R (mkBalBranch6Size_l fm_L key elt fm_R + mkBalBranch6Size_r fm_L key elt fm_R < 2); mkBalBranch6Double_L zvy zvz zwu zwv fm_l (Branch key_r elt_r vzx (Branch key_rl elt_rl vzy fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 zvz zwu fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); mkBalBranch6Double_R zvy zvz zwu zwv (Branch key_l elt_l vyy fm_ll (Branch key_lr elt_lr vyz fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 zvz zwu fm_lrr fm_r); mkBalBranch6MkBalBranch0 zvy zvz zwu zwv fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch6MkBalBranch02 zvy zvz zwu zwv fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr); mkBalBranch6MkBalBranch00 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr True = mkBalBranch6Double_L zvy zvz zwu zwv fm_L fm_R; mkBalBranch6MkBalBranch01 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr True = mkBalBranch6Single_L zvy zvz zwu zwv fm_L fm_R; mkBalBranch6MkBalBranch01 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr False = mkBalBranch6MkBalBranch00 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr otherwise; mkBalBranch6MkBalBranch02 zvy zvz zwu zwv fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch6MkBalBranch01 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); mkBalBranch6MkBalBranch1 zvy zvz zwu zwv fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch6MkBalBranch12 zvy zvz zwu zwv fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr); mkBalBranch6MkBalBranch10 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr True = mkBalBranch6Double_R zvy zvz zwu zwv fm_L fm_R; mkBalBranch6MkBalBranch11 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr True = mkBalBranch6Single_R zvy zvz zwu zwv fm_L fm_R; mkBalBranch6MkBalBranch11 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr False = mkBalBranch6MkBalBranch10 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr otherwise; mkBalBranch6MkBalBranch12 zvy zvz zwu zwv fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch6MkBalBranch11 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll); mkBalBranch6MkBalBranch2 zvy zvz zwu zwv key elt fm_L fm_R True = mkBranch 2 key elt fm_L fm_R; mkBalBranch6MkBalBranch3 zvy zvz zwu zwv key elt fm_L fm_R True = mkBalBranch6MkBalBranch1 zvy zvz zwu zwv fm_L fm_R fm_L; mkBalBranch6MkBalBranch3 zvy zvz zwu zwv key elt fm_L fm_R False = mkBalBranch6MkBalBranch2 zvy zvz zwu zwv key elt fm_L fm_R otherwise; mkBalBranch6MkBalBranch4 zvy zvz zwu zwv key elt fm_L fm_R True = mkBalBranch6MkBalBranch0 zvy zvz zwu zwv fm_L fm_R fm_R; mkBalBranch6MkBalBranch4 zvy zvz zwu zwv key elt fm_L fm_R False = mkBalBranch6MkBalBranch3 zvy zvz zwu zwv key elt fm_L fm_R (mkBalBranch6Size_l zvy zvz zwu zwv > sIZE_RATIO * mkBalBranch6Size_r zvy zvz zwu zwv); mkBalBranch6MkBalBranch5 zvy zvz zwu zwv key elt fm_L fm_R True = mkBranch 1 key elt fm_L fm_R; mkBalBranch6MkBalBranch5 zvy zvz zwu zwv key elt fm_L fm_R False = mkBalBranch6MkBalBranch4 zvy zvz zwu zwv key elt fm_L fm_R (mkBalBranch6Size_r zvy zvz zwu zwv > sIZE_RATIO * mkBalBranch6Size_l zvy zvz zwu zwv); mkBalBranch6Single_L zvy zvz zwu zwv fm_l (Branch key_r elt_r wuw fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 zvz zwu fm_l fm_rl) fm_rr; mkBalBranch6Single_R zvy zvz zwu zwv (Branch key_l elt_l vyx fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 zvz zwu fm_lr fm_r); mkBalBranch6Size_l zvy zvz zwu zwv = sizeFM zvy; mkBalBranch6Size_r zvy zvz zwu zwv = sizeFM zwv; mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkBranch which key elt fm_l fm_r = mkBranchResult key elt fm_l fm_r; mkBranchBalance_ok zwy zwz zxu = True; mkBranchLeft_ok zwy zwz zxu = mkBranchLeft_ok0 zwy zwz zxu zwy zwz zwy; mkBranchLeft_ok0 zwy zwz zxu fm_l key EmptyFM = True; mkBranchLeft_ok0 zwy zwz zxu fm_l key (Branch left_key vwx vwy vwz vxu) = mkBranchLeft_ok0Biggest_left_key fm_l < key; mkBranchLeft_ok0Biggest_left_key zzx = fst (findMax zzx); mkBranchLeft_size zwy zwz zxu = sizeFM zwy; mkBranchResult zxv zxw zxx zxy = Branch zxv zxw (mkBranchUnbox zxx zxv zxy (1 + mkBranchLeft_size zxx zxv zxy + mkBranchRight_size zxx zxv zxy)) zxx zxy; mkBranchRight_ok zwy zwz zxu = mkBranchRight_ok0 zwy zwz zxu zxu zwz zxu; mkBranchRight_ok0 zwy zwz zxu fm_r key EmptyFM = True; mkBranchRight_ok0 zwy zwz zxu fm_r key (Branch right_key vxv vxw vxx vxy) = key < mkBranchRight_ok0Smallest_right_key fm_r; mkBranchRight_ok0Smallest_right_key zzy = fst (findMin zzy); mkBranchRight_size zwy zwz zxu = sizeFM zxu; mkBranchUnbox :: Ord a => -> (FiniteMap a b) ( -> a ( -> (FiniteMap a b) (Int -> Int))); mkBranchUnbox zwy zwz zxu x = x; mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkVBalBranch key elt EmptyFM fm_r = mkVBalBranch5 key elt EmptyFM fm_r; mkVBalBranch key elt fm_l EmptyFM = mkVBalBranch4 key elt fm_l EmptyFM; mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) = mkVBalBranch3 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy); mkVBalBranch3 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) = mkVBalBranch3MkVBalBranch2 vvu vvv vvw vvx vvy vuu vuv vuw vux vuy key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * mkVBalBranch3Size_l vvu vvv vvw vvx vvy vuu vuv vuw vux vuy < mkVBalBranch3Size_r vvu vvv vvw vvx vvy vuu vuv vuw vux vuy); mkVBalBranch3MkVBalBranch0 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBranch 13 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy); mkVBalBranch3MkVBalBranch1 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vuu vuv vux (mkVBalBranch key elt vuy (Branch vvu vvv vvw vvx vvy)); mkVBalBranch3MkVBalBranch1 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch3MkVBalBranch0 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy otherwise; mkVBalBranch3MkVBalBranch2 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vvu vvv (mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) vvx) vvy; mkVBalBranch3MkVBalBranch2 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch3MkVBalBranch1 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * mkVBalBranch3Size_r zuu zuv zuw zux zuy zuz zvu zvv zvw zvx < mkVBalBranch3Size_l zuu zuv zuw zux zuy zuz zvu zvv zvw zvx); mkVBalBranch3Size_l zuu zuv zuw zux zuy zuz zvu zvv zvw zvx = sizeFM (Branch zuz zvu zvv zvw zvx); mkVBalBranch3Size_r zuu zuv zuw zux zuy zuz zvu zvv zvw zvx = sizeFM (Branch zuu zuv zuw zux zuy); mkVBalBranch4 key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch4 xxy xxz xyu xyv = mkVBalBranch3 xxy xxz xyu xyv; mkVBalBranch5 key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch5 xyx xyy xyz xzu = mkVBalBranch4 xyx xyy xyz xzu; sIZE_RATIO :: Int; sIZE_RATIO = 5; sizeFM :: FiniteMap b a -> Int; sizeFM EmptyFM = 0; sizeFM (Branch wxw wxx size wxy wxz) = size; splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitGT EmptyFM split_key = splitGT4 EmptyFM split_key; splitGT (Branch key elt vwv fm_l fm_r) split_key = splitGT3 (Branch key elt vwv fm_l fm_r) split_key; splitGT0 key elt vwv fm_l fm_r split_key True = fm_r; splitGT1 key elt vwv fm_l fm_r split_key True = mkVBalBranch key elt (splitGT fm_l split_key) fm_r; splitGT1 key elt vwv fm_l fm_r split_key False = splitGT0 key elt vwv fm_l fm_r split_key otherwise; splitGT2 key elt vwv fm_l fm_r split_key True = splitGT fm_r split_key; splitGT2 key elt vwv fm_l fm_r split_key False = splitGT1 key elt vwv fm_l fm_r split_key (split_key < key); splitGT3 (Branch key elt vwv fm_l fm_r) split_key = splitGT2 key elt vwv fm_l fm_r split_key (split_key > key); splitGT4 EmptyFM split_key = emptyFM; splitGT4 xzx xzy = splitGT3 xzx xzy; splitLT :: Ord a => FiniteMap a b -> a -> FiniteMap a b; splitLT EmptyFM split_key = splitLT4 EmptyFM split_key; splitLT (Branch key elt vww fm_l fm_r) split_key = splitLT3 (Branch key elt vww fm_l fm_r) split_key; splitLT0 key elt vww fm_l fm_r split_key True = fm_l; splitLT1 key elt vww fm_l fm_r split_key True = mkVBalBranch key elt fm_l (splitLT fm_r split_key); splitLT1 key elt vww fm_l fm_r split_key False = splitLT0 key elt vww fm_l fm_r split_key otherwise; splitLT2 key elt vww fm_l fm_r split_key True = splitLT fm_l split_key; splitLT2 key elt vww fm_l fm_r split_key False = splitLT1 key elt vww fm_l fm_r split_key (split_key > key); splitLT3 (Branch key elt vww fm_l fm_r) split_key = splitLT2 key elt vww fm_l fm_r split_key (split_key < key); splitLT4 EmptyFM split_key = emptyFM; splitLT4 yuv yuw = splitLT3 yuv yuw; unitFM :: a -> b -> FiniteMap a b; unitFM key elt = Branch key elt 1 emptyFM emptyFM; } module Maybe where { import qualified FiniteMap; import qualified Main; import qualified Prelude; isJust :: Maybe a -> Bool; isJust Nothing = False; isJust wzw = True; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (13) NumRed (SOUND) Num Reduction:All numbers are transformed to their corresponding representation with Succ, Pred and Zero. ---------------------------------------- (14) Obligation: mainModule Main module FiniteMap where { import qualified Main; import qualified Maybe; import qualified Prelude; data FiniteMap b a = EmptyFM | Branch b a Int (FiniteMap b a) (FiniteMap b a) ; instance (Eq a, Eq b) => Eq FiniteMap b a where { (==) fm_1 fm_2 = sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2; } addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b; addToFM fm key elt = addToFM_C addToFM0 fm key elt; addToFM0 old new = new; addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a; addToFM_C combiner EmptyFM key elt = addToFM_C4 combiner EmptyFM key elt; addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt = addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt; addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt True = Branch new_key (combiner elt new_elt) size fm_l fm_r; addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt True = mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt); addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt False = addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt otherwise; addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt True = mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r; addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt False = addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt (new_key > key); addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt = addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt (new_key < key); addToFM_C4 combiner EmptyFM key elt = unitFM key elt; addToFM_C4 xwx xwy xwz xxu = addToFM_C3 xwx xwy xwz xxu; deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMax (Branch key elt vvz fm_l EmptyFM) = fm_l; deleteMax (Branch key elt vwu fm_l fm_r) = mkBalBranch key elt fm_l (deleteMax fm_r); deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMin (Branch key elt wyv EmptyFM fm_r) = fm_r; deleteMin (Branch key elt wyw fm_l fm_r) = mkBalBranch key elt (deleteMin fm_l) fm_r; emptyFM :: FiniteMap b a; emptyFM = EmptyFM; findMax :: FiniteMap b a -> (b,a); findMax (Branch key elt vxz vyu EmptyFM) = (key,elt); findMax (Branch key elt vyv vyw fm_r) = findMax fm_r; findMin :: FiniteMap a b -> (a,b); findMin (Branch key elt wyy EmptyFM wyz) = (key,elt); findMin (Branch key elt wzu fm_l wzv) = findMin fm_l; fmToList :: FiniteMap b a -> [(b,a)]; fmToList fm = foldFM fmToList0 [] fm; fmToList0 key elt rest = (key,elt) : rest; foldFM :: (c -> b -> a -> a) -> a -> FiniteMap c b -> a; foldFM k z EmptyFM = z; foldFM k z (Branch key elt wxv fm_l fm_r) = foldFM k (k key elt (foldFM k z fm_r)) fm_l; glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a; glueBal EmptyFM fm2 = glueBal4 EmptyFM fm2; glueBal fm1 EmptyFM = glueBal3 fm1 EmptyFM; glueBal fm1 fm2 = glueBal2 fm1 fm2; glueBal2 fm1 fm2 = glueBal2GlueBal1 fm1 fm2 fm1 fm2 (sizeFM fm2 > sizeFM fm1); glueBal2GlueBal0 yzy yzz fm1 fm2 True = mkBalBranch (glueBal2Mid_key1 yzy yzz) (glueBal2Mid_elt1 yzy yzz) (deleteMax fm1) fm2; glueBal2GlueBal1 yzy yzz fm1 fm2 True = mkBalBranch (glueBal2Mid_key2 yzy yzz) (glueBal2Mid_elt2 yzy yzz) fm1 (deleteMin fm2); glueBal2GlueBal1 yzy yzz fm1 fm2 False = glueBal2GlueBal0 yzy yzz fm1 fm2 otherwise; glueBal2Mid_elt1 yzy yzz = glueBal2Mid_elt10 yzy yzz (glueBal2Vv2 yzy yzz); glueBal2Mid_elt10 yzy yzz (wuy,mid_elt1) = mid_elt1; glueBal2Mid_elt2 yzy yzz = glueBal2Mid_elt20 yzy yzz (glueBal2Vv3 yzy yzz); glueBal2Mid_elt20 yzy yzz (wux,mid_elt2) = mid_elt2; glueBal2Mid_key1 yzy yzz = glueBal2Mid_key10 yzy yzz (glueBal2Vv2 yzy yzz); glueBal2Mid_key10 yzy yzz (mid_key1,wuz) = mid_key1; glueBal2Mid_key2 yzy yzz = glueBal2Mid_key20 yzy yzz (glueBal2Vv3 yzy yzz); glueBal2Mid_key20 yzy yzz (mid_key2,wvu) = mid_key2; glueBal2Vv2 yzy yzz = findMax yzy; glueBal2Vv3 yzy yzz = findMin yzz; glueBal3 fm1 EmptyFM = fm1; glueBal3 yvu yvv = glueBal2 yvu yvv; glueBal4 EmptyFM fm2 = fm2; glueBal4 yvx yvy = glueBal3 yvx yvy; glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b; glueVBal EmptyFM fm2 = glueVBal5 EmptyFM fm2; glueVBal fm1 EmptyFM = glueVBal4 fm1 EmptyFM; glueVBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) = glueVBal3 (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu); glueVBal3 (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu) = glueVBal3GlueVBal2 www wwx wwy wwz wxu wvw wvx wvy wvz wwu wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * glueVBal3Size_l www wwx wwy wwz wxu wvw wvx wvy wvz wwu < glueVBal3Size_r www wwx wwy wwz wxu wvw wvx wvy wvz wwu); glueVBal3GlueVBal0 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = glueBal (Branch wvw wvx wvy wvz wwu) (Branch www wwx wwy wwz wxu); glueVBal3GlueVBal1 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch wvw wvx wvz (glueVBal wwu (Branch www wwx wwy wwz wxu)); glueVBal3GlueVBal1 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal3GlueVBal0 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu otherwise; glueVBal3GlueVBal2 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu True = mkBalBranch www wwx (glueVBal (Branch wvw wvx wvy wvz wwu) wwz) wxu; glueVBal3GlueVBal2 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu False = glueVBal3GlueVBal1 zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw wvw wvx wvy wvz wwu www wwx wwy wwz wxu (sIZE_RATIO * glueVBal3Size_r zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw < glueVBal3Size_l zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw); glueVBal3Size_l zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw = sizeFM (Branch zyy zyz zzu zzv zzw); glueVBal3Size_r zxz zyu zyv zyw zyx zyy zyz zzu zzv zzw = sizeFM (Branch zxz zyu zyv zyw zyx); glueVBal4 fm1 EmptyFM = fm1; glueVBal4 yww ywx = glueVBal3 yww ywx; glueVBal5 EmptyFM fm2 = fm2; glueVBal5 ywz yxu = glueVBal4 ywz yxu; intersectFM_C :: Ord c => (d -> b -> a) -> FiniteMap c d -> FiniteMap c b -> FiniteMap c a; intersectFM_C combiner fm1 EmptyFM = intersectFM_C4 combiner fm1 EmptyFM; intersectFM_C combiner EmptyFM fm2 = intersectFM_C3 combiner EmptyFM fm2; intersectFM_C combiner fm1 (Branch split_key elt2 wyx left right) = intersectFM_C2 combiner fm1 (Branch split_key elt2 wyx left right); intersectFM_C2 combiner fm1 (Branch split_key elt2 wyx left right) = intersectFM_C2IntersectFM_C1 fm1 split_key combiner fm1 split_key elt2 wyx left right (Maybe.isJust (intersectFM_C2Maybe_elt1 fm1 split_key)); intersectFM_C2Elt1 zww zwx = intersectFM_C2Elt10 zww zwx (intersectFM_C2Vv1 zww zwx); intersectFM_C2Elt10 zww zwx (Just elt1) = elt1; intersectFM_C2Gts zww zwx = splitGT zww zwx; intersectFM_C2IntersectFM_C0 zww zwx combiner fm1 split_key elt2 wyx left right True = glueVBal (intersectFM_C combiner (intersectFM_C2Lts zww zwx) left) (intersectFM_C combiner (intersectFM_C2Gts zww zwx) right); intersectFM_C2IntersectFM_C1 zww zwx combiner fm1 split_key elt2 wyx left right True = mkVBalBranch split_key (combiner (intersectFM_C2Elt1 zww zwx) elt2) (intersectFM_C combiner (intersectFM_C2Lts zww zwx) left) (intersectFM_C combiner (intersectFM_C2Gts zww zwx) right); intersectFM_C2IntersectFM_C1 zww zwx combiner fm1 split_key elt2 wyx left right False = intersectFM_C2IntersectFM_C0 zww zwx combiner fm1 split_key elt2 wyx left right otherwise; intersectFM_C2Lts zww zwx = splitLT zww zwx; intersectFM_C2Maybe_elt1 zww zwx = lookupFM zww zwx; intersectFM_C2Vv1 zww zwx = intersectFM_C2Maybe_elt1 zww zwx; intersectFM_C3 combiner EmptyFM fm2 = emptyFM; intersectFM_C3 yyv yyw yyx = intersectFM_C2 yyv yyw yyx; intersectFM_C4 combiner fm1 EmptyFM = emptyFM; intersectFM_C4 yyz yzu yzv = intersectFM_C3 yyz yzu yzv; lookupFM :: Ord b => FiniteMap b a -> b -> Maybe a; lookupFM EmptyFM key = lookupFM4 EmptyFM key; lookupFM (Branch key elt wyu fm_l fm_r) key_to_find = lookupFM3 (Branch key elt wyu fm_l fm_r) key_to_find; lookupFM0 key elt wyu fm_l fm_r key_to_find True = Just elt; lookupFM1 key elt wyu fm_l fm_r key_to_find True = lookupFM fm_r key_to_find; lookupFM1 key elt wyu fm_l fm_r key_to_find False = lookupFM0 key elt wyu fm_l fm_r key_to_find otherwise; lookupFM2 key elt wyu fm_l fm_r key_to_find True = lookupFM fm_l key_to_find; lookupFM2 key elt wyu fm_l fm_r key_to_find False = lookupFM1 key elt wyu fm_l fm_r key_to_find (key_to_find > key); lookupFM3 (Branch key elt wyu fm_l fm_r) key_to_find = lookupFM2 key elt wyu fm_l fm_r key_to_find (key_to_find < key); lookupFM4 EmptyFM key = Nothing; lookupFM4 yxx yxy = lookupFM3 yxx yxy; mkBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkBalBranch key elt fm_L fm_R = mkBalBranch6 key elt fm_L fm_R; mkBalBranch6 key elt fm_L fm_R = mkBalBranch6MkBalBranch5 fm_L key elt fm_R key elt fm_L fm_R (mkBalBranch6Size_l fm_L key elt fm_R + mkBalBranch6Size_r fm_L key elt fm_R < Pos (Succ (Succ Zero))); mkBalBranch6Double_L zvy zvz zwu zwv fm_l (Branch key_r elt_r vzx (Branch key_rl elt_rl vzy fm_rll fm_rlr) fm_rr) = mkBranch (Pos (Succ (Succ (Succ (Succ (Succ Zero)))))) key_rl elt_rl (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))) zvz zwu fm_l fm_rll) (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))) key_r elt_r fm_rlr fm_rr); mkBalBranch6Double_R zvy zvz zwu zwv (Branch key_l elt_l vyy fm_ll (Branch key_lr elt_lr vyz fm_lrl fm_lrr)) fm_r = mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))))))) key_lr elt_lr (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))))) key_l elt_l fm_ll fm_lrl) (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))))))))) zvz zwu fm_lrr fm_r); mkBalBranch6MkBalBranch0 zvy zvz zwu zwv fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch6MkBalBranch02 zvy zvz zwu zwv fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr); mkBalBranch6MkBalBranch00 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr True = mkBalBranch6Double_L zvy zvz zwu zwv fm_L fm_R; mkBalBranch6MkBalBranch01 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr True = mkBalBranch6Single_L zvy zvz zwu zwv fm_L fm_R; mkBalBranch6MkBalBranch01 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr False = mkBalBranch6MkBalBranch00 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr otherwise; mkBalBranch6MkBalBranch02 zvy zvz zwu zwv fm_L fm_R (Branch vzz wuu wuv fm_rl fm_rr) = mkBalBranch6MkBalBranch01 zvy zvz zwu zwv fm_L fm_R vzz wuu wuv fm_rl fm_rr (sizeFM fm_rl < Pos (Succ (Succ Zero)) * sizeFM fm_rr); mkBalBranch6MkBalBranch1 zvy zvz zwu zwv fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch6MkBalBranch12 zvy zvz zwu zwv fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr); mkBalBranch6MkBalBranch10 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr True = mkBalBranch6Double_R zvy zvz zwu zwv fm_L fm_R; mkBalBranch6MkBalBranch11 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr True = mkBalBranch6Single_R zvy zvz zwu zwv fm_L fm_R; mkBalBranch6MkBalBranch11 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr False = mkBalBranch6MkBalBranch10 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr otherwise; mkBalBranch6MkBalBranch12 zvy zvz zwu zwv fm_L fm_R (Branch vzu vzv vzw fm_ll fm_lr) = mkBalBranch6MkBalBranch11 zvy zvz zwu zwv fm_L fm_R vzu vzv vzw fm_ll fm_lr (sizeFM fm_lr < Pos (Succ (Succ Zero)) * sizeFM fm_ll); mkBalBranch6MkBalBranch2 zvy zvz zwu zwv key elt fm_L fm_R True = mkBranch (Pos (Succ (Succ Zero))) key elt fm_L fm_R; mkBalBranch6MkBalBranch3 zvy zvz zwu zwv key elt fm_L fm_R True = mkBalBranch6MkBalBranch1 zvy zvz zwu zwv fm_L fm_R fm_L; mkBalBranch6MkBalBranch3 zvy zvz zwu zwv key elt fm_L fm_R False = mkBalBranch6MkBalBranch2 zvy zvz zwu zwv key elt fm_L fm_R otherwise; mkBalBranch6MkBalBranch4 zvy zvz zwu zwv key elt fm_L fm_R True = mkBalBranch6MkBalBranch0 zvy zvz zwu zwv fm_L fm_R fm_R; mkBalBranch6MkBalBranch4 zvy zvz zwu zwv key elt fm_L fm_R False = mkBalBranch6MkBalBranch3 zvy zvz zwu zwv key elt fm_L fm_R (mkBalBranch6Size_l zvy zvz zwu zwv > sIZE_RATIO * mkBalBranch6Size_r zvy zvz zwu zwv); mkBalBranch6MkBalBranch5 zvy zvz zwu zwv key elt fm_L fm_R True = mkBranch (Pos (Succ Zero)) key elt fm_L fm_R; mkBalBranch6MkBalBranch5 zvy zvz zwu zwv key elt fm_L fm_R False = mkBalBranch6MkBalBranch4 zvy zvz zwu zwv key elt fm_L fm_R (mkBalBranch6Size_r zvy zvz zwu zwv > sIZE_RATIO * mkBalBranch6Size_l zvy zvz zwu zwv); mkBalBranch6Single_L zvy zvz zwu zwv fm_l (Branch key_r elt_r wuw fm_rl fm_rr) = mkBranch (Pos (Succ (Succ (Succ Zero)))) key_r elt_r (mkBranch (Pos (Succ (Succ (Succ (Succ Zero))))) zvz zwu fm_l fm_rl) fm_rr; mkBalBranch6Single_R zvy zvz zwu zwv (Branch key_l elt_l vyx fm_ll fm_lr) fm_r = mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))))) key_l elt_l fm_ll (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))) zvz zwu fm_lr fm_r); mkBalBranch6Size_l zvy zvz zwu zwv = sizeFM zvy; mkBalBranch6Size_r zvy zvz zwu zwv = sizeFM zwv; mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; mkBranch which key elt fm_l fm_r = mkBranchResult key elt fm_l fm_r; mkBranchBalance_ok zwy zwz zxu = True; mkBranchLeft_ok zwy zwz zxu = mkBranchLeft_ok0 zwy zwz zxu zwy zwz zwy; mkBranchLeft_ok0 zwy zwz zxu fm_l key EmptyFM = True; mkBranchLeft_ok0 zwy zwz zxu fm_l key (Branch left_key vwx vwy vwz vxu) = mkBranchLeft_ok0Biggest_left_key fm_l < key; mkBranchLeft_ok0Biggest_left_key zzx = fst (findMax zzx); mkBranchLeft_size zwy zwz zxu = sizeFM zwy; mkBranchResult zxv zxw zxx zxy = Branch zxv zxw (mkBranchUnbox zxx zxv zxy (Pos (Succ Zero) + mkBranchLeft_size zxx zxv zxy + mkBranchRight_size zxx zxv zxy)) zxx zxy; mkBranchRight_ok zwy zwz zxu = mkBranchRight_ok0 zwy zwz zxu zxu zwz zxu; mkBranchRight_ok0 zwy zwz zxu fm_r key EmptyFM = True; mkBranchRight_ok0 zwy zwz zxu fm_r key (Branch right_key vxv vxw vxx vxy) = key < mkBranchRight_ok0Smallest_right_key fm_r; mkBranchRight_ok0Smallest_right_key zzy = fst (findMin zzy); mkBranchRight_size zwy zwz zxu = sizeFM zxu; mkBranchUnbox :: Ord a => -> (FiniteMap a b) ( -> a ( -> (FiniteMap a b) (Int -> Int))); mkBranchUnbox zwy zwz zxu x = x; mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b; mkVBalBranch key elt EmptyFM fm_r = mkVBalBranch5 key elt EmptyFM fm_r; mkVBalBranch key elt fm_l EmptyFM = mkVBalBranch4 key elt fm_l EmptyFM; mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) = mkVBalBranch3 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy); mkVBalBranch3 key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy) = mkVBalBranch3MkVBalBranch2 vvu vvv vvw vvx vvy vuu vuv vuw vux vuy key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * mkVBalBranch3Size_l vvu vvv vvw vvx vvy vuu vuv vuw vux vuy < mkVBalBranch3Size_r vvu vvv vvw vvx vvy vuu vuv vuw vux vuy); mkVBalBranch3MkVBalBranch0 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))))))) key elt (Branch vuu vuv vuw vux vuy) (Branch vvu vvv vvw vvx vvy); mkVBalBranch3MkVBalBranch1 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vuu vuv vux (mkVBalBranch key elt vuy (Branch vvu vvv vvw vvx vvy)); mkVBalBranch3MkVBalBranch1 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch3MkVBalBranch0 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy otherwise; mkVBalBranch3MkVBalBranch2 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy True = mkBalBranch vvu vvv (mkVBalBranch key elt (Branch vuu vuv vuw vux vuy) vvx) vvy; mkVBalBranch3MkVBalBranch2 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy False = mkVBalBranch3MkVBalBranch1 zuu zuv zuw zux zuy zuz zvu zvv zvw zvx key elt vuu vuv vuw vux vuy vvu vvv vvw vvx vvy (sIZE_RATIO * mkVBalBranch3Size_r zuu zuv zuw zux zuy zuz zvu zvv zvw zvx < mkVBalBranch3Size_l zuu zuv zuw zux zuy zuz zvu zvv zvw zvx); mkVBalBranch3Size_l zuu zuv zuw zux zuy zuz zvu zvv zvw zvx = sizeFM (Branch zuz zvu zvv zvw zvx); mkVBalBranch3Size_r zuu zuv zuw zux zuy zuz zvu zvv zvw zvx = sizeFM (Branch zuu zuv zuw zux zuy); mkVBalBranch4 key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch4 xxy xxz xyu xyv = mkVBalBranch3 xxy xxz xyu xyv; mkVBalBranch5 key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch5 xyx xyy xyz xzu = mkVBalBranch4 xyx xyy xyz xzu; sIZE_RATIO :: Int; sIZE_RATIO = Pos (Succ (Succ (Succ (Succ (Succ Zero))))); sizeFM :: FiniteMap a b -> Int; sizeFM EmptyFM = Pos Zero; sizeFM (Branch wxw wxx size wxy wxz) = size; splitGT :: Ord a => FiniteMap a b -> a -> FiniteMap a b; splitGT EmptyFM split_key = splitGT4 EmptyFM split_key; splitGT (Branch key elt vwv fm_l fm_r) split_key = splitGT3 (Branch key elt vwv fm_l fm_r) split_key; splitGT0 key elt vwv fm_l fm_r split_key True = fm_r; splitGT1 key elt vwv fm_l fm_r split_key True = mkVBalBranch key elt (splitGT fm_l split_key) fm_r; splitGT1 key elt vwv fm_l fm_r split_key False = splitGT0 key elt vwv fm_l fm_r split_key otherwise; splitGT2 key elt vwv fm_l fm_r split_key True = splitGT fm_r split_key; splitGT2 key elt vwv fm_l fm_r split_key False = splitGT1 key elt vwv fm_l fm_r split_key (split_key < key); splitGT3 (Branch key elt vwv fm_l fm_r) split_key = splitGT2 key elt vwv fm_l fm_r split_key (split_key > key); splitGT4 EmptyFM split_key = emptyFM; splitGT4 xzx xzy = splitGT3 xzx xzy; splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitLT EmptyFM split_key = splitLT4 EmptyFM split_key; splitLT (Branch key elt vww fm_l fm_r) split_key = splitLT3 (Branch key elt vww fm_l fm_r) split_key; splitLT0 key elt vww fm_l fm_r split_key True = fm_l; splitLT1 key elt vww fm_l fm_r split_key True = mkVBalBranch key elt fm_l (splitLT fm_r split_key); splitLT1 key elt vww fm_l fm_r split_key False = splitLT0 key elt vww fm_l fm_r split_key otherwise; splitLT2 key elt vww fm_l fm_r split_key True = splitLT fm_l split_key; splitLT2 key elt vww fm_l fm_r split_key False = splitLT1 key elt vww fm_l fm_r split_key (split_key > key); splitLT3 (Branch key elt vww fm_l fm_r) split_key = splitLT2 key elt vww fm_l fm_r split_key (split_key < key); splitLT4 EmptyFM split_key = emptyFM; splitLT4 yuv yuw = splitLT3 yuv yuw; unitFM :: b -> a -> FiniteMap b a; unitFM key elt = Branch key elt (Pos (Succ Zero)) emptyFM emptyFM; } module Maybe where { import qualified FiniteMap; import qualified Main; import qualified Prelude; isJust :: Maybe a -> Bool; isJust Nothing = False; isJust wzw = True; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; }