<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>utils/FiniteMap.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The University of Glasgow 2006
% (c) The AQUA Project, Glasgow University, 1994-1998
%
``Finite maps'' are the heart of the compiler's
lookup-tables/environments and its implementation of sets. Important
stuff!
This code is derived from that in the paper:
\begin{display}
S Adams
"Efficient sets: a balancing act"
Journal of functional programming 3(4) Oct 1993, pp553-562
\end{display}
The code is SPECIALIZEd to various highly-desirable types (e.g., Id)
near the end.
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-layout'>(</span>
<a name="line-2"></a> <span class='hs-comment'>-- * Mappings keyed from arbitrary types</span>
<a name="line-3"></a> <span class='hs-conid'>FiniteMap</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- abstract type</span>
<a name="line-4"></a>
<a name="line-5"></a> <span class='hs-comment'>-- ** Manipulating those mappings</span>
<a name="line-6"></a> <span class='hs-varid'>emptyFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>unitFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>listToFM</span><span class='hs-layout'>,</span>
<a name="line-7"></a>
<a name="line-8"></a> <span class='hs-varid'>addToFM</span><span class='hs-layout'>,</span>
<a name="line-9"></a> <span class='hs-varid'>addToFM_C</span><span class='hs-layout'>,</span>
<a name="line-10"></a> <span class='hs-varid'>addListToFM</span><span class='hs-layout'>,</span>
<a name="line-11"></a> <span class='hs-varid'>addListToFM_C</span><span class='hs-layout'>,</span>
<a name="line-12"></a> <span class='hs-varid'>delFromFM</span><span class='hs-layout'>,</span>
<a name="line-13"></a> <span class='hs-varid'>delListFromFM</span><span class='hs-layout'>,</span>
<a name="line-14"></a>
<a name="line-15"></a> <span class='hs-varid'>plusFM</span><span class='hs-layout'>,</span>
<a name="line-16"></a> <span class='hs-varid'>plusFM_C</span><span class='hs-layout'>,</span>
<a name="line-17"></a> <span class='hs-varid'>minusFM</span><span class='hs-layout'>,</span>
<a name="line-18"></a> <span class='hs-varid'>foldFM</span><span class='hs-layout'>,</span>
<a name="line-19"></a>
<a name="line-20"></a> <span class='hs-varid'>intersectFM</span><span class='hs-layout'>,</span>
<a name="line-21"></a> <span class='hs-varid'>intersectFM_C</span><span class='hs-layout'>,</span>
<a name="line-22"></a> <span class='hs-varid'>mapFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>filterFM</span><span class='hs-layout'>,</span>
<a name="line-23"></a>
<a name="line-24"></a> <span class='hs-varid'>sizeFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>isEmptyFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>elemFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>lookupFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>lookupWithDefaultFM</span><span class='hs-layout'>,</span>
<a name="line-25"></a>
<a name="line-26"></a> <span class='hs-varid'>fmToList</span><span class='hs-layout'>,</span> <span class='hs-varid'>keysFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>eltsFM</span><span class='hs-layout'>,</span>
<a name="line-27"></a>
<a name="line-28"></a> <span class='hs-varid'>bagToFM</span>
<a name="line-29"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-30"></a>
<a name="line-31"></a><span class='hs-cpp'>#if defined(DEBUG_FINITEMAPS)/* NB NB NB */</span>
<a name="line-32"></a><span class='hs-cpp'>#define OUTPUTABLE_key , Outputable key</span>
<a name="line-33"></a><span class='hs-cpp'>#else</span>
<a name="line-34"></a><span class='hs-cpp'>#define OUTPUTABLE_key {--}</span>
<a name="line-35"></a><span class='hs-cpp'>#endif</span>
<a name="line-36"></a>
<a name="line-37"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Maybes</span>
<a name="line-38"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Bag</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Bag</span><span class='hs-layout'>,</span> <span class='hs-varid'>foldrBag</span> <span class='hs-layout'>)</span>
<a name="line-39"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-40"></a>
<a name="line-41"></a><span class='hs-cpp'>#if 0</span>
<a name="line-42"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>GHC</span><span class='hs-varop'>.</span><span class='hs-conid'>Exts</span>
<a name="line-43"></a><span class='hs-comment'>-- was this import only needed for I#, or does it have something</span>
<a name="line-44"></a><span class='hs-comment'>-- to do with the (not-presently-used) IF_NCG also?</span>
<a name="line-45"></a><span class='hs-cpp'>#endif</span>
<a name="line-46"></a>
<a name="line-47"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span>
<a name="line-48"></a>
<a name="line-49"></a><span class='hs-cpp'>#if 0</span>
<a name="line-50"></a><span class='hs-cpp'>#if ! OMIT_NATIVE_CODEGEN</span>
<a name="line-51"></a><span class='hs-cpp'># define IF_NCG(a) a</span>
<a name="line-52"></a><span class='hs-cpp'>#else</span>
<a name="line-53"></a><span class='hs-cpp'># define IF_NCG(a) {--}</span>
<a name="line-54"></a><span class='hs-cpp'>#endif</span>
<a name="line-55"></a><span class='hs-cpp'>#endif</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{The signature of the module}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="emptyFM"></a><span class='hs-comment'>-- BUILDING</span>
<a name="line-2"></a><span class='hs-definition'>emptyFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-3"></a><a name="unitFM"></a><span class='hs-definition'>unitFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-4"></a><a name="listToFM"></a><span class='hs-comment'>-- | In the case of duplicates keys, the last item is taken</span>
<a name="line-5"></a><span class='hs-definition'>listToFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span><span class='hs-varid'>elt</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-6"></a><a name="bagToFM"></a><span class='hs-comment'>-- | In the case of duplicate keys, who knows which item is taken</span>
<a name="line-7"></a><span class='hs-definition'>bagToFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Bag</span> <span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span><span class='hs-varid'>elt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-comment'>-- ADDING AND DELETING</span>
<a name="line-10"></a>
<a name="line-11"></a><a name="addToFM"></a><span class='hs-comment'>-- | Throws away any previous binding</span>
<a name="line-12"></a><span class='hs-definition'>addToFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-14"></a><a name="addListToFM"></a><span class='hs-comment'>-- | Throws away any previous binding, items are added left-to-right</span>
<a name="line-15"></a><span class='hs-definition'>addListToFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span><span class='hs-varid'>elt</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-17"></a>
<a name="line-18"></a><a name="addToFM_C"></a><span class='hs-comment'>-- | Combines added item with previous item, if any</span>
<a name="line-19"></a><span class='hs-definition'>addToFM_C</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span>
<a name="line-20"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span>
<a name="line-21"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-22"></a><a name="addListToFM_C"></a><span class='hs-comment'>-- | Combines added item with previous item, if any, items are added left-to-right</span>
<a name="line-23"></a><span class='hs-definition'>addListToFM_C</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span><span class='hs-varid'>elt</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-25"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-26"></a>
<a name="line-27"></a><a name="delFromFM"></a><span class='hs-comment'>-- | Deletion doesn't complain if you try to delete something which isn't there</span>
<a name="line-28"></a><span class='hs-definition'>delFromFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-29"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-30"></a><a name="delListFromFM"></a><span class='hs-comment'>-- | Deletion doesn't complain if you try to delete something which isn't there</span>
<a name="line-31"></a><span class='hs-definition'>delListFromFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-32"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>key</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-33"></a>
<a name="line-34"></a><span class='hs-comment'>-- COMBINING</span>
<a name="line-35"></a>
<a name="line-36"></a><a name="plusFM"></a><span class='hs-comment'>-- | Bindings in right argument shadow those in the left</span>
<a name="line-37"></a><span class='hs-definition'>plusFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-38"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-39"></a>
<a name="line-40"></a><a name="plusFM_C"></a><span class='hs-comment'>-- | Combines bindings for the same thing with the given function, </span>
<a name="line-41"></a><span class='hs-comment'>-- bindings in right argument shadow those in the left</span>
<a name="line-42"></a><span class='hs-definition'>plusFM_C</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-43"></a> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span>
<a name="line-44"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-45"></a>
<a name="line-46"></a><a name="minusFM"></a><span class='hs-comment'>-- | Deletes from the left argument any bindings in the right argument</span>
<a name="line-47"></a><span class='hs-definition'>minusFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-48"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-49"></a>
<a name="line-50"></a><a name="intersectFM"></a><span class='hs-definition'>intersectFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-51"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-52"></a><a name="intersectFM_C"></a><span class='hs-comment'>-- | Combines bindings for the same thing in the two maps with the given function</span>
<a name="line-53"></a><span class='hs-definition'>intersectFM_C</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-54"></a> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>elt1</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt2</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt3</span><span class='hs-layout'>)</span>
<a name="line-55"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt1</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt2</span>
<a name="line-56"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt3</span>
<a name="line-57"></a>
<a name="line-58"></a><a name="foldFM"></a><span class='hs-comment'>-- MAPPING, FOLDING, FILTERING</span>
<a name="line-59"></a><span class='hs-definition'>foldFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span>
<a name="line-60"></a><a name="mapFM"></a><span class='hs-definition'>mapFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt1</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt2</span><span class='hs-layout'>)</span>
<a name="line-61"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt1</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt2</span>
<a name="line-62"></a><a name="filterFM"></a><span class='hs-definition'>filterFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-63"></a> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span>
<a name="line-64"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-65"></a>
<a name="line-66"></a><a name="sizeFM"></a><span class='hs-comment'>-- INTERROGATING</span>
<a name="line-67"></a><span class='hs-definition'>sizeFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span>
<a name="line-68"></a><a name="isEmptyFM"></a><span class='hs-definition'>isEmptyFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-69"></a>
<a name="line-70"></a><a name="elemFM"></a><span class='hs-definition'>elemFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-71"></a> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-72"></a><a name="lookupFM"></a><span class='hs-definition'>lookupFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-73"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-varid'>elt</span>
<a name="line-74"></a><a name="lookupWithDefaultFM"></a><span class='hs-comment'>-- | Supplies a "default" element in return for an unmapped key</span>
<a name="line-75"></a><span class='hs-definition'>lookupWithDefaultFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-76"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span>
<a name="line-77"></a>
<a name="line-78"></a><a name="fmToList"></a><span class='hs-comment'>-- LISTIFYING</span>
<a name="line-79"></a><span class='hs-definition'>fmToList</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span><span class='hs-varid'>elt</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-80"></a><a name="keysFM"></a><span class='hs-definition'>keysFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>key</span><span class='hs-keyglyph'>]</span>
<a name="line-81"></a><a name="eltsFM"></a><span class='hs-definition'>eltsFM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>elt</span><span class='hs-keyglyph'>]</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{The @FiniteMap@ data type, and building of same}
%* *
%************************************************************************
Invariants about @FiniteMap@:
\begin{enumerate}
\item
all keys in a FiniteMap are distinct
\item
all keys in left subtree are $<$ key in Branch and
all keys in right subtree are $>$ key in Branch
\item
size field of a Branch gives number of Branch nodes in the tree
\item
size of left subtree is differs from size of right subtree by a
factor of at most \tr{sIZE_RATIO}
\end{enumerate}
\begin{code}
<pre><a name="line-1"></a><a name="FiniteMap"></a><span class='hs-comment'>-- | A finite mapping from (orderable) key types to elements</span>
<a name="line-2"></a><a name="FiniteMap"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>EmptyFM</span>
<a name="line-4"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-comment'>-- Key and elt stored here</span>
<a name="line-5"></a> <span class='hs-comment'>{-# UNPACK #-}</span> <span class='hs-varop'>!</span><span class='hs-conid'>Int</span> <span class='hs-comment'>-- Size >= 1</span>
<a name="line-6"></a> <span class='hs-layout'>(</span><span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Children</span>
<a name="line-7"></a> <span class='hs-layout'>(</span><span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="emptyFM"></a><span class='hs-definition'>emptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>EmptyFM</span>
<a name="line-2"></a><span class='hs-comment'>{-
<a name="line-3"></a>emptyFM
<a name="line-4"></a> = Branch bottom bottom 0 bottom bottom
<a name="line-5"></a> where
<a name="line-6"></a> bottom = panic "emptyFM"
<a name="line-7"></a>-}</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-comment'>-- #define EmptyFM (Branch _ _ 0 _ _)</span>
<a name="line-10"></a>
<a name="line-11"></a><a name="unitFM"></a><span class='hs-definition'>unitFM</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-num'>1</span> <span class='hs-varid'>emptyFM</span> <span class='hs-varid'>emptyFM</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="listToFM"></a><span class='hs-definition'>listToFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addListToFM</span> <span class='hs-varid'>emptyFM</span>
<a name="line-14"></a>
<a name="line-15"></a><a name="bagToFM"></a><span class='hs-definition'>bagToFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldrBag</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>k</span><span class='hs-layout'>,</span><span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>addToFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>k</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-varid'>emptyFM</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Adding to and deleting from @FiniteMaps@}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="addToFM"></a><span class='hs-definition'>addToFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addToFM_C</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-sel'>_old</span> <span class='hs-varid'>new</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>new</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-2"></a>
<a name="line-3"></a><a name="addToFM_C"></a><span class='hs-definition'>addToFM_C</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unitFM</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-4"></a><span class='hs-definition'>addToFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>size</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span> <span class='hs-varid'>new_key</span> <span class='hs-varid'>new_elt</span>
<a name="line-5"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>compare</span> <span class='hs-varid'>new_key</span> <span class='hs-varid'>key</span> <span class='hs-keyword'>of</span>
<a name="line-6"></a> <span class='hs-conid'>LT</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-layout'>(</span><span class='hs-varid'>addToFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>new_key</span> <span class='hs-varid'>new_elt</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_r</span>
<a name="line-7"></a> <span class='hs-conid'>GT</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span> <span class='hs-layout'>(</span><span class='hs-varid'>addToFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>fm_r</span> <span class='hs-varid'>new_key</span> <span class='hs-varid'>new_elt</span><span class='hs-layout'>)</span>
<a name="line-8"></a> <span class='hs-conid'>EQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Branch</span> <span class='hs-varid'>new_key</span> <span class='hs-layout'>(</span><span class='hs-varid'>combiner</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>new_elt</span><span class='hs-layout'>)</span> <span class='hs-varid'>size</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span>
<a name="line-9"></a>
<a name="line-10"></a><a name="addListToFM"></a><span class='hs-definition'>addListToFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>key_elt_pairs</span>
<a name="line-11"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addListToFM_C</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-sel'>_old</span> <span class='hs-varid'>new</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>new</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>key_elt_pairs</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="addListToFM_C"></a><span class='hs-definition'>addListToFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>key_elt_pairs</span>
<a name="line-14"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldl'</span> <span class='hs-varid'>add</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>key_elt_pairs</span> <span class='hs-comment'>-- foldl adds from the left</span>
<a name="line-15"></a> <span class='hs-keyword'>where</span>
<a name="line-16"></a> <span class='hs-varid'>add</span> <span class='hs-varid'>fmap</span> <span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span><span class='hs-varid'>elt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addToFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>fmap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="delFromFM"></a><span class='hs-definition'>delFromFM</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyFM</span>
<a name="line-2"></a><span class='hs-definition'>delFromFM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span> <span class='hs-varid'>del_key</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>compare</span> <span class='hs-varid'>del_key</span> <span class='hs-varid'>key</span> <span class='hs-keyword'>of</span>
<a name="line-4"></a> <span class='hs-conid'>GT</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span> <span class='hs-layout'>(</span><span class='hs-varid'>delFromFM</span> <span class='hs-varid'>fm_r</span> <span class='hs-varid'>del_key</span><span class='hs-layout'>)</span>
<a name="line-5"></a> <span class='hs-conid'>LT</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-layout'>(</span><span class='hs-varid'>delFromFM</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>del_key</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_r</span>
<a name="line-6"></a> <span class='hs-conid'>EQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>glueBal</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span>
<a name="line-7"></a>
<a name="line-8"></a><a name="delListFromFM"></a><span class='hs-definition'>delListFromFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>keys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldl'</span> <span class='hs-varid'>delFromFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>keys</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Combining @FiniteMaps@}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="plusFM_C"></a><span class='hs-definition'>plusFM_C</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-varid'>fm2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm2</span>
<a name="line-2"></a><span class='hs-definition'>plusFM_C</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm1</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm1</span>
<a name="line-3"></a><span class='hs-definition'>plusFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>fm1</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>split_key</span> <span class='hs-varid'>elt2</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>left</span> <span class='hs-varid'>right</span><span class='hs-layout'>)</span>
<a name="line-4"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVBalBranch</span> <span class='hs-varid'>split_key</span> <span class='hs-varid'>new_elt</span>
<a name="line-5"></a> <span class='hs-layout'>(</span><span class='hs-varid'>plusFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>lts</span> <span class='hs-varid'>left</span><span class='hs-layout'>)</span>
<a name="line-6"></a> <span class='hs-layout'>(</span><span class='hs-varid'>plusFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>gts</span> <span class='hs-varid'>right</span><span class='hs-layout'>)</span>
<a name="line-7"></a> <span class='hs-keyword'>where</span>
<a name="line-8"></a> <span class='hs-varid'>lts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitLT</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>split_key</span>
<a name="line-9"></a> <span class='hs-varid'>gts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitGT</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>split_key</span>
<a name="line-10"></a> <span class='hs-varid'>new_elt</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupFM</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>split_key</span> <span class='hs-keyword'>of</span>
<a name="line-11"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt2</span>
<a name="line-12"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>elt1</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>elt1</span> <span class='hs-varid'>elt2</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-comment'>-- It's worth doing plusFM specially, because we don't need</span>
<a name="line-15"></a><span class='hs-comment'>-- to do the lookup in fm1.</span>
<a name="line-16"></a><span class='hs-comment'>-- FM2 over-rides FM1.</span>
<a name="line-17"></a>
<a name="line-18"></a><a name="plusFM"></a><span class='hs-definition'>plusFM</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-varid'>fm2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm2</span>
<a name="line-19"></a><span class='hs-definition'>plusFM</span> <span class='hs-varid'>fm1</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm1</span>
<a name="line-20"></a><span class='hs-definition'>plusFM</span> <span class='hs-varid'>fm1</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>split_key</span> <span class='hs-varid'>elt1</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>left</span> <span class='hs-varid'>right</span><span class='hs-layout'>)</span>
<a name="line-21"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVBalBranch</span> <span class='hs-varid'>split_key</span> <span class='hs-varid'>elt1</span> <span class='hs-layout'>(</span><span class='hs-varid'>plusFM</span> <span class='hs-varid'>lts</span> <span class='hs-varid'>left</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>plusFM</span> <span class='hs-varid'>gts</span> <span class='hs-varid'>right</span><span class='hs-layout'>)</span>
<a name="line-22"></a> <span class='hs-keyword'>where</span>
<a name="line-23"></a> <span class='hs-varid'>lts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitLT</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>split_key</span>
<a name="line-24"></a> <span class='hs-varid'>gts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitGT</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>split_key</span>
<a name="line-25"></a>
<a name="line-26"></a><a name="minusFM"></a><span class='hs-definition'>minusFM</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyFM</span>
<a name="line-27"></a><span class='hs-definition'>minusFM</span> <span class='hs-varid'>fm1</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm1</span>
<a name="line-28"></a><span class='hs-definition'>minusFM</span> <span class='hs-varid'>fm1</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>split_key</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>left</span> <span class='hs-varid'>right</span><span class='hs-layout'>)</span>
<a name="line-29"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>glueVBal</span> <span class='hs-layout'>(</span><span class='hs-varid'>minusFM</span> <span class='hs-varid'>lts</span> <span class='hs-varid'>left</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>minusFM</span> <span class='hs-varid'>gts</span> <span class='hs-varid'>right</span><span class='hs-layout'>)</span>
<a name="line-30"></a> <span class='hs-comment'>-- The two can be way different, so we need glueVBal</span>
<a name="line-31"></a> <span class='hs-keyword'>where</span>
<a name="line-32"></a> <span class='hs-varid'>lts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitLT</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>split_key</span> <span class='hs-comment'>-- NB gt and lt, so the equal ones</span>
<a name="line-33"></a> <span class='hs-varid'>gts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitGT</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>split_key</span> <span class='hs-comment'>-- are not in either.</span>
<a name="line-34"></a>
<a name="line-35"></a><a name="intersectFM"></a><span class='hs-definition'>intersectFM</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>fm2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>intersectFM_C</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>right</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>right</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>fm2</span>
<a name="line-36"></a>
<a name="line-37"></a><a name="intersectFM_C"></a><span class='hs-definition'>intersectFM_C</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyFM</span>
<a name="line-38"></a><span class='hs-definition'>intersectFM_C</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyFM</span>
<a name="line-39"></a><span class='hs-definition'>intersectFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>fm1</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>split_key</span> <span class='hs-varid'>elt2</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>left</span> <span class='hs-varid'>right</span><span class='hs-layout'>)</span>
<a name="line-40"></a>
<a name="line-41"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>maybeToBool</span> <span class='hs-varid'>maybe_elt1</span> <span class='hs-comment'>-- split_elt *is* in intersection</span>
<a name="line-42"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVBalBranch</span> <span class='hs-varid'>split_key</span> <span class='hs-layout'>(</span><span class='hs-varid'>combiner</span> <span class='hs-varid'>elt1</span> <span class='hs-varid'>elt2</span><span class='hs-layout'>)</span>
<a name="line-43"></a> <span class='hs-layout'>(</span><span class='hs-varid'>intersectFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>lts</span> <span class='hs-varid'>left</span><span class='hs-layout'>)</span>
<a name="line-44"></a> <span class='hs-layout'>(</span><span class='hs-varid'>intersectFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>gts</span> <span class='hs-varid'>right</span><span class='hs-layout'>)</span>
<a name="line-45"></a>
<a name="line-46"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- split_elt is *not* in intersection</span>
<a name="line-47"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>glueVBal</span> <span class='hs-layout'>(</span><span class='hs-varid'>intersectFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>lts</span> <span class='hs-varid'>left</span><span class='hs-layout'>)</span>
<a name="line-48"></a> <span class='hs-layout'>(</span><span class='hs-varid'>intersectFM_C</span> <span class='hs-varid'>combiner</span> <span class='hs-varid'>gts</span> <span class='hs-varid'>right</span><span class='hs-layout'>)</span>
<a name="line-49"></a>
<a name="line-50"></a> <span class='hs-keyword'>where</span>
<a name="line-51"></a> <span class='hs-varid'>lts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitLT</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>split_key</span> <span class='hs-comment'>-- NB gt and lt, so the equal ones</span>
<a name="line-52"></a> <span class='hs-varid'>gts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitGT</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>split_key</span> <span class='hs-comment'>-- are not in either.</span>
<a name="line-53"></a>
<a name="line-54"></a> <span class='hs-varid'>maybe_elt1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lookupFM</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>split_key</span>
<a name="line-55"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>elt1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>maybe_elt1</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Mapping, folding, and filtering with @FiniteMaps@}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="foldFM"></a><span class='hs-definition'>foldFM</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>z</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>z</span>
<a name="line-2"></a><span class='hs-definition'>foldFM</span> <span class='hs-varid'>k</span> <span class='hs-varid'>z</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldFM</span> <span class='hs-varid'>k</span> <span class='hs-layout'>(</span><span class='hs-varid'>k</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldFM</span> <span class='hs-varid'>k</span> <span class='hs-varid'>z</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_l</span>
<a name="line-4"></a>
<a name="line-5"></a><a name="mapFM"></a><span class='hs-definition'>mapFM</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyFM</span>
<a name="line-6"></a><span class='hs-definition'>mapFM</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>size</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span> <span class='hs-varid'>size</span> <span class='hs-layout'>(</span><span class='hs-varid'>mapFM</span> <span class='hs-varid'>f</span> <span class='hs-varid'>fm_l</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>mapFM</span> <span class='hs-varid'>f</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-8"></a>
<a name="line-9"></a><a name="filterFM"></a><span class='hs-definition'>filterFM</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyFM</span>
<a name="line-10"></a><span class='hs-definition'>filterFM</span> <span class='hs-varid'>p</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-11"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>p</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-comment'>-- Keep the item</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-layout'>(</span><span class='hs-varid'>filterFM</span> <span class='hs-varid'>p</span> <span class='hs-varid'>fm_l</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>filterFM</span> <span class='hs-varid'>p</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- Drop the item</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>glueVBal</span> <span class='hs-layout'>(</span><span class='hs-varid'>filterFM</span> <span class='hs-varid'>p</span> <span class='hs-varid'>fm_l</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>filterFM</span> <span class='hs-varid'>p</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Interrogating @FiniteMaps@}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="sizeFM"></a><span class='hs-comment'>--{-# INLINE sizeFM #-}</span>
<a name="line-2"></a><span class='hs-definition'>sizeFM</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span>
<a name="line-3"></a><span class='hs-definition'>sizeFM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>size</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>size</span>
<a name="line-4"></a>
<a name="line-5"></a><a name="isEmptyFM"></a><span class='hs-definition'>isEmptyFM</span> <span class='hs-varid'>fm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm</span> <span class='hs-varop'>==</span> <span class='hs-num'>0</span>
<a name="line-6"></a>
<a name="line-7"></a><a name="lookupFM"></a><span class='hs-definition'>lookupFM</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-8"></a><span class='hs-definition'>lookupFM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span> <span class='hs-varid'>key_to_find</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>compare</span> <span class='hs-varid'>key_to_find</span> <span class='hs-varid'>key</span> <span class='hs-keyword'>of</span>
<a name="line-10"></a> <span class='hs-conid'>LT</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>lookupFM</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>key_to_find</span>
<a name="line-11"></a> <span class='hs-conid'>GT</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>lookupFM</span> <span class='hs-varid'>fm_r</span> <span class='hs-varid'>key_to_find</span>
<a name="line-12"></a> <span class='hs-conid'>EQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-varid'>elt</span>
<a name="line-13"></a>
<a name="line-14"></a><a name="elemFM"></a><span class='hs-definition'>key</span> <span class='hs-varop'>`elemFM`</span> <span class='hs-varid'>fm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isJust</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookupFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>key</span><span class='hs-layout'>)</span>
<a name="line-15"></a>
<a name="line-16"></a><a name="lookupWithDefaultFM"></a><span class='hs-definition'>lookupWithDefaultFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>deflt</span> <span class='hs-varid'>key</span>
<a name="line-17"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookupFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>key</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>deflt</span><span class='hs-layout'>;</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span> <span class='hs-layout'>}</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Listifying @FiniteMaps@}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="fmToList"></a><span class='hs-definition'>fmToList</span> <span class='hs-varid'>fm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldFM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>rest</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>rest</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>fm</span>
<a name="line-2"></a><a name="keysFM"></a><span class='hs-definition'>keysFM</span> <span class='hs-varid'>fm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldFM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>key</span> <span class='hs-sel'>_elt</span> <span class='hs-varid'>rest</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>key</span> <span class='hs-conop'>:</span> <span class='hs-varid'>rest</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>fm</span>
<a name="line-3"></a><a name="eltsFM"></a><span class='hs-definition'>eltsFM</span> <span class='hs-varid'>fm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldFM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-sel'>_key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>rest</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span> <span class='hs-conop'>:</span> <span class='hs-varid'>rest</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>fm</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{The implementation of balancing}
%* *
%************************************************************************
%************************************************************************
%* *
\subsubsection{Basic construction of a @FiniteMap@}
%* *
%************************************************************************
@mkBranch@ simply gets the size component right. This is the ONLY
(non-trivial) place the Branch object is built, so the ASSERTion
recursively checks consistency. (The trivial use of Branch is in
@unitFM@.)
\begin{code}
<pre><a name="line-1"></a><a name="sIZE_RATIO"></a><span class='hs-definition'>sIZE_RATIO</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span>
<a name="line-2"></a><span class='hs-definition'>sIZE_RATIO</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>5</span>
<a name="line-3"></a>
<a name="line-4"></a><a name="mkBranch"></a><span class='hs-definition'>mkBranch</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Used for the assertion checking only</span>
<a name="line-5"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Int</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span>
<a name="line-7"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-8"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-9"></a>
<a name="line-10"></a><span class='hs-definition'>mkBranch</span> <span class='hs-sel'>_which</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span>
<a name="line-11"></a> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>--ASSERT( left_ok && right_ok && balance_ok )</span>
<a name="line-12"></a><span class='hs-cpp'>#if defined(DEBUG_FINITEMAPS)</span>
<a name="line-13"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span> <span class='hs-varid'>left_ok</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>right_ok</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>balance_ok</span> <span class='hs-layout'>)</span> <span class='hs-keyword'>then</span>
<a name="line-14"></a> <span class='hs-varid'>pprPanic</span> <span class='hs-layout'>(</span><span class='hs-str'>"mkBranch:"</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-sel'>_which</span><span class='hs-layout'>)</span>
<a name="line-15"></a> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ppr</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>left_ok</span><span class='hs-layout'>,</span> <span class='hs-varid'>right_ok</span><span class='hs-layout'>,</span> <span class='hs-varid'>balance_ok</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span>
<a name="line-16"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>key</span><span class='hs-layout'>,</span>
<a name="line-17"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>fm_l</span><span class='hs-layout'>,</span>
<a name="line-18"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>fm_r</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-keyword'>else</span>
<a name="line-20"></a><span class='hs-cpp'>#endif</span>
<a name="line-21"></a> <span class='hs-keyword'>let</span>
<a name="line-22"></a> <span class='hs-varid'>result</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-layout'>(</span><span class='hs-num'>1</span> <span class='hs-varop'>+</span> <span class='hs-varid'>left_size</span> <span class='hs-varop'>+</span> <span class='hs-varid'>right_size</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span>
<a name="line-23"></a> <span class='hs-keyword'>in</span>
<a name="line-24"></a><span class='hs-comment'>-- if sizeFM result <= 8 then</span>
<a name="line-25"></a> <span class='hs-varid'>result</span>
<a name="line-26"></a><span class='hs-comment'>-- else</span>
<a name="line-27"></a><span class='hs-comment'>-- pprTrace ("mkBranch:"++(show which)) (ppr result) (</span>
<a name="line-28"></a><span class='hs-comment'>-- result</span>
<a name="line-29"></a><span class='hs-comment'>-- )</span>
<a name="line-30"></a> <span class='hs-keyword'>where</span>
<a name="line-31"></a><span class='hs-cpp'>#if defined(DEBUG_FINITEMAPS)</span>
<a name="line-32"></a> <span class='hs-varid'>left_ok</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>fm_l</span> <span class='hs-keyword'>of</span>
<a name="line-33"></a> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>True</span>
<a name="line-34"></a> <span class='hs-conid'>Branch</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>let</span>
<a name="line-35"></a> <span class='hs-varid'>biggest_left_key</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fst</span> <span class='hs-layout'>(</span><span class='hs-varid'>findMax</span> <span class='hs-varid'>fm_l</span><span class='hs-layout'>)</span>
<a name="line-36"></a> <span class='hs-keyword'>in</span>
<a name="line-37"></a> <span class='hs-varid'>biggest_left_key</span> <span class='hs-varop'><</span> <span class='hs-varid'>key</span>
<a name="line-38"></a> <span class='hs-varid'>right_ok</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>fm_r</span> <span class='hs-keyword'>of</span>
<a name="line-39"></a> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>True</span>
<a name="line-40"></a> <span class='hs-conid'>Branch</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>let</span>
<a name="line-41"></a> <span class='hs-varid'>smallest_right_key</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fst</span> <span class='hs-layout'>(</span><span class='hs-varid'>findMin</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-42"></a> <span class='hs-keyword'>in</span>
<a name="line-43"></a> <span class='hs-varid'>key</span> <span class='hs-varop'><</span> <span class='hs-varid'>smallest_right_key</span>
<a name="line-44"></a> <span class='hs-varid'>balance_ok</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- sigh</span>
<a name="line-45"></a><span class='hs-cpp'>#endif</span>
<a name="line-46"></a><span class='hs-comment'>{- LATER:
<a name="line-47"></a> balance_ok
<a name="line-48"></a> = -- Both subtrees have one or no elements...
<a name="line-49"></a> (left_size + right_size <= 1)
<a name="line-50"></a>-- NO || left_size == 0 -- ???
<a name="line-51"></a>-- NO || right_size == 0 -- ???
<a name="line-52"></a> -- ... or the number of elements in a subtree does not exceed
<a name="line-53"></a> -- sIZE_RATIO times the number of elements in the other subtree
<a name="line-54"></a> || (left_size * sIZE_RATIO >= right_size &&
<a name="line-55"></a> right_size * sIZE_RATIO >= left_size)
<a name="line-56"></a>-}</span>
<a name="line-57"></a>
<a name="line-58"></a> <span class='hs-varid'>left_size</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_l</span>
<a name="line-59"></a> <span class='hs-varid'>right_size</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_r</span>
</pre>\end{code}
%************************************************************************
%* *
\subsubsection{{\em Balanced} construction of a @FiniteMap@}
%* *
%************************************************************************
@mkBalBranch@ rebalances, assuming that the subtrees aren't too far
out of whack.
\begin{code}
<pre><a name="line-1"></a><a name="mkBalBranch"></a><span class='hs-definition'>mkBalBranch</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>mkBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_L</span> <span class='hs-varid'>fm_R</span>
<a name="line-7"></a>
<a name="line-8"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>size_l</span> <span class='hs-varop'>+</span> <span class='hs-varid'>size_r</span> <span class='hs-varop'><</span> <span class='hs-num'>2</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBranch</span> <span class='hs-num'>1</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_L</span> <span class='hs-varid'>fm_R</span>
<a name="line-10"></a>
<a name="line-11"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>size_r</span> <span class='hs-varop'>></span> <span class='hs-varid'>sIZE_RATIO</span> <span class='hs-varop'>*</span> <span class='hs-varid'>size_l</span> <span class='hs-comment'>-- Right tree too big</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>fm_R</span> <span class='hs-keyword'>of</span>
<a name="line-13"></a> <span class='hs-conid'>Branch</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_rl</span> <span class='hs-varid'>fm_rr</span>
<a name="line-14"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_rl</span> <span class='hs-varop'><</span> <span class='hs-num'>2</span> <span class='hs-varop'>*</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_rr</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>single_L</span> <span class='hs-varid'>fm_L</span> <span class='hs-varid'>fm_R</span>
<a name="line-15"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>double_L</span> <span class='hs-varid'>fm_L</span> <span class='hs-varid'>fm_R</span>
<a name="line-16"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>panic</span> <span class='hs-str'>"mkBalBranch: impossible case 1"</span>
<a name="line-17"></a>
<a name="line-18"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>size_l</span> <span class='hs-varop'>></span> <span class='hs-varid'>sIZE_RATIO</span> <span class='hs-varop'>*</span> <span class='hs-varid'>size_r</span> <span class='hs-comment'>-- Left tree too big</span>
<a name="line-19"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>fm_L</span> <span class='hs-keyword'>of</span>
<a name="line-20"></a> <span class='hs-conid'>Branch</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_ll</span> <span class='hs-varid'>fm_lr</span>
<a name="line-21"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_lr</span> <span class='hs-varop'><</span> <span class='hs-num'>2</span> <span class='hs-varop'>*</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_ll</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>single_R</span> <span class='hs-varid'>fm_L</span> <span class='hs-varid'>fm_R</span>
<a name="line-22"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>double_R</span> <span class='hs-varid'>fm_L</span> <span class='hs-varid'>fm_R</span>
<a name="line-23"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>panic</span> <span class='hs-str'>"mkBalBranch: impossible case 2"</span>
<a name="line-24"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- No imbalance</span>
<a name="line-25"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBranch</span> <span class='hs-num'>2</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_L</span> <span class='hs-varid'>fm_R</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-keyword'>where</span>
<a name="line-28"></a> <span class='hs-varid'>size_l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_L</span>
<a name="line-29"></a> <span class='hs-varid'>size_r</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_R</span>
<a name="line-30"></a>
<a name="line-31"></a> <span class='hs-varid'>single_L</span> <span class='hs-varid'>fm_l</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key_r</span> <span class='hs-varid'>elt_r</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_rl</span> <span class='hs-varid'>fm_rr</span><span class='hs-layout'>)</span>
<a name="line-32"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBranch</span> <span class='hs-num'>3</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key_r</span> <span class='hs-varid'>elt_r</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkBranch</span> <span class='hs-num'>4</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_rl</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_rr</span>
<a name="line-33"></a> <span class='hs-varid'>single_L</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"mkBalBranch: impossible case 3"</span>
<a name="line-34"></a>
<a name="line-35"></a> <span class='hs-varid'>double_L</span> <span class='hs-varid'>fm_l</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key_r</span> <span class='hs-varid'>elt_r</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key_rl</span> <span class='hs-varid'>elt_rl</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_rll</span> <span class='hs-varid'>fm_rlr</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_rr</span><span class='hs-layout'>)</span>
<a name="line-36"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBranch</span> <span class='hs-num'>5</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key_rl</span> <span class='hs-varid'>elt_rl</span>
<a name="line-37"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkBranch</span> <span class='hs-num'>6</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_rll</span><span class='hs-layout'>)</span>
<a name="line-38"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkBranch</span> <span class='hs-num'>7</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key_r</span> <span class='hs-varid'>elt_r</span> <span class='hs-varid'>fm_rlr</span> <span class='hs-varid'>fm_rr</span><span class='hs-layout'>)</span>
<a name="line-39"></a> <span class='hs-varid'>double_L</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"mkBalBranch: impossible case 4"</span>
<a name="line-40"></a>
<a name="line-41"></a> <span class='hs-varid'>single_R</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key_l</span> <span class='hs-varid'>elt_l</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_ll</span> <span class='hs-varid'>fm_lr</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_r</span>
<a name="line-42"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBranch</span> <span class='hs-num'>8</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key_l</span> <span class='hs-varid'>elt_l</span> <span class='hs-varid'>fm_ll</span>
<a name="line-43"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkBranch</span> <span class='hs-num'>9</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_lr</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-44"></a> <span class='hs-varid'>single_R</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"mkBalBranch: impossible case 5"</span>
<a name="line-45"></a>
<a name="line-46"></a> <span class='hs-varid'>double_R</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key_l</span> <span class='hs-varid'>elt_l</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_ll</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key_lr</span> <span class='hs-varid'>elt_lr</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_lrl</span> <span class='hs-varid'>fm_lrr</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_r</span>
<a name="line-47"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBranch</span> <span class='hs-num'>10</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key_lr</span> <span class='hs-varid'>elt_lr</span>
<a name="line-48"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkBranch</span> <span class='hs-num'>11</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key_l</span> <span class='hs-varid'>elt_l</span> <span class='hs-varid'>fm_ll</span> <span class='hs-varid'>fm_lrl</span><span class='hs-layout'>)</span>
<a name="line-49"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkBranch</span> <span class='hs-num'>12</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_lrr</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-50"></a> <span class='hs-varid'>double_R</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"mkBalBranch: impossible case 6"</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="mkVBalBranch"></a><span class='hs-definition'>mkVBalBranch</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elt</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-comment'>-- Assert: in any call to (mkVBalBranch_C comb key elt l r),</span>
<a name="line-7"></a><span class='hs-comment'>-- (a) all keys in l are < all keys in r</span>
<a name="line-8"></a><span class='hs-comment'>-- (b) all keys in l are < key</span>
<a name="line-9"></a><span class='hs-comment'>-- (c) all keys in r are > key</span>
<a name="line-10"></a>
<a name="line-11"></a><span class='hs-definition'>mkVBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-varid'>fm_r</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addToFM</span> <span class='hs-varid'>fm_r</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-12"></a><span class='hs-definition'>mkVBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addToFM</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-definition'>mkVBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key_l</span> <span class='hs-varid'>elt_l</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_ll</span> <span class='hs-varid'>fm_lr</span><span class='hs-layout'>)</span>
<a name="line-15"></a> <span class='hs-varid'>fm_r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key_r</span> <span class='hs-varid'>elt_r</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_rl</span> <span class='hs-varid'>fm_rr</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>sIZE_RATIO</span> <span class='hs-varop'>*</span> <span class='hs-varid'>size_l</span> <span class='hs-varop'><</span> <span class='hs-varid'>size_r</span>
<a name="line-17"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>key_r</span> <span class='hs-varid'>elt_r</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkVBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_rl</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_rr</span>
<a name="line-18"></a>
<a name="line-19"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>sIZE_RATIO</span> <span class='hs-varop'>*</span> <span class='hs-varid'>size_r</span> <span class='hs-varop'><</span> <span class='hs-varid'>size_l</span>
<a name="line-20"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>key_l</span> <span class='hs-varid'>elt_l</span> <span class='hs-varid'>fm_ll</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkVBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_lr</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-21"></a>
<a name="line-22"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-23"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBranch</span> <span class='hs-num'>13</span><span class='hs-comment'>{-which-}</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span>
<a name="line-24"></a>
<a name="line-25"></a> <span class='hs-keyword'>where</span>
<a name="line-26"></a> <span class='hs-varid'>size_l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_l</span>
<a name="line-27"></a> <span class='hs-varid'>size_r</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_r</span>
</pre>\end{code}
%************************************************************************
%* *
\subsubsection{Gluing two trees together}
%* *
%************************************************************************
@glueBal@ assumes its two arguments aren't too far out of whack, just
like @mkBalBranch@. But: all keys in first arg are $<$ all keys in
second.
\begin{code}
<pre><a name="line-1"></a><a name="glueBal"></a><span class='hs-definition'>glueBal</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-definition'>glueBal</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-varid'>fm2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm2</span>
<a name="line-6"></a><span class='hs-definition'>glueBal</span> <span class='hs-varid'>fm1</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm1</span>
<a name="line-7"></a><span class='hs-definition'>glueBal</span> <span class='hs-varid'>fm1</span> <span class='hs-varid'>fm2</span>
<a name="line-8"></a> <span class='hs-comment'>-- The case analysis here (absent in Adams' program) is really to deal</span>
<a name="line-9"></a> <span class='hs-comment'>-- with the case where fm2 is a singleton. Then deleting the minimum means</span>
<a name="line-10"></a> <span class='hs-comment'>-- we pass an empty tree to mkBalBranch, which breaks its invariant.</span>
<a name="line-11"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm2</span> <span class='hs-varop'>></span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm1</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>mid_key2</span> <span class='hs-varid'>mid_elt2</span> <span class='hs-varid'>fm1</span> <span class='hs-layout'>(</span><span class='hs-varid'>deleteMin</span> <span class='hs-varid'>fm2</span><span class='hs-layout'>)</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>mid_key1</span> <span class='hs-varid'>mid_elt1</span> <span class='hs-layout'>(</span><span class='hs-varid'>deleteMax</span> <span class='hs-varid'>fm1</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm2</span>
<a name="line-16"></a> <span class='hs-keyword'>where</span>
<a name="line-17"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mid_key1</span><span class='hs-layout'>,</span> <span class='hs-varid'>mid_elt1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findMax</span> <span class='hs-varid'>fm1</span>
<a name="line-18"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mid_key2</span><span class='hs-layout'>,</span> <span class='hs-varid'>mid_elt2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findMin</span> <span class='hs-varid'>fm2</span>
</pre>\end{code}
@glueVBal@ copes with arguments which can be of any size.
But: all keys in first arg are $<$ all keys in second.
\begin{code}
<pre><a name="line-1"></a><a name="glueVBal"></a><span class='hs-definition'>glueVBal</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-definition'>glueVBal</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-varid'>fm2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm2</span>
<a name="line-6"></a><span class='hs-definition'>glueVBal</span> <span class='hs-varid'>fm1</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm1</span>
<a name="line-7"></a><span class='hs-definition'>glueVBal</span> <span class='hs-varid'>fm_l</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key_l</span> <span class='hs-varid'>elt_l</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_ll</span> <span class='hs-varid'>fm_lr</span><span class='hs-layout'>)</span>
<a name="line-8"></a> <span class='hs-varid'>fm_r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key_r</span> <span class='hs-varid'>elt_r</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_rl</span> <span class='hs-varid'>fm_rr</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>sIZE_RATIO</span> <span class='hs-varop'>*</span> <span class='hs-varid'>size_l</span> <span class='hs-varop'><</span> <span class='hs-varid'>size_r</span>
<a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>key_r</span> <span class='hs-varid'>elt_r</span> <span class='hs-layout'>(</span><span class='hs-varid'>glueVBal</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_rl</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_rr</span>
<a name="line-11"></a>
<a name="line-12"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>sIZE_RATIO</span> <span class='hs-varop'>*</span> <span class='hs-varid'>size_r</span> <span class='hs-varop'><</span> <span class='hs-varid'>size_l</span>
<a name="line-13"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>key_l</span> <span class='hs-varid'>elt_l</span> <span class='hs-varid'>fm_ll</span> <span class='hs-layout'>(</span><span class='hs-varid'>glueVBal</span> <span class='hs-varid'>fm_lr</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-14"></a>
<a name="line-15"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- We now need the same two cases as in glueBal above.</span>
<a name="line-16"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>glueBal</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span>
<a name="line-17"></a> <span class='hs-keyword'>where</span>
<a name="line-18"></a> <span class='hs-varid'>size_l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_l</span>
<a name="line-19"></a> <span class='hs-varid'>size_r</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_r</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Local utilities}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="splitLT"></a><span class='hs-definition'>splitLT</span><span class='hs-layout'>,</span> <span class='hs-varid'>splitGT</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>key</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-comment'>-- splitLT fm split_key = fm restricted to keys < split_key</span>
<a name="line-4"></a><span class='hs-comment'>-- splitGT fm split_key = fm restricted to keys > split_key</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>splitLT</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyFM</span>
<a name="line-7"></a><span class='hs-definition'>splitLT</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span> <span class='hs-varid'>split_key</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>compare</span> <span class='hs-varid'>split_key</span> <span class='hs-varid'>key</span> <span class='hs-keyword'>of</span>
<a name="line-9"></a> <span class='hs-conid'>LT</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>splitLT</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>split_key</span>
<a name="line-10"></a> <span class='hs-conid'>GT</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mkVBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span> <span class='hs-layout'>(</span><span class='hs-varid'>splitLT</span> <span class='hs-varid'>fm_r</span> <span class='hs-varid'>split_key</span><span class='hs-layout'>)</span>
<a name="line-11"></a> <span class='hs-conid'>EQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>fm_l</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="splitGT"></a><span class='hs-definition'>splitGT</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyFM</span>
<a name="line-14"></a><span class='hs-definition'>splitGT</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span> <span class='hs-varid'>split_key</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>compare</span> <span class='hs-varid'>split_key</span> <span class='hs-varid'>key</span> <span class='hs-keyword'>of</span>
<a name="line-16"></a> <span class='hs-conid'>GT</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>splitGT</span> <span class='hs-varid'>fm_r</span> <span class='hs-varid'>split_key</span>
<a name="line-17"></a> <span class='hs-conid'>LT</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mkVBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-layout'>(</span><span class='hs-varid'>splitGT</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>split_key</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_r</span>
<a name="line-18"></a> <span class='hs-conid'>EQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>fm_r</span>
<a name="line-19"></a>
<a name="line-20"></a><a name="findMin"></a><span class='hs-definition'>findMin</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span><span class='hs-varid'>elt</span><span class='hs-layout'>)</span>
<a name="line-21"></a><span class='hs-definition'>findMin</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span>
<a name="line-22"></a><span class='hs-definition'>findMin</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_l</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findMin</span> <span class='hs-varid'>fm_l</span>
<a name="line-23"></a><span class='hs-definition'>findMin</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"findMin: Empty"</span>
<a name="line-24"></a>
<a name="line-25"></a><a name="deleteMin"></a><span class='hs-definition'>deleteMin</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-26"></a><span class='hs-definition'>deleteMin</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm_r</span>
<a name="line-27"></a><span class='hs-definition'>deleteMin</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-28"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-layout'>(</span><span class='hs-varid'>deleteMin</span> <span class='hs-varid'>fm_l</span><span class='hs-layout'>)</span> <span class='hs-varid'>fm_r</span>
<a name="line-29"></a><span class='hs-definition'>deleteMin</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"deleteMin: Empty"</span>
<a name="line-30"></a>
<a name="line-31"></a><a name="findMax"></a><span class='hs-definition'>findMax</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span>
<a name="line-32"></a><span class='hs-definition'>findMax</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>EmptyFM</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>key</span><span class='hs-layout'>,</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span>
<a name="line-33"></a><span class='hs-definition'>findMax</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findMax</span> <span class='hs-varid'>fm_r</span>
<a name="line-34"></a><span class='hs-definition'>findMax</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"findMax: Empty"</span>
<a name="line-35"></a>
<a name="line-36"></a><a name="deleteMax"></a><span class='hs-definition'>deleteMax</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>key</span> <span class='hs-conid'>OUTPUTABLE_key</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span>
<a name="line-37"></a><span class='hs-definition'>deleteMax</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_l</span> <span class='hs-conid'>EmptyFM</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fm_l</span>
<a name="line-38"></a><span class='hs-definition'>deleteMax</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBalBranch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>fm_l</span> <span class='hs-layout'>(</span><span class='hs-varid'>deleteMax</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-39"></a><span class='hs-definition'>deleteMax</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"deleteMax: Empty"</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Output-ery}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><span class='hs-cpp'>#</span><span class='hs-keyword'>if</span> <span class='hs-varid'>defined</span><span class='hs-layout'>(</span><span class='hs-conid'>DEBUG_FINITEMAPS</span><span class='hs-layout'>)</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Outputable</span> <span class='hs-varid'>key</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Outputable</span> <span class='hs-layout'>(</span><span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-4"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>fm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprX</span> <span class='hs-varid'>fm</span>
<a name="line-5"></a>
<a name="line-6"></a><a name="pprX"></a><span class='hs-definition'>pprX</span> <span class='hs-conid'>EmptyFM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'!'</span>
<a name="line-7"></a><span class='hs-definition'>pprX</span> <span class='hs-layout'>(</span><span class='hs-conid'>Branch</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span> <span class='hs-varid'>sz</span> <span class='hs-varid'>fm_l</span> <span class='hs-varid'>fm_r</span><span class='hs-layout'>)</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parens</span> <span class='hs-layout'>(</span><span class='hs-varid'>hcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>pprX</span> <span class='hs-varid'>fm_l</span><span class='hs-layout'>,</span> <span class='hs-varid'>space</span><span class='hs-layout'>,</span>
<a name="line-9"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>key</span><span class='hs-layout'>,</span> <span class='hs-varid'>space</span><span class='hs-layout'>,</span> <span class='hs-varid'>int</span> <span class='hs-varid'>sz</span><span class='hs-layout'>,</span> <span class='hs-varid'>space</span><span class='hs-layout'>,</span>
<a name="line-10"></a> <span class='hs-varid'>pprX</span> <span class='hs-varid'>fm_r</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-11"></a><span class='hs-cpp'>#else</span>
<a name="line-12"></a><span class='hs-comment'>-- and when not debugging the package itself...</span>
<a name="line-13"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Outputable</span> <span class='hs-varid'>key</span><span class='hs-layout'>,</span> <span class='hs-conid'>Outputable</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Outputable</span> <span class='hs-layout'>(</span><span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-14"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>fm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>fmToList</span> <span class='hs-varid'>fm</span><span class='hs-layout'>)</span>
<a name="line-15"></a><span class='hs-cpp'>#endif</span>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-cpp'>#if 0</span>
<a name="line-18"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span> <span class='hs-varid'>key</span><span class='hs-layout'>,</span> <span class='hs-conid'>Eq</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Eq</span> <span class='hs-layout'>(</span><span class='hs-conid'>FiniteMap</span> <span class='hs-varid'>key</span> <span class='hs-varid'>elt</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-19"></a> <span class='hs-varid'>fm_1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>fm_2</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>sizeFM</span> <span class='hs-varid'>fm_2</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-comment'>-- quick test</span>
<a name="line-20"></a> <span class='hs-layout'>(</span><span class='hs-varid'>fmToList</span> <span class='hs-varid'>fm_1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>fmToList</span> <span class='hs-varid'>fm_2</span><span class='hs-layout'>)</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-comment'>{- NO: not clear what The Right Thing to do is:
<a name="line-23"></a>instance (Ord key, Ord elt) => Ord (FiniteMap key elt) where
<a name="line-24"></a> fm_1 <= fm_2 = (sizeFM fm_1 <= sizeFM fm_2) && -- quick test
<a name="line-25"></a> (fmToList fm_1 <= fmToList fm_2)
<a name="line-26"></a>-}</span>
<a name="line-27"></a><span class='hs-cpp'>#endif</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Efficiency pragmas for GHC}
%* *
%************************************************************************
When the FiniteMap module is used in GHC, we specialise it for
\tr{Uniques}, for dastardly efficiency reasons.
\begin{code}
<pre><a name="line-1"></a><span class='hs-cpp'>#</span><span class='hs-keyword'>if</span> <span class='hs-num'>0</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-cpp'>#ifdef __GLASGOW_HASKELL__</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-comment'>{-# SPECIALIZE addListToFM
<a name="line-6"></a> :: FiniteMap (FastString, FAST_STRING) elt -> [((FAST_STRING, FAST_STRING),elt)] -> FiniteMap (FAST_STRING, FAST_STRING) elt
<a name="line-7"></a> , FiniteMap RdrName elt -> [(RdrName,elt)] -> FiniteMap RdrName elt
<a name="line-8"></a> IF_NCG(COMMA FiniteMap Reg elt -> [(Reg COMMA elt)] -> FiniteMap Reg elt)
<a name="line-9"></a> #-}</span>
<a name="line-10"></a><span class='hs-comment'>{-# SPECIALIZE addListToFM_C
<a name="line-11"></a> :: (elt -> elt -> elt) -> FiniteMap TyCon elt -> [(TyCon,elt)] -> FiniteMap TyCon elt
<a name="line-12"></a> , (elt -> elt -> elt) -> FiniteMap FastString elt -> [(FAST_STRING,elt)] -> FiniteMap FAST_STRING elt
<a name="line-13"></a> IF_NCG(COMMA (elt -> elt -> elt) -> FiniteMap Reg elt -> [(Reg COMMA elt)] -> FiniteMap Reg elt)
<a name="line-14"></a> #-}</span>
<a name="line-15"></a><span class='hs-comment'>{-# SPECIALIZE addToFM
<a name="line-16"></a> :: FiniteMap CLabel elt -> CLabel -> elt -> FiniteMap CLabel elt
<a name="line-17"></a> , FiniteMap FastString elt -> FAST_STRING -> elt -> FiniteMap FAST_STRING elt
<a name="line-18"></a> , FiniteMap (FastString, FAST_STRING) elt -> (FAST_STRING, FAST_STRING) -> elt -> FiniteMap (FAST_STRING, FAST_STRING) elt
<a name="line-19"></a> , FiniteMap RdrName elt -> RdrName -> elt -> FiniteMap RdrName elt
<a name="line-20"></a> IF_NCG(COMMA FiniteMap Reg elt -> Reg -> elt -> FiniteMap Reg elt)
<a name="line-21"></a> #-}</span>
<a name="line-22"></a><span class='hs-comment'>{-# SPECIALIZE addToFM_C
<a name="line-23"></a> :: (elt -> elt -> elt) -> FiniteMap (RdrName, RdrName) elt -> (RdrName, RdrName) -> elt -> FiniteMap (RdrName, RdrName) elt
<a name="line-24"></a> , (elt -> elt -> elt) -> FiniteMap FastString elt -> FAST_STRING -> elt -> FiniteMap FAST_STRING elt
<a name="line-25"></a> IF_NCG(COMMA (elt -> elt -> elt) -> FiniteMap Reg elt -> Reg -> elt -> FiniteMap Reg elt)
<a name="line-26"></a> #-}</span>
<a name="line-27"></a><span class='hs-comment'>{-# SPECIALIZE bagToFM
<a name="line-28"></a> :: Bag (FastString,elt) -> FiniteMap FAST_STRING elt
<a name="line-29"></a> #-}</span>
<a name="line-30"></a><span class='hs-comment'>{-# SPECIALIZE delListFromFM
<a name="line-31"></a> :: FiniteMap RdrName elt -> [RdrName] -> FiniteMap RdrName elt
<a name="line-32"></a> , FiniteMap FastString elt -> [FAST_STRING] -> FiniteMap FAST_STRING elt
<a name="line-33"></a> IF_NCG(COMMA FiniteMap Reg elt -> [Reg] -> FiniteMap Reg elt)
<a name="line-34"></a> #-}</span>
<a name="line-35"></a><span class='hs-comment'>{-# SPECIALIZE listToFM
<a name="line-36"></a> :: [([Char],elt)] -> FiniteMap [Char] elt
<a name="line-37"></a> , [(FastString,elt)] -> FiniteMap FAST_STRING elt
<a name="line-38"></a> , [((FastString,FAST_STRING),elt)] -> FiniteMap (FAST_STRING, FAST_STRING) elt
<a name="line-39"></a> IF_NCG(COMMA [(Reg COMMA elt)] -> FiniteMap Reg elt)
<a name="line-40"></a> #-}</span>
<a name="line-41"></a><span class='hs-comment'>{-# SPECIALIZE lookupFM
<a name="line-42"></a> :: FiniteMap CLabel elt -> CLabel -> Maybe elt
<a name="line-43"></a> , FiniteMap [Char] elt -> [Char] -> Maybe elt
<a name="line-44"></a> , FiniteMap FastString elt -> FAST_STRING -> Maybe elt
<a name="line-45"></a> , FiniteMap (FastString,FAST_STRING) elt -> (FAST_STRING,FAST_STRING) -> Maybe elt
<a name="line-46"></a> , FiniteMap RdrName elt -> RdrName -> Maybe elt
<a name="line-47"></a> , FiniteMap (RdrName,RdrName) elt -> (RdrName,RdrName) -> Maybe elt
<a name="line-48"></a> IF_NCG(COMMA FiniteMap Reg elt -> Reg -> Maybe elt)
<a name="line-49"></a> #-}</span>
<a name="line-50"></a><span class='hs-comment'>{-# SPECIALIZE lookupWithDefaultFM
<a name="line-51"></a> :: FiniteMap FastString elt -> elt -> FAST_STRING -> elt
<a name="line-52"></a> IF_NCG(COMMA FiniteMap Reg elt -> elt -> Reg -> elt)
<a name="line-53"></a> #-}</span>
<a name="line-54"></a><span class='hs-comment'>{-# SPECIALIZE plusFM
<a name="line-55"></a> :: FiniteMap RdrName elt -> FiniteMap RdrName elt -> FiniteMap RdrName elt
<a name="line-56"></a> , FiniteMap FastString elt -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt
<a name="line-57"></a> IF_NCG(COMMA FiniteMap Reg elt -> FiniteMap Reg elt -> FiniteMap Reg elt)
<a name="line-58"></a> #-}</span>
<a name="line-59"></a><span class='hs-comment'>{-# SPECIALIZE plusFM_C
<a name="line-60"></a> :: (elt -> elt -> elt) -> FiniteMap FastString elt -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt
<a name="line-61"></a> IF_NCG(COMMA (elt -> elt -> elt) -> FiniteMap Reg elt -> FiniteMap Reg elt -> FiniteMap Reg elt)
<a name="line-62"></a> #-}</span>
<a name="line-63"></a>
<a name="line-64"></a><span class='hs-cpp'>#endif /* compiling with ghc and have specialiser */</span>
<a name="line-65"></a>
<a name="line-66"></a><span class='hs-cpp'>#endif /* 0 */</span>
</pre>\end{code}
</body>
</html>
