js -> eberon transition

src/context.js

@@ -785,102 +785,6 @@ exports.ActualParameters = ChainedContext.extend({
     }
 });
 
-function isTypeRecursive(type, base){
-    if (type == base)
-        return true;
-    if (type instanceof Type.Record){
-        if (isTypeRecursive(type.base, base))
-            return true;
-        var fields = type.fields;
-        for(var fieldName in fields){
-            if (isTypeRecursive(fields[fieldName].type(), base))
-                return true;
-        }
-    }
-    else if (type instanceof Type.Array)
-        return isTypeRecursive(type.elementsType, base);
-    return false;
-}
-
-exports.RecordDecl = ChainedContext.extend({
-    init: function RecordDeclContext(context, RecordCons){
-        ChainedContext.prototype.init.call(this, context);
-        var parent = this.parent();
-        this.__cons = parent.genTypeName();
-        var name = parent.isAnonymousDeclaration() ? "" : this.__cons;
-        this.__type = new RecordCons(name, this.__cons, context.root().currentScope());
-        parent.setType(this.__type);
-    },
-    type: function(){return this.__type;},
-    addField: function(field, type){
-        if (isTypeRecursive(type, this.__type))
-            throw new Errors.Error("recursive field definition: '"
-                + field.id() + "'");
-        this.__type.addField(this._makeField(field, type));
-        if (field.exported())
-            this.parent().exportField(field.id());
-    },
-    setBaseType: function(type){
-        if (!(type instanceof Type.Record))
-            throw new Errors.Error(
-                "RECORD type is expected as a base type, got '"
-                + type.description()
-                + "'");
-        if (isTypeRecursive(type, this.__type))
-            throw new Errors.Error("recursive inheritance: '"
-                + Type.typeName(this.__type) + "'");
-
-        this.__type.setBase(type);
-    },
-    endParse: function(){
-        var gen = this.codeGenerator();
-        this.codeGenerator().write(
-              this._generateConstructor()
-            + this._generateInheritance()
-            );
-    },
-    _generateConstructor: function(){
-        var gen = CodeGenerator.makeGenerator();
-        gen.write("function " + this.__cons + "()");
-        gen.openScope();
-        gen.write(this._generateBaseConstructorCallCode() 
-                + this.__generateFieldsInitializationCode());
-        gen.closeScope("");
-        return gen.result();
-    },
-    _qualifiedBaseConstructor: function(){
-        var baseType = this.__type.base;
-        if (!baseType)
-            return "";
-        return this.qualifyScope(baseType.scope) + Type.typeName(baseType);
-    },
-    _generateBaseConstructorCallCode: function(){
-        var baseType = this.__type.base;
-        var qualifiedBase = baseType ? this.qualifyScope(baseType.scope) + Type.typeName(baseType) : undefined; 
-        var result = this._qualifiedBaseConstructor();
-        return result ? result + ".call(this);\n" : "";
-    },
-    __generateFieldsInitializationCode: function(){
-        var result = "";
-        var ownFields = this.__type.fields;
-        for(var f in ownFields){
-            var fieldType = ownFields[f].type();
-            result += "this." + Record.mangleField(f) + " = " + fieldType.initializer(this) + ";\n";
-        }
-        return result;
-    },
-    _generateInheritance: function(){
-        var base = this.__type.base;
-        if (!base)
-            return "";
-        var qualifiedBase = this.qualifyScope(base.scope) + Type.typeName(base); 
-        return this.root().language().rtl().extend(this.__cons, qualifiedBase) + ";\n";
-    },
-    _makeField: function(field, type){
-        return new Record.Field(field, type);
-    }
-});
-
 exports.TypeDeclaration = ChainedContext.extend({
     init: function TypeDeclarationContext(context){
         ChainedContext.prototype.init.call(this, context);

src/eberon/eberon_context.js

@@ -540,14 +540,14 @@ var TypeDeclaration = Context.TypeDeclaration.extend({
     }
 });
 
-var RecordDecl = Context.RecordDecl.extend({
+var RecordDecl = Class.extend.call(ContextType.Record, {
     init: function EberonContext$RecordDecl(context){
-        Context.RecordDecl.prototype.init.call(this, context, EberonRecord.Record);
+        ContextType.Record.call(this, context, function(name, cons, scope){return new EberonRecord.Record(name, cons, scope); });
     },
     handleMessage: function(msg){
         if (msg instanceof MethodOrProcMsg){
             var methodType = msg.type;
-            var boundType = this.type();
+            var boundType = this.type;
             var id = msg.id.id();
             if (Type.typeName(boundType) == id){
                 if (msg.id.exported()){
@@ -567,29 +567,29 @@ var RecordDecl = Context.RecordDecl.extend({
             return undefined;
         if (msg instanceof Context.AddArgumentMsg) // not used
             return undefined;
-        return Context.RecordDecl.prototype.handleMessage.call(this, msg);
+        return ContextType.Record.prototype.handleMessage.call(this, msg);
     },
-    _makeField: function(field, type){
-        return new EberonRecord.Field(field, type, this.__type);
+    doMakeField: function(field, type){
+        return new EberonRecord.Field(field, type, this.type);
     },
-    _generateBaseConstructorCallCode: function(){
-        var base = this.type().base;
+    doGenerateBaseConstructorCallCode: function(){
+        var base = this.type.base;
         if (!base)
             return "";
         var baseConstructor = EberonRecord.constructor$(base);
         if (!baseConstructor || !baseConstructor.args().length)
-            return Context.RecordDecl.prototype._generateBaseConstructorCallCode.call(this);
+            return ContextType.Record.prototype.doGenerateBaseConstructorCallCode.call(this);
         
-        return this._qualifiedBaseConstructor() + ".apply(this, arguments);\n";
+        return this.qualifiedBaseConstructor() + ".apply(this, arguments);\n";
     },
     endParse: function(){
-        var type = this.type();
+        var type = this.type;
         if (!type.customConstructor)
-            return Context.RecordDecl.prototype.endParse.call(this);
+            return ContextType.Record.prototype.endParse.call(this);
 
-        this.codeGenerator().write(this._generateInheritance());
+        this.codeGenerator().write(this.generateInheritance());
         type.setRecordInitializationCode(
-            this._generateBaseConstructorCallCode());
+            this.doGenerateBaseConstructorCallCode());
     }
 });
 

src/ob/ContextHierarchy.ob

@@ -31,7 +31,7 @@ TYPE
         PROCEDURE codeGenerator*(): CodeGenerator.PIGenerator;
         PROCEDURE handleLiteral*(s: STRING);
         PROCEDURE handleIdent*(s: STRING);
-        PROCEDURE genTypeName(): STRING;
+        PROCEDURE genTypeName*(): STRING;
         PROCEDURE endParse*();
 
         mParent: PNode;
@@ -46,7 +46,7 @@ TYPE
         PROCEDURE findSymbol(ident: STRING): Symbols.PFoundSymbol;
         PROCEDURE findModule(name: STRING): Types.PModule;
 
-        PROCEDURE currentScope(): Scope.PType;
+        PROCEDURE currentScope*(): Scope.PType;
         PROCEDURE pushScope(scope: Scope.PType);
         PROCEDURE popScope();
 

src/ob/ContextType.ob

@@ -1,7 +1,7 @@
 MODULE ContextType;
 IMPORT
-    CodeGenerator, ConstValue, ContextExpression, ContextHierarchy, 
-    Errors, Expression, String, Types;
+    Chars, CodeGenerator, ConstValue, Context, ContextExpression, ContextHierarchy, 
+    Errors, Expression, R := Record, ScopeBase, String, Types;
 TYPE
     HandleSymbolAsType* = RECORD(ContextHierarchy.Node)
         PROCEDURE handleQIdent(q: ContextHierarchy.QIdent);
@@ -34,6 +34,30 @@ TYPE
         dimensions: ARRAY * OF INTEGER;
     END;
 
+    Declaration = RECORD(HandleSymbolAsType)
+        PROCEDURE isAnonymousDeclaration(): BOOLEAN;
+        PROCEDURE exportField(name: STRING);
+    END;
+    PDeclaration = POINTER TO Declaration;
+
+    RecordTypeFactory = PROCEDURE(name, cons: STRING; scope: ScopeBase.PType): R.PType; 
+
+    Record* = RECORD(ContextHierarchy.Node)
+        PROCEDURE Record(parent: PDeclaration; factory: RecordTypeFactory);
+
+        PROCEDURE addField(field: Context.PIdentdefInfo; type: Types.PStorageType);
+        PROCEDURE setBaseType(type: Types.PType);
+        PROCEDURE doMakeField(field: Context.PIdentdefInfo; type: Types.PStorageType): Types.PField;
+        PROCEDURE doGenerateConstructor(): STRING;
+        PROCEDURE generateInheritance(): STRING;
+        PROCEDURE doGenerateBaseConstructorCallCode(): STRING;
+        PROCEDURE qualifiedBaseConstructor(): STRING;
+
+        declaration: PDeclaration;
+        cons: STRING;
+        type: R.PType;
+    END;
+
 PROCEDURE HandleSymbolAsType.handleQIdent(q: ContextHierarchy.QIdent);
 BEGIN
     s <- ContextHierarchy.getQIdSymbolAndScope(SELF.root()^, q);
@@ -151,4 +175,133 @@ BEGIN
     SELF.parent()^(Array).dimensions := SELF(POINTER);
 END;
 
+PROCEDURE isTypeRecursive(type, base: Types.PType): BOOLEAN;
+BEGIN
+    result <- FALSE;
+    IF type = base THEN
+        result := TRUE;
+    ELSIF type IS R.PType THEN
+        IF isTypeRecursive(type.base, base) THEN
+            result := TRUE;
+        ELSE
+            FOR name, field IN type.fields DO
+                IF ~result & isTypeRecursive(field.type(), base) THEN
+                    result := TRUE;
+                END;
+            END;
+        END;
+    ELSIF type IS Types.PArray THEN
+        result := isTypeRecursive(type.elementsType, base);
+    END;
+    RETURN result;
+END;
+
+PROCEDURE Record.Record(parent: PDeclaration; factory: RecordTypeFactory)
+    | SUPER(parent),
+      declaration(parent);
+VAR
+    name: STRING;
+BEGIN
+    SELF.cons := parent.genTypeName();
+    IF ~parent.isAnonymousDeclaration() THEN
+        name := SELF.cons;
+    END;
+    SELF.type := factory(name, SELF.cons, parent.root().currentScope());
+    parent.setType(SELF.type);
+END;
+
+PROCEDURE Record.addField(field: Context.PIdentdefInfo; type: Types.PStorageType);
+BEGIN
+    IF isTypeRecursive(type, SELF.type) THEN
+        Errors.raise("recursive field definition: '" + field.id() + "'");
+    END;
+    SELF.type.addField(SELF.doMakeField(field, type));
+    IF field.exported() THEN
+        SELF.declaration.exportField(field.id());
+    END;
+END;
+
+PROCEDURE Record.setBaseType(type: Types.PType);
+BEGIN
+    IF ~(type IS R.PType) THEN
+        Errors.raise(
+            "RECORD type is expected as a base type, got '"
+            + type.description()
+            + "'");
+    ELSE
+        IF isTypeRecursive(type, SELF.type) THEN
+            Errors.raise("recursive inheritance: '"
+                         + SELF.type.description() + "'");
+        END;
+
+        SELF.type.setBase(type);
+    END;
+END;
+
+PROCEDURE Record.doMakeField(field: Context.PIdentdefInfo; type: Types.PStorageType): Types.PField;
+BEGIN
+    RETURN NEW R.Field(field, type);
+END;
+
+PROCEDURE generateFieldsInitializationCode(r: Record): STRING;
+VAR
+    result: STRING;
+BEGIN
+    FOR f, t IN r.type.fields DO
+        result := result + "this." + R.mangleField(f) + " = " + t.type().initializer(r) + ";" + Chars.ln;
+    END;
+    RETURN result;
+END;
+
+PROCEDURE Record.doGenerateConstructor(): STRING;
+BEGIN
+    gen <- CodeGenerator.makeGenerator();
+    gen.write("function " + SELF.cons + "()");
+    gen.openScope();
+    gen.write(SELF.doGenerateBaseConstructorCallCode() 
+            + generateFieldsInitializationCode(SELF));
+    gen.closeScope("");
+    RETURN gen.result();
+END;
+
+PROCEDURE Record.generateInheritance(): STRING;
+VAR
+    result: STRING;
+BEGIN
+    base <- SELF.type.base;
+    IF base # NIL THEN
+        qualifiedBase <- SELF.qualifyScope(base.scope) + base.name; 
+        result := SELF.root().language().rtl().extend(SELF.cons, qualifiedBase) + ";" + Chars.ln;
+    END;
+    RETURN result;
+END;
+
+PROCEDURE Record.doGenerateBaseConstructorCallCode(): STRING;
+BEGIN
+    result <- SELF.qualifiedBaseConstructor();
+    IF LEN(result) # 0 THEN
+        result := result + ".call(this);" + Chars.ln;
+    END;
+    RETURN result;
+END;
+
+PROCEDURE Record.qualifiedBaseConstructor(): STRING;
+VAR
+    result: STRING;
+BEGIN
+    baseType <- SELF.type.base;
+    IF baseType # NIL THEN
+        result := SELF.qualifyScope(baseType.scope) + baseType.name;
+    END;
+    RETURN result;
+END;
+
+PROCEDURE Record.endParse();
+BEGIN
+    SELF.codeGenerator().write(
+          SELF.doGenerateConstructor()
+        + SELF.generateInheritance()
+        );
+END;
+
 END ContextType.

src/ob/OberonRtl.ob

@@ -10,6 +10,7 @@ TYPE
         setInclR*: PROCEDURE(l, r: STRING): STRING;
         assertId*: PROCEDURE(): STRING;
         makeRef*: PROCEDURE(derefCode, propCode: STRING): STRING;
+        PROCEDURE extend*(cons, base: STRING): STRING;
         PROCEDURE makeArray*(dimensions: STRING): STRING;
         PROCEDURE makeCharArray*(dimensions: STRING): STRING;
         PROCEDURE typeGuard*(from, to: STRING): STRING;

src/oberon/oberon_context.js

@@ -1,17 +1,19 @@
 "use strict";
 
+var Class = require("rtl.js").Class;
 var CodeGenerator = require("js/CodeGenerator.js");
 var Context = require("context.js");
 var ContextExpression = require("js/ContextExpression.js");
+var ContextType = require("js/ContextType.js");
 var Errors = require("js/Errors.js");
 var Expression = require("js/Expression.js");
 var op = require("js/Operator.js");
 var Record = require("js/Record.js");
 var Type = require("js/Types.js");
 
-var RecordDecl = Context.RecordDecl.extend({
+var RecordDecl = Class.extend.call(ContextType.Record, {
     init: function OberonContext$RecordDecl(context){
-        Context.RecordDecl.prototype.init.call(this, context, Record.Type);
+        ContextType.Record.call(this, context, function(name, cons, scope){return new Record.Type(name, cons, scope); });
     }
 });