Reading declarations from a file.


§1. Keeping the syntax module happy. We are going to need to use the sentence-breaking apparatus from the syntax module, which means that the following four nonterminals need to exist. But in fact they are really just placeholders — they are wired so that they can never match any text.

<dividing-sentence> ::=
    ... ==> { fail }

<structural-sentence> ::=
    ... ==> { fail }

<language-modifying-sentence> ::=
    ... ==> { fail }

<comma-divisible-sentence> ::=
    ... ==> { fail }

§2. A sort of REPL. The following function reads a file whose name is in arg, feeds it into the lexer, builds a syntax tree of its sentences, and then walks through that tree, applying the Preform nonterminal <declaration-line> to each sentence. In effect, this is a read-evaluate-print loop.

parse_node_tree *syntax_tree = NULL;

kind *kind_vars[27];

void Declarations::load_from_file(text_stream *arg) {
    filename *F = Filenames::from_text(arg);
    feed_t FD = Feeds::begin();
    source_file *sf = TextFromFiles::feed_into_lexer(F, NULL_GENERAL_POINTER);
    wording W = Feeds::end(FD);
    if (sf == NULL) { PRINT("File has failed to open\n"); return; }
    syntax_tree = SyntaxTree::new();
    Sentences::break(syntax_tree, W);

    for (int i=1; i<=26; i++) {
        kind_vars[i] = Kinds::var_construction(i, NULL);
    }
    kind_checker_mode = MATCH_KIND_VARIABLES_AS_UNIVERSAL;

    SyntaxTree::traverse(syntax_tree, Declarations::parse);
}

§3.

define KIND_VARIABLE_FROM_CONTEXT Declarations::kv
kind *Declarations::kv(int v) {
    return kind_vars[v];
}

void Declarations::parse(parse_node *p) {
    if (Node::get_type(p) == SENTENCE_NT) {
        wording W = Node::get_text(p);
        <declaration-line>(W);
    }
}

§4.

enum kind_relationship_CLASS
define EXACT_PARSING_BITMAP (KIND_SLOW_MC)
DECLARE_CLASS(kind_relationship)

typedef struct kind_relationship {
    struct kind *sub;
    struct kind *super;
    CLASS_DEFINITION
} kind_relationship;

§5.

<declaration-line> ::=
    new unit <kind-eval> |                     ==> Kind already exists error5.4
    new unit ... |                             ==> Create new unit5.5
    new enum <kind-eval> |                     ==> Kind already exists error5.4
    new enum ... |                             ==> Create new enum5.6
    new kind ... of <kind-eval> |              ==> Create new base5.7
    <kind-eval> * <kind-eval> = <kind-eval> |  ==> New arithmetic rule5.8
    <k-formal-variable> = <kind-eval> |   ==> Set kind variable5.9
    <kind-eval> |                              ==> Show REPL result5.1
    <kind-condition> |                         ==> Show kind condition5.2
    <kind-eval> compatible with <kind-eval> |  ==> Show compatibility5.3
    ... which varies |                         ==> { -, - }
    ...                                        ==> Fail with error5.11

<kind-eval> ::=
    ( <kind-eval> ) |                          ==> { pass 1 }
    <kind-eval> + <kind-eval> |                ==> Perform plus5.12
    <kind-eval> - <kind-eval> |                ==> Perform minus5.13
    <kind-eval> * <kind-eval> |                ==> Perform times5.14
    <kind-eval> over <kind-eval> |             ==> Perform divide5.15
    <kind-eval> % <kind-eval> |                ==> Perform remainder5.16
    <kind-eval> to the nearest <kind-eval> |   ==> Perform approx5.17
    - <kind-eval> |                            ==> Perform unary minus5.18
    square root of <kind-eval> |               ==> Perform square root5.19
    real square root of <kind-eval> |          ==> Perform real square root5.20
    cube root of <kind-eval> |                 ==> Perform cube root5.21
    join of <kind-eval> and <kind-eval> |      ==> Perform join5.22
    meet of <kind-eval> and <kind-eval> |      ==> Perform meet5.23
    first term of <kind-eval> |                ==> Extract first term5.24
    second term of <kind-eval> |               ==> Extract second term5.25
    dereference <kind-eval> |                  ==> Dereference kind5.27
    weaken <kind-eval> |                       ==> Weaken kind5.26
    super of <kind-eval> |                     ==> Super kind5.28
    substitute <kind-eval> for <k-formal-variable> in <kind-eval> | ==> Substitute5.31
    void |                                     ==> { -, K_void }
    <k-kind> |                                 ==> { pass 1 }
    <k-formal-variable>                   ==> { pass 1 }

<kind-condition> ::=
    <kind-eval> <= <kind-eval> |               ==> Test le5.29
    <kind-eval> is definite                    ==> Test definiteness5.30

§5.1. Show REPL result5.1 =

    kind *K = RP[1];
    PRINT("'%<W': %u\n", W, K);

§5.2. Show kind condition5.2 =

    PRINT("'%<W?': %s\n", W, R[1]?"true":"false");

§5.3. Show compatibility5.3 =

    kind *K1 = RP[1];
    kind *K2 = RP[2];
    switch (Kinds::compatible(K1, K2)) {
        case NEVER_MATCH:     PRINT("'%<W?': never\n", W); break;
        case ALWAYS_MATCH:    PRINT("'%<W?': always\n", W); break;
        case SOMETIMES_MATCH: PRINT("'%<W?': sometimes\n", W); break;
    }

§5.4. Kind already exists error5.4 =

    kind *K = RP[1];
    PRINT("Kind already exists: '%u'\n", K);
    ==> { fail }

§5.5. Create new unit5.5 =

    kind *K = Kinds::new_base(GET_RW(<declaration-line>, 1), K_value);
    Kinds::Behaviour::convert_to_unit(K);
    PRINT("'%<W': ok\n", W);

§5.6. Create new enum5.6 =

    kind *K = Kinds::new_base(GET_RW(<declaration-line>, 1), K_value);
    Kinds::Behaviour::convert_to_enumeration(K);
    PRINT("'%<W': ok\n", W);

§5.7. Create new base5.7 =

    kind *X = RP[1];
    kind *K = Kinds::new_base(GET_RW(<declaration-line>, 1), X);
    kind_relationship *KR = CREATE(kind_relationship);
    KR->sub = K;
    KR->super = X;
    PRINT("'%<W': ok\n", W);

§5.8. New arithmetic rule5.8 =

    kind *K1 = (kind *) RP[1];
    kind *K2 = (kind *) RP[2];
    kind *K = (kind *) RP[3];
    Kinds::Dimensions::make_unit_derivation(K1, K2, K);
    PRINT("'%<W': %u\n", W, K);

§5.9. Set kind variable5.9 =

    kind *KV = RP[1];
    kind *K = RP[2];
    kind_vars[KV->kind_variable_number] = K;
    ==> { -, K }
    PRINT("'%<W': %u\n", W, K);

§5.10. No such kind error5.10 =

    PRINT("No such kind as '%W'\n", W);
    ==> { fail }

§5.11. Fail with error5.11 =

    PRINT("Declaration not understood: '%W'\n", W);
    ==> { fail }

§5.12. Perform plus5.12 =

    int op = PLUS_OPERATION;
    Perform arithmetic5.12.1;

§5.13. Perform minus5.13 =

    int op = MINUS_OPERATION;
    Perform arithmetic5.12.1;

§5.14. Perform times5.14 =

    int op = TIMES_OPERATION;
    Perform arithmetic5.12.1;

§5.15. Perform divide5.15 =

    int op = DIVIDE_OPERATION;
    Perform arithmetic5.12.1;

§5.16. Perform remainder5.16 =

    int op = REMAINDER_OPERATION;
    Perform arithmetic5.12.1;

§5.17. Perform approx5.17 =

    int op = APPROXIMATE_OPERATION;
    Perform arithmetic5.12.1;

§5.12.1. Perform arithmetic5.12.1 =

    kind *K1 = RP[1];
    kind *K2 = RP[2];
    ==> { - , Kinds::Dimensions::arithmetic_on_kinds(K1, K2, op) }

§5.18. Perform unary minus5.18 =

    int op = NEGATE_OPERATION;
    Perform unary arithmetic5.18.1;

§5.19. Perform square root5.19 =

    int op = ROOT_OPERATION;
    Perform unary arithmetic5.18.1;

§5.20. Perform real square root5.20 =

    int op = REALROOT_OPERATION;
    Perform unary arithmetic5.18.1;

§5.21. Perform cube root5.21 =

    int op = CUBEROOT_OPERATION;
    Perform unary arithmetic5.18.1;

§5.18.1. Perform unary arithmetic5.18.1 =

    kind *K = RP[1];
    ==> { - , Kinds::Dimensions::arithmetic_on_kinds(K, NULL, op) }

§5.22. Perform join5.22 =

    kind *K1 = RP[1];
    kind *K2 = RP[2];
    ==> { - , Latticework::join(K1, K2) }

§5.23. Perform meet5.23 =

    kind *K1 = RP[1];
    kind *K2 = RP[2];
    ==> { - , Latticework::meet(K1, K2) }

§5.24. Extract first term5.24 =

    kind *K = RP[1];
    switch (Kinds::arity_of_constructor(K)) {
        case 0: ==> { -, NULL }; break;
        case 1: ==> { -, Kinds::unary_construction_material(K) }; break;
        case 2: {
            kind *X, *Y;
            Kinds::binary_construction_material(K, &X, &Y);
            ==> { -, X }; break;
        }
    }

§5.25. Extract second term5.25 =

    kind *K = RP[1];
    switch (Kinds::arity_of_constructor(K)) {
        case 0: ==> { -, NULL }; break;
        case 1: ==> { -, NULL }; break;
        case 2: {
            kind *X, *Y;
            Kinds::binary_construction_material(K, &X, &Y);
            ==> { -, Y }; break;
        }
    }

§5.26. Weaken kind5.26 =

    kind *K = RP[1];
    ==> { - , Kinds::weaken(K, K_object) }

§5.27. Dereference kind5.27 =

    kind *K = RP[1];
    ==> { - , Kinds::dereference_properties(K) }

§5.28. Super kind5.28 =

    kind *K = RP[1];
    ==> { - , Latticework::super(K) }

§5.29. Test le5.29 =

    kind *K1 = RP[1];
    kind *K2 = RP[2];
    ==> { Kinds::conforms_to(K1, K2), - }

§5.30. Test definiteness5.30 =

    kind *K = RP[1];
    ==> { Kinds::Behaviour::definite(K), - }

§5.31. Substitute5.31 =

    kind *K1 = RP[1];
    kind *KV = RP[2];
    kind *K2 = RP[3];
    kind *slate[27];
    for (int i=1; i<=26; i++) slate[i] = NULL;
    slate[KV->kind_variable_number] = K1;
    int changed;
    ==> { -, Kinds::substitute(K2, slate, &changed, FALSE) }

§6.

define HIERARCHY_GET_SUPER_KINDS_CALLBACK Declarations::super
define HIERARCHY_ALLOWS_SOMETIMES_MATCH_KINDS_CALLBACK Declarations::sometimes
int Declarations::le(kind *K1, kind *K2) {
    while (K1) {
        if (Kinds::eq(K1, K2)) return TRUE;
        K1 = Declarations::super(K1);
    }
    return FALSE;
}
kind *Declarations::super(kind *K1) {
    kind_relationship *KR;
    LOOP_OVER(KR, kind_relationship)
        if (Kinds::eq(K1, KR->sub))
            return KR->super;
    return NULL;
}
int Declarations::sometimes(kind *from) {
    while (from) {
        if (Kinds::eq(from, K_object)) return TRUE;
        from = Latticework::super(from);
    }
    return FALSE;
}