js -> eberon transition

bug fixes

build.py

@@ -130,7 +130,7 @@ def recompile(bin):
     sources = ['ContextAssignment.ob', 'ContextCase.ob', 'ContextConst.ob', 
                'ContextIdentdef.ob', 'ContextLoop.ob', 'ContextModule.ob', 'ContextProcedure.ob', 
                'ContextVar.ob', 'EberonSymbols.ob', 'EberonCast.ob', 
-               'EberonContextExpression.ob', 'EberonContextIdentdef.ob', 'EberonContextType.ob', 'EberonScope.ob',
+               'EberonContextExpression.ob', 'EberonContextIdentdef.ob', 'EberonContextType.ob', 'EberonOperatorScopes.ob',
                'OberonContext.ob', 'OberonContextType.ob', 'OberonContextVar.ob',
                'OberonSymbols.ob', 'Lexer.ob', 'Module.ob']
     

src/eberon/EberonContextType.ob

@@ -48,6 +48,13 @@ PROCEDURE Record.Record(parent: PDeclaration)
     | SUPER(parent, recordTypeFactory);
 END;
 
+PROCEDURE checkMethodExport(record: Record; method: Context.PIdentdefInfo; hint: STRING);
+BEGIN
+    IF ~record.declaration.id.exported() & method.exported() THEN
+        Errors.raise(hint + " '" + method.id() + "' cannot be exported because record itslef is not exported");
+    END;
+END;
+
 PROCEDURE Record.handleMessage(VAR msg: ContextHierarchy.Message): Object.PType;
 VAR
     result: Object.PType;
@@ -57,16 +64,12 @@ BEGIN
         boundType <- SELF.type(EberonRecord.PRecord);
         id <- msg.id.id();
         IF boundType.name = id THEN
-            IF msg.id.exported() THEN
-                typeId <- SELF.parent()(PDeclaration).id;
-                IF ~typeId.exported() THEN
-                    Errors.raise("constructor '" + id + "' cannot be exported because record itslef is not exported");
-                END;
-            END;
+            checkMethodExport(SELF, msg.id, "constructor");
             boundType.declareConstructor(methodType, msg.id.exported());
         ELSE
             boundType.addMethod(msg.id,
                                 NEW EberonTypes.MethodType(id, methodType, Procedure.makeProcCallGenerator));
+            checkMethodExport(SELF, msg.id, "method");
         END;
     ELSIF msg IS ContextProcedure.EndParametersMsg THEN (* not used *)
     ELSIF msg IS ContextProcedure.AddArgumentMsg THEN   (* not used *)

src/eberon/EberonOperatorScopes.ob

@@ -0,0 +1,85 @@
+MODULE EberonOperatorScopes;
+IMPORT
+    ContextHierarchy, 
+    EberonContextDesignator, EberonContextProcedure, EberonScope,
+    EberonTypePromotion,
+    Scope;
+TYPE
+    Type* = RECORD
+        PROCEDURE Type(cx: ContextHierarchy.PNode);
+
+        PROCEDURE handleMessage(VAR msg: ContextHierarchy.Message): BOOLEAN;
+        PROCEDURE doThen();
+        PROCEDURE alternate();
+        PROCEDURE reset();
+
+        context: ContextHierarchy.PNode;
+        scope: Scope.PType;
+        ignorePromotions: BOOLEAN;
+        typePromotion: EberonTypePromotion.PType;
+        typePromotions: ARRAY * OF EberonTypePromotion.PType;
+    END;
+
+PROCEDURE Type.Type(cx: ContextHierarchy.PNode)
+    | context(cx);
+BEGIN
+    SELF.alternate();
+END;
+
+PROCEDURE Type.handleMessage(VAR msg: ContextHierarchy.Message): BOOLEAN;
+BEGIN
+    result <- FALSE;
+
+    IF SELF.ignorePromotions THEN
+    ELSIF msg IS EberonContextDesignator.TransferPromotedTypesMsg THEN
+        result := TRUE;
+    ELSIF msg IS EberonContextDesignator.PromoteTypeMsg THEN
+        SELF.typePromotion := NEW EberonTypePromotion.ForVariable(msg.info, msg.type, FALSE);
+        SELF.typePromotions.add(SELF.typePromotion);
+        result := TRUE;
+    ELSIF msg IS EberonContextProcedure.BeginTypePromotionOrMsg THEN
+        tp <- NEW EberonTypePromotion.Or(FALSE);
+        SELF.typePromotion := tp;
+        SELF.typePromotions.add(tp);
+        msg.result := tp;
+        result := TRUE;
+    END;
+    RETURN result;
+END;
+
+PROCEDURE Type.doThen();
+BEGIN
+    IF SELF.typePromotion # NIL THEN
+        SELF.typePromotion.and();
+    END;
+    SELF.ignorePromotions := TRUE;
+END;
+
+PROCEDURE Type.alternate();
+BEGIN
+    root <- SELF.context.root();
+    IF SELF.scope # NIL THEN
+        root.popScope();
+    END;
+    SELF.scope := EberonScope.makeOperator(
+        root.currentScope(),
+        root.language().stdSymbols);
+    root.pushScope(SELF.scope);
+
+    IF SELF.typePromotion # NIL THEN
+        SELF.typePromotion.reset();
+        SELF.typePromotion.or();
+        SELF.typePromotion := NIL;
+    END;
+    SELF.ignorePromotions := FALSE;
+END;
+
+PROCEDURE Type.reset();
+BEGIN
+    SELF.context.root().popScope();
+    FOR i <- 0 TO LEN(SELF.typePromotions) - 1 DO
+        SELF.typePromotions[i].reset();
+    END;
+END;
+
+END EberonOperatorScopes.

src/eberon/EberonTypePromotion.ob

@@ -7,15 +7,15 @@ TYPE
     END;
     PVariable* = POINTER TO Variable;
 
-    Type = RECORD
-        PROCEDURE and();
-        PROCEDURE or();
-        PROCEDURE reset();
+    Type* = RECORD
+        PROCEDURE and*();
+        PROCEDURE or*();
+        PROCEDURE reset*();
     END;
-    PType = POINTER TO Type;
+    PType* = POINTER TO Type;
 
     ForVariable* = RECORD(Type)
-        PROCEDURE ForVariable(v: PVariable; type: Types.PStorageType; inverted: BOOLEAN);
+        PROCEDURE ForVariable*(v: PVariable; type: Types.PStorageType; inverted: BOOLEAN);
 
         PROCEDURE invert();
 
@@ -49,7 +49,7 @@ TYPE
         PROCEDURE Or*(inverted: BOOLEAN);
     END;
 
-    Maybe = RECORD
+    Maybe* = RECORD
         PROCEDURE Maybe(handler: PCombined);
 
         PROCEDURE promote*(v: PVariable; type: Types.PStorageType);

src/eberon/eberon_context.js

@@ -24,6 +24,7 @@ var EberonContextProcedure = require("js/EberonContextProcedure.js");
 var EberonContextType = require("js/EberonContextType.js");
 var EberonDynamicArray = require("js/EberonDynamicArray.js");
 var EberonMap = require("js/EberonMap.js");
+var EberonOperatorScopes = require("js/EberonOperatorScopes.js");
 var EberonRecord = require("js/EberonRecord.js");
 var EberonScope = require("js/EberonScope.js");
 var EberonString = require("js/EberonString.js");
@@ -252,67 +253,10 @@ var VariableDeclaration = Class.extend.call(ContextVar.Declaration, {
     }
 });
 
-var OperatorScopes = Class.extend({
-    init: function EberonContext$OperatorScopes(context){
-        this.__context = context;
-        this.__scope = undefined;
-
-        this.__typePromotion = undefined;
-        this.__typePromotions = [];
-        this.__ignorePromotions = false;
-        this.alternate();
-    },
-    handleMessage: function(msg){
-        if (this.__ignorePromotions)
-            return false;
-        if (msg instanceof EberonContextDesignator.TransferPromotedTypesMsg)
-            return true;
-        if (msg instanceof EberonContextDesignator.PromoteTypeMsg){
-            this.__typePromotion = new TypePromotion.ForVariable(msg.info, msg.type);
-            this.__typePromotions.push(this.__typePromotion);
-            return true;
-        }
-        if (msg instanceof EberonContextProcedure.BeginTypePromotionOrMsg){
-            this.__typePromotion = new TypePromotion.Or();
-            this.__typePromotions.push(this.__typePromotion);
-            msg.result = this.__typePromotion;
-            return true;
-        }
-        return false;
-    },
-    doThen: function(){
-        if (this.__typePromotion)
-            this.__typePromotion.and();
-        this.__ignorePromotions = true;
-    },
-    alternate: function(){
-        var root = this.__context.root();
-        if (this.__scope)
-            root.popScope();
-        this.__scope = EberonScope.makeOperator(
-            root.currentScope(),
-            root.language().stdSymbols);
-        root.pushScope(this.__scope);
-
-        if (this.__typePromotion){
-            this.__typePromotion.reset();
-            this.__typePromotion.or();
-            this.__typePromotion = undefined;
-        }
-        this.__ignorePromotions = false;
-    },
-    reset: function(){
-        this.__context.root().popScope();
-        for(var i = 0; i < this.__typePromotions.length; ++i){
-            this.__typePromotions[i].reset();
-        }
-    }
-});
-
 var While = Class.extend.call(ContextLoop.While, {
     init: function EberonContext$While(context){
         ContextLoop.While.call(this, context);
-        this.__scopes = new OperatorScopes(this);
+        this.__scopes = new EberonOperatorScopes.Type(this);
     },
     handleLiteral: function(s){
         ContextLoop.While.prototype.handleLiteral.call(this, s);
@@ -336,7 +280,7 @@ var While = Class.extend.call(ContextLoop.While, {
 var If = Class.extend.call(ContextIf.Type, {
     init: function EberonContext$If(context){
         ContextIf.Type.call(this, context);
-        this.__scopes = new OperatorScopes(this);
+        this.__scopes = new EberonOperatorScopes.Type(this);
     },
     handleMessage: function(msg){
         if (this.__scopes.handleMessage(msg))

src/ob/Code.ob

@@ -46,7 +46,7 @@ VAR
     result: STRING;
 BEGIN
     r <- Record.pointerBase(type);
-    IF LEN(Types.typeName(r^)) = 0 THEN
+    IF r.finalizedAsNonExported THEN
         result := r.cons;
     END;
     RETURN result

src/ob/ContextDesignator.ob

@@ -117,16 +117,16 @@ PROCEDURE handleDeref(VAR designator: Type);
 BEGIN
     t <- designator.currentType;
     IF t IS Record.PPointer THEN
-        designator.currentType := Record.pointerBase(t^);
+        base <- Record.pointerBase(t^);
+        IF base.finalizedAsNonExported THEN
+            Errors.raise("POINTER TO non-exported RECORD type cannot be dereferenced");
+        END;
+        designator.currentType := base;
     ELSE
         Errors.raise("POINTER TO type expected, got '"
                      + designator.currentType.description() + "'");
     END;
     
-    IF designator.currentType IS Record.PNonExported THEN
-        Errors.raise("POINTER TO non-exported RECORD type cannot be dereferenced");
-    END;
-    
     designator.lval := "";
 END;
 

src/ob/ContextType.ob

@@ -67,7 +67,7 @@ TYPE
         PROCEDURE doGenerateConstructor(): STRING;
         PROCEDURE doGenerateBaseConstructorCallCode*(): STRING;
 
-        declaration: PDeclaration;
+        declaration-: PDeclaration;
         cons: STRING;
         type-: R.PType;
     END;

src/ob/Procedure.ob

@@ -333,7 +333,7 @@ PROCEDURE makeNew(): Symbols.PSymbol;
                          + argType.description() + "'");
         ELSE
             baseType <- Record.pointerBase(argType^);
-            IF baseType IS Record.PNonExported THEN
+            IF baseType.finalizedAsNonExported THEN
                 Errors.raise("non-exported RECORD type cannot be used in NEW");
             END;
             right <- Expression.makeSimple(baseType.codeForNew(cx.cx^), argType);

src/ob/Record.ob

@@ -18,14 +18,10 @@ TYPE
         base-:   PType;
         cons-:   STRING;
         scope-:  ScopeBase.PType;
-        notExported: ARRAY * OF STRING
+        notExported: ARRAY * OF STRING;
+        finalizedAsNonExported-: BOOLEAN;
     END;
 
-    NonExported = RECORD(Type)
-        PROCEDURE NonExported(cons: STRING; scope: ScopeBase.PType; base: PType);
-    END;
-    PNonExported* = POINTER TO NonExported;
-
     Field* = RECORD(Types.Field)
         PROCEDURE Field*(identdef: Context.PIdentdefInfo; type: Types.PStorageType);
 
@@ -89,12 +85,6 @@ BEGIN
     scope.addFinalizer(finalizeRecord, SELF(POINTER));
 END;
 
-PROCEDURE NonExported.NonExported(cons: STRING; scope: ScopeBase.PType; base: PType)
-    | SUPER("", cons, scope);
-BEGIN
-    SELF.base := base;
-END;    
-
 PROCEDURE Type.description(): STRING;
 VAR
     result: STRING;
@@ -211,7 +201,7 @@ PROCEDURE stripTypeId*(VAR id: TypeId.Type);
 BEGIN
     r <- id.type();
     IF r IS PType THEN
-        id.reset(NEW NonExported(r.cons, r.scope, r.base));
+        r.finalizedAsNonExported := TRUE;
     ELSE
         id.reset(NIL);
     END;

test/test_unit.js

@@ -1071,6 +1071,13 @@ return {
          ["MODULE m; IMPORT test; VAR p: test.TP; BEGIN p := test.makeTP(); p.i := 123; END m.",
           "POINTER TO non-exported RECORD type cannot be dereferenced"])
     ),
+"imported pointer type can be used as a base of derived type even if pointer's record type is not exported": testWithModule(
+    "MODULE test;"
+    + "TYPE B = RECORD END; PB* = POINTER TO B; T* = RECORD(B) END;"
+    + "END test.",
+    pass("MODULE m; IMPORT test; VAR pb: test.PB; p: POINTER TO test.T; BEGIN pb := p; END m."),
+    fail()
+    ),
 "imported pointer variable: anonymous record field cannot be used": testWithModule(
     "MODULE test; VAR p*: POINTER TO RECORD i: INTEGER END; END test.",
     pass(),

test/test_unit_eberon.js

@@ -153,12 +153,12 @@ exports.suite = {
 "new method declaration": testWithContext(
     context(grammar.declarationSequence, 
             "TYPE T = RECORD PROCEDURE p(); intField: INTEGER END; A = ARRAY 1 OF INTEGER;"),
-    pass("PROCEDURE T.p(); END T.p;"
+    pass("PROCEDURE T.p(); END T.p;",
+         "PROCEDURE T.p(); END;"
          ),
-        fail(["PROCEDURE TUnk.p(), NEW; END TUnk.p;", "undeclared identifier: 'TUnk'"],
-         ["PROCEDURE A.p(), NEW; END A.p;",
+    fail(["PROCEDURE TUnk.p(); END TUnk.p;", "undeclared identifier: 'TUnk'"],
+         ["PROCEDURE A.p(); END A.p;",
           "RECORD type expected in method declaration, got 'ARRAY 1 OF INTEGER'"],
-         ["PROCEDURE T.p(), NEW; END;", "not parsed"],
          ["PROCEDURE T.p(); END p;",
           "mismatched method names: expected 'T.p' at the end (or nothing), got 'p'"],
          ["PROCEDURE T.p(); END T2.p;",
@@ -322,7 +322,9 @@ exports.suite = {
             ),
     pass(),
     fail(["PROCEDURE T.p*(); END T.p;",
-          "method implementation cannot be exported: p"])
+          "method implementation cannot be exported: p"],
+         ["TYPE R = RECORD PROCEDURE m*(); END;",
+          "method 'm' cannot be exported because record itslef is not exported"] )
     ),
 "import method": testWithModule(
       "MODULE test;"