1
0
Fork 0
mirror of https://github.com/ganelson/inform.git synced 2024-07-09 02:24:21 +03:00
inform7/inter/pipeline-module/Chapter 3/Kinds.w
2021-10-07 23:40:40 +01:00

500 lines
18 KiB
OpenEdge ABL

[SynopticKinds::] Kinds.
To compile the main/synoptic/kinds submodule.
@ Before this runs, kind packages are scattered all over the Inter tree.
We must allocate each one a unique ID.
As this is called, //Synoptic Utilities// has already formed a list |kind_nodes|
of packages of type |_kind|, and similarly for |derived_kind_nodes|.
=
void SynopticKinds::compile(inter_tree *I, tree_inventory *inv) {
if (TreeLists::len(inv->kind_nodes) > 0) {
TreeLists::sort(inv->kind_nodes, Synoptic::module_order);
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack = Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
inter_symbol *id_s = Metadata::read_optional_symbol(pack, I"^strong_id");
if (id_s) Inter::Symbols::set_int(id_s, i+2);
}
}
if (TreeLists::len(inv->derived_kind_nodes) > 0) {
TreeLists::sort(inv->derived_kind_nodes, Synoptic::module_order);
}
@<Define BASE_KIND_HWM@>;
@<Define DEFAULTVALUEFINDER function@>;
@<Define DEFAULTVALUEOFKOV function@>;
@<Define PRINTKINDVALUEPAIR function@>;
@<Define KOVCOMPARISONFUNCTION function@>;
@<Define KOVDOMAINSIZE function@>;
@<Define KOVISBLOCKVALUE function@>;
@<Define I7_KIND_NAME function@>;
@<Define KOVSUPPORTFUNCTION function@>;
@<Define SHOWMEKINDDETAILS function@>;
@<Define RUCKSACK_CLASS constant@>;
@<Define KINDHIERARCHY array@>;
}
@<Define BASE_KIND_HWM@> =
inter_name *iname = HierarchyLocations::find(I, BASE_KIND_HWM_HL);
Produce::numeric_constant(I, iname, K_value, (inter_ti) (TreeLists::len(inv->kind_nodes) + 2));
@<Define DEFAULTVALUEFINDER function@> =
inter_name *iname = HierarchyLocations::find(I, DEFAULTVALUEFINDER_HL);
Synoptic::begin_function(I, iname);
inter_symbol *k_s = Synoptic::local(I, I"k", NULL);
for (int i=0; i<TreeLists::len(inv->derived_kind_nodes); i++) {
inter_package *pack = Inter::Package::defined_by_frame(inv->derived_kind_nodes->list[i].node);
if (Metadata::read_numeric(pack, I"^default_value_needed")) {
inter_symbol *rks_s = Synoptic::get_symbol(pack, I"strong_id");
inter_symbol *dv_s = Synoptic::get_symbol(pack, I"default_value");
Produce::inv_primitive(I, IF_BIP);
Produce::down(I);
Produce::inv_primitive(I, EQ_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::val_symbol(I, K_value, rks_s);
Produce::up(I);
Produce::code(I);
Produce::down(I);
Produce::inv_primitive(I, RETURN_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, dv_s);
Produce::up(I);
Produce::up(I);
Produce::up(I);
}
}
Produce::rfalse(I);
Synoptic::end_function(I, iname);
@ |DefaultValueOfKOV(K)| returns the default value for kind |K|: it's needed,
for instance, when increasing the size of a list of $K$ to include new entries,
which have to be given some type-safe value to start out at.
@<Define DEFAULTVALUEOFKOV function@> =
inter_name *iname = HierarchyLocations::find(I, DEFAULTVALUEOFKOV_HL);
Synoptic::begin_function(I, iname);
inter_symbol *sk_s = Synoptic::local(I, I"sk", NULL);
inter_symbol *k_s = Synoptic::local(I, I"k", NULL);
Produce::inv_primitive(I, STORE_BIP);
Produce::down(I);
Produce::ref_symbol(I, K_value, k_s);
Produce::inv_call_iname(I, HierarchyLocations::find(I, KINDATOMIC_HL));
Produce::down(I);
Produce::val_symbol(I, K_value, sk_s);
Produce::up(I);
Produce::up(I);
Produce::inv_primitive(I, SWITCH_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::code(I);
Produce::down(I);
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack = Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
if (Metadata::read_optional_symbol(pack, I"^mkdef_fn")) {
inter_symbol *id_s = Metadata::read_symbol(pack, I"^strong_id");
inter_symbol *mkdef_fn_s = Metadata::read_symbol(pack, I"^mkdef_fn");
Produce::inv_primitive(I, CASE_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, id_s);
Produce::code(I);
Produce::down(I);
Produce::inv_primitive(I, RETURN_BIP);
Produce::down(I);
Produce::inv_call(I, mkdef_fn_s);
Produce::down(I);
Produce::val_symbol(I, K_value, sk_s);
Produce::up(I);
Produce::up(I);
Produce::up(I);
Produce::up(I);
}
}
Produce::up(I);
Produce::up(I);
Produce::rfalse(I);
Synoptic::end_function(I, iname);
@ |PrintKindValuePair(K, V)| prints out the value |V|, declaring its kind to be |K|.
@<Define PRINTKINDVALUEPAIR function@> =
inter_name *iname = HierarchyLocations::find(I, PRINTKINDVALUEPAIR_HL);
Synoptic::begin_function(I, iname);
inter_symbol *k_s = Synoptic::local(I, I"k", NULL);
inter_symbol *v_s = Synoptic::local(I, I"v", NULL);
Produce::inv_primitive(I, STORE_BIP);
Produce::down(I);
Produce::ref_symbol(I, K_value, k_s);
Produce::inv_call_iname(I, HierarchyLocations::find(I, KINDATOMIC_HL));
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::up(I);
Produce::up(I);
Produce::inv_primitive(I, SWITCH_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::code(I);
Produce::down(I);
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack = Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
if ((Metadata::read_optional_numeric(pack, I"^is_base")) &&
(Metadata::read_optional_symbol(pack, I"^print_fn")) &&
(Metadata::read_optional_numeric(pack, I"^is_subkind_of_object") == FALSE)) {
inter_symbol *id_s = Metadata::read_symbol(pack, I"^strong_id");
inter_symbol *print_fn_s = Metadata::read_symbol(pack, I"^print_fn");
Produce::inv_primitive(I, CASE_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, id_s);
Produce::code(I);
Produce::down(I);
Produce::inv_call(I, print_fn_s);
Produce::down(I);
Produce::val_symbol(I, K_value, v_s);
Produce::up(I);
Produce::up(I);
Produce::up(I);
}
}
Produce::inv_primitive(I, DEFAULT_BIP);
Produce::down(I);
Produce::code(I);
Produce::down(I);
Produce::inv_primitive(I, PRINTNUMBER_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, v_s);
Produce::up(I);
Produce::up(I);
Produce::up(I);
Produce::up(I);
Produce::up(I);
Synoptic::end_function(I, iname);
@ |KOVComparisonFunction(K)| returns either the address of a function to
perform a comparison between two values, or else 0 to signal that no
special sort of comparison is needed. (In which case signed numerical
comparison will be used.) The function |F| may be used in a sorting algorithm,
so it must have no side-effects. |F(x,y)| should return 1 if $x>y$,
0 if $x=y$ and $-1$ if $x<y$. Note that it is not permitted to return 0
unless the two values are genuinely equal.
@<Define KOVCOMPARISONFUNCTION function@> =
inter_name *iname = HierarchyLocations::find(I, KOVCOMPARISONFUNCTION_HL);
Synoptic::begin_function(I, iname);
inter_symbol *k_s = Synoptic::local(I, I"k", NULL);
Produce::inv_primitive(I, STORE_BIP);
Produce::down(I);
Produce::ref_symbol(I, K_value, k_s);
Produce::inv_call_iname(I, HierarchyLocations::find(I, KINDATOMIC_HL));
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::up(I);
Produce::up(I);
Produce::inv_primitive(I, SWITCH_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::code(I);
Produce::down(I);
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack = Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
if (Metadata::read_optional_symbol(pack, I"^cmp_fn")) {
inter_symbol *id_s = Metadata::read_symbol(pack, I"^strong_id");
inter_symbol *cmp_fn_s = Metadata::read_symbol(pack, I"^cmp_fn");
Produce::inv_primitive(I, CASE_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, id_s);
Produce::code(I);
Produce::down(I);
Produce::inv_primitive(I, RETURN_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, cmp_fn_s);
Produce::up(I);
Produce::up(I);
Produce::up(I);
}
}
Produce::up(I);
Produce::up(I);
Produce::rfalse(I);
Synoptic::end_function(I, iname);
@<Define KOVDOMAINSIZE function@> =
inter_name *iname = HierarchyLocations::find(I, KOVDOMAINSIZE_HL);
Synoptic::begin_function(I, iname);
inter_symbol *k_s = Synoptic::local(I, I"k", NULL);
Produce::inv_primitive(I, STORE_BIP);
Produce::down(I);
Produce::ref_symbol(I, K_value, k_s);
Produce::inv_call_iname(I, HierarchyLocations::find(I, KINDATOMIC_HL));
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::up(I);
Produce::up(I);
Produce::inv_primitive(I, SWITCH_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::code(I);
Produce::down(I);
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack = Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
if (Metadata::read_optional_numeric(pack, I"^domain_size")) {
inter_symbol *id_s = Metadata::read_symbol(pack, I"^strong_id");
inter_ti domain_size = Metadata::read_numeric(pack, I"^domain_size");
Produce::inv_primitive(I, CASE_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, id_s);
Produce::code(I);
Produce::down(I);
Produce::inv_primitive(I, RETURN_BIP);
Produce::down(I);
Produce::val(I, K_value, LITERAL_IVAL, domain_size);
Produce::up(I);
Produce::up(I);
Produce::up(I);
}
}
Produce::up(I);
Produce::up(I);
Produce::rfalse(I);
Synoptic::end_function(I, iname);
@ |KOVIsBlockValue(k)| is true if and only if |k| is the (strong or weak) ID of
a kind storing pointers to blocks of data.
@<Define KOVISBLOCKVALUE function@> =
inter_name *iname = HierarchyLocations::find(I, KOVISBLOCKVALUE_HL);
Synoptic::begin_function(I, iname);
inter_symbol *k_s = Synoptic::local(I, I"k", NULL);
Produce::inv_primitive(I, STORE_BIP);
Produce::down(I);
Produce::ref_symbol(I, K_value, k_s);
Produce::inv_call_iname(I, HierarchyLocations::find(I, KINDATOMIC_HL));
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::up(I);
Produce::up(I);
Produce::inv_primitive(I, SWITCH_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::code(I);
Produce::down(I);
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack = Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
if (Metadata::read_optional_numeric(pack, I"^has_block_values")) {
inter_symbol *id_s = Metadata::read_symbol(pack, I"^strong_id");
Produce::inv_primitive(I, CASE_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, id_s);
Produce::code(I);
Produce::down(I);
Produce::rtrue(I);
Produce::up(I);
Produce::up(I);
}
}
Produce::up(I);
Produce::up(I);
Produce::rfalse(I);
Synoptic::end_function(I, iname);
@<Define I7_KIND_NAME function@> =
inter_name *iname = HierarchyLocations::find(I, I7_KIND_NAME_HL);
Synoptic::begin_function(I, iname);
inter_symbol *k_s = Synoptic::local(I, I"k", NULL);
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack = Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
inter_symbol *class_s = Metadata::read_optional_symbol(pack, I"^object_class");
if (class_s) {
text_stream *pn = Metadata::read_textual(pack, I"^printed_name");
Produce::inv_primitive(I, IF_BIP);
Produce::down(I);
Produce::inv_primitive(I, EQ_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::val_symbol(I, K_value, class_s);
Produce::up(I);
Produce::code(I);
Produce::down(I);
Produce::inv_primitive(I, PRINT_BIP);
Produce::down(I);
Produce::val_text(I, pn);
Produce::up(I);
Produce::up(I);
Produce::up(I);
}
}
Synoptic::end_function(I, iname);
@ |KOVSupportFunction(K)| returns the address of the specific support function
for a pointer-value kind |K|, or returns 0 if |K| is not such a kind. For what
such a function does, see "BlockValues.i6t".
@<Define KOVSUPPORTFUNCTION function@> =
inter_name *iname = HierarchyLocations::find(I, KOVSUPPORTFUNCTION_HL);
Synoptic::begin_function(I, iname);
inter_symbol *k_s = Synoptic::local(I, I"k", NULL);
inter_symbol *fail_s = Synoptic::local(I, I"fail", NULL);
Produce::inv_primitive(I, STORE_BIP);
Produce::down(I);
Produce::ref_symbol(I, K_value, k_s);
Produce::inv_call_iname(I, HierarchyLocations::find(I, KINDATOMIC_HL));
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::up(I);
Produce::up(I);
Produce::inv_primitive(I, SWITCH_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, k_s);
Produce::code(I);
Produce::down(I);
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack = Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
if (Metadata::read_optional_numeric(pack, I"^has_block_values")) {
inter_symbol *id_s = Metadata::read_symbol(pack, I"^strong_id");
inter_symbol *support_s = Metadata::read_symbol(pack, I"^support_fn");
Produce::inv_primitive(I, CASE_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, id_s);
Produce::code(I);
Produce::down(I);
Produce::inv_primitive(I, RETURN_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, support_s);
Produce::up(I);
Produce::up(I);
Produce::up(I);
}
}
Produce::up(I);
Produce::up(I);
Produce::inv_primitive(I, IF_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, fail_s);
Produce::code(I);
Produce::down(I);
Produce::inv_call_iname(I, HierarchyLocations::find(I, BLKVALUEERROR_HL));
Produce::down(I);
Produce::val_symbol(I, K_value, fail_s);
Produce::up(I);
Produce::up(I);
Produce::up(I);
Produce::rfalse(I);
Synoptic::end_function(I, iname);
@<Define SHOWMEKINDDETAILS function@> =
inter_name *iname = HierarchyLocations::find(I, SHOWMEKINDDETAILS_HL);
Synoptic::begin_function(I, iname);
inter_symbol *which_s = Synoptic::local(I, I"which", NULL);
inter_symbol *na_s = Synoptic::local(I, I"na", NULL);
inter_symbol *t_0_s = Synoptic::local(I, I"t_0", NULL);
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack = Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
if (Metadata::read_optional_numeric(pack, I"^is_object")) {
inter_symbol *showme_s = Metadata::read_optional_symbol(pack, I"^showme_fn");
if (showme_s) {
Produce::inv_primitive(I, STORE_BIP);
Produce::down(I);
Produce::ref_symbol(I, K_value, na_s);
Produce::inv_call(I, showme_s);
Produce::down(I);
Produce::val_symbol(I, K_value, which_s);
Produce::val_symbol(I, K_value, na_s);
Produce::val_symbol(I, K_value, t_0_s);
Produce::up(I);
Produce::up(I);
}
}
}
Produce::inv_primitive(I, RETURN_BIP);
Produce::down(I);
Produce::val_symbol(I, K_value, na_s);
Produce::up(I);
Synoptic::end_function(I, iname);
@ This goes right back to a curious feature of Inform 1, in 1993. To enable
the use of player's holdalls, we must declare a constant |RUCKSACK_CLASS| to
tell some code in |WorldModelKit| to use possessions with this Inter class as
the rucksack pro tem. This is all a bit of a hack, and isn't really fully
general: only the player has the benefit of a "player's holdall" (hence the
name), with other actors oblivious.
@<Define RUCKSACK_CLASS constant@> =
inter_name *iname = HierarchyLocations::find(I, RUCKSACK_CLASS_HL);
int found = FALSE;
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack =
Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
if (Metadata::read_optional_numeric(pack, I"^rucksack_class")) {
inter_symbol *value_s = Metadata::read_symbol(pack, I"^object_class");
Produce::symbol_constant(I, iname, K_value, value_s);
found = TRUE;
break;
}
}
if (found == FALSE) Produce::numeric_constant(I, iname, K_value, 0);
@ The kind inheritance tree is represented by an array providing metadata on
the kinds of object: there are just two words per kind -- the class, then
the instance count for its own kind. For instance, "door" is usually
kind number 4, so it occupies record 4 in this array -- words 8 and 9. Word
8 will be |K4_door|, the Inform 6 class for doors, and word 9 will be the
number 2, meaning kind number 2, "thing". This tells us that a door is
a kind of thing.
@<Define KINDHIERARCHY array@> =
linked_list *L = NEW_LINKED_LIST(inter_symbol);
for (int i=0; i<TreeLists::len(inv->kind_nodes); i++) {
inter_package *pack =
Inter::Package::defined_by_frame(inv->kind_nodes->list[i].node);
if (Metadata::read_optional_numeric(pack, I"^is_subkind_of_object")) {
inter_symbol *kind_name = Metadata::read_symbol(pack, I"^object_class");
ADD_TO_LINKED_LIST(kind_name, inter_symbol, L);
}
}
inter_symbol **ordered = VanillaObjects::sorted_array(L, VanillaObjects::in_source_order);
for (int i=0; i<LinkedLists::len(L); i++) {
inter_symbol *kind_name = ordered[i];
Inter::Symbols::annotate_i(kind_name, OBJECT_KIND_COUNTER_IANN, (inter_ti) i+1);
}
inter_name *iname = HierarchyLocations::find(I, KINDHIERARCHY_HL);
Synoptic::begin_array(I, iname);
if (LinkedLists::len(L) > 0) {
Synoptic::symbol_entry(object_kind_symbol);
Synoptic::numeric_entry(0);
for (int i=0; i<LinkedLists::len(L); i++) {
inter_symbol *kind_name = ordered[i];
inter_package *pack = Inter::Packages::container(kind_name->definition);
// inter_symbol *kind_name = Metadata::read_symbol(pack, I"^object_class");
Synoptic::symbol_entry(kind_name);
// inter_symbol *super_name = Metadata::read_optional_symbol(pack, I"^superkind");
inter_symbol *super_name = Inter::Kind::super(kind_name);
if ((super_name) && (super_name != object_kind_symbol)) {
Synoptic::numeric_entry(SynopticKinds::kind_of_object_count(super_name));
} else {
Synoptic::numeric_entry(0);
}
}
} else {
Synoptic::numeric_entry(0);
Synoptic::numeric_entry(0);
}
Synoptic::end_array(I);
@
=
inter_ti SynopticKinds::kind_of_object_count(inter_symbol *kind_name) {
if ((kind_name == NULL) || (kind_name == object_kind_symbol)) return 0;
int N = Inter::Symbols::read_annotation(kind_name, OBJECT_KIND_COUNTER_IANN);
if (N >= 0) return (inter_ti) N;
return 0;
}