Defining the primitive construct.


§1. Definition. For what this does and why it is used, see Textual Inter (in inter).

void PrimitiveInstruction::define_construct(void) {
    inter_construct *IC = InterInstruction::create_construct(PRIMITIVE_IST, I"primitive");
    InterInstruction::defines_symbol_in_fields(IC, DEFN_PRIM_IFLD, -1);
    InterInstruction::specify_syntax(IC, I"primitive !IDENTIFIER TOKENS -> TOKEN");
    InterInstruction::data_extent_at_least(IC, 3);
    InterInstruction::permit(IC, OUTSIDE_OF_PACKAGES_ICUP);
    METHOD_ADD(IC, CONSTRUCT_READ_MTID, PrimitiveInstruction::read);
    METHOD_ADD(IC, CONSTRUCT_VERIFY_MTID, PrimitiveInstruction::verify);
    METHOD_ADD(IC, CONSTRUCT_WRITE_MTID, PrimitiveInstruction::write);
}

§2. Instructions. In bytecode, the frame of a primitive instruction is laid out with the compulsory words — see Inter Nodes — followed by a variable number of words depending on the length of the signature.

Note that cat1 cat2 ... catN -> result takes N+1 words, one for each primitive category: but that void -> result takes only 1. (Thus the not-really-a-category void is not stored when it is an argument, though it is stored — as 0 — when it is the result: the result is always stored.) It follows that the shortest possible signature, say void -> void, occupies 1 word, so the minimum extent of a primitive instruction is 4.

define DEFN_PRIM_IFLD      (DATA_IFLD + 0)
define BIP_PRIM_IFLD       (DATA_IFLD + 1)
define SIGNATURE_PRIM_IFLD (DATA_IFLD + 2)
inter_error_message *PrimitiveInstruction::new(inter_bookmark *IBM, inter_symbol *prim_name,
    text_stream *from, text_stream *to, inter_ti level, inter_error_location *eloc) {

    inter_tree_node *F = Inode::new_with_2_data_fields(IBM, PRIMITIVE_IST,
        /* DEFN_PRIM_IFLD: */ InterSymbolsTable::id_at_bookmark(IBM, prim_name),
        /* BIP_PRIM_IFLD: */ 0,
        eloc, level);

    inter_error_message *E = NULL;
    text_stream *in = from;
    match_results mr = Regexp::create_mr();
    while (Regexp::match(&mr, in, U" *(%i+) *(%c*)")) {
        inter_ti lcat = PrimitiveInstruction::read_category(eloc, mr.exp[0], &E);
        if (E) break;
        if (lcat == 0) break;
        Inode::extend_instruction_by(F, 1);
        F->W.instruction[F->W.extent - 1] = lcat;
        Str::copy(in, mr.exp[1]);
    }
    Regexp::dispose_of(&mr);
    if (E) return E;

    inter_ti rcat = PrimitiveInstruction::read_category(eloc, to, &E);
    if (E) return E;
    Inode::extend_instruction_by(F, 1);
    F->W.instruction[F->W.extent - 1] = rcat;

    E = VerifyingInter::instruction(InterBookmark::package(IBM), F);
    if (E) return E;
    NodePlacement::move_to_moving_bookmark(F, IBM);

    return NULL;
}

§3. Verification consists only of sanity checks.

void PrimitiveInstruction::verify(inter_construct *IC, inter_tree_node *P,
    inter_package *owner, inter_error_message **E) {
    if (P->W.instruction[BIP_PRIM_IFLD] >= MAX_BIPS) {
        *E = Inode::error(P, I"primitive with impossible BIP code", NULL);
        return;
    }
    inter_symbol *prim_name = PrimitiveInstruction::primitive(P);
    if ((prim_name == NULL) ||
        (Str::get_first_char(InterSymbol::identifier(prim_name)) != '!')) {
        *E = Inode::error(P, I"primitive name not beginning with '!'", NULL);
        return;
    }
    int voids = 0, args = 0;
    for (int i=SIGNATURE_PRIM_IFLD; i<P->W.extent-1; i++) {
        inter_ti prim_cat = P->W.instruction[i];
        if (PrimitiveInstruction::category_is_valid(prim_cat) == FALSE) {
            *E = Inode::error(P, I"unknown primitive category", NULL);
            return;
        }
        if (prim_cat == 0) voids++;
        args++;
    }
    if ((voids > 1) || ((voids == 1) && (args > 1))) {
        *E = Inode::error(P, I"if used on the left, 'void' must be the only argument", NULL);
        return;
    }
}

§4. Creating from textual Inter syntax.

void PrimitiveInstruction::read(inter_construct *IC, inter_bookmark *IBM,
    inter_line_parse *ilp, inter_error_location *eloc, inter_error_message **E) {
    inter_symbol *prim_name =
        TextualInter::new_symbol(eloc, InterBookmark::scope(IBM), ilp->mr.exp[0], E);
    if (*E) return;
    *E = PrimitiveInstruction::new(IBM, prim_name, ilp->mr.exp[1], ilp->mr.exp[2],
        (inter_ti) ilp->indent_level, eloc);
}

§5. Writing to textual Inter syntax.

void PrimitiveInstruction::write(inter_construct *IC, OUTPUT_STREAM, inter_tree_node *P) {
    inter_symbol *prim_name = InterSymbolsTable::symbol_from_ID_at_node(P, DEFN_PRIM_IFLD);
    WRITE("primitive %S", InterSymbol::identifier(prim_name));
    for (int i=SIGNATURE_PRIM_IFLD; i<P->W.extent-1; i++) {
        WRITE(" ");
        PrimitiveInstruction::write_category(OUT, P->W.instruction[i]);
    }
    if (SIGNATURE_PRIM_IFLD == P->W.extent-1) WRITE(" void");
    WRITE(" -> ");
    PrimitiveInstruction::write_category(OUT, P->W.instruction[P->W.extent-1]);
}

§6. The BIP. The BIP code is a quick index code to identify which primitive is used from the standard Inform set (if, indeed, the primitive is from that set: it will be 0 otherwise).

inter_ti PrimitiveInstruction::get_BIP(inter_symbol *prim) {
    if (prim == NULL) return 0;
    inter_tree_node *D = InterSymbol::definition(prim);
    if (D == NULL) return 0;
    return D->W.instruction[BIP_PRIM_IFLD];
}

void PrimitiveInstruction::set_BIP(inter_symbol *prim, inter_ti BIP) {
    if (prim == NULL) internal_error("no primitive for BIP");
    inter_tree_node *D = InterSymbol::definition(prim);
    if (D == NULL) internal_error("undefined primitive for BIP");
    D->W.instruction[BIP_PRIM_IFLD] = BIP;
}

§7. Primitive categories.

define VAL_PRIM_CAT 1
define REF_PRIM_CAT 2
define LAB_PRIM_CAT 3
define CODE_PRIM_CAT 4
inter_ti PrimitiveInstruction::read_category(inter_error_location *eloc, text_stream *T,
    inter_error_message **E) {
    *E = NULL;
    if (Str::eq(T, I"void")) return 0;
    if (Str::eq(T, I"val")) return VAL_PRIM_CAT;
    if (Str::eq(T, I"ref")) return REF_PRIM_CAT;
    if (Str::eq(T, I"lab")) return LAB_PRIM_CAT;
    if (Str::eq(T, I"code")) return CODE_PRIM_CAT;
    *E = InterErrors::quoted(I"no such category", T, eloc);
    return VAL_PRIM_CAT;
}

void PrimitiveInstruction::write_category(OUTPUT_STREAM, inter_ti cat) {
    WRITE("%s", PrimitiveInstruction::cat_name(cat));
}

char *PrimitiveInstruction::cat_name(inter_ti cat) {
    switch (cat) {
        case REF_PRIM_CAT: return "ref";
        case VAL_PRIM_CAT: return "val";
        case LAB_PRIM_CAT: return "lab";
        case CODE_PRIM_CAT: return "code";
        case 0: return "void";
    }
    return "<unknown>";
}

int PrimitiveInstruction::category_is_valid(inter_ti cat) {
    switch (cat) {
        case VAL_PRIM_CAT: return TRUE;
        case REF_PRIM_CAT: return TRUE;
        case LAB_PRIM_CAT: return TRUE;
        case CODE_PRIM_CAT: return TRUE;
        case 0: return TRUE;
    }
    return FALSE;
}

§8. Signature of a primitive.

int PrimitiveInstruction::arity(inter_symbol *prim) {
    if (prim == NULL) return 0;
    inter_tree_node *D = InterSymbol::definition(prim);
    if (D == NULL) return 0;
    return D->W.extent - SIGNATURE_PRIM_IFLD - 1;
}

inter_ti PrimitiveInstruction::operand_category(inter_symbol *prim, int i) {
    if (prim == NULL) return 0;
    inter_tree_node *D = InterSymbol::definition(prim);
    if (D == NULL) return 0;
    return D->W.instruction[SIGNATURE_PRIM_IFLD + i];
}

inter_ti PrimitiveInstruction::result_category(inter_symbol *prim) {
    if (prim == NULL) return 0;
    inter_tree_node *D = InterSymbol::definition(prim);
    if (D == NULL) return 0;
    return D->W.instruction[D->W.extent - 1];
}

inter_symbol *PrimitiveInstruction::primitive(inter_tree_node *P) {
    if (P == NULL) return NULL;
    if (Inode::isnt(P, PRIMITIVE_IST)) return NULL;
    return InterSymbolsTable::symbol_from_ID_at_node(P, DEFN_PRIM_IFLD);
}