Browse Source

js -> eberon transition
fix ICE on 'POINTER to itself' declaration

Vladislav Folts 10 years ago
parent
commit
fff899eb0e

BIN
bin/compiled.zip


+ 1 - 2
build.py

@@ -130,8 +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', 
-               'EberonContextDesignator.ob', 'EberonOperator.ob', 'EberonScope.ob',
-               'EberonTypePromotion.ob',
+               'EberonContextProcedure.ob', 'EberonOperator.ob', 'EberonScope.ob',
                'OberonContext.ob', 'OberonContextType.ob', 'OberonContextVar.ob',
                'OberonSymbols.ob', 'Lexer.ob', 'Module.ob']
     

+ 3 - 3
src/eberon/EberonContextDesignator.ob

@@ -27,7 +27,7 @@ TYPE
     END;
 
     TypeNarrowVariable* = RECORD(TypeNarrowVariableBase)
-        PROCEDURE TypeNarrowVariable(type: Types.PStorageType; isRef, isReadOnly: BOOLEAN; code: STRING);
+        PROCEDURE TypeNarrowVariable*(type: Types.PStorageType; isRef, isReadOnly: BOOLEAN; code: STRING);
 
         PROCEDURE setType(type: Types.PStorageType);
 
@@ -78,12 +78,12 @@ TYPE
     END;
 
     SuperMethodInfo* = RECORD(Object.Type)
-        PROCEDURE SuperMethodInfo(info: Types.PProcedureId; code: STRING);
+        PROCEDURE SuperMethodInfo*(info: Types.PProcedureId; code: STRING);
 
         info: Types.PProcedureId;
         code: STRING;
     END;
-    PSuperMethodInfo = POINTER TO SuperMethodInfo;
+    PSuperMethodInfo* = POINTER TO SuperMethodInfo;
 
 VAR
     getMethodSelfMsg: GetMethodSelfMsg;

+ 267 - 0
src/eberon/EberonContextProcedure.ob

@@ -0,0 +1,267 @@
+MODULE EberonContextProcedure;
+IMPORT
+    Chars, Context, ContextHierarchy, ContextProcedure, 
+    EberonConstructor, EberonContextDesignator, EberonRecord, EberonTypePromotion, EberonTypes,
+    Errors, Expression, LanguageContext, Object, Procedure, Types;
+TYPE
+    ProcOrMethodDeclaration* = RECORD(ContextProcedure.Declaration)
+        boundType: EberonRecord.PRecord;
+        baseConstructorWasCalled: BOOLEAN;
+        methodId: Context.PIdentdefInfo;
+        methodType: EberonTypes.PMethodType;
+        isConstructor: BOOLEAN;
+        initedFields: ARRAY * OF STRING;
+        type: Procedure.PType;
+        endingId: STRING;
+    END;
+    PProcOrMethodDeclaration = POINTER TO ProcOrMethodDeclaration;
+
+    GetConstructorBoundTypeMsg* = RECORD(ContextHierarchy.Message)
+    END;
+    GetConstructorSuperMsg* = RECORD(ContextHierarchy.Message)
+    END;
+
+    InitFieldMsg* = RECORD(ContextHierarchy.Message)
+        PROCEDURE InitFieldMsg(id: STRING);
+
+        id: STRING;
+    END;
+
+    MethodOrProcMsg* = RECORD(ContextHierarchy.Message)
+        PROCEDURE MethodOrProcMsg(id: Context.PIdentdefInfo; type: EberonRecord.PRecord);
+        
+        id: Context.PIdentdefInfo; 
+        type: EberonRecord.PRecord;
+    END;
+
+    BeginTypePromotionOrMsg* = RECORD(ContextHierarchy.Message)
+        result: EberonTypePromotion.PCombined;
+    END;
+
+PROCEDURE superMethodCallGenerator(cx: LanguageContext.PType; type: Procedure.Type): Procedure.PCallGenerator;
+BEGIN
+    args <- Procedure.makeArgumentsCode(cx);
+    args.write(Expression.makeSimple("this", NIL), NIL, NIL);
+    RETURN Procedure.makeProcCallGeneratorWithCustomArgs(cx, type, args);
+END;
+
+PROCEDURE handleSuperCall(d: ProcOrMethodDeclaration): EberonContextDesignator.PSuperMethodInfo;
+VAR
+    procId: Types.PProcedureId;
+BEGIN
+    IF d.methodId = NIL THEN
+        Errors.raise("SUPER can be used only in methods");
+    END;
+
+    baseType <- d.boundType.base(EberonRecord.PRecord);
+    IF baseType = NIL THEN
+        Errors.raise(
+              "'" + d.boundType.description()
+            + "' has no base type - SUPER cannot be used");
+    END;
+
+    id <- d.methodId.id();
+    IF ~d.isConstructor THEN
+        EberonRecord.requireMethodDefinition(baseType, id, "cannot use abstract method(s) in SUPER calls");
+        procId := NEW Types.ProcedureId(NEW EberonTypes.MethodType(id, d.methodType.procType(), superMethodCallGenerator));
+    END;
+    
+    RETURN NEW EberonContextDesignator.SuperMethodInfo(
+        procId,
+        d.qualifyScope(baseType.scope) + baseType.description() + ".prototype." + id + ".call");
+END;
+
+PROCEDURE handleFieldInit(d: PProcOrMethodDeclaration; id: STRING): Procedure.PCallGenerator;
+BEGIN
+    IF ~(id IN d.boundType.fields) THEN
+        Errors.raise("'" + id + "' is not record '" + d.boundType.description() + "' own field");
+    END;        
+
+    IF d.initedFields.indexOf(id) # -1 THEN
+        Errors.raise("field '" + id + "' is already initialized");
+    END;
+
+    d.initedFields.add(id);        
+    type <- d.boundType.fields[id].type();
+    RETURN EberonConstructor.makeFieldInitCall(type, ContextHierarchy.makeLanguageContext(d), id);
+END;
+
+PROCEDURE handleTypePromotionMadeInSeparateStatement*(VAR msg: ContextHierarchy.Message): BOOLEAN;
+BEGIN
+    result <- FALSE;
+    IF EberonContextDesignator.breakTypePromotion(msg) THEN
+        result := TRUE;
+    ELSIF msg IS BeginTypePromotionOrMsg THEN
+        msg.result := NEW EberonTypePromotion.Or(FALSE);
+        result := TRUE;
+    END
+    RETURN result;
+END;
+
+PROCEDURE ProcOrMethodDeclaration.handleMessage(VAR msg: ContextHierarchy.Message): Object.PType;
+VAR
+    result: Object.PType;
+BEGIN
+    IF msg IS EberonContextDesignator.GetMethodSelfMsg THEN
+        IF SELF.boundType = NIL THEN
+            Errors.raise("SELF can be used only in methods");
+        END;
+        result := SELF.boundType;
+    ELSIF msg IS EberonContextDesignator.GetSelfAsPointerMsg THEN
+        SELF.boundType.requireNewOnly();
+        result := SELF.boundType;
+    ELSIF msg IS GetConstructorBoundTypeMsg THEN
+        result := SELF.boundType;
+    ELSIF msg IS GetConstructorSuperMsg THEN
+        SELF.baseConstructorWasCalled := TRUE;
+        result := handleSuperCall(SELF);
+    ELSIF msg IS EberonContextDesignator.GetMethodSuperMsg THEN
+        IF SELF.isConstructor THEN
+            Errors.raise("cannot call base constructor from procedure body (use '| SUPER' to pass parameters to base constructor)");
+        END;
+        result := handleSuperCall(SELF);
+    ELSIF msg IS InitFieldMsg THEN
+        result := handleFieldInit(SELF(POINTER), msg.id);
+    ELSIF msg IS MethodOrProcMsg THEN
+        id <- msg.id;
+        type <- msg.type;
+        IF type # NIL THEN
+            SELF.methodId := id;
+            SELF.boundType := type;
+            SELF.isConstructor := type.name = id.id();
+        END;
+
+        ContextProcedure.handleIdentdef(SELF, id);
+    ELSIF handleTypePromotionMadeInSeparateStatement(msg) THEN
+        (* break message passing *)
+    ELSE
+        result := SUPER(msg);
+    END;
+
+    RETURN result;
+END ProcOrMethodDeclaration.handleMessage;
+
+PROCEDURE ProcOrMethodDeclaration.doProlog(): STRING;
+VAR
+    result: STRING;
+BEGIN
+    IF SELF.boundType # NIL THEN
+        IF SELF.isConstructor THEN
+            result := "function " + SELF.boundType.name + "(";
+        ELSE
+            result := SELF.boundType.name + ".prototype." + SELF.methodId.id() + " = function(";
+        END;
+    ELSE
+        result := SUPER();
+    END;
+    RETURN result;
+END;
+
+PROCEDURE ProcOrMethodDeclaration.doEpilog(): STRING;
+VAR
+    result: STRING;
+BEGIN
+    IF (SELF.boundType # NIL) & ~SELF.isConstructor THEN
+        result := ";" + Chars.ln;
+    ELSE
+        result := SUPER();
+    END;
+    RETURN result;
+END;
+
+PROCEDURE ProcOrMethodDeclaration.doBeginBody();
+BEGIN
+    SUPER();
+    IF SELF.isConstructor THEN
+        SELF.codeGenerator().write(
+                SELF.boundType.baseConstructorCallCode
+              + EberonRecord.fieldsInitializationCode(SELF.boundType, SELF(POINTER)));
+    END;
+END;
+
+PROCEDURE ProcOrMethodDeclaration.doMakeArgumentVariable(arg: Types.ProcedureArgument; name: STRING): Types.PVariable;
+VAR
+    result: Types.PVariable;
+BEGIN
+    IF ~arg.isVar THEN
+        result := NEW EberonContextDesignator.TypeNarrowVariable(arg.type, FALSE, TRUE, name);
+    ELSIF arg.type IS Types.PRecord THEN
+        result := NEW EberonContextDesignator.TypeNarrowVariable(arg.type, TRUE, FALSE, name);
+    ELSE
+        result := SUPER(arg, name);
+    END;
+    RETURN result;
+END;
+
+PROCEDURE ProcOrMethodDeclaration.setType(type: Types.PStorageType);
+BEGIN
+    IF SELF.methodId # NIL THEN
+        t <- type(Procedure.PType);
+        SELF.methodType := NEW EberonTypes.MethodType(SELF.methodId.id(), t, Procedure.makeProcCallGenerator);
+        SELF.type := t;
+    ELSE
+        SUPER(type);
+    END;
+END;
+
+PROCEDURE ProcOrMethodDeclaration.handleIdent(id: STRING);
+BEGIN
+    IF SELF.boundType = NIL THEN
+        SUPER(id);
+    ELSIF LEN(SELF.endingId) # 0 THEN
+        SELF.endingId := SELF.endingId + "." + id;
+    ELSE
+        SELF.endingId := id;
+    END;
+END;
+
+PROCEDURE ProcOrMethodDeclaration.endParse(): BOOLEAN;
+VAR
+    baseConstructor: Procedure.PType;
+BEGIN
+    result <- SUPER();
+    IF result THEN
+        IF SELF.boundType # NIL THEN
+            IF LEN(SELF.endingId) # 0 THEN
+                expected <- SELF.boundType.name + "." + SELF.id.id();
+                IF SELF.endingId # expected THEN
+                    Errors.raise(
+                          "mismatched method names: expected '" 
+                        + expected
+                        + "' at the end (or nothing), got '" 
+                        + SELF.endingId + "'");
+                END;
+            END;
+
+            IF SELF.isConstructor THEN
+                SELF.boundType.defineConstructor(SELF.methodType.procType());
+
+                base <- SELF.boundType.base;
+                IF base # NIL THEN
+                    baseConstructor := EberonRecord.constructor(base^(EberonRecord.Record));
+                END;
+
+                IF ~SELF.baseConstructorWasCalled & (baseConstructor # NIL) & (LEN(baseConstructor.args()) # 0) THEN
+                    Errors.raise("base record constructor has parameters but was not called (use '| SUPER' to pass parameters to base constructor)");
+                END;
+                IF SELF.baseConstructorWasCalled & ((baseConstructor = NIL) OR (LEN(baseConstructor.args()) = 0)) THEN
+                    Errors.raise("base record constructor has no parameters and will be called automatically (do not use '| SUPER' to call base constructor)");
+                END;
+            ELSE
+                SELF.boundType.defineMethod(SELF.methodId, SELF.methodType);
+            END;
+        END;
+    END;
+    RETURN result;
+END;
+
+PROCEDURE InitFieldMsg.InitFieldMsg(id: STRING)
+    | id(id);
+END;
+
+PROCEDURE MethodOrProcMsg.MethodOrProcMsg(id: Context.PIdentdefInfo; type: EberonRecord.PRecord)
+    | id(id),
+      type(type);
+END;
+
+END EberonContextProcedure.

+ 3 - 3
src/eberon/EberonRecord.ob

@@ -20,9 +20,9 @@ TYPE
 
         PROCEDURE declareConstructor(type: Procedure.PType; exported: BOOLEAN);
         PROCEDURE addMethod(methodId: Context.PIdentdefInfo; type: Types.PProcedure);
-        PROCEDURE defineConstructor(type: Procedure.PType);
-        PROCEDURE defineMethod(methodId: Context.PIdentdefInfo; type: EberonTypes.PMethodType);
-        PROCEDURE requireNewOnly();
+        PROCEDURE defineConstructor*(type: Procedure.PType);
+        PROCEDURE defineMethod*(methodId: Context.PIdentdefInfo; type: EberonTypes.PMethodType);
+        PROCEDURE requireNewOnly*();
         PROCEDURE setBaseConstructorCallCode(code: STRING);
         PROCEDURE setFieldInitializationCode(field: STRING; code: STRING);
         PROCEDURE setRecordInitializationCode(baseConstructorCallCode: STRING);

+ 1 - 1
src/eberon/EberonTypePromotion.ob

@@ -47,7 +47,7 @@ TYPE
     END;
 
     Or* = RECORD(Combined)
-        PROCEDURE Or(inverted: BOOLEAN);
+        PROCEDURE Or*(inverted: BOOLEAN);
     END;
 
     Maybe = RECORD

+ 11 - 209
src/eberon/eberon_context.js

@@ -19,6 +19,7 @@ var ContextVar = require("js/ContextVar.js");
 var EberonConstructor = require("js/EberonConstructor.js");
 var EberonContext = require("js/EberonContext.js");
 var EberonContextDesignator = require("js/EberonContextDesignator.js");
+var EberonContextProcedure = require("js/EberonContextProcedure.js");
 var EberonDynamicArray = require("js/EberonDynamicArray.js");
 var EberonMap = require("js/EberonMap.js");
 var EberonRecord = require("js/EberonRecord.js");
@@ -44,17 +45,6 @@ function log(s){
 }
 */
 
-function superMethodCallGenerator(context, type){
-    var args = Procedure.makeArgumentsCode(context);
-    args.write(Expression.make("this"));
-    return Procedure.makeProcCallGeneratorWithCustomArgs(context, type, args);
-}
-
-function MethodOrProcMsg(id, type){
-    this.id = id;
-    this.type = type;
-}
-
 var ChainedContext = ContextHierarchy.Node;
 ChainedContext.extend = Class.extend;
 ChainedContext.prototype.init = ContextHierarchy.Node;
@@ -84,7 +74,7 @@ var ProcOrMethodId = ChainedContext.extend({
         if (this.__type && id.exported())
             throw new Errors.Error("method implementation cannot be exported: " + id.id());
         checkOrdinaryExport(id, "procedure");
-        this.handleMessage(new MethodOrProcMsg(id, this.__type));
+        this.handleMessage(new EberonContextProcedure.MethodOrProcMsg(id, this.__type));
     }
 });
 
@@ -101,7 +91,7 @@ var MethodHeading = ChainedContext.extend({
     typeName: function(){return "";},
     setType: function(type){this.__type = type;},
     endParse: function(){
-        this.handleMessage(new MethodOrProcMsg(this.__id, this.__type));
+        this.handleMessage(new EberonContextProcedure.MethodOrProcMsg(this.__id, this.__type));
     }
 });
 
@@ -341,7 +331,7 @@ var RecordDecl = Class.extend.call(ContextType.Record, {
         ContextType.Record.call(this, context, function(name, cons, scope){return new EberonRecord.Record(name, cons, scope); });
     },
     handleMessage: function(msg){
-        if (msg instanceof MethodOrProcMsg){
+        if (msg instanceof EberonContextProcedure.MethodOrProcMsg){
             var methodType = msg.type;
             var boundType = this.type;
             var id = msg.id.id();
@@ -389,23 +379,6 @@ var RecordDecl = Class.extend.call(ContextType.Record, {
     }
 });
 
-function handleTypePromotionMadeInSeparateStatement(msg){
-    if (EberonContextDesignator.breakTypePromotion(msg))
-        return true;
-    if (msg instanceof BeginTypePromotionOrMsg){
-        msg.result = new TypePromotion.Or();
-        return true;
-    }
-    return false;
-}
-
-function getConstructorSuperMsg(){}
-function getConstructorBoundType(){}
-
-function InitFieldMsg(id){
-    this.id = id;
-}
-
 var BaseInit = ChainedContext.extend({
     init: function EberonContext$BaseInit(parent){
         ChainedContext.prototype.init.call(this, parent);
@@ -415,7 +388,7 @@ var BaseInit = ChainedContext.extend({
     },
     type: function(){
         if (!this.__type)
-            this.__type = this.handleMessage(getConstructorBoundType);
+            this.__type = this.handleMessage(new EberonContextProcedure.GetConstructorBoundTypeMsg());
         return this.__type;
     },
     codeGenerator: function(){return CodeGenerator.nullGenerator();},
@@ -434,14 +407,14 @@ var BaseInit = ChainedContext.extend({
     },
     handleIdent: function(id){
         this.__initField = id;
-        this.__initCall = this.handleMessage(new InitFieldMsg(id));
+        this.__initCall = this.handleMessage(new EberonContextProcedure.InitFieldMsg(id));
     },
     handleExpression: function(e){
         this.__initCall.handleArgument(e);
     },
     handleLiteral: function(s){
         if (s == "SUPER"){
-            var ms = this.handleMessage(getConstructorSuperMsg);
+            var ms = this.handleMessage(new EberonContextProcedure.GetConstructorSuperMsg());
             this.__initCall = makeContextCall(
                 this,
                 function(cx){ 
@@ -454,172 +427,6 @@ var BaseInit = ChainedContext.extend({
     }
 });
 
-var ProcOrMethodDecl = Class.extend.call(ContextProcedure.Declaration, {
-    init: function EberonContext$ProcOrMethodDecl(parent, stdSymbols){
-        ContextProcedure.Declaration.call(this, parent, stdSymbols);
-        this.__methodId = undefined;
-        this.__methodType = undefined;
-        this.__boundType = undefined;
-        this.__endingId = undefined;
-        this.__isConstructor = false;
-        this.__baseConstructorWasCalled = false;
-        this.__initedFields = [];
-    },
-    handleMessage: function(msg){
-        if (msg instanceof EberonContextDesignator.GetMethodSelfMsg){
-            if (!this.__boundType)
-                throw new Errors.Error("SELF can be used only in methods");
-            return this.__boundType;
-        }
-        if (msg instanceof EberonContextDesignator.GetSelfAsPointerMsg){
-            this.__boundType.requireNewOnly();
-            return this.__boundType;
-        }
-
-        if (msg == getConstructorBoundType)
-            return this.__boundType;
-
-        if (msg == getConstructorSuperMsg){
-            this.__baseConstructorWasCalled = true;
-            return this.__handleSuperCall();
-        }
-
-        if (msg instanceof EberonContextDesignator.GetMethodSuperMsg){
-            if (this.__isConstructor)
-                throw new Errors.Error("cannot call base constructor from procedure body (use '| SUPER' to pass parameters to base constructor)");
-            return this.__handleSuperCall();
-        }
-
-        if (msg instanceof InitFieldMsg)
-            return this.__handleFieldInit(msg.id);
-
-        if (msg instanceof MethodOrProcMsg){
-            var id = msg.id;
-            var type = msg.type;
-            if (type){
-                this.__methodId = id;
-                this.__boundType = type;
-                var name = Type.typeName(type);
-                this.__isConstructor = name == id.id();
-            }
-
-            ContextProcedure.Declaration.prototype.handleIdentdef.call(this, id);
-            return;
-        }
-
-        if (handleTypePromotionMadeInSeparateStatement(msg))
-            return;
-
-        return ContextProcedure.Declaration.prototype.handleMessage.call(this, msg);
-    },
-    doProlog: function(){
-        return this.__boundType
-            ? this.__isConstructor ? "function " + Type.typeName(this.__boundType) + "("
-                                   : Type.typeName(this.__boundType) + ".prototype." + this.__methodId.id() + " = function("
-            : ContextProcedure.Declaration.prototype.doProlog.call(this);
-    },
-    doEpilog: function(){
-        return this.__boundType && !this.__isConstructor
-            ? ";\n"
-            : ContextProcedure.Declaration.prototype.doEpilog.call(this);
-    },
-    doBeginBody: function(){
-        ContextProcedure.Declaration.prototype.doBeginBody.call(this);
-        if (this.__isConstructor)
-            this.codeGenerator().write(
-                this.__boundType.baseConstructorCallCode
-              + EberonRecord.fieldsInitializationCode(this.__boundType, this));
-    },
-    doMakeArgumentVariable: function(arg, name){
-        if (!arg.isVar)
-            return new EberonContextDesignator.TypeNarrowVariable(arg.type, false, true, name);
-
-        if (arg.type instanceof Type.Record)
-            return new EberonContextDesignator.TypeNarrowVariable(arg.type, true, false, name);
-
-        return ContextProcedure.Declaration.prototype.doMakeArgumentVariable.call(this, arg, name);
-    },
-    setType: function(type){
-        if (this.__methodId){
-            this.__methodType = new EberonTypes.MethodType(this.__methodId.id(), type, Procedure.makeProcCallGenerator);
-            this.type = type;
-            }            
-        else
-            ContextProcedure.Declaration.prototype.setType.call(this, type);
-    },
-    handleIdent: function(id){
-        if (!this.__boundType)
-            ContextProcedure.Declaration.prototype.handleIdent.call(this, id);
-        else if (this.__endingId)
-            this.__endingId = this.__endingId + "." + id;
-        else
-            this.__endingId = id;
-    },
-    endParse: function(){
-        ContextProcedure.Declaration.prototype.endParse.call(this);
-
-        if (this.__boundType){
-            if (this.__endingId){
-                var expected = Type.typeName(this.__boundType) + "." + this.id.id();
-                if (this.__endingId != expected)
-                    throw new Errors.Error(
-                          "mismatched method names: expected '" 
-                        + expected
-                        + "' at the end (or nothing), got '" 
-                        + this.__endingId + "'");
-            }
-
-            if (this.__isConstructor){
-                this.__boundType.defineConstructor(this.__methodType.procType());
-
-                var base = this.__boundType.base;
-                var baseConstructor = base && EberonRecord.constructor$(base);
-                if (!this.__baseConstructorWasCalled && baseConstructor && baseConstructor.args().length)
-                    throw new Errors.Error("base record constructor has parameters but was not called (use '| SUPER' to pass parameters to base constructor)");
-                if (this.__baseConstructorWasCalled && (!baseConstructor || !baseConstructor.args().length))
-                    throw new Errors.Error("base record constructor has no parameters and will be called automatically (do not use '| SUPER' to call base constructor)");
-            }
-            else
-                this.__boundType.defineMethod(this.__methodId, this.__methodType);
-        }
-    },
-    __handleSuperCall: function(){
-        if (!this.__methodId)
-            throw new Errors.Error("SUPER can be used only in methods");
-
-        var baseType = this.__boundType.base;
-        if (!baseType)
-            throw new Errors.Error(
-                  "'" + Type.typeName(this.__boundType)
-                + "' has no base type - SUPER cannot be used");
-
-        var id = this.__methodId.id();
-        if (!this.__isConstructor)
-            EberonRecord.requireMethodDefinition(baseType, id, "cannot use abstract method(s) in SUPER calls");
-        
-        return new EberonContextDesignator.SuperMethodInfo(
-            this.__isConstructor ? undefined
-                                 : new Type.ProcedureId(new EberonTypes.MethodType(id, this.__methodType.procType(), superMethodCallGenerator)),
-            this.qualifyScope(baseType.scope)
-                + Type.typeName(baseType) + ".prototype." + id + ".call"
-            );
-    },
-    __handleFieldInit: function(id){
-        var fields = this.__boundType.fields;
-        if (!fields.hasOwnProperty(id))
-            throw new Errors.Error("'" + id + "' is not record '" + Type.typeName(this.__boundType) + "' own field");
-        
-        if (this.__initedFields.indexOf(id) != -1)
-            throw new Errors.Error("field '" + id + "' is already initialized");
-
-        this.__initedFields.push(id);        
-        var type = fields[id].type();
-        return makeContextCall(
-            this, 
-            function(cx){return EberonConstructor.makeFieldInitCall(type, cx, id);});
-    }
-});
-
 var Factor = Class.extend.call(ContextExpression.Factor, {
     init: function EberonContext$Factor(context){
         ContextExpression.Factor.call(this, context);
@@ -717,10 +524,6 @@ function BeginTypePromotionAndMsg(){
     this.result = undefined;
 }
 
-function BeginTypePromotionOrMsg(){
-    this.result = undefined;
-}
-
 var Term = Class.extend.call(ContextExpression.Term, {
     init: function EberonContext$Term(context){
         ContextExpression.Term.call(this, context);
@@ -736,7 +539,7 @@ var Term = Class.extend.call(ContextExpression.Term, {
                 p.promote(promoted, msg.type);
             return;
         }
-        if (msg instanceof BeginTypePromotionOrMsg){
+        if (msg instanceof EberonContextProcedure.BeginTypePromotionOrMsg){
             var cp = this.getCurrentPromotion();
             if (cp)
                 msg.result = cp.makeOr();
@@ -794,7 +597,7 @@ var SimpleExpression = Class.extend.call(ContextExpression.SimpleExpression, {
     },
     __getCurrentPromotion: function(){
         if (!this.__currentPromotion){
-            var msg = new BeginTypePromotionOrMsg();
+            var msg = new EberonContextProcedure.BeginTypePromotionOrMsg();
             this.parent().handleMessage(msg);
             this.__typePromotion = msg.result;
             if (this.__typePromotion){
@@ -863,7 +666,7 @@ var OperatorScopes = Class.extend({
             this.__typePromotions.push(this.__typePromotion);
             return true;
         }
-        if (msg instanceof BeginTypePromotionOrMsg){
+        if (msg instanceof EberonContextProcedure.BeginTypePromotionOrMsg){
             this.__typePromotion = new TypePromotion.Or();
             this.__typePromotions.push(this.__typePromotion);
             msg.result = this.__typePromotion;
@@ -1184,7 +987,7 @@ var ModuleDeclaration = Class.extend.call(ContextModule.Declaration, {
         ContextModule.Declaration.call(this, context);
     },
     handleMessage: function(msg){
-        if (handleTypePromotionMadeInSeparateStatement(msg))
+        if (EberonContextProcedure.handleTypePromotionMadeInSeparateStatement(msg))
             return;
         return ContextModule.Declaration.prototype.handleMessage.call(this, msg);
     }
@@ -1212,7 +1015,6 @@ exports.AssignmentOrProcedureCall = AssignmentOrProcedureCall;
 exports.Factor = Factor;
 exports.MapDecl = MapDecl;
 exports.ProcOrMethodId = ProcOrMethodId;
-exports.ProcOrMethodDecl = ProcOrMethodDecl;
 exports.RecordDecl = RecordDecl;
 exports.Repeat = Repeat;
 exports.SimpleExpression = SimpleExpression;

+ 2 - 1
src/eberon/eberon_grammar.js

@@ -6,6 +6,7 @@ var CodeGenerator = require("js/CodeGenerator.js");
 var ContextType = require("js/ContextType.js");
 var EbContext = require("eberon/eberon_context.js");
 var EberonContextDesignator = require("js/EberonContextDesignator.js");
+var EberonContextProcedure = require("js/EberonContextProcedure.js");
 var Grammar = require("grammar.js");
 var EbRtl = require("js/EberonRtl.js");
 var EbRtlCode = require("eberon/eberon_rtl.js");
@@ -73,7 +74,7 @@ function makeProcedureDeclaration(ident, procedureHeading, procedureBody){
     return context(and(procedureHeading, ";",
                        procedureBody,
                        optional(and(ident, optional(and(".", ident))))),
-                   EbContext.ProcOrMethodDecl);
+                   EberonContextProcedure.ProcOrMethodDeclaration);
 }
 
 function makeMethodHeading(identdef, formalParameters){

+ 15 - 10
src/ob/ContextProcedure.ob

@@ -6,17 +6,17 @@ IMPORT
     Object, Procedure, Scope, Symbols, TypeId, Types, Variable;
 TYPE
     Declaration* = RECORD(ContextType.DeclarationAndIdentHandle)
-        PROCEDURE Declaration(parent: ContextHierarchy.PNode);
+        PROCEDURE Declaration*(parent: ContextHierarchy.PNode);
 
-        PROCEDURE doProlog(): STRING;
-        PROCEDURE doEpilog(): STRING;
-        PROCEDURE doBeginBody();
-        PROCEDURE doMakeArgumentVariable(arg: Types.ProcedureArgument; name: STRING): Types.PVariable;
+        PROCEDURE doProlog*(): STRING;
+        PROCEDURE doEpilog*(): STRING;
+        PROCEDURE doBeginBody*();
+        PROCEDURE doMakeArgumentVariable*(arg: Types.ProcedureArgument; name: STRING): Types.PVariable;
 
         PROCEDURE handleReturn(e: Expression.PType);
 
         outerScope: Scope.PType;
-        id: Context.PIdentdefInfo;
+        id-: Context.PIdentdefInfo;
         type: Procedure.PType;
         multipleArguments: BOOLEAN;
         returnParsed: BOOLEAN;
@@ -60,14 +60,19 @@ PROCEDURE Declaration.Declaration(parent: ContextHierarchy.PNode)
       outerScope(SELF.root().currentScope());
 END;
 
-PROCEDURE Declaration.handleIdentdef(id: Context.PIdentdefInfo);
+PROCEDURE handleIdentdef*(VAR d: Declaration; id: Context.PIdentdefInfo);
 BEGIN
-    SELF.id := id;
-    SELF.codeGenerator().write(SELF.doProlog());
-    root <- SELF.root();
+    d.id := id;
+    d.codeGenerator().write(d.doProlog());
+    root <- d.root();
     root.pushScope(Scope.makeProcedure(root.language().stdSymbols));
 END;
 
+PROCEDURE Declaration.handleIdentdef(id: Context.PIdentdefInfo);
+BEGIN
+    handleIdentdef(SELF, id);
+END;
+
 PROCEDURE Declaration.handleIdent(id: STRING);
 BEGIN
     expectId <- SELF.id.id();

+ 8 - 5
src/ob/ContextType.ob

@@ -450,15 +450,18 @@ BEGIN
     RETURN TRUE;
 END;
 
-PROCEDURE setTypeId(p: Pointer; typeId: TypeId.PType);
+PROCEDURE setPointerTypeId(p: Pointer; typeId: TypeId.PType);
 VAR
     name: STRING;
+    typeDesc: STRING;
 BEGIN
     IF ~(typeId^ IS TypeId.Forward) THEN
         type <- typeId.type();
         IF ~(type IS Types.PRecord) THEN
-            Errors.raise("RECORD is expected as a POINTER base type, got '" 
-                         + type.description() + "'");
+            IF type # NIL THEN
+                typeDesc := ", got '" + type.description() + "'";
+            END;
+            Errors.raise("RECORD is expected as a POINTER base type" + typeDesc);
         END;
     END;
     
@@ -492,14 +495,14 @@ BEGIN
         msg <- NEW ForwardTypeMsg(id);
         info := SELF.parent().handleMessage(msg^)(Types.PId);
     END;
-    setTypeId(SELF, ContextExpression.unwrapTypeId(info));
+    setPointerTypeId(SELF, ContextExpression.unwrapTypeId(info));
 END;
 
 PROCEDURE Pointer.setType(type: Types.PStorageType);
 BEGIN
     typeId <- NEW TypeId.Type(type);
     SELF.root().currentScope().addFinalizer(stripTypeId, typeId);
-    setTypeId(SELF, typeId);
+    setPointerTypeId(SELF, typeId);
 END;
 
 PROCEDURE Pointer.isAnonymousDeclaration(): BOOLEAN;

+ 1 - 1
src/ob/Procedure.ob

@@ -33,7 +33,7 @@ TYPE
         check: LenArgumentCheck
     END;
 
-    CallGenerator* = RECORD
+    CallGenerator* = RECORD(Object.Type)
         PROCEDURE handleArgument*(e: Expression.PType);
         PROCEDURE end*(): Expression.PType;
     END;

+ 3 - 1
test/test_unit.js

@@ -208,7 +208,9 @@ return {
          ["T = POINTER TO POINTER TO RECORD END",
           "RECORD is expected as a POINTER base type, got 'POINTER TO anonymous RECORD'"],
          ["T = POINTER TO RECORD p: POINTER TO T END",
-          "RECORD is expected as a POINTER base type, got 'T'"]
+          "RECORD is expected as a POINTER base type, got 'T'"],
+         ["T = POINTER TO T",
+          "RECORD is expected as a POINTER base type"]
         )
     ),
 "POINTER dereference": testWithContext(