Support generic message bus.

doc/wiki/eberon-implicit-type-narrowing.md

@@ -15,7 +15,7 @@ Original Oberon-07 has no facility for runtime type testing combined with type c
         ASSERT(~(pb IS PDerived) OR (pb(PDerived).derivedField = 123));
     END.
 
-As you can see here there is two separate operations - type test and then type cast. *Implicit type narrowing* is introduced to resolve this problem.
+As you can see here there are two separate operations - type test and then type cast. *Implicit type narrowing* is introduced to resolve this problem.
 
 The idea of *implicit type narrowing* is to make the compiler smart enough to comprehend that type testing (using IS) and following IF branch or logical conjunction (&) in expression narrows just tested variable type. The same type narrowing happens in the inverse case: logical not (~) for IS operation and following ELSE branch or logical disjunction (OR). Also compiler should guarantee that tested variable is not modified after type narrowing so there is no loopholes to corrupt type system by chance. That guarantee is easy to reach in case of [In Place Variables](/vladfolts/oberonjs/wiki/eberon-in-place-variables) because their scope is very local and they cannot be modified by local procedures. So if the example will use *pb* variable as *in place* variable then it will be compiled without addition type casts:
 
@@ -30,4 +30,21 @@ The idea of *implicit type narrowing* is to make the compiler smart enough to co
         ASSERT(~(pb IS PDerived) OR (pb.derivedField = 123));
     END.
 
-Type narrowing is also applies for WHILE statement and its ELSIF branches.
+Type narrowing is also applies for WHILE statement and its ELSIF branches.
+
+### Generic Message Bus
+*Implicit type narrowing* is also used for VAR arguments to support generic message bus pattern.
+
+    TYPE
+        Message = RECORD END;
+        Derived1 = RECORD (Message) derivedField1: BOOLEAN END;
+        Derived2 = RECORD (Message) derivedField2: BOOLEAN END;
+
+    PROCEDURE handleMessage(VAR msg: Message);
+    BEGIN
+        IF msg IS Derived1 THEN
+            ASSERT(msg.derivedField1);
+        ELSIF msg IS Derived2 THEN
+            ASSERT(msg.derivedField2);
+        END;
+    END handleMessage;        

src/context.js

@@ -597,10 +597,7 @@ exports.ProcDecl = ChainedContext.extend({
     __addArgument: function(name, arg){
         if (name == this.__id.id())
             throw new Errors.Error("argument '" + name + "' has the same name as procedure");
-        var readOnly = !arg.isVar 
-                    && (arg.type instanceof Type.Array || arg.type instanceof Type.Record);
-        var v = arg.isVar ? Type.makeVariableRef(arg.type)
-                          : Type.makeVariable(arg.type, readOnly);
+        var v = this._makeArgumentVariable(arg);
         var s = Symbol.makeSymbol(name, v);
         this.currentScope().addSymbol(s);
 
@@ -611,6 +608,12 @@ exports.ProcDecl = ChainedContext.extend({
             this.__firstArgument = false;
         code.write(name + "/*" + arg.description() + "*/");
     },
+    _makeArgumentVariable: function(arg){
+        var readOnly = !arg.isVar 
+                    && (arg.type instanceof Type.Array || arg.type instanceof Type.Record);
+        return arg.isVar ? Type.makeVariableRef(arg.type)
+                         : Type.makeVariable(arg.type, readOnly);
+    },
     handleMessage: function(msg){
         if (msg == endParametersMsg){
             var code = this.codeGenerator();

src/eberon/eberon_context.js

@@ -125,13 +125,13 @@ var ResultVariable = Type.Variable.extend({
     idType: function(){return "procedure call " + (this.type() ? "result" : "statement");}
 });
 
-var TempVariable = Type.Variable.extend({
-    init: function TempVariable(e){
-        this.__type = e.type();
+var TypeNarrowVariable = Type.Variable.extend({
+    init: function TypeNarrowVariable(type, isRef){
+        this.__type = type;
         this.__invertedType = this.__type;
+        this.__isRef = isRef;
 
         /*
-        this.__isRef = false;
         var d = e.designator();
         if (d) {
             var v = d.info();
@@ -144,7 +144,7 @@ var TempVariable = Type.Variable.extend({
         return this.__type;
     },
     isReference: function(){
-        return false;
+        return this.__isRef;
     },
     //idType: function(){return "temporary variable";},
     promoteType: function(t){
@@ -259,7 +259,7 @@ var TemplValueInit = Context.Chained.extend({
         this.__code = "var " + this.__id + " = ";
     },
     handleExpression: function(e){
-        var v = new TempVariable(e);
+        var v = new TypeNarrowVariable(e.type(), false);
         this.__symbol = Symbol.makeSymbol(this.__id, v);
         var type = e.type();
         if (type instanceof Type.Record)
@@ -605,6 +605,11 @@ var ProcOrMethodDecl = Context.ProcDecl.extend({
             ? Type.typeName(this.__boundType) + ".prototype." + this.__methodId.id() + " = function("
             : Context.ProcDecl.prototype._prolog.call(this);
     },
+    _makeArgumentVariable: function(arg){
+        if (arg.isVar)
+            return new TypeNarrowVariable(arg.type, true);
+        return Context.ProcDecl.prototype._makeArgumentVariable.call(this, arg);
+    },
     setType: function(type){
         Context.ProcDecl.prototype.setType.call(this, type);
         if (this.__methodId)
@@ -753,7 +758,7 @@ var RelationOps = Context.RelationOps.extend({
             var d = left.designator();
             if (d){
                 var v = d.info();
-                if (v instanceof TempVariable)
+                if (v instanceof TypeNarrowVariable)
                     context.handleMessage(new PromoteTypeMsg(v, type));
             }
             return impl(left, right);

test/expected/eberon/generic_message_bus.js

@@ -0,0 +1,51 @@
+var RTL$ = {
+    extend: function extend(methods){
+        function Type(){
+            for(var m in methods)
+                this[m] = methods[m];
+        }
+        Type.prototype = this.prototype;
+
+        var result = methods.init;
+        result.prototype = new Type(); // inherit this.prototype
+        result.prototype.constructor = result; // to see constructor name in diagnostic
+        
+        result.extend = extend;
+        return result;
+    },
+    assert: function (condition){
+        if (!condition)
+            throw new Error("assertion failed");
+    }
+};
+var m = function (){
+var Message = RTL$.extend({
+	init: function Message(){
+	}
+});
+var Derived1 = Message.extend({
+	init: function Derived1(){
+		Message.prototype.init.call(this);
+		this.derivedField1 = false;
+	}
+});
+var Derived2 = Message.extend({
+	init: function Derived2(){
+		Message.prototype.init.call(this);
+		this.derivedField2 = false;
+	}
+});
+var d1 = new Derived1();
+var d2 = new Derived2();
+
+function handleMessage(msg/*VAR Message*/){
+	if (msg instanceof Derived1){
+		RTL$.assert(msg.derivedField1);
+	}
+	else if (msg instanceof Derived2){
+		RTL$.assert(msg.derivedField2);
+	}
+}
+handleMessage(d1);
+handleMessage(d2);
+}();

test/input/eberon/generic_message_bus.ob

@@ -0,0 +1,24 @@
+MODULE m;
+
+TYPE
+    Message = RECORD END;
+    Derived1 = RECORD (Message) derivedField1: BOOLEAN END;
+    Derived2 = RECORD (Message) derivedField2: BOOLEAN END;
+
+VAR 
+    d1: Derived1; 
+    d2: Derived2;
+
+PROCEDURE handleMessage(VAR msg: Message);
+BEGIN
+    IF msg IS Derived1 THEN
+        ASSERT(msg.derivedField1);
+    ELSIF msg IS Derived2 THEN
+        ASSERT(msg.derivedField2);
+    END;
+END handleMessage;
+
+BEGIN
+    handleMessage(d1);
+    handleMessage(d2);
+END m.

test/test_unit_eberon.js

@@ -617,5 +617,10 @@ exports.suite = {
           fail(["PROCEDURE p(b: Base); BEGIN baseRef <- b; ASSERT(baseRef IS Derived); END p;",
                 "invalid type test: a value variable cannot be used"])
       )*/
-    }
+    },
+    "type promotion for VAR arguments": testWithContext(
+        context(grammar.declarationSequence, 
+                "TYPE Base = RECORD END; Derived = RECORD (Base) flag: BOOLEAN END;"),
+        pass("PROCEDURE p(VAR b: Base); BEGIN ASSERT((b IS Derived) & b.flag); END p;")
+    )
 };