## list-map-g.pkg
# Compiled by:
# src/lib/std/standard.lib# An implementation of finite maps on ordered keys
# which uses a sorted list representation. Normally
# src/lib/src/red-black-map-g.pkg# is preferred.
### "More people have ascended bodily into heaven
### than have shipped great software on time."
###
### -- Jim McCarthy
generic package list_map_g (k: Key) # Key is from src/lib/src/key.api:
Map # Map is from src/lib/src/map.apiwhere
key::Key == k::Key
=
package {
package key = k;
Map(X) = List ((k::Key, X));
empty = [];
fun is_empty [] => TRUE;
is_empty _ => FALSE;
end;
# Return the first item in the map
# or NULL if it is empty:
#
fun first_val_else_null [] => NULL;
first_val_else_null ((_, value) ! _) => THE value;
end;
# Return the first item in the map
# and its key, or NULL if it is empty:
#
fun first_keyval_else_null [] => NULL;
first_keyval_else_null ((key, value) ! _) => THE (key, value);
end;
# Return the last item in the map
# or NULL if it is empty:
#
fun last_val_else_null [] => NULL;
last_val_else_null ((_, value) ! []) => THE value;
last_val_else_null (_ ! rest) => last_val_else_null rest;
end;
# Return the last item in the map
# and its key, or NULL if it is empty:
#
fun last_keyval_else_null [] => NULL;
last_keyval_else_null ((key, value) ! []) => THE (key, value);
last_keyval_else_null (_ ! rest) => last_keyval_else_null rest;
end;
fun singleton (key, item)
=
[(key, item)];
fun debug_print (map, print_key, print_val) = 0; # Placeholder
fun all_invariants_hold map = TRUE; # Placeholder
fun set (l, key, item)
=
f l
where
fun f []
=>
[(key, item)];
f ((element as (key', _)) ! r)
=>
case (key::compare (key, key'))
#
LESS => (key, item) ! element ! r;
EQUAL => (key, item) ! r;
GREATER => element ! (f r);
esac;
end;
end;
fun m $ (x, v)
=
set (m, x, v);
fun set' ((k, x), m)
=
set (m, k, x);
# Return TRUE if the key is in the map's domain:
#
fun contains_key (l, key)
=
f l
where
fun f ((key', x) ! r)
=>
case (key::compare (key, key'))
#
LESS => FALSE;
EQUAL => TRUE;
GREATER => f r;
esac;
f [] => FALSE;
end;
end;
fun preceding_key (l, key)
=
f (l, NULL)
where
fun f ((key', x) ! r, result)
=>
case (key::compare (key, key'))
#
LESS => result;
EQUAL => result;
GREATER => f (r, THE key');
esac;
f ([], result) => result;
end;
end;
fun following_key (l, key)
=
f l
where
fun f ((key', x) ! r)
=>
case (key::compare (key, key'))
#
LESS => THE key';
EQUAL => f r;
GREATER => f r;
esac;
f [] => NULL;
end;
end;
# Search on a key, return (THE value) if found,
# else return NULL.
#
fun get (l, key)
=
f l
where
fun f ((key', x) ! r)
=>
case (key::compare (key, key'))
#
LESS => NULL;
EQUAL => THE x;
GREATER => f r;
esac;
f [] => NULL;
end;
end;
# Search on a key, return value if found,
# else raise lib_base::NOT_FOUND
#
fun get_or_raise_exception_not_found (l, key)
=
f l
where
fun f ((key', x) ! r)
=>
case (key::compare (key, key'))
#
LESS => raise exception lib_base::NOT_FOUND;
EQUAL => x;
GREATER => f r;
esac;
f [] => raise exception lib_base::NOT_FOUND;
end;
end;
stipulate
# Remove an item, returning new map and value removed.
# Raise Lib_base::NOT_FOUND if not found.
#
fun drop' (l, key)
=
f ([], l)
where
fun f (_, [])
=>
raise exception lib_base::NOT_FOUND;
f (prefix, (element as (key', x)) ! r)
=>
case (key::compare (key, key'))
#
LESS => raise exception lib_base::NOT_FOUND;
EQUAL => (list::reverse_and_prepend (prefix, r), x);
GREATER => f (element ! prefix, r);
esac;
end;
end;
herein
fun drop (old_map, key_to_drop) # Return new_map, or old_map if key_to_drop was not found.
=
#1 (drop' (old_map, key_to_drop))
except
lib_base::NOT_FOUND = old_map;
fun get_and_drop (old_map, key_to_drop) # Return (new_map, THE value) or (old_map, NULL) if key_to_drop was not found.
=
{ (drop' (old_map, key_to_drop))
->
(new_map, val);
(new_map, THE val);
}
except
lib_base::NOT_FOUND = (old_map, NULL);
end;
# Return the number of items in the map
#
fun vals_count l
=
list::length l;
# Return a list of the items (and their keys) in the map
#
fun vals_list (l: Map(X))
=
list::map #2 l;
fun keyvals_list l
=
l;
fun keys_list (l: Map(X))
=
list::map #1 l;
fun compare_sequences compare_rng
=
compare
where
fun compare ([], []) => EQUAL;
compare ([], _) => LESS;
compare (_, []) => GREATER;
compare ((x1, y1) ! r1, (x2, y2) ! r2)
=>
case (key::compare (x1, x2))
#
EQUAL => case (compare_rng (y1, y2))
#
EQUAL => compare (r1, r2);
order => order;
esac;
order => order;
esac;
end;
end;
fun difference_with (m1, m2)
=
{ keys_to_remove = keys_list m2;
#
remove (m1, keys_to_remove)
where
fun remove (m1, [])
=>
m1;
remove (m1, key ! rest)
=>
remove (drop (m1, key), rest);
end;
end;
};
fun from_list (pairs: List((key::Key, X)))
=
{ tree = empty;
#
add (tree, pairs)
where
fun add (tree, [])
=>
tree;
add (tree, (key,val) ! rest)
=>
add (set (tree, key, val), rest);
end;
end;
};
# Return a map whose domain is the union
# of the domains of the two input maps,
# using the supplied function to define
# the map on elements that are in both
# domains.
#
fun union_with f (m1: Map(X), m2: Map(X))
=
merge (m1, m2, [])
where
fun merge ([], [], l) => list::reverse l;
merge ([], m2, l) => list::reverse_and_prepend (l, m2);
merge (m1, [], l) => list::reverse_and_prepend (l, m1);
merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
=>
case (key::compare (k1, k2))
#
LESS => merge (r1, m2, (k1, x1) ! l);
EQUAL => merge (r1, r2, (k1, f (x1, x2)) ! l);
GREATER => merge (m1, r2, (k2, x2) ! l);
esac;
end;
end;
fun keyed_union_with f (m1: Map(X), m2: Map(X))
=
merge (m1, m2, [])
where
fun merge ([], [], l) => list::reverse l;
merge ([], m2, l) => list::reverse_and_prepend (l, m2);
merge (m1, [], l) => list::reverse_and_prepend (l, m1);
merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
=>
case (key::compare (k1, k2))
#
LESS => merge (r1, m2, (k1, x1) ! l);
EQUAL => merge (r1, r2, (k1, f (k1, x1, x2)) ! l);
GREATER => merge (m1, r2, (k2, x2) ! l);
esac;
end;
end;
# Return a map whose domain is the
# intersection of the domains of the
# two input maps, using the supplied
# function to define the range.
#
fun intersect_with f (m1: Map(X), m2: Map(Y))
=
merge (m1, m2, [])
where
fun merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
=>
case (key::compare (k1, k2))
#
LESS => merge (r1, m2, l);
EQUAL => merge (r1, r2, (k1, f (x1, x2)) ! l);
GREATER => merge (m1, r2, l);
esac;
merge (_, _, l)
=>
list::reverse l;
end;
end;
fun keyed_intersect_with f (m1: Map(X), m2: Map(Y))
=
merge (m1, m2, [])
where
fun merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
=>
case (key::compare (k1, k2))
#
LESS => merge (r1, m2, l);
EQUAL => merge (r1, r2, (k1, f (k1, x1, x2)) ! l);
GREATER => merge (m1, r2, l);
esac;
merge (_, _, l)
=>
list::reverse l;
end;
end;
fun merge_with f (m1: Map(X), m2: Map(Y))
=
merge (m1, m2, [])
where
fun merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
=>
case (key::compare (k1, k2))
#
LESS => mergef (k1, THE x1, NULL, r1, m2, l);
EQUAL => mergef (k1, THE x1, THE x2, r1, r2, l);
GREATER => mergef (k2, NULL, THE x2, m1, r2, l);
esac;
merge ([], [], l) => list::reverse l;
merge ((k1, x1) ! r1, [], l) => mergef (k1, THE x1, NULL, r1, [], l);
merge ([], (k2, x2) ! r2, l) => mergef (k2, NULL, THE x2, [], r2, l);
end
also
fun mergef (k, x1, x2, r1, r2, l)
=
case (f (x1, x2))
#
NULL => merge (r1, r2, l);
THE y => merge (r1, r2, (k, y) ! l);
esac;
end;
fun keyed_merge_with f (m1: Map(X), m2: Map(Y))
=
merge (m1, m2, [])
where
fun merge ( m1 as ((k1, x1) ! r1),
m2 as ((k2, x2) ! r2),
l
)
=>
case (key::compare (k1, k2))
#
LESS => mergef (k1, THE x1, NULL, r1, m2, l);
EQUAL => mergef (k1, THE x1, THE x2, r1, r2, l);
GREATER => mergef (k2, NULL, THE x2, m1, r2, l);
esac;
merge ([], [], l) => list::reverse l;
merge ((k1, x1) ! r1, [], l) => mergef (k1, THE x1, NULL, r1, [], l);
merge ([], (k2, x2) ! r2, l) => mergef (k2, NULL, THE x2, [], r2, l);
end
also
fun mergef (k, x1, x2, r1, r2, l)
=
case (f (k, x1, x2))
#
NULL => merge (r1, r2, l);
THE y => merge (r1, r2, (k, y) ! l);
esac;
end;
# Apply a function to the entries
# of the map in map order:
keyed_apply = list::apply;
fun apply f l
=
keyed_apply
(\\ (_, item) = f item)
l;
# Create a new table by applying
# a map function to the name/value
# pairs in the table.
fun keyed_map f l
=
list::map
(\\ (key, item) = (key, f (key, item)))
l;
fun map f l
=
list::map
(\\ (key, item) = (key, f item))
l;
# Apply a folding function
# to the entries of the map
# in increasing map order.
fun keyed_fold_forward f init l
=
list::fold_forward
(\\ ((key, item), accum) = f (key, item, accum))
init
l;
fun fold_forward f init l
=
list::fold_forward
(\\ ((_, item), accum) = f (item, accum))
init
l;
# Apply a folding function
# to the entries of the map
# in decreasing map order.
fun keyed_fold_backward f init l
=
list::fold_backward
(\\ ((key, item), accum) = f (key, item, accum))
init
l;
fun fold_backward f init l
=
list::fold_backward
(\\ ((_, item), accum) = f (item, accum))
init
l;
fun filter predicate l
=
list::filter
(\\ (_, item) = predicate item)
l;
fun keyed_filter predicate l
=
list::filter predicate l;
fun keyed_map' f l
=
list::map_partial_fn f' l
where
fun f' (key, item)
=
case (f (key, item))
#
THE y => THE (key, y);
NULL => NULL;
esac;
end;
fun map' f l
=
keyed_map'
(\\ (_, item) = f item)
l;
}; # generic package list_map_g
## COPYRIGHT (c) 1996 by AT&T Research. See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.