## 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.
### "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;
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;
# Look for an item, return NULL
# if the item doesn't exist:
#
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;
# 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;
# 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;
# 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
(fn (_, 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
(fn (key, item) = (key, f (key, item)))
l;
fun map f l
=
list::map
(fn (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
(fn ((key, item), accum) = f (key, item, accum))
init
l;
fun fold_forward f init l
=
list::fold_forward
(fn ((_, 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
(fn ((key, item), accum) = f (key, item, accum))
init
l;
fun fold_backward f init l
=
list::fold_backward
(fn ((_, item), accum) = f (item, accum))
init
l;
fun filter predicate l
=
list::filter
(fn (_, 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'
(fn (_, 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-2013,
## released per terms of SMLNJ-COPYRIGHT.