## int-list-map.pkg
# Compiled by:
# src/lib/std/standard.lib# An implementation of finite maps on integer keys
# which uses a sorted list representation. Normally
# src/lib/src/int-red-black-map.pkg# is preferred.
package int_list_map
:
Map # Map is from src/lib/src/map.apiwhere
key::Key == int::Int
=
package {
package key {
Key = Int;
compare = int::compare;
};
Map(X) = List ((Int, 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 ((elem as (key', _)) ! r)
=>
case (key::compare (key, key'))
LESS => (key, item) ! elem ! r;
EQUAL => (key, item) ! r;
GREATER => elem ! (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 [] => FALSE;
f ((key', x) ! r) => (key' <= key) and ((key' == key) or f r);
end;
end;
fun preceding_key (l, key)
=
f (l, NULL)
where
fun f ((key', x) ! r, result)
=>
case (int::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 (int::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 [] => NULL;
f ((key', x) ! r)
=>
if (key < key') NULL;
elif (key == key') THE x;
else f r;
fi;
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 [] => raise exception lib_base::NOT_FOUND;
f ((key', x) ! r)
=>
if (key < key') raise exception lib_base::NOT_FOUND;
elif (key == key') x;
else f r;
fi;
end;
end;
stipulate
# Remove an item, returning new map and value removed.
# Raise excaption lib_base::NOT_FOUND if not found.
#
fun drop' (l, key)
=
f ([], l)
where
fun f (_, []) => raise exception lib_base::NOT_FOUND;
f (prefix, (elem 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 (elem ! 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;
# 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;
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 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)
=>
if (k1 < k2)
mergef (k1, THE x1, NULL, r1, m2, l);
else
if (k1 == k2)
mergef (k1, THE x1, THE x2, r1, r2, l);
else mergef (k2, NULL, THE x2, m1, r2, l); fi;
fi;
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)
=>
if (k1 < k2)
mergef (k1, THE x1, NULL, r1, m2, l);
else
if (k1 == k2) mergef (k1, THE x1, THE x2, r1, r2, l);
else mergef (k2, NULL, THE x2, m1, r2, l); fi;
fi;
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 prior l
=
list::filter (\\ (_, item) = prior item) l;
fun keyed_filter prior l
=
list::filter prior l;
fun keyed_map' f l
=
list::map_partial_fn f' l
where
fun f' (key, item)
=
case (f (key, item))
NULL => NULL;
THE y => THE (key, y);
esac;
end;
fun map' f l
=
keyed_map' (\\ (_, item) = f item) l;
}; # int_list_map