multi dimensional arrays WIP

CHiPs44 · CHiPs44 · commit fbea85cbb40d · 2026-03-31T23:05:58.000+02:00
diff --git a/examples/034-array4.pas b/examples/034-array4.pas
@@ -0,0 +1,39 @@
+(*
+    This file is part of the PascalScript Pascal interpreter.
+    SPDX-FileCopyrightText: 2026 Christophe 'CHiPs' Petit <chips44@gmail.com>
+    SPDX-License-Identifier: LGPL-Cols.0-or-later
+*)
+Program Arrays;
+
+Const
+    Rows = 3;
+    Cols = 5;
+
+Type
+    NumberArray = Array[1..Rows, 1..Cols] Of Integer;
+    // ArrayOfArray = Array[1..Rows] Of Array[1..Cols] Of Char;
+
+Var
+    Numbers: NumberArray;
+    // Chars: ArrayOfArray;
+    I, J: Integer;
+
+Begin
+    For I := 1 To Rows Do
+        For J := 1 To Cols Do
+        Begin
+            Numbers[I, J] := (I * J) Mod 26;
+            // Chars[I, J] := Char(65 + (I * J) Mod 26);
+        End;
+    Write('    ');
+    For J := 1 To Cols Do
+        Write(J:4);
+    WriteLn;
+    For I := 1 To Rows Do
+    Begin
+        Write(I:3, ' ');
+        For J := 1 To Cols Do
+            Write(Numbers[I, J]:4);
+        WriteLn;
+    End;
+End.
diff --git a/include/ps_array.h b/include/ps_array.h
@@ -27,8 +27,10 @@ extern "C"
 
     /** @brief Get array type definition */
     ps_type_definition *ps_array_get_type_def(const ps_symbol *array);
-    /** @brief Get array subrange */
-    ps_symbol *ps_array_get_subrange(const ps_symbol *array);
+    /** @brief Get array subranges */
+    ps_symbol **ps_array_get_subranges(const ps_symbol *array);
+    /** @brief Get array dimensions */
+    int ps_array_get_dimensions(const ps_symbol *array_type);
     /** @brief Get array item type */
     ps_symbol *ps_array_get_item_type(const ps_symbol *array);
     /** @brief value := array[index] (allocating value if NULL) */
diff --git a/include/ps_error.h b/include/ps_error.h
@@ -76,6 +76,7 @@ extern "C"
         PS_ERROR_INVALID_PARAMETERS,
         PS_ERROR_TOO_MANY_VARIABLES,
         PS_ERROR_TOO_MANY_DIMENSIONS,
+        PS_ERROR_NOT_ENOUGH_DIMENSIONS,
         PS_ERROR_PARAMETER_COUNT_MISMATCH,
         PS_ERROR_MATH_NAN_INF,
         // ...
diff --git a/src/ps_array.c b/src/ps_array.c
@@ -78,7 +78,7 @@ ps_type_definition *ps_array_get_type_def(const ps_symbol *symbol)
     return type_def;
 }
 
-ps_symbol *ps_array_get_subrange(const ps_symbol *array_type)
+ps_symbol **ps_array_get_subranges(const ps_symbol *array_type)
 {
     if (ps_array_debug)
         ps_symbol_debug(stderr, "ps_array_get_subrange, array_type: ", array_type);
@@ -87,10 +87,18 @@ ps_symbol *ps_array_get_subrange(const ps_symbol *array_type)
         ps_type_definition_debug(stderr, "GET_SUBRANGE\tTYPE_DEF\t", type_def);
     if (type_def == NULL)
         return NULL;
-    ps_symbol *subrange = type_def->def.a.subranges[0];
+    ps_symbol **subranges = type_def->def.a.subranges;
+    return subranges;
+}
+
+int ps_array_get_dimensions(const ps_symbol *array_type)
+{
     if (ps_array_debug)
-        ps_symbol_debug(stderr, "GET_SUBRANGE\tSUBRANGE\t", subrange);
-    return subrange;
+        ps_symbol_debug(stderr, "ps_array_get_dimensions, array_type: ", array_type);
+    const ps_type_definition *type_def = ps_array_get_type_def(array_type);
+    if (type_def == NULL)
+        return NULL;
+    return type_def->def.a.dimensions;
 }
 
 ps_symbol *ps_array_get_item_type(const ps_symbol *array_type)
@@ -125,20 +133,20 @@ ps_error ps_array_get_value(const ps_symbol *array_var, const ps_value *index, p
     return error;
 }
 
-ps_error ps_array_set_value(ps_symbol *array_var, const ps_value *index, const ps_value *value, bool range_check)
+ps_error ps_array_set_value(ps_symbol *array_var, const ps_value **indicies, const ps_value *value, bool range_check)
 {
     if (ps_array_debug)
     {
         ps_symbol_debug(stderr, "PS_ARRAY_SET_VALUE, array_var: ", array_var);
-        ps_value_debug(stderr, "PS_ARRAY_SET_VALUE, index: ", index);
+        ps_value_debug(stderr, "PS_ARRAY_SET_VALUE, index: ", indicies);
     }
     if (array_var == NULL || array_var->value == NULL || array_var->value->type == NULL ||
         array_var->value->data.a->values == NULL)
         return PS_ERROR_INVALID_PARAMETERS;
     const ps_symbol *subrange = ps_array_get_subrange(array_var->value->type);
     // Get offset from index
     ps_array_debug = true;
-    ps_unsigned offset = ps_type_definition_get_subrange_offset(subrange->value->data.t, index);
+    ps_unsigned offset = ps_type_definition_get_subrange_offset(subrange->value->data.t, indicies);
     if (offset >= array_var->value->data.a->count)
         return PS_ERROR_INVALID_SUBRANGE;
     ps_array_debug = false;
diff --git a/src/ps_error.c b/src/ps_error.c
@@ -75,7 +75,8 @@ static const ps_error_message ps_error_messages[] = {
     {PS_ERROR_OUT_OF_RANGE, "Out of range"},
     {PS_ERROR_INVALID_PARAMETERS, "Invalid parameters"},
     {PS_ERROR_TOO_MANY_VARIABLES, "Too many variables in declaration"},
-    {PS_ERROR_TOO_MANY_DIMENSIONS, "Too many dimensions in array definition"},
+    {PS_ERROR_TOO_MANY_DIMENSIONS, "Too many dimensions for array"},
+    {PS_ERROR_NOT_ENOUGH_DIMENSIONS, "Not enough dimensions for array"},
     {PS_ERROR_PARAMETER_COUNT_MISMATCH, "Parameter count mismatch"},
     {PS_ERROR_MATH_NAN_INF, "Math result is NaN or Infinity"},
     {PS_ERROR_MAX, "MAX error?"},
diff --git a/src/ps_value.c b/src/ps_value.c
@@ -448,8 +448,8 @@ char *ps_value_to_string(const ps_value *value, bool debug, int16_t width, int16
         EXECUTABLE_VALUE
         break;
     case PS_TYPE_ARRAY:
-        snprintf(buffer, sizeof(buffer) - 1, "ARRAY[%s] OF %s", value->type->value->data.t->def.a.subranges[0]->name,
-                 value->type->value->data.t->def.a.item_type->name);
+        snprintf(buffer, sizeof(buffer) - 1, "ARRAY[%s,%d] OF %s", value->type->value->data.t->def.a.subranges[0]->name,
+                 value->type->value->data.t->def.a.dimensions, value->type->value->data.t->def.a.item_type->name);
         break;
     case PS_TYPE_POINTER:
         snprintf(buffer, sizeof(buffer) - 1, "%p", value->data.p);
diff --git a/src/ps_visit_statement.c b/src/ps_visit_statement.c
@@ -80,34 +80,53 @@ bool ps_visit_compound_statement(ps_interpreter *interpreter, ps_interpreter_mod
     VISIT_END("OK")
 }
 
-// bool ps_visit_assignment_array(ps_interpreter *interpreter, ps_interpreter_mode mode, ps_symbol *variable)
-// {
-//     VISIT_BEGIN("ASSIGNMENT", "");
-//     VISIT_END("OK");
-// }
-
 bool ps_visit_assignment_array(ps_interpreter *interpreter, ps_interpreter_mode mode, ps_symbol *variable)
 {
     VISIT_BEGIN("ASSIGNMENT", "ARRAY")
 
-    ps_value result = {.type = &ps_system_none, .data.v = NULL};
-    ps_value index = {.type = &ps_system_none, .data.v = NULL};
+    ps_value result = {.allocated = false, .type = &ps_system_none, .data.v = NULL};
+    ps_value indicies[8] = {0};
+    int dimensions = variable->value->type->value->data.t->def.a.dimensions;
+    int dimension = 0;
+
+    for (ps_unsigned i = 0; i < dimensions; i++)
+    {
+        indicies[i].type = variable->value->type->value->data.t->def.a.subranges[i];
+        indicies[i].allocated = false;
+        indicies[i].data.v = NULL;
+    }
 
     EXPECT_TOKEN(PS_TOKEN_LEFT_BRACKET)
     READ_NEXT_TOKEN
-    index.type = variable->value->type->value->data.t->def.a.subranges[0];
-    if (!ps_visit_expression(interpreter, mode, &index))
-        TRACE_ERROR("INDEX")
-    EXPECT_TOKEN(PS_TOKEN_RIGHT_BRACKET)
-    READ_NEXT_TOKEN
+    do
+    {
+        if (!ps_visit_expression(interpreter, mode, &indicies[dimension]))
+            TRACE_ERROR("INDEX")
+        dimension += 1;
+        if (lexer->current_token.type == PS_TOKEN_COMMA)
+        {
+            if (dimension == dimensions)
+                RETURN_ERROR(PS_ERROR_TOO_MANY_DIMENSIONS)
+            READ_NEXT_TOKEN
+            continue;
+        }
+        if (lexer->current_token.type == PS_TOKEN_RIGHT_BRACKET)
+        {
+            if (dimension != dimensions)
+                RETURN_ERROR(PS_ERROR_TOO_MANY_DIMENSIONS)
+            READ_NEXT_TOKEN
+            break;
+        }
+        RETURN_ERROR(PS_ERROR_UNEXPECTED_TOKEN)
+    } while (true);
     EXPECT_TOKEN(PS_TOKEN_ASSIGN)
     READ_NEXT_TOKEN
     result.type = variable->value->type->value->data.t->def.a.item_type;
     if (!ps_visit_expression(interpreter, mode, &result))
         TRACE_ERROR("EXPRESSION1")
     if (mode == MODE_EXEC)
     {
-        ps_error error = ps_array_set_value(variable, &index, &result, interpreter->range_check);
+        ps_error error = ps_array_set_value(variable, &indicies, &result, interpreter->range_check);
         if (error != PS_ERROR_NONE)
         {
             interpreter->error = error;
diff --git a/src/ps_visit_type.c b/src/ps_visit_type.c
@@ -593,7 +593,7 @@ bool ps_visit_type_reference_subrange(ps_interpreter *interpreter, ps_interprete
 }
 
 /**
- * 'ARRAY' '[' SUBRANGE | IDENTIFIER ']' 'OF' TYPE_REFERENCE
+ * 'ARRAY' '[' SUBRANGE | IDENTIFIER [ ',' SUBRANGE | IDENTIFIER ]* ']' 'OF' TYPE_REFERENCE
  */
 bool ps_visit_type_reference_array(ps_interpreter *interpreter, ps_interpreter_mode mode, ps_symbol **type_symbol,
                                    const char *type_name)
@@ -615,7 +615,7 @@ bool ps_visit_type_reference_array(ps_interpreter *interpreter, ps_interpreter_m
     READ_NEXT_TOKEN
     do
     {
-        // SUBRANGE (LOW '..' HIGH)
+        // SUBRANGE: LOW '..' HIGH | IDENTIFIER
         if (!ps_visit_type_reference(interpreter, mode, &subrange, NULL))
             TRACE_ERROR("DIMENSION")
         // Dimension *must* be a subrange
@@ -628,14 +628,17 @@ bool ps_visit_type_reference_array(ps_interpreter *interpreter, ps_interpreter_m
         {
             if (dimensions == 8)
                 RETURN_ERROR(PS_ERROR_TOO_MANY_DIMENSIONS)
+            READ_NEXT_TOKEN
             continue;
         }
         // ']'
         if (lexer->current_token.type == PS_TOKEN_RIGHT_BRACKET)
+        {
+            READ_NEXT_TOKEN
             break;
+        }
         RETURN_ERROR(PS_ERROR_UNEXPECTED_TOKEN)
     } while (true);
-    READ_NEXT_TOKEN
     // 'OF'
     if (lexer->current_token.type != PS_TOKEN_OF)
         RETURN_ERROR(PS_ERROR_UNEXPECTED_TOKEN)
@@ -644,7 +647,11 @@ bool ps_visit_type_reference_array(ps_interpreter *interpreter, ps_interpreter_m
     if (!ps_visit_type_reference(interpreter, mode, &item_type, NULL))
         TRACE_ERROR("ITEM_TYPE")
     // Item type can be any type, even another array
-
+    if (item_type->kind != PS_SYMBOL_KIND_TYPE_DEFINITION)
+        RETURN_ERROR(PS_ERROR_EXPECTED_TYPE)
+    // For now, item_type cannot be an array type
+    if (item_type->value->data.t->type == PS_TYPE_ARRAY)
+        RETURN_ERROR(PS_ERROR_NOT_IMPLEMENTED)
     // Create type definition for array
     ps_type_definition *type_def = NULL;
     ps_identifier name = {0};
@@ -661,11 +668,12 @@ bool ps_visit_type_reference_array(ps_interpreter *interpreter, ps_interpreter_m
         ps_type_definition_free(type_def);
         RETURN_ERROR(PS_ERROR_OUT_OF_MEMORY);
     }
-    for (int i = 0; i <= dimensions; i++) {
+    for (int i = 0; i <= dimensions; i++)
+    {
         type_def->def.a.subranges[i] = subranges[i];
     }
-    type_def->def.a.item_type = item_type;
     type_def->def.a.dimensions = dimensions;
+    type_def->def.a.item_type = item_type;
     // Register new type definition in symbol table
     if (!ps_type_definition_register(interpreter, mode, name, type_def, type_symbol))
         RETURN_ERROR(interpreter->error)
