/export/starexec/sandbox2/solver/bin/starexec_run_standard /export/starexec/sandbox2/benchmark/theBenchmark.hs /export/starexec/sandbox2/output/output_files -------------------------------------------------------------------------------- MAYBE proof of /export/starexec/sandbox2/benchmark/theBenchmark.hs # AProVE Commit ID: 48fb2092695e11cc9f56e44b17a92a5f88ffb256 marcel 20180622 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) BR [EQUIVALENT, 0 ms] (6) HASKELL (7) COR [EQUIVALENT, 11 ms] (8) HASKELL (9) LetRed [EQUIVALENT, 25 ms] (10) HASKELL (11) NumRed [SOUND, 0 ms] (12) HASKELL ---------------------------------------- (0) 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 { } addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b; addToFM fm key elt = addToFM_C (\old new ->new) fm key elt; addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b; 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 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 b a -> (b,a); findMin (Branch key elt _ EmptyFM _) = (key,elt); findMin (Branch key elt _ fm_l _) = findMin 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; }; minusFM :: Ord b => FiniteMap b c -> FiniteMap b a -> FiniteMap b c; minusFM EmptyFM fm2 = emptyFM; minusFM fm1 EmptyFM = fm1; minusFM fm1 (Branch split_key elt _ left right) = glueVBal (minusFM lts left) (minusFM gts right) where { gts = splitGT fm1 split_key; lts = splitLT fm1 split_key; }; 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 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 b a -> 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 :: 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; } 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; " ---------------------------------------- (2) 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 { } 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 a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b; 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 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 b a -> (b,a); findMin (Branch key elt _ EmptyFM _) = (key,elt); findMin (Branch key elt _ fm_l _) = findMin 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; }; minusFM :: Ord a => FiniteMap a c -> FiniteMap a b -> FiniteMap a c; minusFM EmptyFM fm2 = emptyFM; minusFM fm1 EmptyFM = fm1; minusFM fm1 (Branch split_key elt _ left right) = glueVBal (minusFM lts left) (minusFM gts right) where { gts = splitGT fm1 split_key; lts = splitLT fm1 split_key; }; 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 = 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 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; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (3) CR (EQUIVALENT) Case Reductions: 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 a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b) ; instance (Eq a, Eq b) => Eq FiniteMap b a where { } 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 a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b; 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 b a -> (b,a); findMin (Branch key elt _ EmptyFM _) = (key,elt); findMin (Branch key elt _ fm_l _) = findMin 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; }; minusFM :: Ord b => FiniteMap b a -> FiniteMap b c -> FiniteMap b a; minusFM EmptyFM fm2 = emptyFM; minusFM fm1 EmptyFM = fm1; minusFM fm1 (Branch split_key elt _ left right) = glueVBal (minusFM lts left) (minusFM gts right) where { gts = splitGT fm1 split_key; lts = splitLT fm1 split_key; }; 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 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 :: 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; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (5) 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 wu wv ww wx wy)" is replaced by the following term "Branch wu wv ww wx wy" The bind variable of the following binding Pattern "fm_r@(Branch xu xv xw xx xy)" is replaced by the following term "Branch xu xv xw xx xy" The bind variable of the following binding Pattern "fm_l@(Branch vxx vxy vxz vyu vyv)" is replaced by the following term "Branch vxx vxy vxz vyu vyv" The bind variable of the following binding Pattern "fm_r@(Branch vyx vyy vyz vzu vzv)" is replaced by the following term "Branch vyx vyy vyz vzu vzv" ---------------------------------------- (6) 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 b a where { } 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 a => FiniteMap a b -> FiniteMap a b; deleteMax (Branch key elt xz fm_l EmptyFM) = fm_l; deleteMax (Branch key elt yu 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 wuu EmptyFM fm_r) = fm_r; deleteMin (Branch key elt wuv 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 vuu vuv EmptyFM) = (key,elt); findMax (Branch key elt vuw vux fm_r) = findMax fm_r; findMin :: FiniteMap b a -> (b,a); findMin (Branch key elt wuw EmptyFM wux) = (key,elt); findMin (Branch key elt wuy fm_l wuz) = findMin 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 (vwz,mid_elt1) = mid_elt1; mid_elt2 = mid_elt20 vv3; mid_elt20 (vwy,mid_elt2) = mid_elt2; mid_key1 = mid_key10 vv2; mid_key10 (mid_key1,vxu) = mid_key1; mid_key2 = mid_key20 vv3; mid_key20 (mid_key2,vxv) = 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 vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) | sIZE_RATIO * size_l < size_r = mkBalBranch vyx vyy (glueVBal (Branch vxx vxy vxz vyu vyv) vzu) vzv | sIZE_RATIO * size_r < size_l = mkBalBranch vxx vxy vyu (glueVBal vyv (Branch vyx vyy vyz vzu vzv)) | otherwise = glueBal (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) where { size_l = sizeFM (Branch vxx vxy vxz vyu vyv); size_r = sizeFM (Branch vyx vyy vyz vzu vzv); }; minusFM :: Ord a => FiniteMap a c -> FiniteMap a b -> FiniteMap a c; minusFM EmptyFM fm2 = emptyFM; minusFM fm1 EmptyFM = fm1; minusFM fm1 (Branch split_key elt yx left right) = glueVBal (minusFM lts left) (minusFM gts right) where { gts = splitGT fm1 split_key; lts = splitLT fm1 split_key; }; 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 vvy (Branch key_rl elt_rl vvz 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 vuz fm_ll (Branch key_lr elt_lr vvu 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 vwu vwv vww 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 vvv vvw vvx 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 vwx 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 vuy 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 yy yz zu zv) = 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 zw zx zy zz) = 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 wu wv ww wx wy) (Branch xu xv xw xx xy) | sIZE_RATIO * size_l < size_r = mkBalBranch xu xv (mkVBalBranch key elt (Branch wu wv ww wx wy) xx) xy | sIZE_RATIO * size_r < size_l = mkBalBranch wu wv wx (mkVBalBranch key elt wy (Branch xu xv xw xx xy)) | otherwise = mkBranch 13 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy) where { size_l = sizeFM (Branch wu wv ww wx wy); size_r = sizeFM (Branch xu xv xw xx xy); }; sIZE_RATIO :: Int; sIZE_RATIO = 5; sizeFM :: FiniteMap a b -> Int; sizeFM EmptyFM = 0; sizeFM (Branch vzw vzx size vzy vzz) = size; splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitGT EmptyFM split_key = emptyFM; splitGT (Branch key elt yv 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 yw 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; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (7) COR (EQUIVALENT) Cond Reductions: The following Function with conditions "undefined |Falseundefined; " is transformed to "undefined = undefined1; " "undefined0 True = undefined; " "undefined1 = undefined0 False; " 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_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_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_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 wvw wvx wvy wvz = addToFM_C3 wvw wvx wvy wvz; " 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 wu wv ww wx wy) (Branch xu xv xw xx xy)|sIZE_RATIO * size_l < size_rmkBalBranch xu xv (mkVBalBranch key elt (Branch wu wv ww wx wy) xx) xy|sIZE_RATIO * size_r < size_lmkBalBranch wu wv wx (mkVBalBranch key elt wy (Branch xu xv xw xx xy))|otherwisemkBranch 13 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy) where { size_l = sizeFM (Branch wu wv ww wx wy); ; size_r = sizeFM (Branch xu xv xw xx xy); } ; " 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 wu wv ww wx wy) (Branch xu xv xw xx xy) = mkVBalBranch3 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy); " "mkVBalBranch3 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy) = mkVBalBranch2 key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * size_l < size_r) where { mkVBalBranch0 key elt wu wv ww wx wy xu xv xw xx xy True = mkBranch 13 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy); ; mkVBalBranch1 key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch wu wv wx (mkVBalBranch key elt wy (Branch xu xv xw xx xy)); mkVBalBranch1 key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch0 key elt wu wv ww wx wy xu xv xw xx xy otherwise; ; mkVBalBranch2 key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch xu xv (mkVBalBranch key elt (Branch wu wv ww wx wy) xx) xy; mkVBalBranch2 key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch1 key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * size_r < size_l); ; size_l = sizeFM (Branch wu wv ww wx wy); ; size_r = sizeFM (Branch xu xv xw xx xy); } ; " "mkVBalBranch4 key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch4 wwx wwy wwz wxu = mkVBalBranch3 wwx wwy wwz wxu; " "mkVBalBranch5 key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch5 wxw wxx wxy wxz = mkVBalBranch4 wxw wxx wxy wxz; " The following Function with conditions "splitGT EmptyFM split_key = emptyFM; splitGT (Branch key elt yv 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 yv fm_l fm_r) split_key = splitGT3 (Branch key elt yv fm_l fm_r) split_key; " "splitGT0 key elt yv fm_l fm_r split_key True = fm_r; " "splitGT1 key elt yv fm_l fm_r split_key True = mkVBalBranch key elt (splitGT fm_l split_key) fm_r; splitGT1 key elt yv fm_l fm_r split_key False = splitGT0 key elt yv fm_l fm_r split_key otherwise; " "splitGT2 key elt yv fm_l fm_r split_key True = splitGT fm_r split_key; splitGT2 key elt yv fm_l fm_r split_key False = splitGT1 key elt yv fm_l fm_r split_key (split_key < key); " "splitGT3 (Branch key elt yv fm_l fm_r) split_key = splitGT2 key elt yv fm_l fm_r split_key (split_key > key); " "splitGT4 EmptyFM split_key = emptyFM; splitGT4 wyw wyx = splitGT3 wyw wyx; " The following Function with conditions "splitLT EmptyFM split_key = emptyFM; splitLT (Branch key elt yw 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 yw fm_l fm_r) split_key = splitLT3 (Branch key elt yw fm_l fm_r) split_key; " "splitLT0 key elt yw fm_l fm_r split_key True = fm_l; " "splitLT2 key elt yw fm_l fm_r split_key True = splitLT fm_l split_key; splitLT2 key elt yw fm_l fm_r split_key False = splitLT1 key elt yw fm_l fm_r split_key (split_key > key); " "splitLT1 key elt yw fm_l fm_r split_key True = mkVBalBranch key elt fm_l (splitLT fm_r split_key); splitLT1 key elt yw fm_l fm_r split_key False = splitLT0 key elt yw fm_l fm_r split_key otherwise; " "splitLT3 (Branch key elt yw fm_l fm_r) split_key = splitLT2 key elt yw fm_l fm_r split_key (split_key < key); " "splitLT4 EmptyFM split_key = emptyFM; splitLT4 wzu wzv = splitLT3 wzu wzv; " The following Function with conditions "mkBalBranch1 fm_L fm_R (Branch vvv vvw vvx 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 vvv vvw vvx fm_ll fm_lr) = mkBalBranch12 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr); " "mkBalBranch10 fm_L fm_R vvv vvw vvx fm_ll fm_lr True = double_R fm_L fm_R; " "mkBalBranch11 fm_L fm_R vvv vvw vvx fm_ll fm_lr True = single_R fm_L fm_R; mkBalBranch11 fm_L fm_R vvv vvw vvx fm_ll fm_lr False = mkBalBranch10 fm_L fm_R vvv vvw vvx fm_ll fm_lr otherwise; " "mkBalBranch12 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch11 fm_L fm_R vvv vvw vvx fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll); " The following Function with conditions "mkBalBranch0 fm_L fm_R (Branch vwu vwv vww 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 vwu vwv vww fm_rl fm_rr) = mkBalBranch02 fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr); " "mkBalBranch00 fm_L fm_R vwu vwv vww fm_rl fm_rr True = double_L fm_L fm_R; " "mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr True = single_L fm_L fm_R; mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr False = mkBalBranch00 fm_L fm_R vwu vwv vww fm_rl fm_rr otherwise; " "mkBalBranch02 fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr) = mkBalBranch01 fm_L fm_R vwu vwv vww 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 vvy (Branch key_rl elt_rl vvz 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 vuz fm_ll (Branch key_lr elt_lr vvu 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 vwu vwv vww 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 vvv vvw vvx 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 vwx 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 vuy 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 vvy (Branch key_rl elt_rl vvz 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 vuz fm_ll (Branch key_lr elt_lr vvu 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 vwu vwv vww fm_rl fm_rr) = mkBalBranch02 fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr); ; mkBalBranch00 fm_L fm_R vwu vwv vww fm_rl fm_rr True = double_L fm_L fm_R; ; mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr True = single_L fm_L fm_R; mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr False = mkBalBranch00 fm_L fm_R vwu vwv vww fm_rl fm_rr otherwise; ; mkBalBranch02 fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr) = mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); ; mkBalBranch1 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch12 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr); ; mkBalBranch10 fm_L fm_R vvv vvw vvx fm_ll fm_lr True = double_R fm_L fm_R; ; mkBalBranch11 fm_L fm_R vvv vvw vvx fm_ll fm_lr True = single_R fm_L fm_R; mkBalBranch11 fm_L fm_R vvv vvw vvx fm_ll fm_lr False = mkBalBranch10 fm_L fm_R vvv vvw vvx fm_ll fm_lr otherwise; ; mkBalBranch12 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch11 fm_L fm_R vvv vvw vvx 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 vwx 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 vuy 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 (vwz,mid_elt1) = mid_elt1; ; mid_elt2 = mid_elt20 vv3; ; mid_elt20 (vwy,mid_elt2) = mid_elt2; ; mid_key1 = mid_key10 vv2; ; mid_key10 (mid_key1,vxu) = mid_key1; ; mid_key2 = mid_key20 vv3; ; mid_key20 (mid_key2,vxv) = 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 (vwz,mid_elt1) = mid_elt1; ; mid_elt2 = mid_elt20 vv3; ; mid_elt20 (vwy,mid_elt2) = mid_elt2; ; mid_key1 = mid_key10 vv2; ; mid_key10 (mid_key1,vxu) = mid_key1; ; mid_key2 = mid_key20 vv3; ; mid_key20 (mid_key2,vxv) = mid_key2; ; vv2 = findMax fm1; ; vv3 = findMin fm2; } ; " "glueBal3 fm1 EmptyFM = fm1; glueBal3 wzz xuu = glueBal2 wzz xuu; " "glueBal4 EmptyFM fm2 = fm2; glueBal4 xuw xux = glueBal3 xuw xux; " The following Function with conditions "glueVBal EmptyFM fm2 = fm2; glueVBal fm1 EmptyFM = fm1; glueVBal (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv)|sIZE_RATIO * size_l < size_rmkBalBranch vyx vyy (glueVBal (Branch vxx vxy vxz vyu vyv) vzu) vzv|sIZE_RATIO * size_r < size_lmkBalBranch vxx vxy vyu (glueVBal vyv (Branch vyx vyy vyz vzu vzv))|otherwiseglueBal (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) where { size_l = sizeFM (Branch vxx vxy vxz vyu vyv); ; size_r = sizeFM (Branch vyx vyy vyz vzu vzv); } ; " is transformed to "glueVBal EmptyFM fm2 = glueVBal5 EmptyFM fm2; glueVBal fm1 EmptyFM = glueVBal4 fm1 EmptyFM; glueVBal (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) = glueVBal3 (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv); " "glueVBal3 (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) = glueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * size_l < size_r) where { glueVBal0 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = glueBal (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv); ; glueVBal1 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vxx vxy vyu (glueVBal vyv (Branch vyx vyy vyz vzu vzv)); glueVBal1 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal0 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv otherwise; ; glueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vyx vyy (glueVBal (Branch vxx vxy vxz vyu vyv) vzu) vzv; glueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal1 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * size_r < size_l); ; size_l = sizeFM (Branch vxx vxy vxz vyu vyv); ; size_r = sizeFM (Branch vyx vyy vyz vzu vzv); } ; " "glueVBal4 fm1 EmptyFM = fm1; glueVBal4 xvv xvw = glueVBal3 xvv xvw; " "glueVBal5 EmptyFM fm2 = fm2; glueVBal5 xvy xvz = glueVBal4 xvy xvz; " ---------------------------------------- (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 b a where { } 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 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 wvw wvx wvy wvz = addToFM_C3 wvw wvx wvy wvz; deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMax (Branch key elt xz fm_l EmptyFM) = fm_l; deleteMax (Branch key elt yu 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 wuu EmptyFM fm_r) = fm_r; deleteMin (Branch key elt wuv 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 vuu vuv EmptyFM) = (key,elt); findMax (Branch key elt vuw vux fm_r) = findMax fm_r; findMin :: FiniteMap b a -> (b,a); findMin (Branch key elt wuw EmptyFM wux) = (key,elt); findMin (Branch key elt wuy fm_l wuz) = findMin 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 = 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 (vwz,mid_elt1) = mid_elt1; mid_elt2 = mid_elt20 vv3; mid_elt20 (vwy,mid_elt2) = mid_elt2; mid_key1 = mid_key10 vv2; mid_key10 (mid_key1,vxu) = mid_key1; mid_key2 = mid_key20 vv3; mid_key20 (mid_key2,vxv) = mid_key2; vv2 = findMax fm1; vv3 = findMin fm2; }; glueBal3 fm1 EmptyFM = fm1; glueBal3 wzz xuu = glueBal2 wzz xuu; glueBal4 EmptyFM fm2 = fm2; glueBal4 xuw xux = glueBal3 xuw xux; 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 vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) = glueVBal3 (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv); glueVBal3 (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) = glueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * size_l < size_r) where { glueVBal0 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = glueBal (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv); glueVBal1 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vxx vxy vyu (glueVBal vyv (Branch vyx vyy vyz vzu vzv)); glueVBal1 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal0 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv otherwise; glueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vyx vyy (glueVBal (Branch vxx vxy vxz vyu vyv) vzu) vzv; glueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal1 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * size_r < size_l); size_l = sizeFM (Branch vxx vxy vxz vyu vyv); size_r = sizeFM (Branch vyx vyy vyz vzu vzv); }; glueVBal4 fm1 EmptyFM = fm1; glueVBal4 xvv xvw = glueVBal3 xvv xvw; glueVBal5 EmptyFM fm2 = fm2; glueVBal5 xvy xvz = glueVBal4 xvy xvz; minusFM :: Ord a => FiniteMap a b -> FiniteMap a c -> FiniteMap a b; minusFM EmptyFM fm2 = emptyFM; minusFM fm1 EmptyFM = fm1; minusFM fm1 (Branch split_key elt yx left right) = glueVBal (minusFM lts left) (minusFM gts right) where { gts = splitGT fm1 split_key; lts = splitLT fm1 split_key; }; 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 vvy (Branch key_rl elt_rl vvz 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 vuz fm_ll (Branch key_lr elt_lr vvu 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 vwu vwv vww fm_rl fm_rr) = mkBalBranch02 fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr); mkBalBranch00 fm_L fm_R vwu vwv vww fm_rl fm_rr True = double_L fm_L fm_R; mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr True = single_L fm_L fm_R; mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr False = mkBalBranch00 fm_L fm_R vwu vwv vww fm_rl fm_rr otherwise; mkBalBranch02 fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr) = mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); mkBalBranch1 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch12 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr); mkBalBranch10 fm_L fm_R vvv vvw vvx fm_ll fm_lr True = double_R fm_L fm_R; mkBalBranch11 fm_L fm_R vvv vvw vvx fm_ll fm_lr True = single_R fm_L fm_R; mkBalBranch11 fm_L fm_R vvv vvw vvx fm_ll fm_lr False = mkBalBranch10 fm_L fm_R vvv vvw vvx fm_ll fm_lr otherwise; mkBalBranch12 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch11 fm_L fm_R vvv vvw vvx 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 vwx 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 vuy 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 yy yz zu zv) = 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 zw zx zy zz) = 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 wu wv ww wx wy) (Branch xu xv xw xx xy) = mkVBalBranch3 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy); mkVBalBranch3 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy) = mkVBalBranch2 key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * size_l < size_r) where { mkVBalBranch0 key elt wu wv ww wx wy xu xv xw xx xy True = mkBranch 13 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy); mkVBalBranch1 key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch wu wv wx (mkVBalBranch key elt wy (Branch xu xv xw xx xy)); mkVBalBranch1 key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch0 key elt wu wv ww wx wy xu xv xw xx xy otherwise; mkVBalBranch2 key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch xu xv (mkVBalBranch key elt (Branch wu wv ww wx wy) xx) xy; mkVBalBranch2 key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch1 key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * size_r < size_l); size_l = sizeFM (Branch wu wv ww wx wy); size_r = sizeFM (Branch xu xv xw xx xy); }; mkVBalBranch4 key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch4 wwx wwy wwz wxu = mkVBalBranch3 wwx wwy wwz wxu; mkVBalBranch5 key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch5 wxw wxx wxy wxz = mkVBalBranch4 wxw wxx wxy wxz; sIZE_RATIO :: Int; sIZE_RATIO = 5; sizeFM :: FiniteMap a b -> Int; sizeFM EmptyFM = 0; sizeFM (Branch vzw vzx size vzy vzz) = size; splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitGT EmptyFM split_key = splitGT4 EmptyFM split_key; splitGT (Branch key elt yv fm_l fm_r) split_key = splitGT3 (Branch key elt yv fm_l fm_r) split_key; splitGT0 key elt yv fm_l fm_r split_key True = fm_r; splitGT1 key elt yv fm_l fm_r split_key True = mkVBalBranch key elt (splitGT fm_l split_key) fm_r; splitGT1 key elt yv fm_l fm_r split_key False = splitGT0 key elt yv fm_l fm_r split_key otherwise; splitGT2 key elt yv fm_l fm_r split_key True = splitGT fm_r split_key; splitGT2 key elt yv fm_l fm_r split_key False = splitGT1 key elt yv fm_l fm_r split_key (split_key < key); splitGT3 (Branch key elt yv fm_l fm_r) split_key = splitGT2 key elt yv fm_l fm_r split_key (split_key > key); splitGT4 EmptyFM split_key = emptyFM; splitGT4 wyw wyx = splitGT3 wyw wyx; splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitLT EmptyFM split_key = splitLT4 EmptyFM split_key; splitLT (Branch key elt yw fm_l fm_r) split_key = splitLT3 (Branch key elt yw fm_l fm_r) split_key; splitLT0 key elt yw fm_l fm_r split_key True = fm_l; splitLT1 key elt yw fm_l fm_r split_key True = mkVBalBranch key elt fm_l (splitLT fm_r split_key); splitLT1 key elt yw fm_l fm_r split_key False = splitLT0 key elt yw fm_l fm_r split_key otherwise; splitLT2 key elt yw fm_l fm_r split_key True = splitLT fm_l split_key; splitLT2 key elt yw fm_l fm_r split_key False = splitLT1 key elt yw fm_l fm_r split_key (split_key > key); splitLT3 (Branch key elt yw fm_l fm_r) split_key = splitLT2 key elt yw fm_l fm_r split_key (split_key < key); splitLT4 EmptyFM split_key = emptyFM; splitLT4 wzu wzv = splitLT3 wzu wzv; 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; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (9) LetRed (EQUIVALENT) Let/Where Reductions: 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 vvy (Branch key_rl elt_rl vvz 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 vuz fm_ll (Branch key_lr elt_lr vvu 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 vwu vwv vww fm_rl fm_rr) = mkBalBranch02 fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr); ; mkBalBranch00 fm_L fm_R vwu vwv vww fm_rl fm_rr True = double_L fm_L fm_R; ; mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr True = single_L fm_L fm_R; mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr False = mkBalBranch00 fm_L fm_R vwu vwv vww fm_rl fm_rr otherwise; ; mkBalBranch02 fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr) = mkBalBranch01 fm_L fm_R vwu vwv vww fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); ; mkBalBranch1 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch12 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr); ; mkBalBranch10 fm_L fm_R vvv vvw vvx fm_ll fm_lr True = double_R fm_L fm_R; ; mkBalBranch11 fm_L fm_R vvv vvw vvx fm_ll fm_lr True = single_R fm_L fm_R; mkBalBranch11 fm_L fm_R vvv vvw vvx fm_ll fm_lr False = mkBalBranch10 fm_L fm_R vvv vvw vvx fm_ll fm_lr otherwise; ; mkBalBranch12 fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch11 fm_L fm_R vvv vvw vvx 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 vwx 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 vuy 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 xwu xwv xww xwx fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch6MkBalBranch12 xwu xwv xww xwx fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr); " "mkBalBranch6MkBalBranch02 xwu xwv xww xwx fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr) = mkBalBranch6MkBalBranch01 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); " "mkBalBranch6MkBalBranch01 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr True = mkBalBranch6Single_L xwu xwv xww xwx fm_L fm_R; mkBalBranch6MkBalBranch01 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr False = mkBalBranch6MkBalBranch00 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr otherwise; " "mkBalBranch6Double_L xwu xwv xww xwx fm_l (Branch key_r elt_r vvy (Branch key_rl elt_rl vvz fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 xwu xwv fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); " "mkBalBranch6Size_l xwu xwv xww xwx = sizeFM xww; " "mkBalBranch6MkBalBranch11 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr True = mkBalBranch6Single_R xwu xwv xww xwx fm_L fm_R; mkBalBranch6MkBalBranch11 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr False = mkBalBranch6MkBalBranch10 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr otherwise; " "mkBalBranch6Double_R xwu xwv xww xwx (Branch key_l elt_l vuz fm_ll (Branch key_lr elt_lr vvu fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 xwu xwv fm_lrr fm_r); " "mkBalBranch6MkBalBranch12 xwu xwv xww xwx fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch6MkBalBranch11 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll); " "mkBalBranch6Single_R xwu xwv xww xwx (Branch key_l elt_l vuy fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 xwu xwv fm_lr fm_r); " "mkBalBranch6MkBalBranch00 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr True = mkBalBranch6Double_L xwu xwv xww xwx fm_L fm_R; " "mkBalBranch6MkBalBranch2 xwu xwv xww xwx key elt fm_L fm_R True = mkBranch 2 key elt fm_L fm_R; " "mkBalBranch6MkBalBranch4 xwu xwv xww xwx key elt fm_L fm_R True = mkBalBranch6MkBalBranch0 xwu xwv xww xwx fm_L fm_R fm_R; mkBalBranch6MkBalBranch4 xwu xwv xww xwx key elt fm_L fm_R False = mkBalBranch6MkBalBranch3 xwu xwv xww xwx key elt fm_L fm_R (mkBalBranch6Size_l xwu xwv xww xwx > sIZE_RATIO * mkBalBranch6Size_r xwu xwv xww xwx); " "mkBalBranch6Single_L xwu xwv xww xwx fm_l (Branch key_r elt_r vwx fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 xwu xwv fm_l fm_rl) fm_rr; " "mkBalBranch6MkBalBranch5 xwu xwv xww xwx key elt fm_L fm_R True = mkBranch 1 key elt fm_L fm_R; mkBalBranch6MkBalBranch5 xwu xwv xww xwx key elt fm_L fm_R False = mkBalBranch6MkBalBranch4 xwu xwv xww xwx key elt fm_L fm_R (mkBalBranch6Size_r xwu xwv xww xwx > sIZE_RATIO * mkBalBranch6Size_l xwu xwv xww xwx); " "mkBalBranch6MkBalBranch0 xwu xwv xww xwx fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr) = mkBalBranch6MkBalBranch02 xwu xwv xww xwx fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr); " "mkBalBranch6MkBalBranch10 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr True = mkBalBranch6Double_R xwu xwv xww xwx fm_L fm_R; " "mkBalBranch6MkBalBranch3 xwu xwv xww xwx key elt fm_L fm_R True = mkBalBranch6MkBalBranch1 xwu xwv xww xwx fm_L fm_R fm_L; mkBalBranch6MkBalBranch3 xwu xwv xww xwx key elt fm_L fm_R False = mkBalBranch6MkBalBranch2 xwu xwv xww xwx key elt fm_L fm_R otherwise; " "mkBalBranch6Size_r xwu xwv xww xwx = sizeFM xwx; " The bindings of the following Let/Where expression "glueVBal (minusFM lts left) (minusFM gts right) where { gts = splitGT fm1 split_key; ; lts = splitLT fm1 split_key; } " are unpacked to the following functions on top level "minusFMGts xwy xwz = splitGT xwy xwz; " "minusFMLts xwy xwz = splitLT xwy xwz; " 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 yy yz zu zv) = 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 zw zx zy zz) = 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 "mkBranchRight_ok xxu xxv xxw = mkBranchRight_ok0 xxu xxv xxw xxu xxv xxu; " "mkBranchLeft_ok xxu xxv xxw = mkBranchLeft_ok0 xxu xxv xxw xxw xxv xxw; " "mkBranchBalance_ok xxu xxv xxw = True; " "mkBranchUnbox xxu xxv xxw x = x; " "mkBranchLeft_ok0 xxu xxv xxw fm_l key EmptyFM = True; mkBranchLeft_ok0 xxu xxv xxw fm_l key (Branch left_key yy yz zu zv) = mkBranchLeft_ok0Biggest_left_key fm_l < key; " "mkBranchRight_size xxu xxv xxw = sizeFM xxu; " "mkBranchLeft_size xxu xxv xxw = sizeFM xxw; " "mkBranchRight_ok0 xxu xxv xxw fm_r key EmptyFM = True; mkBranchRight_ok0 xxu xxv xxw fm_r key (Branch right_key zw zx zy zz) = 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 xxx xxy xxz xyu = Branch xxx xxy (mkBranchUnbox xxz xxx xyu (1 + mkBranchLeft_size xxz xxx xyu + mkBranchRight_size xxz xxx xyu)) xyu xxz; " The bindings of the following Let/Where expression "glueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * size_l < size_r) where { glueVBal0 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = glueBal (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv); ; glueVBal1 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vxx vxy vyu (glueVBal vyv (Branch vyx vyy vyz vzu vzv)); glueVBal1 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal0 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv otherwise; ; glueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vyx vyy (glueVBal (Branch vxx vxy vxz vyu vyv) vzu) vzv; glueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal1 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * size_r < size_l); ; size_l = sizeFM (Branch vxx vxy vxz vyu vyv); ; size_r = sizeFM (Branch vyx vyy vyz vzu vzv); } " are unpacked to the following functions on top level "glueVBal3Size_l xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy = sizeFM (Branch xyv xyw xyx xyy xyz); " "glueVBal3GlueVBal1 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vxx vxy vyu (glueVBal vyv (Branch vyx vyy vyz vzu vzv)); glueVBal3GlueVBal1 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal3GlueVBal0 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv otherwise; " "glueVBal3GlueVBal2 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vyx vyy (glueVBal (Branch vxx vxy vxz vyu vyv) vzu) vzv; glueVBal3GlueVBal2 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal3GlueVBal1 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * glueVBal3Size_r xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy < glueVBal3Size_l xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy); " "glueVBal3GlueVBal0 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = glueBal (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv); " "glueVBal3Size_r xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy = sizeFM (Branch xzu xzv xzw xzx xzy); " 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 (vwz,mid_elt1) = mid_elt1; ; mid_elt2 = mid_elt20 vv3; ; mid_elt20 (vwy,mid_elt2) = mid_elt2; ; mid_key1 = mid_key10 vv2; ; mid_key10 (mid_key1,vxu) = mid_key1; ; mid_key2 = mid_key20 vv3; ; mid_key20 (mid_key2,vxv) = mid_key2; ; vv2 = findMax fm1; ; vv3 = findMin fm2; } " are unpacked to the following functions on top level "glueBal2Vv3 xzz yuu = findMin xzz; " "glueBal2Mid_key10 xzz yuu (mid_key1,vxu) = mid_key1; " "glueBal2Mid_elt2 xzz yuu = glueBal2Mid_elt20 xzz yuu (glueBal2Vv3 xzz yuu); " "glueBal2GlueBal1 xzz yuu fm1 fm2 True = mkBalBranch (glueBal2Mid_key2 xzz yuu) (glueBal2Mid_elt2 xzz yuu) fm1 (deleteMin fm2); glueBal2GlueBal1 xzz yuu fm1 fm2 False = glueBal2GlueBal0 xzz yuu fm1 fm2 otherwise; " "glueBal2GlueBal0 xzz yuu fm1 fm2 True = mkBalBranch (glueBal2Mid_key1 xzz yuu) (glueBal2Mid_elt1 xzz yuu) (deleteMax fm1) fm2; " "glueBal2Mid_elt20 xzz yuu (vwy,mid_elt2) = mid_elt2; " "glueBal2Mid_key2 xzz yuu = glueBal2Mid_key20 xzz yuu (glueBal2Vv3 xzz yuu); " "glueBal2Mid_key20 xzz yuu (mid_key2,vxv) = mid_key2; " "glueBal2Mid_elt10 xzz yuu (vwz,mid_elt1) = mid_elt1; " "glueBal2Mid_elt1 xzz yuu = glueBal2Mid_elt10 xzz yuu (glueBal2Vv2 xzz yuu); " "glueBal2Mid_key1 xzz yuu = glueBal2Mid_key10 xzz yuu (glueBal2Vv2 xzz yuu); " "glueBal2Vv2 xzz yuu = findMax yuu; " The bindings of the following Let/Where expression "mkVBalBranch2 key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * size_l < size_r) where { mkVBalBranch0 key elt wu wv ww wx wy xu xv xw xx xy True = mkBranch 13 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy); ; mkVBalBranch1 key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch wu wv wx (mkVBalBranch key elt wy (Branch xu xv xw xx xy)); mkVBalBranch1 key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch0 key elt wu wv ww wx wy xu xv xw xx xy otherwise; ; mkVBalBranch2 key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch xu xv (mkVBalBranch key elt (Branch wu wv ww wx wy) xx) xy; mkVBalBranch2 key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch1 key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * size_r < size_l); ; size_l = sizeFM (Branch wu wv ww wx wy); ; size_r = sizeFM (Branch xu xv xw xx xy); } " are unpacked to the following functions on top level "mkVBalBranch3MkVBalBranch0 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy True = mkBranch 13 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy); " "mkVBalBranch3MkVBalBranch1 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch wu wv wx (mkVBalBranch key elt wy (Branch xu xv xw xx xy)); mkVBalBranch3MkVBalBranch1 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch3MkVBalBranch0 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy otherwise; " "mkVBalBranch3Size_r yuv yuw yux yuy yuz yvu yvv yvw yvx yvy = sizeFM (Branch yuv yuw yux yuy yuz); " "mkVBalBranch3Size_l yuv yuw yux yuy yuz yvu yvv yvw yvx yvy = sizeFM (Branch yvu yvv yvw yvx yvy); " "mkVBalBranch3MkVBalBranch2 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch xu xv (mkVBalBranch key elt (Branch wu wv ww wx wy) xx) xy; mkVBalBranch3MkVBalBranch2 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch3MkVBalBranch1 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * mkVBalBranch3Size_r yuv yuw yux yuy yuz yvu yvv yvw yvx yvy < mkVBalBranch3Size_l yuv yuw yux yuy yuz yvu yvv yvw yvx yvy); " 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 yvz = fst (findMax yvz); " 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 ywu = fst (findMin ywu); " ---------------------------------------- (10) 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 { } 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 wvw wvx wvy wvz = addToFM_C3 wvw wvx wvy wvz; deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMax (Branch key elt xz fm_l EmptyFM) = fm_l; deleteMax (Branch key elt yu 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 wuu EmptyFM fm_r) = fm_r; deleteMin (Branch key elt wuv 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 vuu vuv EmptyFM) = (key,elt); findMax (Branch key elt vuw vux fm_r) = findMax fm_r; findMin :: FiniteMap a b -> (a,b); findMin (Branch key elt wuw EmptyFM wux) = (key,elt); findMin (Branch key elt wuy fm_l wuz) = findMin 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 fm2 fm1 fm1 fm2 (sizeFM fm2 > sizeFM fm1); glueBal2GlueBal0 xzz yuu fm1 fm2 True = mkBalBranch (glueBal2Mid_key1 xzz yuu) (glueBal2Mid_elt1 xzz yuu) (deleteMax fm1) fm2; glueBal2GlueBal1 xzz yuu fm1 fm2 True = mkBalBranch (glueBal2Mid_key2 xzz yuu) (glueBal2Mid_elt2 xzz yuu) fm1 (deleteMin fm2); glueBal2GlueBal1 xzz yuu fm1 fm2 False = glueBal2GlueBal0 xzz yuu fm1 fm2 otherwise; glueBal2Mid_elt1 xzz yuu = glueBal2Mid_elt10 xzz yuu (glueBal2Vv2 xzz yuu); glueBal2Mid_elt10 xzz yuu (vwz,mid_elt1) = mid_elt1; glueBal2Mid_elt2 xzz yuu = glueBal2Mid_elt20 xzz yuu (glueBal2Vv3 xzz yuu); glueBal2Mid_elt20 xzz yuu (vwy,mid_elt2) = mid_elt2; glueBal2Mid_key1 xzz yuu = glueBal2Mid_key10 xzz yuu (glueBal2Vv2 xzz yuu); glueBal2Mid_key10 xzz yuu (mid_key1,vxu) = mid_key1; glueBal2Mid_key2 xzz yuu = glueBal2Mid_key20 xzz yuu (glueBal2Vv3 xzz yuu); glueBal2Mid_key20 xzz yuu (mid_key2,vxv) = mid_key2; glueBal2Vv2 xzz yuu = findMax yuu; glueBal2Vv3 xzz yuu = findMin xzz; glueBal3 fm1 EmptyFM = fm1; glueBal3 wzz xuu = glueBal2 wzz xuu; glueBal4 EmptyFM fm2 = fm2; glueBal4 xuw xux = glueBal3 xuw xux; 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 vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) = glueVBal3 (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv); glueVBal3 (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) = glueVBal3GlueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * glueVBal3Size_l vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv < glueVBal3Size_r vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv); glueVBal3GlueVBal0 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = glueBal (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv); glueVBal3GlueVBal1 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vxx vxy vyu (glueVBal vyv (Branch vyx vyy vyz vzu vzv)); glueVBal3GlueVBal1 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal3GlueVBal0 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv otherwise; glueVBal3GlueVBal2 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vyx vyy (glueVBal (Branch vxx vxy vxz vyu vyv) vzu) vzv; glueVBal3GlueVBal2 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal3GlueVBal1 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * glueVBal3Size_r xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy < glueVBal3Size_l xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy); glueVBal3Size_l xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy = sizeFM (Branch xyv xyw xyx xyy xyz); glueVBal3Size_r xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy = sizeFM (Branch xzu xzv xzw xzx xzy); glueVBal4 fm1 EmptyFM = fm1; glueVBal4 xvv xvw = glueVBal3 xvv xvw; glueVBal5 EmptyFM fm2 = fm2; glueVBal5 xvy xvz = glueVBal4 xvy xvz; minusFM :: Ord a => FiniteMap a c -> FiniteMap a b -> FiniteMap a c; minusFM EmptyFM fm2 = emptyFM; minusFM fm1 EmptyFM = fm1; minusFM fm1 (Branch split_key elt yx left right) = glueVBal (minusFM (minusFMLts fm1 split_key) left) (minusFM (minusFMGts fm1 split_key) right); minusFMGts xwy xwz = splitGT xwy xwz; minusFMLts xwy xwz = splitLT xwy xwz; 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 key elt fm_L fm_R key elt fm_L fm_R (mkBalBranch6Size_l key elt fm_L fm_R + mkBalBranch6Size_r key elt fm_L fm_R < 2); mkBalBranch6Double_L xwu xwv xww xwx fm_l (Branch key_r elt_r vvy (Branch key_rl elt_rl vvz fm_rll fm_rlr) fm_rr) = mkBranch 5 key_rl elt_rl (mkBranch 6 xwu xwv fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr); mkBalBranch6Double_R xwu xwv xww xwx (Branch key_l elt_l vuz fm_ll (Branch key_lr elt_lr vvu fm_lrl fm_lrr)) fm_r = mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 xwu xwv fm_lrr fm_r); mkBalBranch6MkBalBranch0 xwu xwv xww xwx fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr) = mkBalBranch6MkBalBranch02 xwu xwv xww xwx fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr); mkBalBranch6MkBalBranch00 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr True = mkBalBranch6Double_L xwu xwv xww xwx fm_L fm_R; mkBalBranch6MkBalBranch01 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr True = mkBalBranch6Single_L xwu xwv xww xwx fm_L fm_R; mkBalBranch6MkBalBranch01 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr False = mkBalBranch6MkBalBranch00 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr otherwise; mkBalBranch6MkBalBranch02 xwu xwv xww xwx fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr) = mkBalBranch6MkBalBranch01 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr); mkBalBranch6MkBalBranch1 xwu xwv xww xwx fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch6MkBalBranch12 xwu xwv xww xwx fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr); mkBalBranch6MkBalBranch10 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr True = mkBalBranch6Double_R xwu xwv xww xwx fm_L fm_R; mkBalBranch6MkBalBranch11 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr True = mkBalBranch6Single_R xwu xwv xww xwx fm_L fm_R; mkBalBranch6MkBalBranch11 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr False = mkBalBranch6MkBalBranch10 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr otherwise; mkBalBranch6MkBalBranch12 xwu xwv xww xwx fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch6MkBalBranch11 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll); mkBalBranch6MkBalBranch2 xwu xwv xww xwx key elt fm_L fm_R True = mkBranch 2 key elt fm_L fm_R; mkBalBranch6MkBalBranch3 xwu xwv xww xwx key elt fm_L fm_R True = mkBalBranch6MkBalBranch1 xwu xwv xww xwx fm_L fm_R fm_L; mkBalBranch6MkBalBranch3 xwu xwv xww xwx key elt fm_L fm_R False = mkBalBranch6MkBalBranch2 xwu xwv xww xwx key elt fm_L fm_R otherwise; mkBalBranch6MkBalBranch4 xwu xwv xww xwx key elt fm_L fm_R True = mkBalBranch6MkBalBranch0 xwu xwv xww xwx fm_L fm_R fm_R; mkBalBranch6MkBalBranch4 xwu xwv xww xwx key elt fm_L fm_R False = mkBalBranch6MkBalBranch3 xwu xwv xww xwx key elt fm_L fm_R (mkBalBranch6Size_l xwu xwv xww xwx > sIZE_RATIO * mkBalBranch6Size_r xwu xwv xww xwx); mkBalBranch6MkBalBranch5 xwu xwv xww xwx key elt fm_L fm_R True = mkBranch 1 key elt fm_L fm_R; mkBalBranch6MkBalBranch5 xwu xwv xww xwx key elt fm_L fm_R False = mkBalBranch6MkBalBranch4 xwu xwv xww xwx key elt fm_L fm_R (mkBalBranch6Size_r xwu xwv xww xwx > sIZE_RATIO * mkBalBranch6Size_l xwu xwv xww xwx); mkBalBranch6Single_L xwu xwv xww xwx fm_l (Branch key_r elt_r vwx fm_rl fm_rr) = mkBranch 3 key_r elt_r (mkBranch 4 xwu xwv fm_l fm_rl) fm_rr; mkBalBranch6Single_R xwu xwv xww xwx (Branch key_l elt_l vuy fm_ll fm_lr) fm_r = mkBranch 8 key_l elt_l fm_ll (mkBranch 9 xwu xwv fm_lr fm_r); mkBalBranch6Size_l xwu xwv xww xwx = sizeFM xww; mkBalBranch6Size_r xwu xwv xww xwx = sizeFM xwx; 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_r fm_l; mkBranchBalance_ok xxu xxv xxw = True; mkBranchLeft_ok xxu xxv xxw = mkBranchLeft_ok0 xxu xxv xxw xxw xxv xxw; mkBranchLeft_ok0 xxu xxv xxw fm_l key EmptyFM = True; mkBranchLeft_ok0 xxu xxv xxw fm_l key (Branch left_key yy yz zu zv) = mkBranchLeft_ok0Biggest_left_key fm_l < key; mkBranchLeft_ok0Biggest_left_key yvz = fst (findMax yvz); mkBranchLeft_size xxu xxv xxw = sizeFM xxw; mkBranchResult xxx xxy xxz xyu = Branch xxx xxy (mkBranchUnbox xxz xxx xyu (1 + mkBranchLeft_size xxz xxx xyu + mkBranchRight_size xxz xxx xyu)) xyu xxz; mkBranchRight_ok xxu xxv xxw = mkBranchRight_ok0 xxu xxv xxw xxu xxv xxu; mkBranchRight_ok0 xxu xxv xxw fm_r key EmptyFM = True; mkBranchRight_ok0 xxu xxv xxw fm_r key (Branch right_key zw zx zy zz) = key < mkBranchRight_ok0Smallest_right_key fm_r; mkBranchRight_ok0Smallest_right_key ywu = fst (findMin ywu); mkBranchRight_size xxu xxv xxw = sizeFM xxu; mkBranchUnbox :: Ord a => -> (FiniteMap a b) ( -> a ( -> (FiniteMap a b) (Int -> Int))); mkBranchUnbox xxu xxv xxw x = x; mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a; 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 wu wv ww wx wy) (Branch xu xv xw xx xy) = mkVBalBranch3 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy); mkVBalBranch3 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy) = mkVBalBranch3MkVBalBranch2 xu xv xw xx xy wu wv ww wx wy key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * mkVBalBranch3Size_l xu xv xw xx xy wu wv ww wx wy < mkVBalBranch3Size_r xu xv xw xx xy wu wv ww wx wy); mkVBalBranch3MkVBalBranch0 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy True = mkBranch 13 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy); mkVBalBranch3MkVBalBranch1 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch wu wv wx (mkVBalBranch key elt wy (Branch xu xv xw xx xy)); mkVBalBranch3MkVBalBranch1 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch3MkVBalBranch0 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy otherwise; mkVBalBranch3MkVBalBranch2 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch xu xv (mkVBalBranch key elt (Branch wu wv ww wx wy) xx) xy; mkVBalBranch3MkVBalBranch2 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch3MkVBalBranch1 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * mkVBalBranch3Size_r yuv yuw yux yuy yuz yvu yvv yvw yvx yvy < mkVBalBranch3Size_l yuv yuw yux yuy yuz yvu yvv yvw yvx yvy); mkVBalBranch3Size_l yuv yuw yux yuy yuz yvu yvv yvw yvx yvy = sizeFM (Branch yvu yvv yvw yvx yvy); mkVBalBranch3Size_r yuv yuw yux yuy yuz yvu yvv yvw yvx yvy = sizeFM (Branch yuv yuw yux yuy yuz); mkVBalBranch4 key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch4 wwx wwy wwz wxu = mkVBalBranch3 wwx wwy wwz wxu; mkVBalBranch5 key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch5 wxw wxx wxy wxz = mkVBalBranch4 wxw wxx wxy wxz; sIZE_RATIO :: Int; sIZE_RATIO = 5; sizeFM :: FiniteMap b a -> Int; sizeFM EmptyFM = 0; sizeFM (Branch vzw vzx size vzy vzz) = size; splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitGT EmptyFM split_key = splitGT4 EmptyFM split_key; splitGT (Branch key elt yv fm_l fm_r) split_key = splitGT3 (Branch key elt yv fm_l fm_r) split_key; splitGT0 key elt yv fm_l fm_r split_key True = fm_r; splitGT1 key elt yv fm_l fm_r split_key True = mkVBalBranch key elt (splitGT fm_l split_key) fm_r; splitGT1 key elt yv fm_l fm_r split_key False = splitGT0 key elt yv fm_l fm_r split_key otherwise; splitGT2 key elt yv fm_l fm_r split_key True = splitGT fm_r split_key; splitGT2 key elt yv fm_l fm_r split_key False = splitGT1 key elt yv fm_l fm_r split_key (split_key < key); splitGT3 (Branch key elt yv fm_l fm_r) split_key = splitGT2 key elt yv fm_l fm_r split_key (split_key > key); splitGT4 EmptyFM split_key = emptyFM; splitGT4 wyw wyx = splitGT3 wyw wyx; splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitLT EmptyFM split_key = splitLT4 EmptyFM split_key; splitLT (Branch key elt yw fm_l fm_r) split_key = splitLT3 (Branch key elt yw fm_l fm_r) split_key; splitLT0 key elt yw fm_l fm_r split_key True = fm_l; splitLT1 key elt yw fm_l fm_r split_key True = mkVBalBranch key elt fm_l (splitLT fm_r split_key); splitLT1 key elt yw fm_l fm_r split_key False = splitLT0 key elt yw fm_l fm_r split_key otherwise; splitLT2 key elt yw fm_l fm_r split_key True = splitLT fm_l split_key; splitLT2 key elt yw fm_l fm_r split_key False = splitLT1 key elt yw fm_l fm_r split_key (split_key > key); splitLT3 (Branch key elt yw fm_l fm_r) split_key = splitLT2 key elt yw fm_l fm_r split_key (split_key < key); splitLT4 EmptyFM split_key = emptyFM; splitLT4 wzu wzv = splitLT3 wzu wzv; 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; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; } ---------------------------------------- (11) NumRed (SOUND) Num Reduction:All numbers are transformed to their corresponding representation with Succ, Pred and Zero. ---------------------------------------- (12) 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 { } 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 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 wvw wvx wvy wvz = addToFM_C3 wvw wvx wvy wvz; deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b; deleteMax (Branch key elt xz fm_l EmptyFM) = fm_l; deleteMax (Branch key elt yu 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 wuu EmptyFM fm_r) = fm_r; deleteMin (Branch key elt wuv 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 vuu vuv EmptyFM) = (key,elt); findMax (Branch key elt vuw vux fm_r) = findMax fm_r; findMin :: FiniteMap a b -> (a,b); findMin (Branch key elt wuw EmptyFM wux) = (key,elt); findMin (Branch key elt wuy fm_l wuz) = findMin 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 fm2 fm1 fm1 fm2 (sizeFM fm2 > sizeFM fm1); glueBal2GlueBal0 xzz yuu fm1 fm2 True = mkBalBranch (glueBal2Mid_key1 xzz yuu) (glueBal2Mid_elt1 xzz yuu) (deleteMax fm1) fm2; glueBal2GlueBal1 xzz yuu fm1 fm2 True = mkBalBranch (glueBal2Mid_key2 xzz yuu) (glueBal2Mid_elt2 xzz yuu) fm1 (deleteMin fm2); glueBal2GlueBal1 xzz yuu fm1 fm2 False = glueBal2GlueBal0 xzz yuu fm1 fm2 otherwise; glueBal2Mid_elt1 xzz yuu = glueBal2Mid_elt10 xzz yuu (glueBal2Vv2 xzz yuu); glueBal2Mid_elt10 xzz yuu (vwz,mid_elt1) = mid_elt1; glueBal2Mid_elt2 xzz yuu = glueBal2Mid_elt20 xzz yuu (glueBal2Vv3 xzz yuu); glueBal2Mid_elt20 xzz yuu (vwy,mid_elt2) = mid_elt2; glueBal2Mid_key1 xzz yuu = glueBal2Mid_key10 xzz yuu (glueBal2Vv2 xzz yuu); glueBal2Mid_key10 xzz yuu (mid_key1,vxu) = mid_key1; glueBal2Mid_key2 xzz yuu = glueBal2Mid_key20 xzz yuu (glueBal2Vv3 xzz yuu); glueBal2Mid_key20 xzz yuu (mid_key2,vxv) = mid_key2; glueBal2Vv2 xzz yuu = findMax yuu; glueBal2Vv3 xzz yuu = findMin xzz; glueBal3 fm1 EmptyFM = fm1; glueBal3 wzz xuu = glueBal2 wzz xuu; glueBal4 EmptyFM fm2 = fm2; glueBal4 xuw xux = glueBal3 xuw xux; 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 vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) = glueVBal3 (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv); glueVBal3 (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv) = glueVBal3GlueVBal2 vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * glueVBal3Size_l vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv < glueVBal3Size_r vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv); glueVBal3GlueVBal0 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = glueBal (Branch vxx vxy vxz vyu vyv) (Branch vyx vyy vyz vzu vzv); glueVBal3GlueVBal1 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vxx vxy vyu (glueVBal vyv (Branch vyx vyy vyz vzu vzv)); glueVBal3GlueVBal1 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal3GlueVBal0 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv otherwise; glueVBal3GlueVBal2 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv True = mkBalBranch vyx vyy (glueVBal (Branch vxx vxy vxz vyu vyv) vzu) vzv; glueVBal3GlueVBal2 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv False = glueVBal3GlueVBal1 xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy vxx vxy vxz vyu vyv vyx vyy vyz vzu vzv (sIZE_RATIO * glueVBal3Size_r xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy < glueVBal3Size_l xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy); glueVBal3Size_l xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy = sizeFM (Branch xyv xyw xyx xyy xyz); glueVBal3Size_r xyv xyw xyx xyy xyz xzu xzv xzw xzx xzy = sizeFM (Branch xzu xzv xzw xzx xzy); glueVBal4 fm1 EmptyFM = fm1; glueVBal4 xvv xvw = glueVBal3 xvv xvw; glueVBal5 EmptyFM fm2 = fm2; glueVBal5 xvy xvz = glueVBal4 xvy xvz; minusFM :: Ord a => FiniteMap a c -> FiniteMap a b -> FiniteMap a c; minusFM EmptyFM fm2 = emptyFM; minusFM fm1 EmptyFM = fm1; minusFM fm1 (Branch split_key elt yx left right) = glueVBal (minusFM (minusFMLts fm1 split_key) left) (minusFM (minusFMGts fm1 split_key) right); minusFMGts xwy xwz = splitGT xwy xwz; minusFMLts xwy xwz = splitLT xwy xwz; 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 key elt fm_L fm_R key elt fm_L fm_R (mkBalBranch6Size_l key elt fm_L fm_R + mkBalBranch6Size_r key elt fm_L fm_R < Pos (Succ (Succ Zero))); mkBalBranch6Double_L xwu xwv xww xwx fm_l (Branch key_r elt_r vvy (Branch key_rl elt_rl vvz 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))))))) xwu xwv fm_l fm_rll) (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))) key_r elt_r fm_rlr fm_rr); mkBalBranch6Double_R xwu xwv xww xwx (Branch key_l elt_l vuz fm_ll (Branch key_lr elt_lr vvu 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))))))))))))) xwu xwv fm_lrr fm_r); mkBalBranch6MkBalBranch0 xwu xwv xww xwx fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr) = mkBalBranch6MkBalBranch02 xwu xwv xww xwx fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr); mkBalBranch6MkBalBranch00 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr True = mkBalBranch6Double_L xwu xwv xww xwx fm_L fm_R; mkBalBranch6MkBalBranch01 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr True = mkBalBranch6Single_L xwu xwv xww xwx fm_L fm_R; mkBalBranch6MkBalBranch01 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr False = mkBalBranch6MkBalBranch00 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr otherwise; mkBalBranch6MkBalBranch02 xwu xwv xww xwx fm_L fm_R (Branch vwu vwv vww fm_rl fm_rr) = mkBalBranch6MkBalBranch01 xwu xwv xww xwx fm_L fm_R vwu vwv vww fm_rl fm_rr (sizeFM fm_rl < Pos (Succ (Succ Zero)) * sizeFM fm_rr); mkBalBranch6MkBalBranch1 xwu xwv xww xwx fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch6MkBalBranch12 xwu xwv xww xwx fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr); mkBalBranch6MkBalBranch10 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr True = mkBalBranch6Double_R xwu xwv xww xwx fm_L fm_R; mkBalBranch6MkBalBranch11 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr True = mkBalBranch6Single_R xwu xwv xww xwx fm_L fm_R; mkBalBranch6MkBalBranch11 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr False = mkBalBranch6MkBalBranch10 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr otherwise; mkBalBranch6MkBalBranch12 xwu xwv xww xwx fm_L fm_R (Branch vvv vvw vvx fm_ll fm_lr) = mkBalBranch6MkBalBranch11 xwu xwv xww xwx fm_L fm_R vvv vvw vvx fm_ll fm_lr (sizeFM fm_lr < Pos (Succ (Succ Zero)) * sizeFM fm_ll); mkBalBranch6MkBalBranch2 xwu xwv xww xwx key elt fm_L fm_R True = mkBranch (Pos (Succ (Succ Zero))) key elt fm_L fm_R; mkBalBranch6MkBalBranch3 xwu xwv xww xwx key elt fm_L fm_R True = mkBalBranch6MkBalBranch1 xwu xwv xww xwx fm_L fm_R fm_L; mkBalBranch6MkBalBranch3 xwu xwv xww xwx key elt fm_L fm_R False = mkBalBranch6MkBalBranch2 xwu xwv xww xwx key elt fm_L fm_R otherwise; mkBalBranch6MkBalBranch4 xwu xwv xww xwx key elt fm_L fm_R True = mkBalBranch6MkBalBranch0 xwu xwv xww xwx fm_L fm_R fm_R; mkBalBranch6MkBalBranch4 xwu xwv xww xwx key elt fm_L fm_R False = mkBalBranch6MkBalBranch3 xwu xwv xww xwx key elt fm_L fm_R (mkBalBranch6Size_l xwu xwv xww xwx > sIZE_RATIO * mkBalBranch6Size_r xwu xwv xww xwx); mkBalBranch6MkBalBranch5 xwu xwv xww xwx key elt fm_L fm_R True = mkBranch (Pos (Succ Zero)) key elt fm_L fm_R; mkBalBranch6MkBalBranch5 xwu xwv xww xwx key elt fm_L fm_R False = mkBalBranch6MkBalBranch4 xwu xwv xww xwx key elt fm_L fm_R (mkBalBranch6Size_r xwu xwv xww xwx > sIZE_RATIO * mkBalBranch6Size_l xwu xwv xww xwx); mkBalBranch6Single_L xwu xwv xww xwx fm_l (Branch key_r elt_r vwx fm_rl fm_rr) = mkBranch (Pos (Succ (Succ (Succ Zero)))) key_r elt_r (mkBranch (Pos (Succ (Succ (Succ (Succ Zero))))) xwu xwv fm_l fm_rl) fm_rr; mkBalBranch6Single_R xwu xwv xww xwx (Branch key_l elt_l vuy 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)))))))))) xwu xwv fm_lr fm_r); mkBalBranch6Size_l xwu xwv xww xwx = sizeFM xww; mkBalBranch6Size_r xwu xwv xww xwx = sizeFM xwx; 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_r fm_l; mkBranchBalance_ok xxu xxv xxw = True; mkBranchLeft_ok xxu xxv xxw = mkBranchLeft_ok0 xxu xxv xxw xxw xxv xxw; mkBranchLeft_ok0 xxu xxv xxw fm_l key EmptyFM = True; mkBranchLeft_ok0 xxu xxv xxw fm_l key (Branch left_key yy yz zu zv) = mkBranchLeft_ok0Biggest_left_key fm_l < key; mkBranchLeft_ok0Biggest_left_key yvz = fst (findMax yvz); mkBranchLeft_size xxu xxv xxw = sizeFM xxw; mkBranchResult xxx xxy xxz xyu = Branch xxx xxy (mkBranchUnbox xxz xxx xyu (Pos (Succ Zero) + mkBranchLeft_size xxz xxx xyu + mkBranchRight_size xxz xxx xyu)) xyu xxz; mkBranchRight_ok xxu xxv xxw = mkBranchRight_ok0 xxu xxv xxw xxu xxv xxu; mkBranchRight_ok0 xxu xxv xxw fm_r key EmptyFM = True; mkBranchRight_ok0 xxu xxv xxw fm_r key (Branch right_key zw zx zy zz) = key < mkBranchRight_ok0Smallest_right_key fm_r; mkBranchRight_ok0Smallest_right_key ywu = fst (findMin ywu); mkBranchRight_size xxu xxv xxw = sizeFM xxu; mkBranchUnbox :: Ord a => -> (FiniteMap a b) ( -> a ( -> (FiniteMap a b) (Int -> Int))); mkBranchUnbox xxu xxv xxw 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 wu wv ww wx wy) (Branch xu xv xw xx xy) = mkVBalBranch3 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy); mkVBalBranch3 key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy) = mkVBalBranch3MkVBalBranch2 xu xv xw xx xy wu wv ww wx wy key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * mkVBalBranch3Size_l xu xv xw xx xy wu wv ww wx wy < mkVBalBranch3Size_r xu xv xw xx xy wu wv ww wx wy); mkVBalBranch3MkVBalBranch0 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy True = mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))))))) key elt (Branch wu wv ww wx wy) (Branch xu xv xw xx xy); mkVBalBranch3MkVBalBranch1 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch wu wv wx (mkVBalBranch key elt wy (Branch xu xv xw xx xy)); mkVBalBranch3MkVBalBranch1 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch3MkVBalBranch0 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy otherwise; mkVBalBranch3MkVBalBranch2 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy True = mkBalBranch xu xv (mkVBalBranch key elt (Branch wu wv ww wx wy) xx) xy; mkVBalBranch3MkVBalBranch2 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy False = mkVBalBranch3MkVBalBranch1 yuv yuw yux yuy yuz yvu yvv yvw yvx yvy key elt wu wv ww wx wy xu xv xw xx xy (sIZE_RATIO * mkVBalBranch3Size_r yuv yuw yux yuy yuz yvu yvv yvw yvx yvy < mkVBalBranch3Size_l yuv yuw yux yuy yuz yvu yvv yvw yvx yvy); mkVBalBranch3Size_l yuv yuw yux yuy yuz yvu yvv yvw yvx yvy = sizeFM (Branch yvu yvv yvw yvx yvy); mkVBalBranch3Size_r yuv yuw yux yuy yuz yvu yvv yvw yvx yvy = sizeFM (Branch yuv yuw yux yuy yuz); mkVBalBranch4 key elt fm_l EmptyFM = addToFM fm_l key elt; mkVBalBranch4 wwx wwy wwz wxu = mkVBalBranch3 wwx wwy wwz wxu; mkVBalBranch5 key elt EmptyFM fm_r = addToFM fm_r key elt; mkVBalBranch5 wxw wxx wxy wxz = mkVBalBranch4 wxw wxx wxy wxz; sIZE_RATIO :: Int; sIZE_RATIO = Pos (Succ (Succ (Succ (Succ (Succ Zero))))); sizeFM :: FiniteMap b a -> Int; sizeFM EmptyFM = Pos Zero; sizeFM (Branch vzw vzx size vzy vzz) = size; splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitGT EmptyFM split_key = splitGT4 EmptyFM split_key; splitGT (Branch key elt yv fm_l fm_r) split_key = splitGT3 (Branch key elt yv fm_l fm_r) split_key; splitGT0 key elt yv fm_l fm_r split_key True = fm_r; splitGT1 key elt yv fm_l fm_r split_key True = mkVBalBranch key elt (splitGT fm_l split_key) fm_r; splitGT1 key elt yv fm_l fm_r split_key False = splitGT0 key elt yv fm_l fm_r split_key otherwise; splitGT2 key elt yv fm_l fm_r split_key True = splitGT fm_r split_key; splitGT2 key elt yv fm_l fm_r split_key False = splitGT1 key elt yv fm_l fm_r split_key (split_key < key); splitGT3 (Branch key elt yv fm_l fm_r) split_key = splitGT2 key elt yv fm_l fm_r split_key (split_key > key); splitGT4 EmptyFM split_key = emptyFM; splitGT4 wyw wyx = splitGT3 wyw wyx; splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a; splitLT EmptyFM split_key = splitLT4 EmptyFM split_key; splitLT (Branch key elt yw fm_l fm_r) split_key = splitLT3 (Branch key elt yw fm_l fm_r) split_key; splitLT0 key elt yw fm_l fm_r split_key True = fm_l; splitLT1 key elt yw fm_l fm_r split_key True = mkVBalBranch key elt fm_l (splitLT fm_r split_key); splitLT1 key elt yw fm_l fm_r split_key False = splitLT0 key elt yw fm_l fm_r split_key otherwise; splitLT2 key elt yw fm_l fm_r split_key True = splitLT fm_l split_key; splitLT2 key elt yw fm_l fm_r split_key False = splitLT1 key elt yw fm_l fm_r split_key (split_key > key); splitLT3 (Branch key elt yw fm_l fm_r) split_key = splitLT2 key elt yw fm_l fm_r split_key (split_key < key); splitLT4 EmptyFM split_key = emptyFM; splitLT4 wzu wzv = splitLT3 wzu wzv; unitFM :: a -> b -> FiniteMap a b; unitFM key elt = Branch key elt (Pos (Succ Zero)) emptyFM emptyFM; } module Maybe where { import qualified FiniteMap; import qualified Main; import qualified Prelude; } module Main where { import qualified FiniteMap; import qualified Maybe; import qualified Prelude; }