Compilation Schemas

To create, and later expand upon, short prototypes of I6 syntax for such run-time tasks as the setting, unsetting or testing of a relation.

§1. An I6 schema is an intermediate-level code for the final stages of compiling to Inform 6 syntax. Its "prototype" is a C string encoded as ISO Latin-1, in which the asterisk * acts as an escape character.

"Expanding" an I6 schema is essentially a form of macro expansion. A caller supplies us with a schema and a number of parameters, each of which is either a literal piece of text or a predicate calculus term. We then copy the schema's prototype into the output, except as specified:

(1) ** expands to a literal asterisk.
(2) *1, *2, ..., *9 expands to the 1st to 9th parameter, where a literal text parameter is copied straight through, whereas a term parameter is compiled as a value. Expanding a parameter which was not supplied does nothing, but is not an error.
- (a) The modifier !, as in *!1 to *!9, enables the use of local variables in any text substitutions compiled in the course of the term.
- (b) The modifier #, as in *#1 to *#9, causes us to expand to the ID number of the kind of value of the parameter, not to the parameter itself. (If the parameter is literal text rather than a term, we do nothing.)
(3) *=- and *=+ turn "dereference pointers" mode off and on, respectively. This has effect only when compiling a value whose content is stored on the heap; Inform ordinarily compiles this by making a new copy of the value and using a pointer to it, but if "dereference pointers" is off then the pointer to the original data is used instead. It's a sort of macro-expansion version of the difference between call-by-value and call-by-reference. The effect lasts only while the expander is running; when the expander finishes, it restores the mode to its setting at the start.
(4) *## is reserved for the use of higher-level code in building schemas — it has to do with locations of data on the heap — but is not strictly speaking legal in a schema. Attempting to expand it will cause an internal error.

Any other occurrence of an asterisk is illegal, and will throw an internal error.

§2. The I6 schema structure is very simple, then:

define TYPICAL_I6_SCHEMA_LENGTH 128  in fact 40 is plenty

typedef struct i6_schema {
    wchar_t prototype_storage[TYPICAL_I6_SCHEMA_LENGTH];
    struct text_stream prototype;
    int no_quoted_inames;
    #ifdef CORE_MODULE
    struct inter_schema *compiled;
    struct inter_name *quoted_inames[2];
    #endif
} i6_schema;

The structure i6_schema is private to this section.

§3.

typedef struct annotated_i6_schema {
    struct i6_schema *schema;
    int negate_schema;  true if atom is to be tested with the opposite parity
    struct pcalc_term pt0;  terms on which the I6 schema is to be expanded
    struct pcalc_term pt1;
    int involves_action_variables;
} annotated_i6_schema;

The structure annotated_i6_schema is accessed in 2/bpf.

§4. Building schemas. The following makes up a new schema from a printf-style formatted string:

define MAX_I6_SCHEMA_ATTEMPT 1024  plenty of room for conjectural schema overruns

int unique_qi_counter = 0;

i6_schema *Calculus::Schemas::new(char *fmt, ...) {
    va_list ap;  the variable argument list signified by the dots
    i6_schema *sch = CREATE(i6_schema);
    sch->prototype = Streams::new_buffer(TYPICAL_I6_SCHEMA_LENGTH, sch->prototype_storage);
    sch->no_quoted_inames = 0;
    text_stream *OUT = &(sch->prototype);
    Process the varargs into schema prototype text4.3;
    va_end(ap);  macro to end variable argument processing
    #ifdef CORE_MODULE
    sch->compiled = InterSchemas::from_i6s(&(sch->prototype), sch->no_quoted_inames, (void **) sch->quoted_inames);
    #endif
    return sch;
}

§4.1. And this is a variation for modifying an existing schema:

void Calculus::Schemas::modify(i6_schema *sch, char *fmt, ...) {
    va_list ap;  the variable argument list signified by the dots
    sch->prototype = Streams::new_buffer(TYPICAL_I6_SCHEMA_LENGTH, sch->prototype_storage);
    sch->no_quoted_inames = 0;
    text_stream *OUT = &(sch->prototype);
    Process the varargs into schema prototype text4.3;
    va_end(ap);  macro to end variable argument processing
    #ifdef CORE_MODULE
    sch->compiled = InterSchemas::from_i6s(&(sch->prototype), sch->no_quoted_inames, (void **) sch->quoted_inames);
    #endif
}

§4.2. And another:

void Calculus::Schemas::append(i6_schema *sch, char *fmt, ...) {
    va_list ap;  the variable argument list signified by the dots
    text_stream *OUT = &(sch->prototype);
    Process the varargs into schema prototype text4.3;
    va_end(ap);  macro to end variable argument processing
    #ifdef CORE_MODULE
    sch->compiled = InterSchemas::from_i6s(&(sch->prototype), sch->no_quoted_inames, (void **) sch->quoted_inames);
    #endif
}

§4.3. Either way, the schema's prototype is written as follows:

Process the varargs into schema prototype text4.3 =

    char *p;
    va_start(ap, fmt);  macro to begin variable argument processing
    for (p = fmt; *p; p++) {
        switch (*p) {
            case '%': Recognise schema-format escape sequences4.3.1; break;
            default: PUT(*p); break;
        }
    }

This code is used in §4, §4.1, §4.2.

§4.3.1. We recognise only a few escapes here: %%, a literal percentage sign; %d, an integer; %s, a C string; %S, a text stream; and %k, a kind ID.

Recognise schema-format escape sequences4.3.1 =

    p++;
    switch (*p) {
        case 'd': WRITE("%d", va_arg(ap, int)); break;
        case 'k':
            #ifdef CORE_MODULE
            Kinds::RunTime::compile_weak_id(OUT, va_arg(ap, kind *));
            #endif
            #ifndef CORE_MODULE
            WRITE("{%u}", va_arg(ap, kind *));
            #endif
            break;
        case 'L':
            #ifdef CORE_MODULE
            WRITE("%~L", va_arg(ap, local_variable *)); break;
            #endif
            #ifndef CORE_MODULE
            WRITE("%08x", va_arg(ap, void *)); break;
            #endif
            break;
        case 'n': {
            int N = sch->no_quoted_inames++;
            if (N >= 2) internal_error("too many inter_name quotes");
            #ifdef CORE_MODULE
            sch->quoted_inames[N] = (inter_name *) va_arg(ap, inter_name *);
            #endif
            WRITE("QUOTED_INAME_%d_%08x", N, unique_qi_counter++);
            break;
        }
        case 'N': WRITE("%N", va_arg(ap, int)); break;
        case 's': WRITE("%s", va_arg(ap, char *)); break;
        case 'S': WRITE("%S", va_arg(ap, text_stream *)); break;
        case '%': PUT('%'); break;
        default:
            fprintf(stderr, "*** Bad schema format: <%s> ***\n", fmt);
            internal_error("Unknown % string escape in schema format");
    }

This code is used in §4.3.

§5. Emptiness. A schema is empty if its prototype is the null string.

int Calculus::Schemas::empty(i6_schema *sch) {
    if (sch == NULL) return TRUE;
    if (Str::len(&(sch->prototype)) == 0) return TRUE;
    return FALSE;
}

§6. Expansion. We provide two routines as a sort of API for expanding schemas. The user can either specify two parameters, both of them terms...

#ifdef CORE_MODULE
void Calculus::Schemas::emit_expand_from_terms(i6_schema *sch,
    pcalc_term *pt1, pcalc_term *pt2, int semicolon) {
    i6s_emission_state ems = Calculus::Schemas::state(pt1, pt2, NULL, NULL);

    Calculus::Schemas::sch_emit_inner(sch, &ems, semicolon);
}

void Calculus::Schemas::emit_expand_from_locals(i6_schema *sch,
    local_variable *v1, local_variable *v2, int semicolon) {
    pcalc_term pt1 = Calculus::Terms::new_constant(
        Lvalues::new_LOCAL_VARIABLE(EMPTY_WORDING, v1));
    pcalc_term pt2 = Calculus::Terms::new_constant(
        Lvalues::new_LOCAL_VARIABLE(EMPTY_WORDING, v2));
    Calculus::Schemas::emit_expand_from_terms(sch, &pt1, &pt2, semicolon);
}

void Calculus::Schemas::emit_val_expand_from_locals(i6_schema *sch,
    local_variable *v1, local_variable *v2) {
    pcalc_term pt1 = Calculus::Terms::new_constant(
        Lvalues::new_LOCAL_VARIABLE(EMPTY_WORDING, v1));
    pcalc_term pt2 = Calculus::Terms::new_constant(
        Lvalues::new_LOCAL_VARIABLE(EMPTY_WORDING, v2));
    Calculus::Schemas::emit_val_expand_from_terms(sch, &pt1, &pt2);
}

void Calculus::Schemas::emit_val_expand_from_terms(i6_schema *sch,
    pcalc_term *pt1, pcalc_term *pt2) {
    i6s_emission_state ems = Calculus::Schemas::state(pt1, pt2, NULL, NULL);

    Calculus::Schemas::sch_emit_inner(sch, &ems, FALSE);
}
#endif

typedef struct i6s_emission_state {
    struct text_stream *ops_textual[2];
    struct pcalc_term *ops_termwise[2];
} i6s_emission_state;

i6s_emission_state Calculus::Schemas::state(pcalc_term *pt1, pcalc_term *pt2, text_stream *str1, text_stream *str2) {
    i6s_emission_state ems;
    ems.ops_textual[0] = str1;
    ems.ops_textual[1] = str2;
    ems.ops_termwise[0] = pt1;
    ems.ops_termwise[1] = pt2;
    return ems;
}

The structure i6s_emission_state is private to this section.

§7.

#ifdef CORE_MODULE
void Calculus::Schemas::sch_emit_inner(i6_schema *sch, i6s_emission_state *ems, int code_mode) {

    if ((ems->ops_textual[0]) || (ems->ops_textual[1])) internal_error("Zap");

    Calculus::Schemas::sch_type_parameter(ems->ops_termwise[0]);
    Calculus::Schemas::sch_type_parameter(ems->ops_termwise[1]);

    BEGIN_COMPILATION_MODE;
    if (sch->compiled->dereference_mode)
        COMPILATION_MODE_EXIT(DEREFERENCE_POINTERS_CMODE);

    value_holster VH = Holsters::new(INTER_VAL_VHMODE);
    int val_mode = FALSE;
    if (code_mode == FALSE) val_mode = TRUE;
    EmitInterSchemas::emit(Emit::tree(), &VH, sch->compiled, ems, code_mode, val_mode, NULL, NULL,
        &Calculus::Schemas::sch_inline, NULL);

    END_COMPILATION_MODE;
}

void Calculus::Schemas::sch_inline(value_holster *VH,
    inter_schema_token *t, void *ems_s, int prim_cat) {

    i6s_emission_state *ems = (i6s_emission_state *) ems_s;

    BEGIN_COMPILATION_MODE;

    int give_kind_id = FALSE, give_comparison_routine = FALSE,
        dereference_property = FALSE, adopt_local_stack_frame = FALSE,
        cast_to_kind_of_other_term = FALSE, by_reference = FALSE;

    if (t->inline_modifiers & PERMIT_LOCALS_IN_TEXT_CMODE_ISSBM)
        COMPILATION_MODE_ENTER(PERMIT_LOCALS_IN_TEXT_CMODE);
    if (t->inline_modifiers & TREAT_AS_LVALUE_CMODE_ISSBM)
        COMPILATION_MODE_ENTER(TREAT_AS_LVALUE_CMODE);
    if (t->inline_modifiers & JUST_ROUTINE_CMODE_ISSBM)
        COMPILATION_MODE_ENTER(JUST_ROUTINE_CMODE);
    if (t->inline_modifiers & GIVE_KIND_ID_ISSBM) give_kind_id = TRUE;
    if (t->inline_modifiers & GIVE_COMPARISON_ROUTINE_ISSBM) give_comparison_routine = TRUE;
    if (t->inline_modifiers & DEREFERENCE_PROPERTY_ISSBM) dereference_property = TRUE;
    if (t->inline_modifiers & ADOPT_LOCAL_STACK_FRAME_ISSBM) adopt_local_stack_frame = TRUE;
    if (t->inline_modifiers & CAST_TO_KIND_OF_OTHER_TERM_ISSBM) cast_to_kind_of_other_term = TRUE;
    if (t->inline_modifiers & BY_REFERENCE_ISSBM) by_reference = TRUE;

    if (t->inline_command == substitute_ISINC) Perform substitution7.1
    else if (t->inline_command == current_sentence_ISINC) Perform current sentence7.2
    else if (t->inline_command == combine_ISINC) Perform combine7.3
    else internal_error("unimplemented command in schema");

    END_COMPILATION_MODE;
}

§7.1. Perform substitution7.1 =

    switch (t->constant_number) {
        case 0: {
            kind *K = NULL;
            if (cast_to_kind_of_other_term) K = ems->ops_termwise[1]->term_checked_as_kind;
            Calculus::Schemas::sch_emit_parameter(ems->ops_termwise[0], give_kind_id,
                give_comparison_routine, dereference_property, K, by_reference);
            break;
        }
        case 1: {
            rule *R = adopted_rule_for_compilation;
            int M = adopted_marker_for_compilation;
            if ((adopt_local_stack_frame) &&
                (Rvalues::is_CONSTANT_of_kind(ems->ops_termwise[0]->constant, K_response))) {
                adopted_rule_for_compilation =
                    Rvalues::to_rule(ems->ops_termwise[0]->constant);
                adopted_marker_for_compilation =
                    Strings::get_marker_from_response_spec(ems->ops_termwise[0]->constant);
            }
            kind *K = NULL;
            if (cast_to_kind_of_other_term) K = ems->ops_termwise[0]->term_checked_as_kind;
            Calculus::Schemas::sch_emit_parameter(ems->ops_termwise[1],
                give_kind_id, give_comparison_routine, dereference_property, K, by_reference);
            adopted_rule_for_compilation = R;
            adopted_marker_for_compilation = M;
            break;
        }
        default:
            internal_error("schemas are currently limited to *1 and *2");
    }

This code is used in §7.

§7.2. Perform current sentence7.2 =

    internal_error("Seems possible after all");

This code is used in §7.

§7.3. Perform combine7.3 =

    int epar = TRUE;
    if ((ems->ops_termwise[0]) && (ems->ops_termwise[1])) {
        kind *reln_K = ems->ops_termwise[0]->term_checked_as_kind;
        kind *comb_K = ems->ops_termwise[1]->term_checked_as_kind;
        if ((Kinds::get_construct(reln_K) == CON_relation) &&
            (Kinds::get_construct(comb_K) == CON_combination)) {
            kind *req_A = NULL, *req_B = NULL, *found_A = NULL, *found_B = NULL;
            Kinds::binary_construction_material(reln_K, &req_A, &req_B);
            Kinds::binary_construction_material(comb_K, &found_A, &found_B);
            parse_node *spec_A = NULL, *spec_B = NULL;
            Rvalues::to_pair(ems->ops_termwise[1]->constant, &spec_A, &spec_B);
            if (!((Kinds::Behaviour::uses_pointer_values(req_A)) && (Kinds::Behaviour::definite(req_A))))
                req_A = NULL;
            if (!((Kinds::Behaviour::uses_pointer_values(req_B)) && (Kinds::Behaviour::definite(req_B))))
                req_B = NULL;
            Specifications::Compiler::emit_to_kind(spec_A, req_A);
            Specifications::Compiler::emit_to_kind(spec_B, req_B);
            epar = FALSE;
        }
    }
    if (epar) {
        Calculus::Schemas::sch_emit_parameter(ems->ops_termwise[1],
            give_kind_id, give_comparison_routine, dereference_property, NULL, FALSE);
        Produce::val(Emit::tree(), K_number, LITERAL_IVAL, 0);
    }

This code is used in §7.

§8.

void Calculus::Schemas::sch_emit_parameter(pcalc_term *pt,
    int give_kind_id, int give_comparison_routine,
    int dereference_property, kind *cast_to, int by_reference) {
    if (give_kind_id) {
        if (pt) Kinds::RunTime::emit_weak_id_as_val(pt->term_checked_as_kind);
    } else if (give_comparison_routine) {
        inter_name *cr = Hierarchy::find(SIGNEDCOMPARE_HL);
        if ((pt) && (pt->term_checked_as_kind)) {
            inter_name *specialised_cr =
                Kinds::Behaviour::get_comparison_routine_as_iname(pt->term_checked_as_kind);
            if (specialised_cr) cr = specialised_cr;
        }
        Produce::val_iname(Emit::tree(), K_value, cr);
    } else {
        if (by_reference) {
            BEGIN_COMPILATION_MODE;
            COMPILATION_MODE_EXIT(DEREFERENCE_POINTERS_CMODE);
            pcalc_term cpt = *pt;
            Calculus::Terms::emit(cpt);
            END_COMPILATION_MODE;
        } else {
            int down = FALSE;
            Kinds::RunTime::emit_cast_call(pt->term_checked_as_kind, cast_to, &down);
            pcalc_term cpt = *pt;
            if ((dereference_property) &&
                (Node::is(cpt.constant, CONSTANT_NT))) {
                kind *K = Specifications::to_kind(cpt.constant);
                if (Kinds::get_construct(K) == CON_property)
                    cpt = Calculus::Terms::new_constant(
                        Lvalues::new_PROPERTY_VALUE(
                            Node::duplicate(cpt.constant),
                            Rvalues::new_self_object_constant()));
            }
            Calculus::Terms::emit(cpt);
            if (down) Produce::up(Emit::tree());
        }
    }
}
#endif

§9. Last and very much least: in case we receive an untypechecked term, we fill in its kind.

#ifdef CORE_MODULE
void Calculus::Schemas::sch_type_parameter(pcalc_term *pt) {
    if ((pt) && (pt->constant) && (pt->term_checked_as_kind == NULL))
        pt->term_checked_as_kind = Specifications::to_kind(pt->constant);
}
#endif

§10. Logging schemas.

void Calculus::Schemas::log(i6_schema *sch) {
    Calculus::Schemas::write(DL, sch);
}

void Calculus::Schemas::write(OUTPUT_STREAM, i6_schema *sch) {
    if (sch == NULL) WRITE("<null schema>");
    else WRITE("<schema: %S>", &(sch->prototype));
}

void Calculus::Schemas::log_applied(i6_schema *sch, pcalc_term *pt1) {
    Calculus::Schemas::write_applied(DL, sch, pt1);
}

void Calculus::Schemas::write_applied(OUTPUT_STREAM, i6_schema *sch, pcalc_term *pt1) {
    if (sch == NULL) { WRITE("<null schema>"); return; }
    else {
        WRITE("<%S : ", &(sch->prototype));
        Calculus::Terms::write(OUT, pt1);
        WRITE(">");
    }
}