## typerstore.pkg
# Compiled by:
# src/lib/compiler/front/typer-stuff/typecheckdata.sublibstipulate
package mp = stamppath; # stamppath is from src/lib/compiler/front/typer-stuff/modules/stamppath.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 ed = stamppath::module_stamp_map;
herein
package typerstore
: (weak) Typerstore # Typerstore is from src/lib/compiler/front/typer-stuff/modules/typerstore.api {
say = control_print::say;
debugging = typer_data_controls::typerstore_debugging; # eval: set_control "ed::typerstore_debugging" "TRUE";
fun if_debugging_say (msg: String)
=
if *debugging
#
say msg;
say "\n";
fi;
fun bug msg
=
error_message::impossible("typerstore: " + msg);
# Module_Stamp = mp::Module_Stamp;
Stamppath = mp::Stamppath;
Typerstore = mld::Typerstore;
exception UNBOUND;
empty = mld::NULL_TYPERSTORE;
fun mark (_, e as mld::MARKED_TYPERSTORE _) => e;
mark (_, e as mld::NULL_TYPERSTORE) => e;
mark (_, e as mld::ERRONEOUS_ENTRY_DICTIONARY) => e;
mark (make_stamp, typerstore)
=>
mld::MARKED_TYPERSTORE {
stamp => make_stamp(),
stub => NULL,
typerstore
};
end;
fun set (mld::NAMED_TYPERSTORE (d, dictionary), v, e) => mld::NAMED_TYPERSTORE (ed::set (d, v, e), dictionary);
set (dictionary, v, e) => mld::NAMED_TYPERSTORE (ed::set (ed::empty, v, e), dictionary);
end;
fun atop (_, mld::ERRONEOUS_ENTRY_DICTIONARY) => mld::ERRONEOUS_ENTRY_DICTIONARY;
atop (mld::ERRONEOUS_ENTRY_DICTIONARY, _) => mld::ERRONEOUS_ENTRY_DICTIONARY;
atop (e1, mld::NULL_TYPERSTORE) => e1;
atop (mld::MARKED_TYPERSTORE { typerstore, ... }, e2) => atop (typerstore, e2);
atop (mld::NAMED_TYPERSTORE (d, e1), e2) => mld::NAMED_TYPERSTORE (d, atop (e1, e2));
atop (mld::NULL_TYPERSTORE, e2) => e2;
end;
fun atop_sp (_, mld::ERRONEOUS_ENTRY_DICTIONARY ) => mld::ERRONEOUS_ENTRY_DICTIONARY;
atop_sp (mld::ERRONEOUS_ENTRY_DICTIONARY, _ ) => mld::ERRONEOUS_ENTRY_DICTIONARY;
atop_sp (e1, mld::NULL_TYPERSTORE ) => e1;
atop_sp (mld::MARKED_TYPERSTORE { typerstore, ... }, e2) => atop_sp (typerstore, e2);
atop_sp (mld::NAMED_TYPERSTORE (d, e1), e2) => atop_merge (d, atop (e1, e2));
atop_sp (mld::NULL_TYPERSTORE, e2) => e2;
end
also
fun atop_merge (d, mld::NULL_TYPERSTORE) => mld::NAMED_TYPERSTORE (d, mld::NULL_TYPERSTORE);
atop_merge (d, mld::NAMED_TYPERSTORE (d', e)) => mld::NAMED_TYPERSTORE (ed::union_with #1 (d, d'), e);
atop_merge (d, mld::MARKED_TYPERSTORE { typerstore, ... } ) => atop_merge (d, typerstore);
atop_merge (d, mld::ERRONEOUS_ENTRY_DICTIONARY) => mld::ERRONEOUS_ENTRY_DICTIONARY;
end;
fun to_list (mld::MARKED_TYPERSTORE { typerstore, ... } )
=>
to_list typerstore;
to_list (mld::NAMED_TYPERSTORE (d, ee)) # ed::fold((op . ), toList ee, d)
=>
ed::keyed_fold_backward
(\\ (key, value, base) = (key, value) ! base)
(to_list ee)
d;
to_list mld::NULL_TYPERSTORE => NIL;
to_list mld::ERRONEOUS_ENTRY_DICTIONARY => NIL;
end;
fun find_entry_by_module_stamp (dictionary, module_stamp)
=
scan dictionary
where
fun scan (mld::MARKED_TYPERSTORE { typerstore, ... } )
=>
scan typerstore;
scan (mld::NAMED_TYPERSTORE (d, rest))
=>
{
if_debugging_say ("find_entry_b_module_stamp/mld::NAMED_TYPERSTORE (d, rest) calling ed::get: src/lib/compiler/front/typer-stuff/modules/typerstore.pkg"); result =
case (ed::get (d, module_stamp))
THE e => e;
NULL => scan rest;
esac;
if_debugging_say ("find_entry_b_module_stamp/mld::NAMED_TYPERSTORE (d, rest) back from ed::get: src/lib/compiler/front/typer-stuff/modules/typerstore.pkg"); result;
};
scan mld::ERRONEOUS_ENTRY_DICTIONARY
=>
mld::ERRONEOUS_ENTRY;
scan mld::NULL_TYPERSTORE
=>
{
if_debugging_say ("didn't find " + mp::module_stamp_to_string module_stamp + ": find_entry_by_module_stamp: src/lib/compiler/front/typer-stuff/modules/typerstore.pkg");
raise exception UNBOUND;
};
end;
end;
fun find_package_by_module_stamp (typerstore, module_stamp)
=
case (find_entry_by_module_stamp (typerstore, module_stamp))
#
mld::PACKAGE_ENTRY ent => ent;
mld::ERRONEOUS_ENTRY => mld::bogus_typechecked_package;
_ => bug "find_package_by_module_stamp";
esac;
fun find_type_by_module_stamp (typerstore, module_stamp)
=
case (find_entry_by_module_stamp (typerstore, module_stamp))
#
mld::TYPE_ENTRY ent => ent;
mld::ERRONEOUS_ENTRY => tdt::ERRONEOUS_TYPE;
_ => bug "find_type_by_module_stamp";
esac;
fun find_generic_by_module_stamp (typerstore, module_stamp)
=
case (find_entry_by_module_stamp (typerstore, module_stamp))
#
mld::GENERIC_ENTRY ent => ent;
mld::ERRONEOUS_ENTRY => mld::bogus_typechecked_generic;
_ => bug "find_generic_by_module_stamp";
esac;
fun find_entry_via_stamppath (typerstore, [])
=>
bug "find_entry_via_stamppath.1";
find_entry_via_stamppath (typerstore, [v])
=>
{
if_debugging_say ("find_entry_via_stamppath/[v] calling find_entry_by_module_stamp: src/lib/compiler/front/typer-stuff/modules/typerstore.pkg"); result =
find_entry_by_module_stamp (typerstore, v);
if_debugging_say ("find_entry_via_stamppath/[v] BACK from find_entry_by_module_stamp: src/lib/compiler/front/typer-stuff/modules/typerstore.pkg"); result;
};
find_entry_via_stamppath (typerstore, stamppath as (v ! rest))
=>
case (find_entry_by_module_stamp (typerstore, v))
#
mld::PACKAGE_ENTRY { typerstore, ... }
=>
find_entry_via_stamppath (typerstore, rest);
mld::ERRONEOUS_ENTRY
=>
mld::ERRONEOUS_ENTRY;
entity
=>
{ say "find_typechecked_package.1: expected PACKAGE_ENTRY\n";
say "found entity: ";
case entity
#
mld::TYPE_ENTRY _ => say "TYPE_ENTRY\n";
mld::GENERIC_ENTRY _ => say "GENERIC_ENTRY\n";
_ => say "ERRONEOUS_ENTRY\n";
esac;
say "stamppath: "; say (mp::stamppath_to_string (stamppath)); say "\n";
bug "findMacroExpansionViaMacroExpansionPath.2";};
esac;
end;
fun find_type_via_stamppath (typerstore, stamppath)
=
{
if_debugging_say ("find_type_via_stamppath calling find_entry_via_stamppath: src/lib/compiler/front/typer-stuff/modules/typerstore.pkg"); result =
case (find_entry_via_stamppath (typerstore, stamppath))
#
mld::TYPE_ENTRY type => type;
mld::ERRONEOUS_ENTRY => tdt::ERRONEOUS_TYPE;
_ => bug "find_type_via_stamppath: wrong entity";
esac;
if_debugging_say ("find_type_via_stamppath back from find_entry_via_stamppath: src/lib/compiler/front/typer-stuff/modules/typerstore.pkg"); result;
};
fun find_package_via_stamppath (typerstore, stamppath)
=
case (find_entry_via_stamppath (typerstore, stamppath))
#
mld::PACKAGE_ENTRY typechecked_package => typechecked_package;
mld::ERRONEOUS_ENTRY => mld::bogus_typechecked_package;
_ => bug "find_package_via_stamppath: wrong entity";
esac;
fun find_generic_via_stamppath (typerstore, stamppath)
=
case (find_entry_via_stamppath (typerstore, stamppath))
#
mld::GENERIC_ENTRY typechecked_package => typechecked_package;
mld::ERRONEOUS_ENTRY => mld::bogus_typechecked_generic;
_ => bug "find_generic_via_moudle_path: wrong entity";
esac;
}; # package typerstore
end; # stipulate ... in ...