Kind Commands

To apply a given command to a given kind constructor.

§1.

void KindCommands::apply(single_kind_command stc, kind_constructor *con) {
    if (stc.completed) return;
    LOGIF(KIND_CREATIONS, "apply: %s (%d/%d/%S/%S) to %d/%S\n",
        stc.which_kind_command->text_of_command,
        stc.boolean_argument, stc.numeric_argument,
        stc.textual_argument, stc.constructor_argument,
        con->allocation_id, con->explicit_identifier);

    int tcc = stc.which_kind_command->opcode_number;

    Apply kind macros or transcribe kind templates on request1.1;

    Most kind commands simply set a field in the constructor structure1.2;
    A few kind commands contribute to linked lists in the constructor structure1.3;
    And the rest fill in fields in the constructor structure in miscellaneous other ways1.4;

    TEMPORARY_TEXT(cmd)
    WRITE_TO(cmd, "%s", stc.which_kind_command->text_of_command);
    NeptuneFiles::error(cmd, I"unimplemented kind command", stc.origin);
    DISCARD_TEXT(cmd)
}

§1.1. Apply kind macros or transcribe kind templates on request1.1 =

    switch (tcc) {
        case invent_source_text_KCC:
            StarTemplates::note(stc.template_argument, con, stc.origin);
            return;
        case apply_macro_KCC:
            NeptuneMacros::play_back(stc.macro_argument, con, stc.origin);
            return;
    }

This code is used in §1.

§1.2.

define SET_BOOLEAN_FIELD(field) case field##_KCC: con->field = stc.boolean_argument; return;
define SET_INTEGER_FIELD(field) case field##_KCC: con->field = stc.numeric_argument; return;
define SET_TEXTUAL_FIELD(field) case field##_KCC: con->field = Str::duplicate(stc.textual_argument); return;
define SET_CCM_FIELD(field) case field##_KCC: con->field = stc.ccm_argument; return;

Most kind commands simply set a field in the constructor structure1.2 =

    switch (tcc) {
        SET_BOOLEAN_FIELD(can_coincide_with_property)
        SET_BOOLEAN_FIELD(can_exchange)
        SET_BOOLEAN_FIELD(indexed_grey_if_empty)
        SET_BOOLEAN_FIELD(is_incompletely_defined)
        SET_BOOLEAN_FIELD(forbid_assertion_creation)
        SET_BOOLEAN_FIELD(dimensionless)

        SET_INTEGER_FIELD(index_priority)
        SET_INTEGER_FIELD(short_block_size)
        SET_INTEGER_FIELD(long_block_size)
        SET_INTEGER_FIELD(flexible_long_block_size)
        SET_INTEGER_FIELD(arithmetic_modulus)

        SET_CCM_FIELD(constant_compilation_method)

        SET_TEXTUAL_FIELD(default_value)
        SET_TEXTUAL_FIELD(distinguish_function)
        SET_TEXTUAL_FIELD(documentation_reference)
        SET_TEXTUAL_FIELD(understand_function)
        SET_TEXTUAL_FIELD(index_default_value)
        SET_TEXTUAL_FIELD(index_maximum_value)
        SET_TEXTUAL_FIELD(index_minimum_value)
        SET_TEXTUAL_FIELD(loop_domain_schema)
        SET_TEXTUAL_FIELD(recognise_function)
        SET_TEXTUAL_FIELD(specification_text)

        SET_TEXTUAL_FIELD(create_function)
        SET_TEXTUAL_FIELD(cast_function)
        SET_TEXTUAL_FIELD(copy_function)
        SET_TEXTUAL_FIELD(copy_short_block_function)
        SET_TEXTUAL_FIELD(quick_copy_function)
        SET_TEXTUAL_FIELD(destroy_function)
        SET_TEXTUAL_FIELD(make_mutable_function)
        SET_TEXTUAL_FIELD(hash_function)
        SET_TEXTUAL_FIELD(long_block_size_function)
        SET_TEXTUAL_FIELD(serialise_function)
        SET_TEXTUAL_FIELD(unserialise_function)
    }

This code is used in §1.

§1.3. A few kind commands contribute to linked lists in the constructor structure1.3 =

    if (tcc == compatible_with_KCC) {
        #ifdef CORE_MODULE
        if ((Str::eq(stc.constructor_argument, I"SNIPPET_TY")) &&
            (FEATURE_INACTIVE(parsing))) return;
        #endif
        kind_constructor_casting_rule *dtcr = CREATE(kind_constructor_casting_rule);
        dtcr->next_casting_rule = con->first_casting_rule;
        con->first_casting_rule = dtcr;
        dtcr->cast_from_kind_unparsed = Str::duplicate(stc.constructor_argument);
        dtcr->cast_from_kind = NULL;
        return;
    }
    if (tcc == conforms_to_KCC) {
        kind_constructor_instance_rule *dti = CREATE(kind_constructor_instance_rule);
        dti->next_instance_rule = con->first_instance_rule;
        con->first_instance_rule = dti;
        dti->instance_of_this_unparsed = Str::duplicate(stc.constructor_argument);
        dti->instance_of_this = NULL;
        return;
    }
    if (tcc == comparison_schema_KCC) {
        kind_constructor_comparison_schema *dtcs = CREATE(kind_constructor_comparison_schema);
        dtcs->next_comparison_schema = con->first_comparison_schema;
        con->first_comparison_schema = dtcs;
        dtcs->comparator_unparsed = Str::duplicate(stc.constructor_argument);
        dtcs->comparator = NULL;
        dtcs->comparison_schema = Str::duplicate(stc.textual_argument);
        return;
    }
    if (tcc == instance_KCC) {
        match_results mr = Regexp::create_mr();
        if (Regexp::match(&mr, stc.textual_argument, U" *(%c+?) *= *(%C+) *= *(%C+) *")) {
            kind_constructor_instance *kci = CREATE(kind_constructor_instance);
            kci->natural_language_name = Str::duplicate(mr.exp[0]);
            kci->identifier = Str::duplicate(mr.exp[1]);
            int bad = FALSE;
            kci->value = KindCommands::parse_literal_number(mr.exp[2], &bad);
            kci->value_specified = TRUE;
            if (bad) {
                NeptuneFiles::error(stc.textual_argument,
                    I"value after the final '=' is not a valid Inform 6 literal", stc.origin);
                kci->value = 0;
                kci->value_specified = FALSE;
            }
            ADD_TO_LINKED_LIST(kci, kind_constructor_instance, con->instances);
        } else if (Regexp::match(&mr, stc.textual_argument, U" *(%c+?) *= *(%C+) *")) {
            kind_constructor_instance *kci = CREATE(kind_constructor_instance);
            kci->natural_language_name = Str::duplicate(mr.exp[0]);
            kci->identifier = Str::duplicate(mr.exp[1]);
            kci->value = 0;
            kci->value_specified = FALSE;
            ADD_TO_LINKED_LIST(kci, kind_constructor_instance, con->instances);
        } else {
            NeptuneFiles::error(stc.textual_argument,
                I"instance not in form NAME = IDENTIFIER = VALUE", stc.origin);
        }
        Regexp::dispose_of(&mr);
        return;
    }

This code is used in §1.

§1.4. And the rest fill in fields in the constructor structure in miscellaneous other ways1.4 =

    switch (tcc) {
        case terms_KCC:
            Parse the constructor arity text1.4.1;
            return;
        case compare_function_KCC:
            if (Str::len(stc.textual_argument) > 31)
                NeptuneFiles::error(stc.textual_argument, I"overlong identifier", stc.origin);
            else con->comparison_routine = Str::duplicate(stc.textual_argument);
            return;
        case say_function_KCC:
            if (Str::len(stc.textual_argument) > 31)
                NeptuneFiles::error(stc.textual_argument, I"overlong identifier", stc.origin);
            else con->print_identifier = Str::duplicate(stc.textual_argument);
            return;
        case printing_routine_for_debugging_KCC:
            if (Str::len(stc.textual_argument) > 31)
                NeptuneFiles::error(stc.textual_argument, I"overlong identifier", stc.origin);
            else con->ACTIONS_identifier = Str::duplicate(stc.textual_argument);
            return;
        case singular_KCC: case plural_KCC: {
            vocabulary_entry **array; int length;
            WordAssemblages::as_array(&(stc.vocabulary_argument), &array, &length);
            if (length == 1) {
                Kinds::mark_vocabulary_as_kind(array[0], Kinds::base_construction(con));
            } else {
                for (int i=0; i<length; i++) {
                    Vocabulary::set_flags(array[i], KIND_SLOW_MC);
                    NTI::mark_vocabulary(array[i], <k-kind>);
                }
                if (con->group != PROPER_CONSTRUCTOR_GRP) {
                    vocabulary_entry *ve = WordAssemblages::hyphenated(&(stc.vocabulary_argument));
                    if (ve) Kinds::mark_vocabulary_as_kind(ve, Kinds::base_construction(con));
                }
            }
            feed_t id = Feeds::begin();
            for (int i=0; i<length; i++)
                Feeds::feed_C_string(Vocabulary::get_exemplar(array[i], FALSE));
            wording LW = Feeds::end(id);
            if (tcc == singular_KCC) {
                int ro = 0;
                if (con->group != PROPER_CONSTRUCTOR_GRP)
                    ro = ADD_TO_LEXICON_NTOPT + WITH_PLURAL_FORMS_NTOPT;
                NATURAL_LANGUAGE_WORDS_TYPE *L = NULL;
                #ifdef CORE_MODULE
                L = Task::language_of_syntax();
                #endif
                noun *nt =
                    Nouns::new_common_noun(LW, NEUTER_GENDER, ro,
                    KIND_SLOW_MC, STORE_POINTER_kind_constructor(con), L);
                con->dt_tag = nt;
            } else {
                NATURAL_LANGUAGE_WORDS_TYPE *L = NULL;
                #ifdef CORE_MODULE
                L = Task::language_of_syntax();
                #endif
                Nouns::set_nominative_plural_in_language(con->dt_tag, LW, L);
            }
            return;
        }
        case plus_schema_KCC:        { int op = PLUS_OPERATION; Arithmetic schema1.4.2; return; }
        case minus_schema_KCC:       { int op = MINUS_OPERATION; Arithmetic schema1.4.2; return; }
        case times_schema_KCC:       { int op = TIMES_OPERATION; Arithmetic schema1.4.2; return; }
        case divide_schema_KCC:      { int op = DIVIDE_OPERATION; Arithmetic schema1.4.2; return; }
        case remainder_schema_KCC:   { int op = REMAINDER_OPERATION; Arithmetic schema1.4.2; return; }
        case approximate_schema_KCC: { int op = APPROXIMATE_OPERATION; Arithmetic schema1.4.2; return; }
        case negate_schema_KCC:      { int op = NEGATE_OPERATION; Arithmetic schema1.4.2; return; }
        case root_schema_KCC:        { int op = ROOT_OPERATION; Arithmetic schema1.4.2; return; }
        case cuberoot_schema_KCC:    { int op = CUBEROOT_OPERATION; Arithmetic schema1.4.2; return; }
        case power_schema_KCC:       { int op = POWER_OPERATION; Arithmetic schema1.4.2; return; }
    }

This code is used in §1.

§1.4.1. Parse the constructor arity text1.4.1 =

    int c = 0;
    string_position pos = Str::start(stc.textual_argument);
    while (TRUE) {
        while (Characters::is_space_or_tab(Str::get(pos))) pos = Str::forward(pos);
        if (Str::get(pos) == 0) break;
        if (Str::get(pos) == ',') { c++; pos = Str::forward(pos); continue; }
        if (c >= 2) { c=1; break; }
        TEMPORARY_TEXT(wd)
        while ((!Characters::is_space_or_tab(Str::get(pos))) && (Str::get(pos) != ',')
            && (Str::get(pos) != 0)) {
            PUT_TO(wd, Str::get(pos)); pos = Str::forward(pos);
        }
        if (Str::len(wd) > 0) {
            if (Str::eq_wide_string(wd, U"covariant")) con->variance[c] = COVARIANT;
            else if (Str::eq_wide_string(wd, U"contravariant")) con->variance[c] = CONTRAVARIANT;
            else if (Str::eq_wide_string(wd, U"optional")) con->tupling[c] = ALLOW_NOTHING_TUPLING;
            else if (Str::eq_wide_string(wd, U"list")) con->tupling[c] = ARBITRARY_TUPLING;
            else NeptuneFiles::error(wd, I"illegal constructor-arity keyword", stc.origin);
        }
        DISCARD_TEXT(wd)
    }
    con->constructor_arity = c+1;

This code is used in §1.4.

§1.4.2. Arithmetic schema1.4.2 =

    arithmetic_schema *ars = CREATE(arithmetic_schema);
    ars->operands[0] = NULL;
    ars->operands[1] = NULL;
    ars->operands_unparsed[0] = NULL;
    ars->operands_unparsed[1] = NULL;
    match_results mr = Regexp::create_mr();
    if (Regexp::match(&mr, stc.textual_argument, U"(%C+), *(%C+): *(%c+)")) {
        ars->operands_unparsed[0] = Str::duplicate(mr.exp[0]);
        ars->operands_unparsed[1] = Str::duplicate(mr.exp[1]);
        ars->schema = Str::duplicate(mr.exp[2]);
    } else {
        ars->schema = Str::duplicate(stc.textual_argument);
    }
    Regexp::dispose_of(&mr);
    ADD_TO_LINKED_LIST(ars, arithmetic_schema, con->arithmetic_schemas[op]);

This code is used in §1.4 (10 times).

§2. This is used for parsing the values of enumeration members in instance commands:

int KindCommands::parse_literal_number(text_stream *S, int *bad) {
    *bad = FALSE;
    int sign = 1, from = 0, to = Str::len(S)-1;
    unsigned int base = 10;
    if ((Str::get_at(S, from) == '(') && (Str::get_at(S, to) == ')')) { from++; to--; }
    while (Characters::is_whitespace(Str::get_at(S, from))) from++;
    while (Characters::is_whitespace(Str::get_at(S, to))) to--;
    if (Str::get_at(S, from) == '-') { sign = -1; from++; }
    else if (Str::get_at(S, from) == '$') {
        from++; base = 16;
        if (Str::get_at(S, from) == '$') {
            from++; base = 2;
        }
    }
    long long int N = 0;
    LOOP_THROUGH_TEXT(pos, S) {
        if (pos.index < from) continue;
        if (pos.index > to) continue;
        inchar32_t c = Str::get(pos), d = 0;
        if ((c >= 'a') && (c <= 'z')) d = c-'a'+10;
        else if ((c >= 'A') && (c <= 'Z')) d = c-'A'+10;
        else if ((c >= '0') && (c <= '9')) d = c-'0';
        else { *bad = TRUE; break; }
        if (d > base) { *bad = TRUE; break; }
        N = base*N + (long long int) d;
        if (pos.index > 34) { *bad = TRUE; break; }
    }
    if (*bad == FALSE) {
        N = sign*N;
        return (int) N;
    }
    return -1;
}