# adl-mapstack.pkg
#
# Another implementation of pushdown-stack of key-val maps.
# (These are used to track syntactic scopes, pushing a new
# map when we enter a scope and popping it when we leave.)
#
# This gets used in:
# src/lib/compiler/back/low/tools/arch/adl-symboltable.pkg# Compiled by:
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.lib### "It is better wither to be silent, or to
### say things of more value than silence.
### Sooner throw a pearl at hazard than
### an idle or useless word; and do not say
### a little in many words, but a great deal in a few."
###
### -- Pythagoras
api Adl_Mapstack {
#
Mapstack(X);
exception SYMBOLTABLE;
symboltable: String -> Mapstack(X);
envir: String -> Ref(Mapstack(X));
#
get: Mapstack(X) -> String -> X;
lookup: Ref(Mapstack(X)) -> String -> X;
#
get' : Mapstack(X) -> X -> String -> X;
put: Mapstack(X) -> (String, X) -> Mapstack(X);
#
set: Ref(Mapstack(X)) -> (String, X) -> Void;
#
apply: ((String, X) -> Void) -> Mapstack(X) -> Void;
map: ((String, X) -> Y) -> Mapstack(X) -> List(Y);
fold: ((String, X, Y) -> Y) -> Y -> Mapstack(X) -> Y;
#
union: (Mapstack(X), Mapstack(X)) -> Mapstack(X);
unions: List( Mapstack(X) ) -> Mapstack(X);
#
empty: Mapstack(X);
#
bind: (String, X) -> Mapstack(X);
consolidate: Mapstack(X) -> Mapstack(X);
};
stipulate
package h = hashtable;
herein
package adl_mapstack
: Adl_Mapstack
{
#
Mapstack(X)
#
= EMPTY
| TABLE (h::Hashtable (String,X))
| OVERRIDE (Mapstack(X), Mapstack(X))
| NAMING (String, X)
;
exception SYMBOLTABLE;
fun symboltable name = EMPTY;
fun envir name = REF EMPTY;
empty = EMPTY;
fun get (NAMING (k, v)) x => if (x == k) v; else raise exception SYMBOLTABLE; fi;
get (OVERRIDE (a, b)) x => get b x except _ = get a x; # Should this be get a x except _ = get b x; ? If not, why not? 2011-05-05 CrT
get (TABLE t) x => h::look_up t x;
#
get EMPTY _ => raise exception SYMBOLTABLE;
end;
fun get' symboltable default x
=
get symboltable x
except
_ = default;
fun lookup (REF symboltable) x
=
get symboltable x;
fun union (a, EMPTY) => a;
union (EMPTY, b) => b;
union (a, b) => OVERRIDE (a, b);
end;
fun put symboltable x = union (symboltable, NAMING x);
fun set symboltable x = symboltable := put *symboltable x;
fun flatten symboltable
=
{ t = h::make_hashtable (hash_string::hash_string, (==)) { size_hint => 13, not_found_exception => SYMBOLTABLE };
#
put = h::set t;
f symboltable
where
fun f EMPTY => ();
f (NAMING x) => put x;
f (OVERRIDE (a, b)) => { f a; f b; };
f (TABLE t) => h::keyed_apply put t;
end;
end;
t;
};
fun apply f symboltable
=
h::keyed_apply f (flatten symboltable);
fun map f symboltable
=
list::map f (h::keyvals_list (flatten symboltable));
fun fold f x symboltable
=
h::foldi f x (flatten symboltable);
fun unions dicts
=
fold_backward union EMPTY dicts;
fun consolidate symboltable
=
TABLE (flatten symboltable);
bind = NAMING;
};
end;