## 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.
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;
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;
# Look for an item, return NULL if the item doesn't exist
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;
# 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;
# 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)
=>
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 (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 prior l
=
list::filter (fn (_, 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' (fn (_, item) = f item) l;
}; # int_list_map