diff --git a/demos/README.md b/demos/README.md index 39fc008..36f29ab 100644 --- a/demos/README.md +++ b/demos/README.md @@ -75,3 +75,72 @@ It reads the Turtle that `--inspect` emits, in the shape it emits it. It is not a general Turtle parser, and it will not do anything sensible with Turtle from somewhere else. For real queries, load the dump into a triplestore and use SPARQL; this exists to make a picture. + +## moving.arch — preconditions, and the one argument left over + +```shell +./build/archetype --source=demos/moving.arch +``` + +It includes nothing, parses nothing, and asks for no input. The protocol is the +whole program. + +The shipped protocol in `intrptr.arch` moves a thing in two steps — write the +new location into it, then send it `'MOVE'` — so the thing is told about the +move only after the move has happened. It recovers the origin from +`last_location`, kept for exactly that purpose, and a handler that wants to +refuse can only put things back afterward. `starship_types.arch` has the +canonical version: a power source moved into an occupied socket complains and +writes `location := last_location`. + +Nearly all of that is fixed by asking first, and asking needs no arguments. +A precondition is a method that is ABSENT for everything with no objection — +which is almost everything — so only the rare exception mentions it at all: + +``` + 'CANNOT MOVE' : ABSENT +``` + +ABSENT is already false enough to fall through an `if`, so the common case +costs nothing and stays invisible. The vise in the demo is the exception, and +it is the entire implementation of being bolted down. + +`'ADD SELF'` and `'DROP SELF'` are unchanged, and want no arguments either: the +thing being added is the thing doing the asking, so `sender` already names it. + +**One thing is left over**, and it is the only list message in the file. A +precondition about the *destination* has to be given the destination, and a +thing has exactly one channel for that — `sender` — which is already saying +which thing is moving. So the destination rides in the message: + +``` + 'MOVE TO' : { + dest_ := head tail message + if dest_ = location then TRUE + else if 'CANNOT MOVE' -> self then FALSE + else if 'CANNOT ACCEPT' -> dest_ then FALSE + else { ... } + } +``` + +That is the whole case for arguments, and the whole price of them: one +attribute, `dest_`, in one handler, to give the argument a name. Everything +else in the protocol was already expressible. + +Two smaller things it shows: + +- **Forwarding is free.** `announced` overrides `'MOVE TO'`, and + `message --> thing` hands the whole list to the parent, arguments and all, + with nothing unpacked and nothing rebuilt. +- **Assembly is not movement.** `'ASSEMBLE'` in `intrptr.arch` clears + `last_location` and calls `'MOVE'`, using the field as a "never placed" flag. + With the guards moved ahead of the mutation there is no such field, so the + initial placement gets its own message. + +Worth noticing where the capacity check ends up. In `intrptr.arch` the mover +reaches into the destination — `if location.capacity then location.capacity -:= +size` — because it has no way to ask. Here the place answers for itself. + +It is a demonstration of a protocol, not a replacement for one. The `'MOVE'` +protocol in `intrptr.arch` is subclassed by shipped games and is not going +anywhere. diff --git a/demos/moving.arch b/demos/moving.arch new file mode 100644 index 0000000..345ed34 --- /dev/null +++ b/demos/moving.arch @@ -0,0 +1,259 @@ +# MOVING.ARCH +# +# Where a message with arguments earns its keep, and where it does not. +# +# The shipped protocol in intrptr.arch moves a thing in two steps: write +# the new location into it, then send it 'MOVE'. The thing hears about the +# move only after the move, works out where it came from by having kept +# "last_location" for that purpose, and a handler that wants to refuse can +# only put things back afterward. +# +# Almost all of that is fixed by asking first, and asking needs no +# arguments at all. A precondition is a method that is ABSENT for the +# things that have no objection -- which is nearly all of them -- and only +# the rare exception says otherwise. ABSENT is already false enough to +# fall through an "if", so the common case costs nothing and is invisible. +# +# One thing is left over, and it is the only list message in this file. A +# precondition about the *destination* has to be given the destination, and +# a thing has exactly one channel for that -- "sender" -- which is already +# saying which thing is moving. So the destination comes in the message. +# +# Nothing here includes the standard library: the protocol is the whole +# program. Run it with +# +# ./build/archetype --source=demos/moving.arch +# +# It demonstrates a protocol. It does not replace the one in intrptr.arch, +# which shipped games subclass. + + +############################################################################# +# Places +# +# 'ADD SELF' and 'DROP SELF' are unchanged from the shipped protocol, and +# want no arguments: the thing being added is the thing doing the asking, +# so "sender" already names it. + +class place based on null + + name : "somewhere" + contents : UNDEFINED + + rest_ : UNDEFINED + +methods + + # The precondition. Nearly every place has no opinion, and says so by + # never mentioning it. + 'CANNOT ACCEPT' : ABSENT + + 'ADD SELF' : contents := sender @ contents + + 'DROP SELF' : { + rest_ := UNDEFINED + while contents do { + if head contents ~= sender then rest_ := head contents @ rest_ + contents := tail contents + } + while rest_ do { + contents := head rest_ @ contents + rest_ := tail rest_ + } + } + + 'ROLL CALL' : { + writes " ", name, " holds:" + rest_ := contents + if rest_ = UNDEFINED then writes " nothing" + while rest_ do { + writes " ", (head rest_).name + rest_ := tail rest_ + } + write "" + } + +end + + +############################################################################# +# Things +# +# A thing knows where it is and never knows where it was, because it is +# never asked to work that out: when ['MOVE TO' dest] arrives, "location" +# is still the origin. Both preconditions run before anything is written, +# so a refusal leaves nothing to undo -- and there is no last_location. + +class thing based on null + + name : "something" + location : UNDEFINED + + # The argument, named. This is the whole cost of the list message, and + # it is one attribute, in one class, in the one handler that takes an + # argument. + dest_ : UNDEFINED + +methods + + # The other precondition: whether this thing can move at all, which has + # nothing to do with where it is going and so needs nothing passed in. + 'CANNOT MOVE' : ABSENT + + # Assembly is not movement. "location" was written down in the source + # and the place has never heard of it. + 'PLACE' : if location then 'ADD SELF' -> location + + 'MOVE TO' : { + dest_ := head tail message + if dest_ = location then + TRUE + else if 'CANNOT MOVE' -> self then + FALSE + else if 'CANNOT ACCEPT' -> dest_ then + FALSE + else { + 'DROP SELF' -> location + 'ADD SELF' -> dest_ + location := dest_ + TRUE + } + } + +end + + +# Forwarding is free: the whole list goes up the chain, arguments and all, +# and by the time the parent is done "location" is the destination. + +class announced based on thing + +methods + + 'MOVE TO' : + if message --> thing then { + write name, " goes to ", location.name, "." + TRUE + } + else + FALSE + +end + + +############################################################################# +# The exceptions, which are few and say so themselves + +place bench name : "the workbench" end + + +# starship_types.arch has this the other way round: the power source is +# moved into an occupied socket, notices afterward, complains, and writes +# location := last_location to undo it. Asked first, the socket answers +# for its own occupancy and nothing needs undoing. + +place socket + + name : "the socket" + +methods + + 'CANNOT ACCEPT' : + if contents then { + write "There is already something in the socket." + TRUE + } + +end + + +place hand + + name : "my hand" + capacity : 2 + +methods + + 'CANNOT ACCEPT' : + # An empty list has no length -- it reads as UNDEFINED, the same as an + # attribute nobody set -- so emptiness is tested before size. + if contents and length contents >= capacity then { + write "My hand is full." + TRUE + } + +end + + +thing bulb name : "the bulb" location : bench end +thing fuse name : "the fuse" location : bench end +announced wrench name : "the wrench" location : bench end + + +# The destination-independent refusal, which is the common kind and wants +# no message with arguments at all. + +thing vise + + name : "the vise" + location : bench + +methods + + 'CANNOT MOVE' : { + write "The vise is bolted to the bench." + TRUE + } + +end + + +############################################################################# + +null main + +methods + + 'ROLL CALL' : { + 'ROLL CALL' -> bench + 'ROLL CALL' -> socket + 'ROLL CALL' -> hand + write "" + } + + 'START' : { + + for each do 'PLACE' -> each + + write "Everything starts on the bench." + 'ROLL CALL' + + write "Putting the bulb in the socket." + if ['MOVE TO' socket] -> bulb then + write "Done." + 'ROLL CALL' + + write "Putting the fuse in the socket, which is spoken for." + if not ['MOVE TO' socket] -> fuse then + write "So the fuse never left the bench." + 'ROLL CALL' + + write "Picking up the vise, which is not going anywhere." + if not ['MOVE TO' hand] -> vise then + write "No argument was needed to find that out." + 'ROLL CALL' + + write "Picking up the fuse and the wrench." + ['MOVE TO' hand] -> fuse + ['MOVE TO' hand] -> wrench + 'ROLL CALL' + + write "Reaching for the bulb with both hands full." + if not ['MOVE TO' hand] -> bulb then + write "So the bulb is still in the socket." + 'ROLL CALL' + + stop "Nothing was moved and put back." + } + +end diff --git a/games/intrptr.arch b/games/intrptr.arch index f0b3b28..2b7b487 100644 --- a/games/intrptr.arch +++ b/games/intrptr.arch @@ -192,8 +192,7 @@ methods stop "EOF; goodbye." } - 'PLAYER CMD' -> system - command -> system + ['PLAYER CMD' command] -> system 'SEND EVENT' -> before @@ -273,14 +272,12 @@ methods # as a message. if send_to then { - 'WHICH OBJECT' -> system - if (match := verb -> system).interpret then + if (match := ['WHICH OBJECT' verb] -> system).interpret then 'INTERPRET' -> match else if match.disabled then 'DISABLED' -> match else { - 'WHICH OBJECT' -> system - if (match := verbmsg -> system).interpret then + if (match := ['WHICH OBJECT' verbmsg] -> system).interpret then 'INTERPRET' -> match else if match.disabled then 'DISABLED' -> match @@ -294,8 +291,7 @@ methods # Now it's time to actually send the message. If who we're sending to has # an ABSENT method, give the appropriate error messages. if verbmsg -> send_to = ABSENT then { - 'WHICH OBJECT' -> system - if (match := verbmsg -> system) and match.normal then + if (match := ['WHICH OBJECT' verbmsg] -> system) and match.normal then { if 'NORMAL' -> match = ABSENT then 'Semantic Error' } else { @@ -315,8 +311,7 @@ methods else answer := ABSENT if answer = ABSENT then { # try the verb alone - 'WHICH OBJECT' -> system - if (match := verb -> system).IsAVerb and match.normal then + if (match := ['WHICH OBJECT' verb] -> system).IsAVerb and match.normal then { if 'NORMAL' -> match = ABSENT then 'Semantic Error' } else 'Semantic Error' @@ -361,8 +356,7 @@ methods 'MENTION' : { mentioned := TRUE - 'WHICH OBJECT' -> system - if it := sender.pronoun -> system then + if it := ['WHICH OBJECT' sender.pronoun] -> system then it.referent := sender else { create pronoun_object named it @@ -417,7 +411,7 @@ methods 'SEND EVENT' : { temp := subscribers while temp do { - event -> (head temp) + event -> head temp temp := tail temp } } @@ -489,14 +483,14 @@ methods temp_ := UNDEFINED while members do { if sender ~= head members then { - temp_ := (head members) @ temp_ + temp_ := head members @ temp_ } members := tail members } # temp_ is now members reversed; put it back members := UNDEFINED while temp_ do { - members := (head temp_) @ members + members := head temp_ @ members temp_ := tail temp_ } } @@ -527,7 +521,7 @@ methods temp := sender.members while temp do { if 'INVENTORY NAME' -> head temp then - items := (head temp) @ items + items := head temp @ items temp := tail temp } items @@ -676,12 +670,12 @@ methods } 'ROOMVIEW' : { - 'BANNER' -> system; '-' -> system + ['BANNER' '-'] -> system if not visited then 'FIRSTDESC' 'LONGDESC' 'INVENTORY' 'INVENTORY' -> compass - 'BANNER' -> system; '-' -> system + ['BANNER' '-'] -> system } # ROOMVIEW 'BRIEF' : @@ -890,8 +884,7 @@ methods 'save' : { writes "Save current state to what file? " - 'SAVE STATE' -> system - if read -> system then + if ['SAVE STATE' read] -> system then write "Game saved." else write "Could not save game." @@ -899,8 +892,7 @@ methods 'load' : { writes "Load game from what file? " - 'LOAD STATE' -> system - if read -> system then + if ['LOAD STATE' read] -> system then write "Game loaded." else write "Could not load game." diff --git a/src/Expression.cc b/src/Expression.cc index 45a0656..057f148 100644 --- a/src/Expression.cc +++ b/src/Expression.cc @@ -12,6 +12,7 @@ #include #include #include +#include #include #include "Expression.hh" @@ -91,6 +92,11 @@ namespace archetype { case OP_STRING: return 12; case OP_RANDOM: return 12; case OP_LENGTH: return 12; + // Selectors, and they bind like the rest of this family: "head list" + // is one operand, so "head list = x" compares the head rather than + // taking the head of a comparison + case OP_HEAD: return 12; + case OP_TAIL: return 12; case OP_POWER: return 11; @@ -121,10 +127,10 @@ namespace archetype { case OP_AND: return 3; case OP_OR: return 2; - // TODO: What's the right precedence here? LISP never has to decide + // LISP never has to decide this, but a language with infix operators + // does. Building stays loose: whatever computes an element finishes + // before the element is joined on, so "a + 1 @ rest" is a list. case OP_PAIR: return 2; - case OP_HEAD: return 2; - case OP_TAIL: return 2; case OP_C_MULTIPLY: return 1; case OP_C_DIVIDE: return 1; @@ -300,6 +306,11 @@ namespace archetype { break; } case OP_LENGTH: { + if (rv->isList()) { + // How many things are in it, not how wide it prints + result = make_unique(rv->listLength()); + break; + } Value rv_s = rv->stringConversion(); if (rv_s->isDefined()) { result = make_unique(static_cast(rv_s->getString().size())); @@ -400,6 +411,22 @@ namespace archetype { return make_unique(result); } + // A list compares by what it is made of, or it does not compare. Two lists + // are equal when their elements are, a list and anything else are simply not + // the same value, and no list is less than another: the only ordering on + // offer would be the order of the text they print as, which is an ordering + // in appearance rather than in fact. + optional compare_lists(Keywords::Operators_e op, const Value& lv, const Value& rv) { + if (not (lv->isList() or rv->isList())) { + return nullopt; + } + switch (op) { + case OP_EQ: return as_boolean_value(lv->isSameValueAs(rv)); + case OP_NE: return as_boolean_value(not lv->isSameValueAs(rv)); + default: return Value{make_unique()}; + } + } + bool eval_compare(Keywords::Operators_e op, const Value& lv, const Value& rv) { // Quick shortcut for identity. Will also catch (v = UNDEFINED) and (UNDEFINED = v). if (op == OP_EQ and lv->isSameValueAs(rv)) { @@ -556,8 +583,7 @@ namespace archetype { result = make_unique(std::move(lv_v), std::move(rv_v)); break; } - case OP_CONCAT: - case OP_WITHIN: { + case OP_CONCAT: { Value lv_s = left_->evaluate()->stringConversion(); Value rv_s = right_->evaluate()->stringConversion(); if (lv_s->isDefined() and rv_s->isDefined()) { @@ -567,11 +593,32 @@ namespace archetype { } break; } + // The text surgery operators go no further than text. Cutting up + // the form a list prints as would answer a question nobody asked, + // and "within" is where membership would want to live one day, so + // a list leaves them unanswered rather than answered wrongly. + case OP_WITHIN: { + Value lv_v = left_->evaluate()->valueConversion(); + Value rv_v = right_->evaluate()->valueConversion(); + Value lv_s = lv_v->stringConversion(); + Value rv_s = rv_v->stringConversion(); + if (lv_v->isList() or rv_v->isList()) { + result = make_unique(); + } else if (lv_s->isDefined() and rv_s->isDefined()) { + result = eval_ss(op(), lv_s->getString(), rv_s->getString()); + } else { + result = make_unique(); + } + break; + } case OP_LEFTFROM: case OP_RIGHTFROM: { - Value lv_s = left_->evaluate()->stringConversion(); + Value lv_v = left_->evaluate()->valueConversion(); Value rv_n = right_->evaluate()->numericConversion(); - if (lv_s->isDefined() and rv_n->isDefined()) { + Value lv_s = lv_v->stringConversion(); + if (lv_v->isList()) { + result = make_unique(); + } else if (lv_s->isDefined() and rv_n->isDefined()) { result = eval_sn(op(), lv_s->getString(), rv_n->getNumber()); } else { result = make_unique(); @@ -645,11 +692,16 @@ namespace archetype { case OP_LT: case OP_LE: case OP_GE: - case OP_GT: - result = as_boolean_value(eval_compare(op(), - left_->evaluate()->valueConversion(), - right_->evaluate()->valueConversion())); + case OP_GT: { + Value lv_v = left_->evaluate()->valueConversion(); + Value rv_v = right_->evaluate()->valueConversion(); + if (optional as_lists = compare_lists(op(), lv_v, rv_v)) { + result = std::move(*as_lists); + } else { + result = as_boolean_value(eval_compare(op(), lv_v, rv_v)); + } break; + } case OP_ASSIGN: { Value lv_a = left_->evaluate()->attributeConversion(); diff --git a/src/Object.cc b/src/Object.cc index c62cc8e..960f2e3 100644 --- a/src/Object.cc +++ b/src/Object.cc @@ -74,15 +74,22 @@ namespace archetype { } Value Object::dispatch() { - Value defined_message = Universe::instance().currentContext().messageValue->messageConversion(); + const Value& sent = Universe::instance().currentContext().messageValue; + // Dispatch always goes by the head. A list supplies its own, so that + // ['MOVE TO' player] finds the 'MOVE TO' method and the rest rides + // along as arguments; an atom is the head of itself, so a bare message + // is a list of one and there is no second case. + Value defined_message = sent->head()->messageConversion(); Value absence = make_unique(); Value result = make_unique(); int message_id = -1; if (defined_message->isDefined()) { if (Debug) { Value target = make_unique(id()); + // The whole message, not just the head it dispatched on: a trace + // that hid the arguments would hide what one wants to trace. Universe::instance().output()->put(format("dispatching {} to {}", - defined_message, target)); + sent, target)); Universe::instance().output()->endLine(); } message_id = defined_message->getMessage(); diff --git a/src/SystemObject.cc b/src/SystemObject.cc index dfda4c9..8a86c9a 100644 --- a/src/SystemObject.cc +++ b/src/SystemObject.cc @@ -67,7 +67,21 @@ namespace archetype { } Value SystemObject::executeDefaultMethod() { - Value message = Universe::instance().currentContext().messageValue->clone(); + const Value& sent = Universe::instance().currentContext().messageValue; + // A list message is the staged dance in one send: the head first, + // then each element of the tail in order, with the reply of the whole + // being the reply of the last. So ['LOAD STATE' "file.acx"] keeps + // its Boolean, and no send can be caught mid-dance by a save. An + // atom is the head of itself with an undefined tail, so a bare + // message walks the same walk in one step. + Value result = interpret_(sent->head()); + for (Value node = sent->tail(); node->isDefined(); node = node->tail()) { + result = interpret_(node->head()); + } + return result; + } + + Value SystemObject::interpret_(const Value& message) { switch (state_) { case IDLING: if (figureState_(message)) { diff --git a/src/SystemObject.hh b/src/SystemObject.hh index 57a890e..7dc4593 100644 --- a/src/SystemObject.hh +++ b/src/SystemObject.hh @@ -53,6 +53,7 @@ namespace archetype { std::unique_ptr parser_; bool figureState_(const Value& message); + Value interpret_(const Value& message); void resetSystem_(); friend void write_parser_rdf(std::ostream& out, bool with_prefixes); diff --git a/src/TestExpression.cc b/src/TestExpression.cc index de1aa0f..d3788c2 100644 --- a/src/TestExpression.cc +++ b/src/TestExpression.cc @@ -396,6 +396,64 @@ namespace archetype { // Curly braces in expression position no longer form a list literal. Expression curly_expr = make_expr_from_str("{1 2 3}"); ARCHETYPE_TEST(curly_expr == nullptr); + + // "length" counts what is in a list rather than measuring how wide it + // prints, and it counts an improper tail as one of them. + Value length_val = make_expr_from_str("length [1 2 3]")->evaluate()->numericConversion(); + ARCHETYPE_TEST(length_val->isDefined()); + ARCHETYPE_TEST_EQUAL(length_val->getNumber(), 3); + Value nested_length = make_expr_from_str("length [[1 2] [3 4]]")->evaluate()->numericConversion(); + ARCHETYPE_TEST_EQUAL(nested_length->getNumber(), 2); + Value pair_length = make_expr_from_str("length (1 @ 2)")->evaluate()->numericConversion(); + ARCHETYPE_TEST_EQUAL(pair_length->getNumber(), 2); + Value empty_length = make_expr_from_str("length []")->evaluate()->numericConversion(); + ARCHETYPE_TEST(not empty_length->isDefined()); + + // Equality asks what a list is made of; it does not settle for the two + // of them printing alike. + Value same = make_expr_from_str("[1 2 3] = [1 2 3]")->evaluate()->valueConversion(); + ARCHETYPE_TEST(same->isTrueEnough()); + Value different = make_expr_from_str("[1 2 3] ~= [1 2 4]")->evaluate()->valueConversion(); + ARCHETYPE_TEST(different->isTrueEnough()); + Value list_vs_text = make_expr_from_str("[1 2 3] = \"[1 2 3]\"")->evaluate()->valueConversion(); + ARCHETYPE_TEST(list_vs_text->isDefined()); + ARCHETYPE_TEST(not list_vs_text->isTrueEnough()); + + // Ordering a list against anything is UNDEFINED rather than FALSE: + // there is no answer, which is not the same as the answer being no. + for (auto const& source : {"[1 2] < [3]", "[1 2] > [3]", "[1 2] <= [3]", + "[1 2] >= [3]", "[1 2] < 5", "\"a\" < [1 2]"}) { + Value ordered = make_expr_from_str(source)->evaluate()->valueConversion(); + ARCHETYPE_TEST(not ordered->isDefined()); + } + + // Text surgery stops at the edge of a list rather than cutting up the + // form it prints as, leaving "within" free to mean membership one day. + for (auto const& source : {"\"2\" within [1 2 3]", "[1 2] within \"[1 2 3]\"", + "[1 2 3] leftfrom 3", "[1 2 3] rightfrom 4"}) { + Value surgery = make_expr_from_str(source)->evaluate()->valueConversion(); + ARCHETYPE_TEST(not surgery->isDefined()); + } + + // But "&" still asks for text, and a list still has some + Value joined = make_expr_from_str("\"items \" & [1 2 3]")->evaluate()->stringConversion(); + ARCHETYPE_TEST(joined->isDefined()); + ARCHETYPE_TEST_EQUAL(joined->getString(), string{"items [1 2 3]"}); + + // An atom is the head of itself: every value is a list of at least + // one. The tail is what tells an atom from a list of one, and the + // head of nothing is still nothing. + Value atom_head = make_expr_from_str("head 5")->evaluate()->numericConversion(); + ARCHETYPE_TEST(atom_head->isDefined()); + ARCHETYPE_TEST_EQUAL(atom_head->getNumber(), 5); + Value string_head = make_expr_from_str("head \"abc\"")->evaluate()->stringConversion(); + ARCHETYPE_TEST_EQUAL(string_head->getString(), string{"abc"}); + Value single = make_expr_from_str("head [5] = head 5")->evaluate()->valueConversion(); + ARCHETYPE_TEST(single->isTrueEnough()); + Value atom_tail = make_expr_from_str("tail 5")->evaluate()->valueConversion(); + ARCHETYPE_TEST(not atom_tail->isDefined()); + Value undef_head = make_expr_from_str("head UNDEFINED")->evaluate()->valueConversion(); + ARCHETYPE_TEST(not undef_head->isDefined()); } void TestExpression::testReplDisplay_() { diff --git a/src/TestObject.cc b/src/TestObject.cc index febe15d..c932a7a 100644 --- a/src/TestObject.cc +++ b/src/TestObject.cc @@ -166,6 +166,79 @@ namespace archetype { ARCHETYPE_TEST_EQUAL(actual2, expected2); } + void TestObject::testListMessages_() { + ObjectPtr vase = Universe::instance().defineNewObject(); + Universe::instance().assignObjectIdentifier(vase, "vase"); + int move_to_id = Universe::instance().Messages.index("MOVE TO"); + vase->setMethod(move_to_id, + make_stmt_from_str("{ if head tail message = UNDEFINED then {\n" + " write \"the vase stays put\"\n" + " } else {\n" + " write \"the vase moves to \", head tail message\n" + " } }\n")); + // The default method sees the message the sender wrote, list and all + vase->setMethod(DefaultMethod, + make_stmt_from_str("write \"the vase ignores \", head message, \" in \", message")); + + Statement stmt1 = make_stmt_from_str("['MOVE TO' \"the attic\"] -> vase"); + Capture capture1; + stmt1->execute(); + string expected1 = "the vase moves to the attic\n"; + string actual1 = capture1.getCapture(); + ARCHETYPE_TEST_EQUAL(actual1, expected1); + + // A plain message still dispatches, and asking it for arguments is not an + // error; a list with nothing after its head is the very same silence. + Statement stmt2 = make_stmt_from_str("{ 'MOVE TO' -> vase; ['MOVE TO'] -> vase }"); + Capture capture2; + stmt2->execute(); + string expected2 = "the vase stays put\nthe vase stays put\n"; + string actual2 = capture2.getCapture(); + ARCHETYPE_TEST_EQUAL(actual2, expected2); + + // An unclaimed head falls to the default method, as an unclaimed message + // always has; a head that is no kind of message falls there too. And + // an atom is the head of itself, so "head message" names the message + // whether or not it arrived in a list: one spelling of the question. + Statement stmt3 = make_stmt_from_str("{ ['SHATTER' 3] -> vase; [42 7] -> vase;" + " 'VANISH' -> vase }"); + Capture capture3; + stmt3->execute(); + string expected3 = "the vase ignores SHATTER in ['SHATTER' 3]\n" + "the vase ignores 42 in [42 7]\n" + "the vase ignores VANISH in VANISH\n"; + string actual3 = capture3.getCapture(); + ARCHETYPE_TEST_EQUAL(actual3, expected3); + + // The reply comes back from a list message like any other, which is what + // lets a method refuse an argument instead of undoing it + int bump_id = Universe::instance().Messages.index("BUMP"); + vase->setMethod(bump_id, make_stmt_from_str("head tail message + 1")); + Expression expr4 = make_expr_from_str("['BUMP' 41] -> vase"); + Value val4 = expr4->evaluate()->numericConversion(); + ARCHETYPE_TEST(val4->isDefined()); + ARCHETYPE_TEST_EQUAL(val4->getNumber(), 42); + + // Passing hands the whole list up, so arguments survive the trip to a + // parent's method without anyone naming them along the way + ObjectPtr furniture = Universe::instance().defineNewObject(); + furniture->setPrototype(true); + Universe::instance().assignObjectIdentifier(furniture, "furniture"); + furniture->setMethod(move_to_id, + make_stmt_from_str("write \"the furniture moves to \", head tail message")); + ObjectPtr crate = Universe::instance().defineNewObject(furniture->id()); + Universe::instance().assignObjectIdentifier(crate, "crate"); + crate->setMethod(move_to_id, + make_stmt_from_str("{ message --> furniture; write \"the crate settles\" }")); + + Statement stmt5 = make_stmt_from_str("['MOVE TO' \"the cellar\"] -> crate"); + Capture capture5; + stmt5->execute(); + string expected5 = "the furniture moves to the cellar\nthe crate settles\n"; + string actual5 = capture5.getCapture(); + ARCHETYPE_TEST_EQUAL(actual5, expected5); + } + void TestObject::testReadDoesNotMutate_() { ObjectPtr subject = Universe::instance().defineNewObject(); Universe::instance().assignObjectIdentifier(subject, "subject"); @@ -207,6 +280,7 @@ namespace archetype { testInheritance_(); testMethods_(); testMessagePassing_(); + testListMessages_(); testReadDoesNotMutate_(); } } diff --git a/src/TestObject.hh b/src/TestObject.hh index 2e373a0..9dc7080 100644 --- a/src/TestObject.hh +++ b/src/TestObject.hh @@ -19,6 +19,7 @@ namespace archetype { void testInheritance_(); void testMethods_(); void testMessagePassing_(); + void testListMessages_(); void testReadDoesNotMutate_(); protected: virtual void runTests_() override; diff --git a/src/TestSystemObject.cc b/src/TestSystemObject.cc index b1214c3..f1455d5 100644 --- a/src/TestSystemObject.cc +++ b/src/TestSystemObject.cc @@ -209,10 +209,63 @@ namespace archetype { ARCHETYPE_TEST(two_statements->isSameValueAs(take_obj)); } + // A list message is the staged dance in one send: the head first, then + // each element of the tail in order, with the reply of the whole being + // the reply of the last. + void TestSystemObject::testListMessages_() { + Universe::destroy(); + + // The sorter loaded in one message. The reply is the last add's + // echo, the same value the staged dance would have ended on. + Value last = make_stmt_from_str( + "['INIT SORTER' \"dog\" \"Ajax\" \"cat\"] -> system" + )->execute()->stringConversion(); + ARCHETYPE_TEST(last->isDefined()); + ARCHETYPE_TEST_EQUAL(last->getString(), string{"cat"}); + make_stmt_from_str("'CLOSE SORTER' -> system")->execute(); + deque expected = {"Ajax", "cat", "dog"}; + Statement stmt = make_stmt_from_str("'NEXT SORTED' -> system"); + for (auto const& s : expected) { + Value ans = stmt->execute()->stringConversion(); + ARCHETYPE_TEST(ans->isDefined()); + ARCHETYPE_TEST_EQUAL(ans->getString(), s); + } + ARCHETYPE_TEST(not stmt->execute()->isDefined()); + + // A list of one is the bare message, to system like to everything. + Value singleton = make_stmt_from_str("['NEXT SORTED'] -> system")->execute(); + ARCHETYPE_TEST(not singleton->isDefined()); + + // A control message rides in a tail like any other element, so a + // whole open-feed-close protocol fits in one send. + make_stmt_from_str("['INIT SORTER' \"b\" \"a\" 'CLOSE SORTER'] -> system")->execute(); + Value first = make_stmt_from_str("'NEXT SORTED' -> system")->execute()->stringConversion(); + ARCHETYPE_TEST(first->isDefined()); + ARCHETYPE_TEST_EQUAL(first->getString(), string{"a"}); + make_stmt_from_str("'NEXT SORTED' -> system")->execute(); + ARCHETYPE_TEST(not make_stmt_from_str("'NEXT SORTED' -> system")->execute()->isDefined()); + + // One-shot 'WHICH OBJECT': no priming, no second send, and the + // answer comes back as the reply of the only send there is. + TokenStream t1(make_source_from_str("program1", program1)); + Universe::instance().make(t1); + make_stmt_from_str( + "{'OPEN PARSER' -> system;" + "'BUILD' -> take;" + "'BUILD' -> money;" + "'CLOSE PARSER' -> system}" + )->execute(); + int take_obj_id = Universe::instance().getObject("take")->id(); + Value one_shot = make_stmt_from_str("['WHICH OBJECT' \"grab\"] -> system")->execute(); + Value take_obj = make_unique(take_obj_id); + ARCHETYPE_TEST(one_shot->isSameValueAs(take_obj)); + } + void TestSystemObject::runTests_() { testSorting_(); testParsing_(); testEmptyPhraseNeverMatches_(); testArrowSequencing_(); + testListMessages_(); } } diff --git a/src/TestSystemObject.hh b/src/TestSystemObject.hh index 0c64efb..e3d3212 100644 --- a/src/TestSystemObject.hh +++ b/src/TestSystemObject.hh @@ -19,6 +19,7 @@ namespace archetype { void testParsing_(); void testEmptyPhraseNeverMatches_(); void testArrowSequencing_(); + void testListMessages_(); protected: virtual void runTests_() override; public: diff --git a/src/TestValue.cc b/src/TestValue.cc index 2a5de2e..a26606c 100644 --- a/src/TestValue.cc +++ b/src/TestValue.cc @@ -90,6 +90,15 @@ namespace archetype { actual = display(node2); expected = "[\"hello\" \"world\"]"; ARCHETYPE_TEST_EQUAL(actual, expected); + + // A list converts to the string it displays as, so that "write" of one + // shows the list rather than nothing + Value written = node2->stringConversion(); + ARCHETYPE_TEST(written->isDefined()); + ARCHETYPE_TEST_EQUAL(written->getString(), display(node2)); + + Value pair_written = ab->stringConversion(); + ARCHETYPE_TEST_EQUAL(pair_written->getString(), string{"(1 @ 2)"}); } void TestValue::runTests_() { diff --git a/src/Value.cc b/src/Value.cc index 691515a..f58cf7d 100644 --- a/src/Value.cc +++ b/src/Value.cc @@ -8,6 +8,7 @@ #include #include +#include #include #include #include @@ -109,10 +110,15 @@ namespace archetype { } Value IValue::head() const { - return make_unique(); + // An atom is the head of itself: every value reads as a list of at + // least one, which is what lets dispatch always go by the head. + return clone(); } Value IValue::tail() const { + // The tail is what tells an atom from a list of one, and it stays + // undefined here on purpose: if an atom were its own tail as well, + // every loop that walks a list would never find the end of it. return make_unique(); } @@ -479,6 +485,32 @@ namespace archetype { return tail_->clone(); } + int PairValue::listLength() const { + // Walked rather than remembered, the way std::list::size once was: the + // spine is the only record of how long a list is. + int length = 0; + for (const PairValue* node = this; node; ) { + ++length; + const PairValue* next = dynamic_cast(node->tail_.get()); + if (not next and node->tail_->isDefined()) { + // An improper tail is a thing in the list too: (1 @ 2) holds two + ++length; + } + node = next; + } + return length; + } + + Value PairValue::stringConversion() const { + // A list's printed form is its string form: the same thing the REPL + // echoes and a message trace shows. Without this, "write" put out + // nothing at all for a list -- the one way of being wrong that leaves + // nothing behind to notice it by. + ostringstream out; + display(out); + return make_unique(out.str()); + } + void PairValue::display(ostream &out) const { const PairValue* tail_p = dynamic_cast(tail_.get()); if (tail_->isDefined() and not tail_p) { diff --git a/src/Value.hh b/src/Value.hh index dc85dc6..4815c1b 100644 --- a/src/Value.hh +++ b/src/Value.hh @@ -59,9 +59,18 @@ namespace archetype { virtual Value attributeConversion() const; virtual Value valueConversion() const { return clone(); } + // Every value is a list of at least itself: an atom's head is the + // atom, and only its undefined tail tells it from a list of one. virtual Value head() const; virtual Value tail() const; + // Not every question about a value is answerable by conversion. An + // operator whose meaning depends on what a value is made of -- how many + // things are in it, whether it can be ordered against another -- has to + // ask, and these are what it asks with. + virtual bool isList() const { return false; } + virtual int listLength() const { return 0; } + virtual Value assign(Value new_value); }; @@ -276,6 +285,11 @@ namespace archetype { virtual Value head() const override; virtual Value tail() const override; + virtual bool isList() const override { return true; } + virtual int listLength() const override; + + virtual Value stringConversion() const override; + virtual void display(std::ostream& out) const override; virtual std::string asRDF() const override; virtual void write(Storage& out) const override; diff --git a/src/main.cc b/src/main.cc index 7385216..c58005c 100644 --- a/src/main.cc +++ b/src/main.cc @@ -40,7 +40,7 @@ namespace archetype { - static constexpr std::string_view VersionString = "3.0"; + static constexpr std::string_view VersionString = "4.0"; class CompilationFailure : public std::runtime_error { public: diff --git a/tests/golden/bare.acx b/tests/golden/bare.acx index c99909a..dfab62c 100644 Binary files a/tests/golden/bare.acx and b/tests/golden/bare.acx differ diff --git a/tests/golden/cherry.acx b/tests/golden/cherry.acx index 8c3abbb..aa4d596 100644 Binary files a/tests/golden/cherry.acx and b/tests/golden/cherry.acx differ