<commit_before>-----------------------------------------------------------------------------
-- |
-- Module      :  Data.FiniteMap
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable
--
-- A finite map implementation, derived from the paper:
-- 	   <NAME>, "Efficient sets: a balancing act"
-- 	   Journal of functional programming 3(4) Oct 1993, pp553-562
--
-- ToDo: clean up, remove the COMPILING_GHC stuff.
--
-----------------------------------------------------------------------------

-- The code is SPECIALIZEd to various highly-desirable types (e.g., Id)
-- near the end (only \tr{#ifdef COMPILING_GHC}).

#ifdef COMPILING_GHC
#include "HsVersions.h"
#define IF_NOT_GHC(a) {--}
#else
#define ASSERT(e) {--}
#define IF_NOT_GHC(a) a
#define COMMA ,
#define _tagCmp compare
#define _LT LT
#define _GT GT
#define _EQ EQ
#endif

#if defined(COMPILING_GHC) && defined(DEBUG_FINITEMAPS)/* NB NB NB */
#define OUTPUTABLE_key , Outputable key
#else
#define OUTPUTABLE_key {--}
#endif

module Data.FiniteMap (
	FiniteMap,		-- abstract type

	emptyFM, unitFM, listToFM,

	addToFM,
	addToFM_C,
	addListToFM,
	addListToFM_C,
	IF_NOT_GHC(delFromFM COMMA)
	delListFromFM,

	plusFM,
	plusFM_C,
	minusFM,
	foldFM,

	IF_NOT_GHC(intersectFM COMMA)
	IF_NOT_GHC(intersectFM_C COMMA)
	IF_NOT_GHC(mapFM COMMA filterFM COMMA)

	sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM,

	fmToList, keysFM, eltsFM

#ifdef COMPILING_GHC
	, bagToFM
#endif
    ) where

import Prelude

import Data.Maybe ( isJust )
#ifdef __GLASGOW_HASKELL__
import GHC.Base
#endif

#ifdef COMPILING_GHC
IMP_Ubiq(){-uitous-}
# ifdef DEBUG
import Pretty
# endif
import Bag	( foldBag )

# if ! OMIT_NATIVE_CODEGEN
#  define IF_NCG(a) a
# else
#  define IF_NCG(a) {--}
# endif
#endif

-- SIGH: but we use unboxed "sizes"...
#if __GLASGOW_HASKELL__
#define IF_GHC(a,b) a
#else /* not GHC */
#define IF_GHC(a,b) b
#endif /* not GHC */


-- ---------------------------------------------------------------------------
-- The signature of the module

--	BUILDING
emptyFM		:: FiniteMap key elt
unitFM		:: key -> elt -> FiniteMap key elt
listToFM	:: (Ord key OUTPUTABLE_key) => [(key,elt)] -> FiniteMap key elt
			-- In the case of duplicates, the last is taken
#ifdef COMPILING_GHC
bagToFM		:: (Ord key OUTPUTABLE_key) => Bag (key,elt) -> FiniteMap key elt
			-- In the case of duplicates, who knows which is taken
#endif

--	ADDING AND DELETING
		   -- Throws away any previous binding
		   -- In the list case, the items are added starting with the
		   -- first one in the list
addToFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> elt  -> FiniteMap key elt
addListToFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt

		   -- Combines with previous binding
		   -- In the combining function, the first argument is the "old" element,
		   -- while the second is the "new" one.
addToFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
			   -> FiniteMap key elt -> key -> elt
			   -> FiniteMap key elt
addListToFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
			   -> FiniteMap key elt -> [(key,elt)]
			   -> FiniteMap key elt

		   -- Deletion doesn't complain if you try to delete something
		   -- which isn't there
delFromFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key   -> FiniteMap key elt
delListFromFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> [key] -> FiniteMap key elt

--	COMBINING
		   -- Bindings in right argument shadow those in the left
plusFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt
			   -> FiniteMap key elt

		   -- Combines bindings for the same thing with the given function
plusFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
			   -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt

minusFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
		   -- (minusFM a1 a2) deletes from a1 any bindings which are bound in a2

intersectFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
intersectFM_C	:: (Ord key OUTPUTABLE_key) => (elt1 -> elt2 -> elt3)
			   -> FiniteMap key elt1 -> FiniteMap key elt2 -> FiniteMap key elt3

--	MAPPING, FOLDING, FILTERING
foldFM		:: (key -> elt -> a -> a) -> a -> FiniteMap key elt -> a
mapFM		:: (key -> elt1 -> elt2) -> FiniteMap key elt1 -> FiniteMap key elt2
filterFM	:: (Ord key OUTPUTABLE_key) => (key -> elt -> Bool)
			   -> FiniteMap key elt -> FiniteMap key elt

--	INTERROGATING
sizeFM		:: FiniteMap key elt -> Int
isEmptyFM	:: FiniteMap key elt -> Bool

elemFM		:: (Ord key OUTPUTABLE_key) => key -> FiniteMap key elt -> Bool
lookupFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> Maybe elt
lookupWithDefaultFM
		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> elt -> key -> elt
		-- lookupWithDefaultFM supplies a "default" elt
		-- to return for an unmapped key

--	LISTIFYING
fmToList	:: FiniteMap key elt -> [(key,elt)]
keysFM		:: FiniteMap key elt -> [key]
eltsFM		:: FiniteMap key elt -> [elt]

-- ---------------------------------------------------------------------------
-- The @FiniteMap@ data type, and building of same

-- Invariants about @FiniteMap@:
--
-- *  all keys in a FiniteMap are distinct
--
-- * all keys in left  subtree are $<$ key in Branch and
--   all keys in right subtree are $>$ key in Branch
-- 
-- * size field of a Branch gives number of Branch nodes in the tree
-- 
-- * size of left subtree is differs from size of right subtree by a
--   factor of at most \tr{sIZE_RATIO}

data FiniteMap key elt
  = EmptyFM
  | Branch key elt	    	-- Key and elt stored here
    IF_GHC(Int#,Int{-STRICT-})	-- Size >= 1
    (FiniteMap key elt)	    	-- Children
    (FiniteMap key elt)


emptyFM = EmptyFM
{-
emptyFM
  = Branch bottom bottom IF_GHC(0#,0) bottom bottom
  where
    bottom = panic "emptyFM"
-}

--  #define EmptyFM (Branch _ _ IF_GHC(0#,0) _ _)

unitFM key elt = Branch key elt IF_GHC(1#,1) emptyFM emptyFM<commit_msg>[project @ 2002-05-28 12:03:06 by simonmar] Document<commit_after>-----------------------------------------------------------------------------
-- |
-- Module      :  Data.FiniteMap
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable
--
-- A finite map implementation, derived from the paper:
-- 	   /Efficient sets: a balancing act/, <NAME>,
-- 	   Journal of functional programming 3(4) Oct 1993, pp553-562
--
-----------------------------------------------------------------------------

-- ToDo: clean up, remove the COMPILING_GHC stuff.

-- The code is SPECIALIZEd to various highly-desirable types (e.g., Id)
-- near the end (only \tr{#ifdef COMPILING_GHC}).

#ifdef COMPILING_GHC
#include "HsVersions.h"
#define IF_NOT_GHC(a) {--}
#else
#define ASSERT(e) {--}
#define IF_NOT_GHC(a) a
#define COMMA ,
#define _tagCmp compare
#define _LT LT
#define _GT GT
#define _EQ EQ
#endif

#if defined(COMPILING_GHC) && defined(DEBUG_FINITEMAPS)/* NB NB NB */
#define OUTPUTABLE_key , Outputable key
#else
#define OUTPUTABLE_key {--}
#endif

module Data.FiniteMap (
	-- * The @FiniteMap@ type
	FiniteMap,		-- abstract type

	-- * Construction
	emptyFM, unitFM, listToFM,

	-- * Lookup operations
	lookupFM, lookupWithDefaultFM,
	elemFM,

	-- * Adding elements
	addToFM,
	addToFM_C,
	addListToFM,
	addListToFM_C,

	-- * Deleting elements
	IF_NOT_GHC(delFromFM COMMA)
	delListFromFM,

	-- * Combination
	plusFM,
	plusFM_C,

	-- * Extracting information
	fmToList, keysFM, eltsFM,
	sizeFM, isEmptyFM,

	-- * Other operations
	minusFM,
	foldFM,
	IF_NOT_GHC(intersectFM COMMA)
	IF_NOT_GHC(intersectFM_C COMMA)
	IF_NOT_GHC(mapFM COMMA filterFM COMMA)

#ifdef COMPILING_GHC
	, bagToFM
#endif
    ) where

import Prelude

import Data.Maybe ( isJust )
#ifdef __GLASGOW_HASKELL__
import GHC.Base
#endif

#ifdef COMPILING_GHC
IMP_Ubiq(){-uitous-}
# ifdef DEBUG
import Pretty
# endif
import Bag	( foldBag )

# if ! OMIT_NATIVE_CODEGEN
#  define IF_NCG(a) a
# else
#  define IF_NCG(a) {--}
# endif
#endif

-- SIGH: but we use unboxed "sizes"...
#if __GLASGOW_HASKELL__
#define IF_GHC(a,b) a
#else /* not GHC */
#define IF_GHC(a,b) b
#endif /* not GHC */


-- ---------------------------------------------------------------------------
-- The signature of the module

-- | An empty 'FiniteMap'.
emptyFM		:: FiniteMap key elt

-- | A 'FiniteMap' containing a single mapping
unitFM		:: key -> elt -> FiniteMap key elt

-- | Makes a 'FiniteMap' from a list of @(key,value)@ pairs. In the
-- case of duplicates, the last is taken
listToFM	:: (Ord key OUTPUTABLE_key) => [(key,elt)] -> FiniteMap key elt

#ifdef COMPILING_GHC
bagToFM		:: (Ord key OUTPUTABLE_key) => Bag (key,elt) -> FiniteMap key elt
			-- In the case of duplicates, who knows which is taken
#endif

--	ADDING AND DELETING

-- | Adds an element to a 'FiniteMap'.  Any previous mapping with the same
-- key is overwritten.
addToFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> elt  -> FiniteMap key elt

-- | Adds a list of elements to a 'FiniteMap', in the order given in
-- the list.  Overwrites previous mappings.
addListToFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt

		   -- Combines with previous binding
		   -- In the combining function, the first argument is the "old" element,
		   -- while the second is the "new" one.

-- | Adds an element to a 'FiniteMap'.  If there is already an element
-- with the same key, then the specified combination function is used
-- to calculate the new value.
addToFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
			   -> FiniteMap key elt -> key -> elt
			   -> FiniteMap key elt

-- | A list version of 'addToFM_C'.  The elements are added in the
-- order given in the list.
addListToFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
			   -> FiniteMap key elt -> [(key,elt)]
			   -> FiniteMap key elt

-- | Deletes an element from a 'FiniteMap'.  If there is no element with
-- the specified key, then the original 'FiniteMap' is returned.
delFromFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key   -> FiniteMap key elt

-- | List version of 'delFromFM'.
delListFromFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> [key] -> FiniteMap key elt

-- | Combine two 'FiniteMaps'.  Mappings in the second argument shadow
-- those in the first.
plusFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt
			   -> FiniteMap key elt

-- | Combine two 'FiniteMaps'.  The specified combination function is
-- used to calculate the new value when there are two elements with
-- the same key.
plusFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
			   -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt

-- | @(minusFM a1 a2)@ deletes from @a1@ any mappings which are bound in @a2@
minusFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt

-- | @(intersectFM a1 a2)@ returns a new 'FiniteMap' containing
-- mappings from @a1@ for which @a2@ also has a mapping with the same
-- key.
intersectFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt

-- | Returns the interesction of two mappings, using the specified
-- combination function to combine values.
intersectFM_C	:: (Ord key OUTPUTABLE_key) => (elt1 -> elt2 -> elt3)
			   -> FiniteMap key elt1 -> FiniteMap key elt2 -> FiniteMap key elt3

--	MAPPING, FOLDING, FILTERING
foldFM		:: (key -> elt -> a -> a) -> a -> FiniteMap key elt -> a
mapFM		:: (key -> elt1 -> elt2) -> FiniteMap key elt1 -> FiniteMap key elt2
filterFM	:: (Ord key OUTPUTABLE_key) => (key -> elt -> Bool)
			   -> FiniteMap key elt -> FiniteMap key elt

--	INTERROGATING
sizeFM		:: FiniteMap key elt -> Int
isEmptyFM	:: FiniteMap key elt -> Bool

-- | Returns 'True' if the specified @key@ has a mapping in this
-- 'FiniteMap', or 'False' otherwise.
elemFM		:: (Ord key OUTPUTABLE_key) => key -> FiniteMap key elt -> Bool

-- | Looks up a key in a 'FiniteMap', returning @'Just' v@ if the key
-- was found with value @v@, or 'Nothing' otherwise.
lookupFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> Maybe elt

-- | Looks up a key in a 'FiniteMap', returning @elt@ if the specified
-- @key@ was not found.
lookupWithDefaultFM
		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> elt -> key -> elt
		-- lookupWithDefaultFM supplies a "default" elt
		-- to return for an unmapped key

--	LISTIFYING
fmToList	:: FiniteMap key elt -> [(key,elt)]
keysFM		:: FiniteMap key elt -> [key]
eltsFM		:: FiniteMap key elt -> [elt]

-- ---------------------------------------------------------------------------
-- The @FiniteMap@ data type, and building of same

-- Invariants about @FiniteMap@:
--
-- *  all keys in a FiniteMap are distinct
--
-- * all keys in left  subtree are $<$ key in Branch and
--   all keys in right subtree are $>$ key in Branch
-- 
-- * size field of a Branch gives number of Branch nodes in the tree
-- 
-- * size of left subtree is differs from size of right subtree by a
--   factor of at most \tr{sIZE_RATIO}

-- | A mapping from @key@s to @elt@s.
data FiniteMap key elt
  = EmptyFM
  | Branch key elt	    	-- Key and elt stored here
    IF_GHC(Int#,Int{-STRICT-})	-- Size >= 1
    (FiniteMap key elt)	    	-- Children
    (FiniteMap key elt)


emptyFM = EmptyFM
{-
emptyFM
  = Branch bottom bottom IF_GHC(0#,0) bottom bottom
  where
    bottom = panic "emptyFM"
-}

--  #define EmptyFM (Branch _ _ IF_GHC(0#,0) _ _)

unitFM key elt = Branch key elt IF_GHC(1#,1) emptyFM emptyFM
{'fraction_non_alphanumeric': 0.15681456857927445, 'fraction_numerical': 0.00664835958953606, 'mean_word_length': 2.6437598736176935, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 177, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '868901', 'n_tokens_mistral': 5025, 'n_tokens_neox': 4782, 'n_words': 1635}