/**
* This module contains strategies for operating on hashtables.
*
* It is important to note that hashtables do not have value semantics;
* all operations on hashtables will modify the existing hashtable.
* Therefore, when you pass a hashtable to a strategy, it will modify
* the hashtable by side-effect.
*
* Hash tables support constant time storing and retrieving of
* values associated with keys. This module wraps the hashtable
* facility provided by the ATerm library.
*
* @author Eelco Visser <visser@acm.org>
* @author Martin Bravenboer <martin.bravenboer@gmail.com>
* @author Karl Trygve Kalleberg <karltk@strategoxt.org> - some documentation
*
*/
module collection/hash-table/common
imports
collection/list/-
signature
constructors
/**
* Represents a reference to a hashtable.
*/
Hashtable : ImplDep -> Hashtable
/**
* Hashtable construction and deconstruction
*/
strategies
/**
* Create a new hashtable with default size and load.
*
* @type _ -> HashTable(K, V)
*/
new-hashtable =
new-hashtable(|117,75)
/**
* Create a new hashtable with specified size and load.
*
* @param initial_size - the initial capacity of the hashtable
* @param max_load - the load percentage at which the hashtable is expanded
* @type _ -> HashTable(K, V)
*/
new-hashtable(|initial_size, max_load) =
prim("SSL_hashtable_create", initial_size, max_load); !Hashtable(<id>)
/**
* Destroys and deallocates memory consumed by an existing hashtable.
*
* @type HashTable(K, V) -> HashTable(K, V)
*/
hashtable-destroy =
?Hashtable(tbl); prim("SSL_hashtable_destroy", tbl); !Hashtable(<id>)
/**
* Clears the contents of an existing hashtable.
*
* @type HashTable(K, V) -> HashTable(K, V)
*/
hashtable-clear =
?Hashtable(tbl); prim("SSL_hashtable_reset", tbl); !Hashtable(<id>)
/**
* Hashtable operations
*/
strategies
/**
* Puts a new key, value pair into the hash table. If the key is
* already bound to a value, the old value will be replaced.
*
* @param key - any term can be used as a key
* @param value - any term can be used as a value
* @type HashTable(K, V) -> HashTable(K, V)
*/
hashtable-put(|key, value) =
?Hashtable(tbl); prim("SSL_hashtable_put", tbl, key, value); !Hashtable(<id>)
/**
* Gets the value for a key. If the key does not exist, this strategy
* fails.
*
* @param key
* @type HashTable(K, V) -> V
*/
hashtable-get(|key) =
?Hashtable(tbl); prim("SSL_hashtable_get", tbl, key)
/**
* Removes a key (with its associated value) from the hashtable. This
* strategy will succeed even if the key does not exist.
*
* @type HashTable(K, V) -> HashTable(K, V)
*/
hashtable-remove(|key) =
?Hashtable(tbl); prim("SSL_hashtable_remove", tbl, key); !Hashtable(<id>)
/**
* Get a list containing all keys of a hashtable.
*
* @type HashTable(K, V) -> List(K)
*/
hashtable-keys =
?Hashtable(tbl); prim("SSL_hashtable_keys", tbl)
/**
* Get a list containing all values of a hashtable
*
* @type HashTable(K, V) -> List(V)
*/
hashtable-values =
?htbl
; hashtable-keys
; map({k: ?k; <hashtable-get(|k)> htbl})
/**
* Apply an iterative fold left (starting with first element) over
* the keys of a hash table; useful for applying an operation to each
* key without constructing a list of keys.
*
* @param (k, v) * a -> a
* @param a
* @type HashTable(k, v) -> a
*/
hashtable-fold(s : k * v * a -> a | t) =
?Hashtable(tbl)
; prim("SSL_table_fold", s | t, tbl)
/**
* Apply an iterative fold left (starting with first element) over
* the keys of a hash table; useful for applying an operation to each
* key without constructing a list of keys.
*
* @param k * a -> a
* @param a
* @type HashTable(k, v) -> a
*/
hashtable-fold-keys(s : k * a -> a | t) =
?Hashtable(tbl)
; prim("SSL_table_keys_fold", s | t, tbl)
/**
* Apply an iterative fold left (starting with first element) over
* the values of a hash table; useful for applying an operation to each
* value without constructing a list of values.
*
* @param v * a -> a
* @param a
* @type (v * a -> a) * a * HashTable(k, v) -> a
*/
hashtable-fold-values(s : v * a -> a | t) =
?Hashtable(tbl)
; prim("SSL_table_values_fold", s | t, tbl)
/**
* Hashtable bulk operations
*/
strategies
/**
* Get the contents of a hashtable as a list of key-value tuples.
*
* @type HashTable(k,v) -> List((k,v), ...)
*/
hashtable-getlist =
?htbl
; let insert(|k, v) = ![(k, v) | <id>]
in hashtable-fold(insert | [])
end
/**
* Put a list of key,value tuples into a hashtable.
*
* @param kv List(Tuple(K, V), ...)
* @type HashTable(K, V) -> HashTable(K, V)
*/
hashtable-putlist(|kv*) =
?htbl
; where(<map(\ (key, value) -> <hashtable-put(|key, value)> htbl \)> kv*)
hashtable-putlist(f : ATerm * ATerm * Hashtable -> Hashtable|kv*) =
?htbl
; where(<map(\ (key, value) -> <f(|key, value)> htbl \)> kv*)
/**
* Create a new hashtable and initialize it from a key-value pair list.
*
* @type List(Tuple(K, V), ...) -> HashTable(K, V)
*/
hashtable-init =
?kv*
; new-hashtable(|<length>, 75)
; hashtable-putlist(|kv*)
/**
* Create a new hashtable and copies the entire contents of the current
* table into the new one.
*
* @type HashTable(K, V) -> HashTable(K,V)
*/
hashtable-copy =
hashtable-getlist
; hashtable-init
/**
* Stack operations (when stored values in hashtables are list-based stacks)
*/
strategies
/**
* Pushes value on top of the stack for key.
* Current term is the hashtable and remains untouched.
*
* @param key t - the key used for lookup
* @param value a - the value to insert
* @type HashTable(K, V) -> HashTable(K, V)
*/
hashtable-push(|key, value) =
hashtable-put(|key, [value | <hashtable-get(|key) <+ ![]>])
/**
* Pushes values on top of the stack for key.
* Current term is the hashtable and remains untouched.
*
* @param key t - the key used for lookup
* @param value List(a) - the values to insert
* @type HashTable(K, V) -> HashTable(K, V')
*/
hashtable-pushlist(|key, value) =
hashtable-put(|key, <conc>(value, <hashtable-get(|key) <+ ![]>))
/**
* Pushes union of values and already present values
* Current term is the hashtable.
*
* @param key t - the key used for lookup
* @param value List(a) - the values to insert
* @type HashTable(K, V) -> HashTable(K, V')
*/
hashtable-pushunion(|key, value) =
hashtable-put(|key, <union>(value, <hashtable-get(|key) <+ ![]>))
/**
* Pops off the top element of the stack for key.
* Current term is the hashtable and remains untouched.
*
* @param key t - the key used for lookup
* @type HashTable(K, (V, ...)) -> V
*/
hashtable-pop(|key) =
hashtable-put(|key, <hashtable-get(|key); Tl>)
/**
* Gets the top value from the stack for key (the stack remains untouched)
* Current term is the hashtable, output is the top value.
*
* @param key t - the key used for lookup
* @type HashTable(K, (V, ...)) -> V
*/
hashtable-peek(|key) =
hashtable-get(|key); Hd
/**
* Gets the top value from the stack for key and pops it off the stack.
* Current term is the hashtable, output is the top value.
*
* @param key t - the key used for lookup
* @type HashTable(K, (V, ...)) -> V
*/
hashtable-peekpop(|key) =
where(hashtable-peek(|key) => val)
; hashtable-pop(|key)
; !val
/**
* Mnemonic parameter strategies for hashtable-merge.
*/
strategies
symmetric-yes = id
symmetric-no = fail
iterate1-yes = id
iterate1-no = fail
iterate2-yes = id
iterate2-no = fail
remove-yes = id
remove-no = fail
default-no = fail
change1-yes = id
change1-no = fail
change2-yes = id
change2-no = fail
strategies
/**
* Merge two hashtables changing one or both.
*
* This a highly generic strategy for merging two hashtables. The algorithm
* is parameterized with a number of knobs that determine its behaviour.
*
* (A little language for table merging!-)
*
* @param symm : apply changes to both tables, if not apply to tbl1.
* @param iterate1 : iterate over keys of tbl1
* @param iterate2 : iterate over keys of tbl2
* @param remove : remove table entry if undefined in other table
* @param merge : operation on pair of values
* @param default : default value in case lookup in other table fails
* @param lookup1 : given a key produce value for left table
* @param lookup2 : given a key produce value for right table
*
* @todo : with a proper partial evaluator for Stratego this strategy can be
* used to create appropriately specialized algorithms.
*/
hashtable-merge(symm, iterate1, iterate2, remove, merge
, default, change1, change2, lookup1, lookup2) :
(tbl1, tbl2) -> tbl1
where if iterate1 then
<hashtable-keys> tbl1
; filter({key, val1, val2, val3:
?key
; if <lookup2> key => val2 then
<hashtable-get(|key)> tbl1 => val1
; <merge>(val1, val2) => val3
; ior(
if <?val1> val3 then
fail // no change to tbl1
else
<hashtable-put(|key, val3)> tbl1; change1
end
, if symm; <?val2> val3 then
fail // no change to tbl2
else
<hashtable-put(|key, val3)> tbl2; change2
end
)
else if <default> key => val2 then
<hashtable-get(|key)> tbl1 => val1
; <merge>(val1, val2) => val3
; ior(
if <?val1> val3 then
fail // no change to tbl1
else
<hashtable-put(|key, val3)> tbl1; change1
end
, if symm then
<hashtable-put(|key, val3)> tbl2; change2
end
)
else // lookup2 failed, no default
if remove then
<hashtable-remove(|key)> tbl1;
if symm then
<hashtable-remove(|key)> tbl2; change2
end
else
fail // no change to either table
end
end end
})
else ![] end => changes1
; if iterate2 then
<hashtable-keys> tbl2
; filter({key, val1, val2, val3:
?key
; if iterate1 then not(<hashtable-get(|key)>tbl1) end
; if <lookup1> key => val1 then
<hashtable-get(|key)> tbl2 => val2
; <merge>(val1, val2) => val3
; ior(if <?val1> val3 then
fail // no change to tbl1
else
<hashtable-put(|key, val3)> tbl1; change1
end
,if symm; <?val2> val3 then
fail // no change to tbl2
else
<hashtable-put(|key, val3)> tbl2; change2
end
)
else if <default> key => val1 then
<hashtable-get(|key)> tbl2 => val2
; <merge>(val1, val2) => val3
; <hashtable-put(|key, val3)> tbl1
; if symm; <not(?val2)> val3 then
<hashtable-put(|key, val3)> tbl2
end
else // lookup1 failed and no default
if remove then
<hashtable-remove(|key)> tbl1;
if symm then
<hashtable-remove(|key)> tbl2; change2
end
else
fail // no change to either table
end
end end
})
else ![] end => changes2
; (<not([])> changes1 <+ <not([])> changes2)
/**
* Version without change arguments for backward compatibility
*/
hashtable-merge(symm, iterate1, iterate2, remove, merge, default,
lookup1, lookup2) =
hashtable-merge(symm, iterate1, iterate2, remove, merge, default,
change1-yes, change2-yes, lookup1, lookup2)
/**
* Merge hashtables creating a new one.
*/
hashtable-merge-func(iterate1, iterate2, remove, merge, default, lookup1, lookup2) :
(tbl1, tbl2) -> tbl3
where <hashtable-copy> tbl1 => tbl3
; <hashtable-merge(symmetric-no, iterate1, iterate2, remove, merge, default, lookup1, lookup2)> (tbl3, tbl2)
strategies // intersection merges
/**
* Intersect hashtables.
*
* Changes tbl1; fails if no changes are made
* Assumes that both hashtables contains lists as values, and intersects
* the two listvalues for each key.
* This is a 'pure' intersection: only keys that appear in both tables
* remain in the input table, rest is removed.
*/
hashtable-intersect(|tbl2) =
?tbl1
; !(tbl1, tbl2)
; hashtable-merge(
symmetric-no,
iterate1-yes,
iterate2-no,
remove-yes,
isect,
default-no,
\ key -> <hashtable-get(|key)> tbl1 \,
\ key -> <hashtable-get(|key)> tbl2 \
)
/**
* Intersect hashtables with default element.
*
* Changes tbl1; fails if no changes are made
* Assumes that both hashtables contains lists as values, and intersects
* the two listvalues for each key.
* Places a dummy value if key does not exist in one of the tables.
*/
hashtable-intersect-wempty(|tbl2, emptyElt) =
?tbl1
; !(tbl1, tbl2)
; hashtable-merge(
symmetric-no,
iterate1-yes,
iterate2-yes,
remove-no,
isect,
!emptyElt,
\ key -> <hashtable-get(|key)> tbl1 \,
\ key -> <hashtable-get(|key)> tbl2 \
)
/**
* Intersect hashtables symmetrically with default element.
*
* Changes tbl1 and tbl2; fails if no changes are made in tbl1
* Assumes that both hashtables contains lists as values, and intersects
* the two listvalues for each key.
* Places a dummy value if key does not exist in one of the tables.
*/
hashtable-intersect-symm-wempty(|emptyElt) =
?(tbl1, tbl2)
; hashtable-merge(
symmetric-yes,
iterate1-yes,
iterate2-yes,
remove-no,
isect,
!emptyElt,
\ key -> <hashtable-get(|key)> tbl1 \,
\ key -> <hashtable-get(|key)> tbl2 \
)
/**
* Intersect hashtables symmetrically with default element.
*
* Changes tbl1 and tbl2; fails if no changes are made in tbl1
* Assumes that both hashtables contains lists as values, and intersects
* the two listvalues for each key.
* Places a dummy value if key does not exist in one of the tables.
*/
hashtable-intersect-symm-wempty-ignore-left(|emptyElt) =
?(tbl1, tbl2)
; hashtable-merge(
symmetric-yes,
iterate1-yes,
iterate2-yes,
remove-no,
isect,
!emptyElt,
change1-no,
change2-yes,
\ key -> <hashtable-get(|key)> tbl1 \,
\ key -> <hashtable-get(|key)> tbl2 \
)
strategies // union merges
/**
* Union of hashtables
*
* Changes tbl1; fails if no changes are made
*/
hashtable-union(|tbl2) =
?tbl1
; !(tbl1, tbl2)
; hashtable-merge(
symmetric-no,
iterate1-no,
iterate2-yes,
remove-no,
union,
![],
\ key -> <hashtable-get(|key)> tbl1 \,
fail
)
hashtable-union-wempty(|tbl2, emptyElt) =
?tbl1
; !(tbl1, tbl2)
; hashtable-merge(
symmetric-no,
iterate1-no,
iterate2-yes,
remove-no,
union,
!emptyElt,
\ key -> <hashtable-get(|key)> tbl1 \,
fail
)
hashtable-union-symm-wempty(|emptyElt) =
?(tbl1, tbl2)
; hashtable-merge(
symmetric-yes,
iterate1-yes,
iterate2-yes,
remove-no,
union,
!emptyElt,
\ key -> <hashtable-get(|key)> tbl1 \,
\ key -> <hashtable-get(|key)> tbl2 \
)
strategies
/**
* Checks whether two hashtables have equal contents.
* This strategy uses the basic `eq` to compare the elements.
*
* @type Tuple(HashTable(K, V), HashTable(K,V)) -> _
*/
hashtable-eq =
hashtable-eq(eq)
/**
* Checks whether two tables have the same keys, and for each key whether
* the associated values are the same (order of keys thus doesn't matter)
*
* @param test strategy that will compare two elements upon their equality.
* @inc hashtable-eq
*
* @type Tuple(HashTable(K, V), HashTable(K,V)) -> _
*/
hashtable-eq(eq) = ?(tbl1, tbl2);
where((hashtable-keys => k*, hashtable-keys); set-eq)
; where(<map( \ key -> <eq> (<hashtable-get(|key)> tbl1, <hashtable-get(|key)> tbl2) \ )> k*)
/**
* Legacy table strategies
*/
strategies
/**
* Retrieves the primitive table-table as a Hashtable
*
*/
table-hashtable =
prim("SSL_table_hashtable"); !Hashtable(<id>)
/**
* Retrieves a named table by looking it up in the table-table.
*/
lookup-table(|name) =
table-hashtable
; ( hashtable-get(|name)
<+ where(<table-create> name); hashtable-get(|name))
/**
* Creates a table with a given name, which can be any term.
*/
table-create =
?name
; where(new-hashtable => htbl)
; where(table-hashtable; hashtable-put(|name, htbl))
/**
* Destroy a table with a given name, which can be any term.
*/
table-destroy =
?name
; where(table-hashtable
; where(lookup-table(|name)
; hashtable-destroy)
; hashtable-remove(|name)
)
/**
* Associate a value with a key in a table.
*
* E.g. <table-put> (t1, key, value) associates value with key in the t1 table.
*/
table-put =
where(
?(name,key,value)
; lookup-table(|name)
; hashtable-put(|key, value)
)
/**
* Get the value associated with a key from a table.
*
* E.g. <table-get> (t1, key) yields the value associated to key or fails in the t1 table.
*/
table-get =
?(name,key)
; lookup-table(|name)
; hashtable-get(|key)
/**
* Remove association of a key in a table.
*
* E.g. <table-remove> (t1, key) removes the entry for key from table t1.
*/
table-remove =
where(
?(name,key)
; lookup-table(|name)
; hashtable-remove(|key)
)
/**
* Produce a list of keys of a table.
*
* E.g. <table-keys>t1 produces the list of keys of table t1.
*/
table-keys =
?name
; lookup-table(|name)
; hashtable-keys
/**
* Renames a table, i.e. only the entry in the table-table is renamed,
* the table contents remain untouched.
*/
table-rename =
?(from-name, to-name)
; where(lookup-table(|from-name) => htbl)
; table-hashtable
; hashtable-put(|to-name, htbl)
; hashtable-remove(|from-name)
; !to-name
strategies
/**
* Get a list of key-value pairs.
*
* E.g. <table-getlist>t1 produces the list of (key,value) pairs in the table t1.
*/
table-getlist = ?name;
table-keys; map(\ x -> (x, <table-get> (name, x))\ )
/**
* Put a list of key-value pairs in a table.
*
* E.g. <table-putlist>(name, list) puts the (key,value) pairs in list into table t1.
*/
table-putlist = ?(name, list);
<map({x,y: ?(x, y); <table-put> (name, x, y)})> list
table-putlist(s) = ?(name, list);
<map({x,y: ?(x, y); <s> (name, x, y)})> list
table-copy = ?(name1, name2);
where(<table-putlist>(name2, <table-getlist> name1))
/*
Symbol tables that deal with scoped bindings need to be able
to store multiple bindings for the same symbol. The following
table operations can be used to maintain a stack (list)
of values for each key.
*/
strategies
table-push = ?(dis, key, val);
where(<table-put>(dis, key, [val | <table-get <+ ![]>(dis, key)]))
table-pop = ?(dis, key);
where(<table-put>(dis, key, <table-get; Tl <+ ![]>(dis, key)))
table-pop-rm = ?(dis, key);
where(
<table-get>(dis, key) => [_|xs]
< <table-put>(dis, key, xs)
+ <table-remove>(dis, key)
)
table-pop-get = ?(dis, key);
where( <table-get>(dis, key) => [val | vals]
; <table-put>(dis, key, vals)
); !val
table-lookup = ?(dis, key);
<table-get>(dis, key); Hd
table-replace = ?(dis, key, value);
where(<table-get>(dis, key) => [_|values]
; <table-put>(dis, key, [value|values])
)
table-union = ?(table, key, val);
where(<table-put> (table, key, <union> (val, <table-get <+ ![]> (table, key))))
table-diff = ?(table, key, val);
where(<table-put> (table, key, <diff> (<table-get <+ ![]> (table, key), val)))
table-append = ?(table, key, val);
where(<table-put> (table, key, <union> (<table-get <+ ![]> (table, key), val)))