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