[m-rev.] New library module: default_map.m

[Ralph Becket]

I've needed something like this often enough that I think it should go
in the standard library.

- Ralph



Estimated hours taken: 1
Branches: main

Extend the library with a new map/2 variant that supports default values
for keys that have not otherwise been bound in the map.

library/default_map.m:
	Added.

library/library.m:
	Added import line for the new module.

NEWS:
	Noted addition of new module.

Index: library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.57
diff -u -r1.57 library.m
--- library.m	2001/05/31 06:00:04	1.57
+++ library.m	2001/07/10 12:01:41
@@ -41,6 +41,7 @@
 :- import_module pprint.
 :- import_module bitmap.
 :- import_module hash_table.
+:- import_module default_map.
 
 :- import_module builtin, private_builtin, table_builtin,
profiling_builtin.
 
Index: ../NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.213
diff -u -r1.213 NEWS
--- ../NEWS	2001/06/27 05:03:57	1.213
+++ ../NEWS	2001/07/10 12:05:32
@@ -42,6 +42,10 @@
 
 * We've added a predicate version of `set__fold'.
 
+* There is a new library module default_map.m supplying a variant of
+  the map datatype taking a default value for keys with no other
+  binding.
+
 Changes to the Mercury implementation:
 * We've fixed a long-standing bug in the handling of module imports.
   Previously, if `module1' imported `module2' which imported `module3'
in

default_map.m:
===================================================================
%-----------------------------------------------------------------------
-------%
%-----------------------------------------------------------------------
-------%
% Copyright (C) 2001 Ralph Becket <rbeck at microsoft.com>
% Tue Jul 10 11:44:37 BST 2001
%
% THIS CODE IS DONATED TO THE MERCURY PROJECT TO BE RELEASED UNDER
% WHATEVER LICENCE IS DEEMED APPROPRIATE BY THE MERCURY PROJECT
% MANAGEMENT.
%
% Variant of the map/2 ADT where lookups on keys that do not have
% explicit bindings succeed returning a default value rather than
% failing.
%
%-----------------------------------------------------------------------
-------%
%-----------------------------------------------------------------------
-------%

:- module default_map.
:- interface.
:- import_module int, list, assoc_list.



:- type default_map(K, V).



    % Construct an empty default_map with a given default value.
    %
:- func new(V) = default_map(K, V).

    % Obtain the default value for a default_map.
    %
:- func default_value(default_map(K, V)) = V.

    % Succeeds iff no non-default bindings are present.
    %
:- pred is_empty(default_map(K, V)::in) is semidet.

    % Succeeds iff a non-default binding for the given key is present.
    %
:- pred has_non_default_binding(default_map(K, V)::in, K::in) is
semidet.

    % Enumerates the non-default bindings in the default_map.
    %
:- pred non_default_binding(default_map(K, V)::in, K::out, V::out) is
nondet.

    % Lookup the binding for a given key.
    %
:- func lookup(default_map(K, V), K) = V.

    % DMap ^ elem(K) = lookup(DMap, K)
    %
:- func elem(K, default_map(K, V)) = V.

    % Set a new binding.
    %
:- func set(default_map(K, V), K, V) = default_map(K, V).

    % ( DMap ^ elem(K) := V ) = set(DMap, K, V).
    %
:- func 'elem :='(K, default_map(K, V), V) = default_map(K, V).

    % Set the binding for a key to the default value.
    %
:- func set_to_default(default_map(K, V), K) = default_map(K, V).

    % Change the default value.
    %
:- func set_default_value(default_map(K, V), V) = default_map(K, V).

    % Apply a function to all values.
    %
:- func map_values(func(V1) = V2, default_map(K, V1)) = default_map(K,
V2).

    % Return the list of keys with non-default bindings.
    %
:- func keys_with_non_default_bindings(default_map(K, V)) = list(K).

    % Return the list of values with non-default bindings.
    %
:- func values_for_non_default_bindings(default_map(K, V)) = list(V).

    % Return the assoc_list of non-default bindings.
    %
:- func non_default_bindings_to_assoc_list(default_map(K, V)) =
            assoc_list(K, V).

    % Return the number of non-default bindings in the default_map.
    %
:- func num_non_default_bindings(default_map(K, V)) = int.

%-----------------------------------------------------------------------
-------%
%-----------------------------------------------------------------------
-------%

:- implementation.

:- import_module std_util, map.



    % Invariant: the bindings map must never contain a binding to
    % the default value.
    %
:- type default_map(K, V)
    --->    default_map(
                bindings                :: map(K, V),
                default                 :: V
            ).

%-----------------------------------------------------------------------
-------%

new(V) = default_map(map__init, V).

default_value(DM) = DM ^ default.

is_empty(DM) :-
    is_empty(DM ^ bindings).

has_non_default_binding(DM, K) :-
    contains(DM ^ bindings, K).

non_default_binding(DM, K, V) :-
    member(DM ^ bindings, K, V).

lookup(DM, K) =
    ( if DM ^ bindings ^ elem(K) = V then V else DM ^ default ).

elem(K, DM) = lookup(DM, K).

set(DM, K, V) =
    ( if V = DM ^ default then DM else DM ^ bindings ^ elem(K) := V ).

'elem :='(K, DM, V) = set(DM, K, V).

set_to_default(DM, K) = ( DM ^ bindings := delete(DM ^ bindings, K) ).

set_default_value(DM, DV) = map_values(id, ( DM ^ default := DV )).

map_values(F, DM0) = DM :-
    DV = F(DM0 ^ default),
    FM =
        ( func(K - V0) = (K - V) is semidet :-
            V =  F(V0),
            V \= DV
        ),
    Bs = from_assoc_list(filter_map(FM, to_assoc_list(DM0 ^ bindings))),
    DM = default_map(Bs, DV).

keys_with_non_default_bindings(DM) = keys(DM ^ bindings).

values_for_non_default_bindings(DM) = values(DM ^ bindings).

non_default_bindings_to_assoc_list(DM) = to_assoc_list(DM ^ bindings).

num_non_default_bindings(DM) = count(DM ^ bindings).

%-----------------------------------------------------------------------
-------%
%-----------------------------------------------------------------------
-------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------