diff --git a/archetype-mode.el b/archetype-mode.el index 69f0b8c..1407eb1 100644 --- a/archetype-mode.el +++ b/archetype-mode.el @@ -140,8 +140,10 @@ All other single quotes (apostrophes, stray ticks) remain punctuation." (,val . font-lock-constant-face) ;; Built-in identifiers (,blt . font-lock-builtin-face) - ;; Message-send operators: --> (broadcast to class) and -> (send to object) - ("-->?" 0 ,op-face) + ;; Message-send operators: --> (broadcast to class), -> (send to object), + ;; and <- (send to object, yielding the object rather than the reply). + ;; "<-" is listed first so it wins over any shorter match. + ("<-\\|-->?" 0 ,op-face) ;; Assignment operators: := and the compound forms +:= -:= &:= ("[+\\-&]?:=" 0 ,op-face))) "Font-lock specification for `archetype-mode'.") @@ -171,6 +173,7 @@ Syntax overview: object NAME attr : value methods 'MSG' : stmt end 'MESSAGE' -> object # send a message, get return value 'MESSAGE' --> class # send to nearest ancestor class + object <- 'M1' <- 'M2' # send for effect, get the object back expr := value # assignment >>verbatim text here # print exactly as written diff --git a/src/Expression.cc b/src/Expression.cc index 265826c..45a0656 100644 --- a/src/Expression.cc +++ b/src/Expression.cc @@ -108,6 +108,7 @@ namespace archetype { case OP_SEND: return 6; case OP_PASS: return 6; + case OP_SEND_TO: return 6; case OP_EQ: return 5; case OP_NE: return 5; @@ -484,6 +485,28 @@ namespace archetype { return false; } bool result = true; + + // "->" and "<-" share a precedence and both group to the left, so + // an unparenthesized mix of the two silently reassociates into + // nonsense: (verb -> system <- 'X') sends 'X' to whatever object + // the reply happened to be. The reading almost certainly meant is + // (verb -> (system <- 'X')), which puts the "<-" on the *right* + // side; only a left-hand child is ambiguous, so only that is + // refused. This does also refuse a deliberate + // ((a -> b) <- c) -- send to whatever object came back -- which + // has to go through an intermediate attribute instead. + auto is_arrow = [](Keywords::Operators_e o) { + return o == OP_SEND or o == OP_PASS or o == OP_SEND_TO; + }; + if (is_arrow(op())) { + if (auto left_arrow = dynamic_cast(left_.get()); + left_arrow and is_arrow(left_arrow->op()) and + (op() == OP_SEND_TO) != (left_arrow->op() == OP_SEND_TO)) { + t.errorMessage("Cannot mix '->' and '<-' without parentheses"); + return false; + } + } + switch (op()) { case OP_DOT: if (auto id_node = dynamic_cast(right_.get())) { @@ -671,6 +694,37 @@ namespace archetype { break; } + // The mirror image of OP_SEND in operand order, but not in + // value: this yields the recipient, not the reply. That is + // what lets sends chain -- (obj <- 'A' <- 'B') -- and what + // lets a stateful recipient be primed in place, as in + // (verb -> (system <- 'WHICH OBJECT')). + case OP_SEND_TO: { + Value lv_o = left_->evaluate()->objectConversion(); + if (not lv_o->isDefined()) { + // An undefined recipient quietly swallows the rest of + // a chain, since every later <- then has an undefined + // left side. This is how OP_SEND degrades too. + result = std::move(lv_o); + break; + } + ObjectPtr recipient = Universe::instance().getObject(lv_o->getObject()); + if (not recipient) { + result = make_unique(); + break; + } + // Evaluated after the recipient, so that a chain sends in + // the order written. + Value rv_v = right_->evaluate()->valueConversion(); + if (recipient->isPrototype()) { + Object::pass(recipient, std::move(rv_v)); + } else { + Object::send(recipient, std::move(rv_v)); + } + result = make_unique(recipient->id()); + break; + } + default: if (is_binary(op())) { throw logic_error("No binary operator evaluation written for " + diff --git a/src/Keywords.cc b/src/Keywords.cc index c87c053..a7fb27a 100644 --- a/src/Keywords.cc +++ b/src/Keywords.cc @@ -107,6 +107,15 @@ namespace archetype { OPERATOR(OP_WITHIN, "within"); OPERATOR(OP_HEAD, "head"); OPERATOR(OP_TAIL, "tail"); + + // The list above is in ASCII order, but only for the reader's + // convenience: the scanner looks operators up by exact string, so + // position carries no meaning to it. Position does fix the + // enumerator's value, though, and those values are serialized, so a + // new operator is appended here rather than filed alphabetically. + // "<-" would otherwise belong between "<" and "<=", which would + // renumber OP_LE onward and break every existing .acx file. + OPERATOR(OP_SEND_TO, "<-"); } Keywords::~Keywords() { diff --git a/src/Keywords.hh b/src/Keywords.hh index 8abaf0d..5769e2b 100644 --- a/src/Keywords.hh +++ b/src/Keywords.hh @@ -93,6 +93,12 @@ namespace archetype { OP_WITHIN, OP_HEAD, OP_TAIL, + + // New operators go here, at the end. These enumerators are the + // ints written into .acx files, so renumbering any of the ones + // above would invalidate every compiled game and save file. + OP_SEND_TO, + NumOperators, // Kept outside of the range of valid operators, but diff --git a/src/TestExpression.cc b/src/TestExpression.cc index 6ae8932..de1aa0f 100644 --- a/src/TestExpression.cc +++ b/src/TestExpression.cc @@ -120,6 +120,20 @@ namespace archetype { string actual8 = as_prefix(expr8); string expected8 = "(> (:= (. x i) (+ (. x i) 1)) 5)"; ARCHETYPE_TEST_EQUAL(actual8, expected8); + + // "<-" groups to the left, which is what lets it chain: each send + // yields the recipient back for the next one to use. + Expression expr9 = make_expr_from_str("system <- 'BANNER' <- '='"); + string actual9 = as_prefix(expr9); + string expected9 = "(<- (<- system 'BANNER') '=')"; + ARCHETYPE_TEST_EQUAL(actual9, expected9); + + // Parenthesized, "<-" lands on the right side of "->", so it primes + // the recipient rather than consuming the reply. + Expression expr10 = make_expr_from_str("verb -> (system <- 'WHICH OBJECT')"); + string actual10 = as_prefix(expr10); + string expected10 = "(-> verb (<- system 'WHICH OBJECT'))"; + ARCHETYPE_TEST_EQUAL(actual10, expected10); } void TestExpression::testEvaluation_() { @@ -246,6 +260,20 @@ namespace archetype { expect("'hello' -> scratch = ABSENT", make_unique(false)); expect("'hello' -> scratch ~= ABSENT", make_unique(true)); + // "<-" yields the recipient, not the reply, so a chain of them + // stays anchored on the same object. scratch.x has been climbing + // by one for every 'hello' sent above; these two send two more. + expect("scratch.x := 0", make_unique(0)); + expect("(scratch <- 'hello' <- 'hello') = scratch", make_unique(true)); + expect("scratch.x", make_unique(2)); + // An unknown message is still a send; it just accomplishes nothing. + expect("(scratch <- 'never') = scratch", make_unique(true)); + expect("scratch.x", make_unique(2)); + // An undefined recipient swallows the whole chain rather than + // throwing: every later "<-" then has an undefined left side. + expect("nowhere <- 'hello' <- 'hello'", make_unique()); + expect("scratch.x", make_unique(2)); + for (auto& p : testing_pairs) { Expression expr = make_expr_from_str(p.first); out() << "Testing: {" << p.first << "}" << endl; @@ -273,6 +301,10 @@ namespace archetype { { "\"Hello \" & \"world\"", "(& \"Hello \" \"world\")" + }, + { + "read -> (system <- 'SAVE STATE')", + "(-> read (<- system 'SAVE STATE'))" } }; for (auto const& p : expressions) { @@ -321,6 +353,26 @@ namespace archetype { ARCHETYPE_TEST(expr6 == nullptr); Expression expr7 = make_expr_from_str("('hello' -> world).tricky := 5"); ARCHETYPE_TEST(expr7 != nullptr); + + // "->" and "<-" share a precedence and both group left, so mixing them + // unparenthesized reassociates into something nobody means. Refused + // rather than quietly obeyed. + Expression expr8 = make_expr_from_str("verb -> system <- 'WHICH OBJECT'"); + ARCHETYPE_TEST(expr8 == nullptr); + Expression expr9 = make_expr_from_str("system <- 'WHICH OBJECT' -> verb"); + ARCHETYPE_TEST(expr9 == nullptr); + Expression expr10 = make_expr_from_str("message --> parent <- 'DONE'"); + ARCHETYPE_TEST(expr10 == nullptr); + + // Parentheses say which reading was meant, and both readings are legal. + Expression expr11 = make_expr_from_str("verb -> (system <- 'WHICH OBJECT')"); + ARCHETYPE_TEST(expr11 != nullptr); + + // Chains of a single arrow are never ambiguous. + Expression expr12 = make_expr_from_str("system <- 'BANNER' <- '='"); + ARCHETYPE_TEST(expr12 != nullptr); + Expression expr13 = make_expr_from_str("'GENERATE' -> namesakes -> system"); + ARCHETYPE_TEST(expr13 != nullptr); } void TestExpression::testListLiterals_() { diff --git a/src/TestSystemObject.cc b/src/TestSystemObject.cc index e7a64b4..b1214c3 100644 --- a/src/TestSystemObject.cc +++ b/src/TestSystemObject.cc @@ -156,9 +156,63 @@ namespace archetype { ARCHETYPE_TEST(are_equal); } + // "<-" exists mainly for system's protocols, which are sequences of + // messages sent for effect. These check the two shapes that buys: a + // chain of effects, and a selector primed in place so that the argument's + // reply can be used in the same expression. + void TestSystemObject::testArrowSequencing_() { + Universe::destroy(); + + // The whole sorter protocol as one chain. Each "<-" hands system back + // to the next, so the messages arrive in written order. + Statement stmt = make_stmt_from_str( + "system <- 'INIT SORTER' <- \"dog\" <- \"Ajax\" <- \"cat\" <- 'CLOSE SORTER'" + ); + stmt->execute(); + deque expected = {"Ajax", "cat", "dog"}; + 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 chain evaluates to the recipient, so it can be sent to again. + Value chained = make_stmt_from_str("(system <- 'INIT SORTER') = system")->execute(); + ARCHETYPE_TEST(chained->isTrueEnough()); + make_stmt_from_str("'CLOSE SORTER' -> system")->execute(); + + // 'WHICH OBJECT' followed by its argument is one logical operation, + // but it took two statements to write before. This only comes out + // right because "->" evaluates its message first and its recipient + // second: system is put into WHICH_OBJECT state after "grab" is + // evaluated and immediately before the send. + 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_liner = make_stmt_from_str("\"grab\" -> (system <- 'WHICH OBJECT')")->execute(); + Value take_obj = make_unique(take_obj_id); + ARCHETYPE_TEST(one_liner->isSameValueAs(take_obj)); + + // Same answer as the two-statement form it replaces. + Value two_statements = make_stmt_from_str( + "{'WHICH OBJECT' -> system; \"grab\" -> system}" + )->execute(); + ARCHETYPE_TEST(two_statements->isSameValueAs(take_obj)); + } + void TestSystemObject::runTests_() { testSorting_(); testParsing_(); testEmptyPhraseNeverMatches_(); + testArrowSequencing_(); } } diff --git a/src/TestSystemObject.hh b/src/TestSystemObject.hh index 16c9315..0c64efb 100644 --- a/src/TestSystemObject.hh +++ b/src/TestSystemObject.hh @@ -18,6 +18,7 @@ namespace archetype { void testSorting_(); void testParsing_(); void testEmptyPhraseNeverMatches_(); + void testArrowSequencing_(); protected: virtual void runTests_() override; public: