FOR..IN for arrays

bug fixes

src/eberon/EberonCast.ob

@@ -89,7 +89,7 @@ BEGIN
             result := Cast.errNo;
         END;
     ELSIF (from IS EberonMap.PType) & (to IS EberonMap.PType) THEN
-        IF Cast.areTypesExactlyMatch(from.valueType, to.valueType) THEN
+        IF Cast.areTypesExactlyMatch(from.elementsType, to.elementsType) THEN
             op := castOpToMap;
             result := Cast.errNo;
         ELSE

src/eberon/EberonContextDesignator.ob

@@ -130,7 +130,7 @@ BEGIN
             "",
             "");
     ELSIF currentType IS EberonMap.PType THEN
-        indexType <- currentType.valueType;
+        indexType <- currentType.elementsType;
         rtl <- SELF.root().language().rtl(EberonRtl.PType);
         rval <- rtl.getMappedValue(code, indexCode);
         lval <- code + "[" + indexCode + "]";

src/eberon/EberonContextLoop.ob

@@ -139,7 +139,7 @@ END;
 PROCEDURE ForEach.handleExpression(e: Expression.PType);
 BEGIN
     type <- e.type();
-    IF ~(type IS EberonMap.PType) THEN
+    IF ~(type IS Types.PArray) THEN
         Errors.raise("expression of type MAP is expected in FOR, got '" 
                      + type.description() + "'");
     ELSE
@@ -159,7 +159,7 @@ BEGIN
         SELF.code := code;
 
         makeVariable(SELF.keyId, EberonString.string, scope);
-        makeVariable(SELF.valueId, type.valueType, scope);
+        makeVariable(SELF.valueId, type.elementsType, scope);
     END;
 END;
 

src/eberon/EberonContextProcedure.ob

@@ -4,7 +4,7 @@ IMPORT
     Context, ContextDesignator, ContextExpression, ContextHierarchy, ContextModule, 
     ContextProcedure, ContextType, 
     EberonConstructor, EberonContext, EberonContextDesignator, 
-    EberonDynamicArray, EberonRecord, EberonTypePromotion, EberonTypes,
+    EberonDynamicArray, EberonMap, EberonRecord, EberonTypePromotion, EberonTypes,
     Errors, Expression, LanguageContext, Object, Procedure, Types;
 TYPE
     ProcOrMethodDeclaration* = RECORD(ContextProcedure.Declaration)
@@ -388,9 +388,14 @@ BEGIN
     RETURN SUPER(msg);
 END;
 
+PROCEDURE isEberonArrayOrMap(type: Types.PStorageType): BOOLEAN;
+    RETURN (type IS EberonDynamicArray.PDynamicArray) 
+        OR (type IS EberonMap.PType);
+END;
+
 PROCEDURE FormalParameters.doCheckResultType(type: Types.PStorageType);
 BEGIN
-    IF ~(type IS EberonDynamicArray.PDynamicArray) THEN
+    IF ~isEberonArrayOrMap(type) THEN
         SUPER(type);
     END;
 END;
@@ -403,7 +408,7 @@ END;
 
 PROCEDURE FormalParametersProcDecl.doCheckResultType(type: Types.PStorageType);
 BEGIN
-    IF ~(type IS EberonDynamicArray.PDynamicArray) THEN
+    IF ~isEberonArrayOrMap(type) THEN
         SUPER(type);
     END;
 END;

src/eberon/EberonContextType.ob

@@ -33,8 +33,6 @@ TYPE
     END;
 
     Map* = RECORD(ContextType.DeclarationHandle)
-        PROCEDURE typeName*(): STRING;
-
         type: Types.PStorageType;
     END;
 
@@ -238,4 +236,14 @@ PROCEDURE MethodDeclMsg.MethodDeclMsg(id: Context.PIdentdefInfo; type: Procedure
       type(type);
 END;
 
+PROCEDURE isTypeRecursive*(type, base: Types.PType): BOOLEAN;
+BEGIN
+    result <- ~(type IS EberonDynamicArray.PDynamicArray) 
+            & ~(type IS EberonMap.PType);
+    IF result THEN
+        result := ContextType.isTypeRecursive(type, base);
+    END;
+    RETURN result;
+END;
+
 END EberonContextType.

src/eberon/EberonMap.ob

@@ -5,10 +5,7 @@ CONST
     removeMethodName = "remove";
     clearMethodName = "clear";
 TYPE
-    Type* = RECORD(Types.StorageType)
-        PROCEDURE Type*(type: Types.PStorageType);
-
-        valueType*: Types.PStorageType;
+    Type* = RECORD(Types.Array)
     END;
     PType* = POINTER TO Type;
 
@@ -45,11 +42,7 @@ PROCEDURE Type.initializer(cx: Context.Type): STRING;
 END;
 
 PROCEDURE Type.description(): STRING;
-    RETURN "MAP OF " + SELF.valueType.description();
-END;
-
-PROCEDURE Type.Type(valueType: Types.PStorageType)
-    | valueType(valueType);
+    RETURN "MAP OF " + SELF.elementsType.description();
 END;
 
 PROCEDURE Type.denote(id: STRING; isReadObly: BOOLEAN): Types.PField;

src/eberon/EberonOperator.ob

@@ -90,7 +90,7 @@ VAR
     result: STRING;
 BEGIN
     IF type IS EberonMap.PType THEN
-        result := "{map: " + generateTypeInfo(type.valueType) + "}";
+        result := "{map: " + generateTypeInfo(type.elementsType) + "}";
     ELSE
         result := Record.generateTypeInfo(type);
     END;

src/eberon/eberon_grammar.js

@@ -176,6 +176,7 @@ exports.language = {
             return Cast.implicit(from, to, toVar, EbOperator.castOperations(), op);
         },
         typeInfo: function(type){return EbOperator.generateTypeInfo(type);},
+        isRecursive: function(type, base){return EberonContextType.isTypeRecursive(type, base);},
         makeStaticArray: function(type, init, length){ return new EbArray.StaticArray(init, type, length); },
         makeOpenArray: function(type){return new EbArray.OpenArray(type); }
     },

src/ob/ContextProcedure.ob

@@ -214,10 +214,8 @@ END;
 
 PROCEDURE FormalParameters.doCheckResultType(type: Types.PStorageType);
 BEGIN
-    IF type IS Types.PArray THEN
-        Errors.raise("the result type of a procedure cannot be an ARRAY");
-    ELSIF type IS Types.PRecord THEN
-        Errors.raise("the result type of a procedure cannot be a RECORD");
+    IF ~type.isScalar() THEN
+        Errors.raise("procedure cannot return " + type.description());
     END;
 END;
 

src/ob/ContextType.ob

@@ -11,6 +11,7 @@ TYPE
     PHandleSymbolAsType = POINTER TO HandleSymbolAsType;
 
     DeclarationHandle* = RECORD(HandleSymbolAsType)
+        PROCEDURE typeName*(): STRING;
         PROCEDURE isAnonymousDeclaration*(): BOOLEAN;
     END;
     PDeclarationHandle* = POINTER TO DeclarationHandle;
@@ -39,7 +40,6 @@ TYPE
 
     DeclarationAndIdentHandle* = RECORD(HavingFieldsDeclaration)
         PROCEDURE handleIdentdef*(id: Context.PIdentdefInfo);
-        PROCEDURE typeName*(): STRING;
     END;
     PDeclarationAndIdentHandle* = POINTER TO DeclarationAndIdentHandle;
 
@@ -144,6 +144,10 @@ BEGIN
     END;
 END;
 
+PROCEDURE Array.typeName(): STRING;
+    RETURN "";
+END;
+
 PROCEDURE Array.setType(elementsType: Types.PStorageType);
 VAR
     dimensions: STRING;
@@ -230,7 +234,7 @@ BEGIN
     RETURN TRUE;
 END;
 
-PROCEDURE isTypeRecursive(type, base: Types.PType): BOOLEAN;
+PROCEDURE isTypeRecursive*(type, base: Types.PType): BOOLEAN;
 BEGIN
     result <- FALSE;
     IF type = base THEN
@@ -324,7 +328,7 @@ END;
 
 PROCEDURE Record.addField(field: Context.PIdentdefInfo; type: Types.PStorageType);
 BEGIN
-    IF isTypeRecursive(type, SELF.type) THEN
+    IF SELF.root().language().types.isRecursive(type, SELF.type) THEN
         Errors.raise("recursive field definition: '" + field.id() + "'");
     END;
     SELF.type.addField(SELF.doMakeField(field, type));
@@ -341,7 +345,7 @@ BEGIN
             + type.description()
             + "'");
     ELSE
-        IF isTypeRecursive(type, SELF.type) THEN
+        IF type = SELF.type THEN
             Errors.raise("recursive inheritance: '"
                          + SELF.type.description() + "'");
         END;

src/ob/LanguageContext.ob

@@ -15,6 +15,7 @@ TYPE
     Types* = RECORD         
         PROCEDURE implicitCast*(from, to: T.PType; toVar: BOOLEAN; VAR op: PCastOp): INTEGER;
         PROCEDURE typeInfo*(type: T.PType): STRING;
+        PROCEDURE isRecursive*(type, base: T.PType): BOOLEAN;
         PROCEDURE makeOpenArray*(type: T.PType): T.PStorageType;
         PROCEDURE makeStaticArray*(type: T.PType; init: STRING; length: INTEGER): T.PStorageType;
     END;

src/oberon/oberon_grammar.js

@@ -144,6 +144,7 @@ exports.language = {
             return Cast.implicit(from, to, toVar, Operator.castOperations(), op);
         },
         typeInfo: function(type){return Record.generateTypeInfo(type);},
+        isRecursive: function(type, base){return ContextType.isTypeRecursive(type, base);},
         makeStaticArray: function(type, init, length){ return new Types.StaticArray(init, type, length); },
         makeOpenArray: function(type){return new Types.OpenArray(type); }
     },

test/expected/eberon/map.js

@@ -10,7 +10,7 @@ function anonymous$1(){
 	this.m = {};
 }
 var r = new anonymous$1();
-var a = RTL$.makeArray(1, {});
+var a = RTL$.makeArray(1, function(){return {};});
 function RecordWithMapInitializedInConstructor(m/*MAP OF INTEGER*/){
 	this.m = RTL$.clone(m, {map: null}, undefined);
 }

test/test_unit.js

@@ -148,6 +148,12 @@ return {
          ["T = RECORD r: RECORD (T) END END", "recursive field definition: 'r'"]
          )
     ),
+"record cannot have forward type as a base": testWithGrammar(
+    grammar.declarationSequence,
+    pass(),
+    fail(["TYPE PForward = POINTER TO Forward; T = RECORD (Forward) END;", 
+          "undeclared identifier: 'Forward'"])
+    ),
 "record extension": testWithContext(
     context(grammar.typeDeclaration,
             "TYPE B = RECORD END;"),
@@ -193,8 +199,9 @@ return {
          "T = PROCEDURE(a: INTEGER)",
          "T = PROCEDURE(a: INTEGER; b: BOOLEAN)",
          "T = PROCEDURE(): T"),
-    fail(["T = PROCEDURE(): A;", "the result type of a procedure cannot be an ARRAY"],
-         ["T = PROCEDURE(): R;", "the result type of a procedure cannot be a RECORD"]
+    fail(["T = PROCEDURE(): A;", "procedure cannot return ARRAY 3 OF INTEGER"],
+         ["T = PROCEDURE(): R;", "procedure cannot return R"]
+         //TODO:["T = ARRAY 3 OF PROCEDURE(): T;", "test"]
         )
     ),
 "POINTER declaration": testWithGrammar(
@@ -1275,11 +1282,11 @@ return {
          ["PROCEDURE p(): undeclared; END p", "undeclared identifier: 'undeclared'"],
          ["PROCEDURE p(): i; END p", "type name expected"],
          ["PROCEDURE p(): INTEGER; RETURN TRUE END p", "RETURN 'INTEGER' expected, got 'BOOLEAN'"],
-         ["PROCEDURE p(a: A): A; RETURN a END p", "the result type of a procedure cannot be an ARRAY"],
-         ["PROCEDURE p(): A; VAR a: A; RETURN a END p", "the result type of a procedure cannot be an ARRAY"],
-         ["PROCEDURE p(r: R): R; RETURN r END p", "the result type of a procedure cannot be a RECORD"],
-         ["PROCEDURE p(): R; VAR r: R; RETURN r END p", "the result type of a procedure cannot be a RECORD"],
-         ["PROCEDURE p(pr: PR): R; RETURN pr END p", "the result type of a procedure cannot be a RECORD"]
+         ["PROCEDURE p(a: A): A; RETURN a END p", "procedure cannot return ARRAY 3 OF INTEGER"],
+         ["PROCEDURE p(): A; VAR a: A; RETURN a END p", "procedure cannot return ARRAY 3 OF INTEGER"],
+         ["PROCEDURE p(r: R): R; RETURN r END p", "procedure cannot return R"],
+         ["PROCEDURE p(): R; VAR r: R; RETURN r END p", "procedure cannot return R"],
+         ["PROCEDURE p(pr: PR): R; RETURN pr END p", "procedure cannot return R"]
          )
     ),
 "pass VAR argument as VAR parameter": testWithContext(

test/test_unit_eberon.js

@@ -953,6 +953,7 @@ exports.suite = {
                      "TYPE P = PROCEDURE(): DA;",
                      "TYPE P = PROCEDURE(VAR a: DA): DA;",
                      "TYPE P = PROCEDURE(VAR a: ARRAY * OF INTEGER): DA;",
+                     "TYPE T = RECORD a: ARRAY * OF T END;",
                      "VAR a: ARRAY * OF INTEGER;",
                      "PROCEDURE p(VAR a: ARRAY * OF INTEGER);END p;",
                      "PROCEDURE p(VAR a: ARRAY * OF ARRAY * OF INTEGER);END p;",
@@ -1336,6 +1337,14 @@ exports.suite = {
          ["NEW undeclared()", "undeclared identifier: 'undeclared'"]
          )
     ),
+"FOR..IN": {
+    "array": testWithContext(
+        context(grammar.statement, 
+                "VAR a: ARRAY 3 OF BOOLEAN;"),
+        pass("FOR i, v IN a DO END"),
+        fail()
+    ),
+},
 "map": {
     "declaration": testWithGrammar(
         grammar.declarationSequence, 
@@ -1343,7 +1352,7 @@ exports.suite = {
              "TYPE M = MAP OF PROCEDURE;",
              "TYPE M = MAP OF PROCEDURE();",
              "TYPE M = MAP OF PROCEDURE(): INTEGER;",
-             "TYPE M = MAP OF PROCEDURE(): M;",
+             //TODO:"TYPE M = MAP OF PROCEDURE(): M;",
              "TYPE M = MAP OF RECORD END;",
              "TYPE M = MAP OF POINTER TO RECORD END;",
              "TYPE M = MAP OF MAP OF INTEGER;",
@@ -1468,6 +1477,11 @@ exports.suite = {
         fail(["PROCEDURE p(m: M); BEGIN; m.remove(\"abc\"); END;", "method 'remove' cannot be applied to non-VAR MAP"],
              ["PROCEDURE p(m: M); BEGIN; m.clear(); END;", "method 'clear' cannot be applied to non-VAR MAP"]
             )
+        ),
+    "return": testWithContext(
+        context(grammar.declarationSequence,
+                "TYPE M = MAP OF INTEGER;"),
+        pass("PROCEDURE p(): M; VAR m: M; BEGIN; RETURN m; END;")
         )
     }
 };