## stampmapstack.pkg
#
# In the early phases of the compiler we track
# variables, functions, types etc by assigning
# them symbols which we store in symbolmapstacks.
# These 'symbols' correspond directly to user
# identifiers appearing in the source code. See:
#
# src/lib/compiler/front/basics/map/symbol.pkg# src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg#
# In the later phases of the compiler, as we simplify
# and abstract away from the sourcecode, we in essence
# switch from *naming* things to *numbering* them.
#
# Instead of looking up symbols in symbolmapstacks
# we look up stamps in stampmapstacks, where 'stamps'
# are in essence small integers sequentially assigned
# starting at zero whose only property of interest is
# uniqueness -- being unequal to all other stamps of
# interest.
#
# See also:
# src/lib/compiler/front/typer-stuff/basics/stamp.pkg# Compiled by:
# src/lib/compiler/front/typer-stuff/typecheckdata.sublib# stampmapstack instances are defined here and created by
#
# collect_all_modtrees_in_symbolmapstack
# in
# src/lib/compiler/front/typer-stuff/symbolmapstack/collect-all-modtrees-in-symbolmapstack.pkg#
# based on the Modtree instances defined in
#
# src/lib/compiler/front/typer-stuff/modules/module-level-declarations.api#
# and placed in symbol tables during unpickling in
#
# src/lib/compiler/front/semantic/pickle/unpickler-junk.pkg #
# The idea is that Modtree instances are compact
# and self-sufficient, hence low-maintenance to
# keep around, whereas stampmapstack instances are what
# we really want for module dependency analysis and
# such: By storing Modtree instances in our
# symbol tables and then generating stampmapstacks
# from them on the fly as needed (afterward promptly
# discarding them) we get the best of both worlds.
stipulate
package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkgherein
api Stampmapstack {
#
Typestamp; # stamppath-context
Apistamp; #
Packagestamp; # stamppath-context
Genericstamp; # stamppath-context
Typerstorestamp; #
typestamp_of: tdt::Sumtype_Record -> Typestamp; # collect-all-modtrees-in-symbolmapstack pickler-junk module-stuff type-api type-package-language-g expand-generic-g
apistamp_of: mld::Api_Record -> Apistamp; # collect-all-modtrees-in-symbolmapstack pickler-junk
packagestamp_of: mld::Package_Record -> Packagestamp; # collect-all-modtrees-in-symbolmapstack module-stuff type-api type-package-language-g expand-generic-g
genericstamp_of: mld::Generic_Record -> Genericstamp; # collect-all-modtrees-in-symbolmapstack module-stuff type-package-language-g
typerstorestamp_of: mld::Typerstore_Record -> Typerstorestamp; # collect-all-modtrees-in-symbolmapstack
make_packagestamp: (mld::Api_Record, mld::Typechecked_Package) -> Packagestamp; # module-stuff type-package-language-g
make_genericstamp: (mld::Generic_Api, mld::Typechecked_Generic) -> Genericstamp; # module-stuff type-package-language-g
# same_typestamp: (Typestamp, Typestamp) -> Bool; #
# same_apistamp: (Apistamp, Apistamp) -> Bool; #
# same_packagestamp: (Packagestamp, Packagestamp) -> Bool; #
# same_genericstamp: (Genericstamp, Genericstamp) -> Bool; #
# same_typerstorestamp: (Typerstorestamp, Typerstorestamp) -> Bool; #
typestamp_is_fresh: Typestamp -> Bool; # pickler-junk
apistamp_is_fresh: Apistamp -> Bool; # pickler-junk
packagestamp_is_fresh: Packagestamp -> Bool; # pickler-junk
genericstamp_is_fresh: Genericstamp -> Bool; # pickler-junk
typerstorestamp_is_fresh: Typerstorestamp -> Bool; # pickler-junk
typestamp_of' : tdt::Type -> Typestamp; # pickler-junk module-stuff type-package-language-g
Stampmapstack; # freezefile-g freezefile-roster-g collect-all-modtrees-in-symbolmapstack pickler unpickler stamppath-context
empty_stampmapstack: Stampmapstack; # freezefile-g freezefile-roster-g collect-all-modtrees-in-symbolmapstack base-types-and-ops-symbolmapstack
find_sumtype_record_by_typestamp: (Stampmapstack, Typestamp) -> Null_Or( tdt::Sumtype_Record ); # pickler-junk unpickler-junk
find_api_record_by_apistamp: (Stampmapstack, Apistamp) -> Null_Or( mld::Api_Record ); # collect-all-modtrees-in-symbolmapstack pickler-junk unpickler-junk
find_typechecked_package_by_packagestamp: (Stampmapstack, Packagestamp) -> Null_Or( mld::Typechecked_Package); # collect-all-modtrees-in-symbolmapstack pickler-junk unpickler-junk
find_typechecked_generic_by_genericstamp: (Stampmapstack, Genericstamp) -> Null_Or( mld::Typechecked_Generic); # collect-all-modtrees-in-symbolmapstack pickler-junk unpickler-junk
find_typerstore_record_by_typerstorestamp: (Stampmapstack, Typerstorestamp) -> Null_Or( mld::Typerstore_Record ); # collect-all-modtrees-in-symbolmapstack pickler-junk unpickler-junk
enter_sumtype_record_by_typestamp: (Stampmapstack, Typestamp, tdt::Sumtype_Record ) -> Stampmapstack; # collect-all-modtrees-in-symbolmapstack
enter_api_record_by_apistamp: (Stampmapstack, Apistamp, mld::Api_Record ) -> Stampmapstack; # collect-all-modtrees-in-symbolmapstack
enter_typechecked_package_by_packagestamp: (Stampmapstack, Packagestamp, mld::Typechecked_Package) -> Stampmapstack; # collect-all-modtrees-in-symbolmapstack
enter_typechecked_generic_by_genericstamp: (Stampmapstack, Genericstamp, mld::Typechecked_Generic) -> Stampmapstack; # collect-all-modtrees-in-symbolmapstack
enter_typerstore_record_by_typerstorestamp: (Stampmapstack, Typerstorestamp, mld::Typerstore_Record) -> Stampmapstack; # collect-all-modtrees-in-symbolmapstack
# Here we re-export the above ten functions, this
# time in type-agnostic (X) instead of typelocked form:
Stampmapstackx(X); # pickler-junk stamppath-context
stampmapstackx: Stampmapstackx(X); # pickler-junk stamppath-context
find_x_by_typestamp: (Stampmapstackx(X), Typestamp ) -> Null_Or(X); # pickler-junk stamppath-context
find_x_by_apistamp: (Stampmapstackx(X), Apistamp ) -> Null_Or(X); # pickler-junk
find_x_by_packagestamp: (Stampmapstackx(X), Packagestamp ) -> Null_Or(X); # pickler-junk stamppath-context
find_x_by_genericstamp: (Stampmapstackx(X), Genericstamp ) -> Null_Or(X); # pickler-junk stamppath-context
find_x_by_typerstorestamp: (Stampmapstackx(X), Typerstorestamp) -> Null_Or(X); # pickler-junk
enter_x_by_typestamp: (Stampmapstackx(X), Typestamp, X) -> Stampmapstackx(X); # pickler-junk stamppath-context
enter_x_by_apistamp: (Stampmapstackx(X), Apistamp, X) -> Stampmapstackx(X); # pickler-junk
enter_x_by_packagestamp: (Stampmapstackx(X), Packagestamp, X) -> Stampmapstackx(X); # pickler-junk stamppath-context
enter_x_by_genericstamp: (Stampmapstackx(X), Genericstamp, X) -> Stampmapstackx(X); # pickler-junk stamppath-context
enter_x_by_typerstorestamp: (Stampmapstackx(X), Typerstorestamp, X) -> Stampmapstackx(X); # pickler-junk
}; # Api Stampmapstack
end;
stipulate
package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg package sta = stamp; # stamp is from src/lib/compiler/front/typer-stuff/basics/stamp.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkgherein
package stampmapstack
: (weak) Stampmapstack # Stampmapstack is from src/lib/compiler/front/typer-stuff/modules/stampmapstack.pkg {
fun bug m
=
err::impossible ("stampmapstack: " + m);
Stamp = sta::Stamp;
Typestamp = Stamp;
Apistamp = Stamp;
Typerstorestamp = Stamp;
Packagestamp
=
{ an_api: Stamp,
typechecked_package: Stamp
};
Genericstamp
=
{ parameter_api: Stamp,
body_api: Stamp,
typechecked_generic: Stamp
};
typestamp_is_fresh = sta::is_fresh;
apistamp_is_fresh = sta::is_fresh;
typerstorestamp_is_fresh = sta::is_fresh;
fun packagestamp_is_fresh { an_api, typechecked_package }
=
sta::is_fresh an_api
or
sta::is_fresh typechecked_package;
fun genericstamp_is_fresh { parameter_api, body_api, typechecked_generic }
=
sta::is_fresh parameter_api
or
sta::is_fresh body_api
or
sta::is_fresh typechecked_generic;
fun typestamp_of (r: tdt::Sumtype_Record) = r.stamp;
fun apistamp_of (s: mld::Api_Record ) = s.stamp;
fun make_packagestamp ( an_api: mld::Api_Record,
typechecked_package: mld::Typechecked_Package
)
=
{ an_api => an_api.stamp,
typechecked_package => typechecked_package.stamp
};
fun packagestamp_of ( { an_api => mld::API api_record,
typechecked_package,
...
}: mld::Package_Record
)
=>
{ an_api => api_record.stamp,
typechecked_package => typechecked_package.stamp
};
packagestamp_of _
=>
bug "packagestamp_of: bad api";
end;
fun make_genericstamp ( mld::GENERIC_API { parameter_api => mld::API parameter_api,
body_api => mld::API body_api,
...
},
typechecked_generic: mld::Typechecked_Generic
)
=>
{ parameter_api => parameter_api.stamp,
body_api => body_api.stamp,
typechecked_generic => typechecked_generic.stamp
};
make_genericstamp _
=>
bug "make_genericstamp/genericStamp2: bad funsig";
end;
fun genericstamp_of ( { a_generic_api, typechecked_generic, ... }: mld::Generic_Record)
=
make_genericstamp ( a_generic_api, typechecked_generic );
fun typerstorestamp_of (typerstore: mld::Typerstore_Record)
=
typerstore.stamp;
package packagestamp_key {
#
Key = Packagestamp;
fun compare ( i1: Packagestamp,
i2: Packagestamp
)
=
case (sta::compare (i1.an_api, i2.an_api))
#
EQUAL => sta::compare (i1.typechecked_package, i2.typechecked_package);
unequal => unequal;
esac;
};
package genericstamp_key {
#
Key = Genericstamp;
fun compare ( i1: Genericstamp,
i2: Genericstamp
)
=
case (sta::compare (
i1.parameter_api,
i2.parameter_api
))
#
EQUAL =>
case (sta::compare (
i1.body_api,
i2.body_api
))
EQUAL => sta::compare ( i1.typechecked_generic,
i2.typechecked_generic
);
#
unequal => unequal;
esac;
#
unequal => unequal;
esac;
};
# red_black_map_g is from src/lib/src/red-black-map-g.pkg package stamp_map = red_black_map_g( sta );
package packagestamp_map = red_black_map_g( packagestamp_key );
package genericstamp_map = red_black_map_g( genericstamp_key );
# same_typestamp = sta::same_stamp;
# same_apistamp = sta::same_stamp;
# fun same_packagestamp (x, y) = packagestamp_key::compare (x, y) == EQUAL;
# fun same_genericstamp (x, y) = genericstamp_key::compare (x, y) == EQUAL;
# same_typerstorestamp = sta::same_stamp;
Stampmapstack
=
{ type_map: stamp_map::Map( tdt::Sumtype_Record ),
api_map: stamp_map::Map( mld::Api_Record ),
package_map: packagestamp_map::Map( mld::Typechecked_Package ),
generic_map: genericstamp_map::Map( mld::Typechecked_Generic ),
typerstore_map: stamp_map::Map( mld::Typerstore_Record )
};
empty_stampmapstack
=
{ type_map => stamp_map::empty,
api_map => stamp_map::empty,
package_map => packagestamp_map::empty,
generic_map => genericstamp_map::empty,
typerstore_map => stamp_map::empty
};
stipulate
fun find
( selector, # One of: .type_map | .api_map | .package_map | .generic_map | .typerstore_map
get # One of: stamp_map::get | packagestamp_map::get | generic_map::get
)
#
( maps as { type_map, api_map, package_map, generic_map, typerstore_map },
key
)
=
get (selector maps, key);
herein
fun find_sumtype_record_by_typestamp maps_and_key = find (.type_map, stamp_map::get) maps_and_key;
fun find_api_record_by_apistamp maps_and_key = find (.api_map, stamp_map::get) maps_and_key;
fun find_typechecked_package_by_packagestamp maps_and_key = find (.package_map, packagestamp_map::get) maps_and_key;
fun find_typechecked_generic_by_genericstamp maps_and_key = find (.generic_map, genericstamp_map::get) maps_and_key;
fun find_typerstore_record_by_typerstorestamp maps_and_key = find (.typerstore_map, stamp_map::get) maps_and_key;
end;
fun enter_sumtype_record_by_typestamp
(
{ type_map, api_map, package_map, generic_map, typerstore_map }, # : Stampmapstack | Stampmapstackx(X),
typestamp : Typestamp,
sumtype_record # : tdt::Sumtype_Record | X
)
=
{ type_map => stamp_map::set (type_map, typestamp, sumtype_record),
api_map,
package_map,
generic_map,
typerstore_map
};
fun enter_api_record_by_apistamp ( { type_map, api_map, package_map, generic_map, typerstore_map }, k, t)
=
{ api_map => stamp_map::set (api_map, k, t),
type_map,
package_map,
generic_map,
typerstore_map
};
fun enter_typechecked_package_by_packagestamp ( { type_map, api_map, package_map, generic_map, typerstore_map }, k, t)
=
{ package_map => packagestamp_map::set (package_map, k, t),
type_map,
api_map,
generic_map,
typerstore_map
};
fun enter_typechecked_generic_by_genericstamp ( { type_map, api_map, package_map, generic_map, typerstore_map }, k, t)
=
{ generic_map => genericstamp_map::set (generic_map, k, t),
type_map,
api_map,
package_map,
typerstore_map
};
fun enter_typerstore_record_by_typerstorestamp ( { type_map, api_map, package_map, generic_map, typerstore_map }, k, t)
=
{ typerstore_map => stamp_map::set (typerstore_map, k, t),
type_map,
api_map,
package_map,
generic_map
};
fun typestamp_of' (tdt::SUM_TYPE sumtype_record) => typestamp_of sumtype_record;
typestamp_of' (tdt::NAMED_TYPE { stamp, ... } ) => stamp;
typestamp_of' _ => bug "typestamp_of': neither tdt::SUM_TYPE nor tdt::NAMED_TYPE";
end;
# And now for uniformly typed maps (implementations are shared)...
Stampmapstackx(X)
=
{ type_map: stamp_map::Map(X),
api_map: stamp_map::Map(X),
package_map: packagestamp_map::Map(X),
generic_map: genericstamp_map::Map(X),
typerstore_map: stamp_map::Map(X)
};
stampmapstackx
=
empty_stampmapstack;
find_x_by_typestamp = find_sumtype_record_by_typestamp;
find_x_by_apistamp = find_api_record_by_apistamp;
find_x_by_packagestamp = find_typechecked_package_by_packagestamp;
find_x_by_genericstamp = find_typechecked_generic_by_genericstamp;
find_x_by_typerstorestamp = find_typerstore_record_by_typerstorestamp;
enter_x_by_typestamp = enter_sumtype_record_by_typestamp;
enter_x_by_apistamp = enter_api_record_by_apistamp;
enter_x_by_packagestamp = enter_typechecked_package_by_packagestamp;
enter_x_by_genericstamp = enter_typechecked_generic_by_genericstamp;
enter_x_by_typerstorestamp = enter_typerstore_record_by_typerstorestamp;
}; # package stampmapstack
end; # stipulate