(********************************************************************)
(*                                                                  *)
(*  struct.s7i    Struct support library                            *)
(*  Copyright (C) 1989 - 2025  Thomas Mertes                        *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "struct_elem.s7i";

const type: STRUCT is newtype;

IN_PARAM_IS_REFERENCE(STRUCT);

const creator: (ref STRUCT: dest) ::= (in STRUCT: source)           is action "SCT_CREATE";
const destroyer: destroy (ref STRUCT: aValue)                       is action "SCT_DESTR";
const proc: (inout STRUCT: dest) := (in STRUCT: source)             is action "SCT_CPY";
const func integer: length (in STRUCT: aStruct)                     is action "SCT_LNG";
const func STRUCT: (in STRUCT: struct1) & (in STRUCT: struct2)      is action "SCT_CAT";
const proc: incl (inout STRUCT: aStruct, in reference: anElem)      is action "SCT_INCL";
const func STRUCT: empty (attr STRUCT)                              is action "SCT_EMPTY";
const func ref_list: declare_elements (ref proc: elem_decl)         is action "DCL_ELEMENTS";


(**
 *  Structure type with elements defined in ''elem_decl''.
 *   const type: point is new struct
 *       var integer: xPos is 0;
 *       var integer: yPos is 0;
 *     end struct;
 *  @param elem_decl Declarations of the struct elements.
 *)
const func type: new struct (ref proc: elem_decl) end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
    var ref_list: elem_list is ref_list.EMPTY;
    var STRUCT: struct_value is empty(STRUCT);
    var integer: number is 0;
    var reference: elem_obj is NIL;
    var structElementArray: structElems is structElementArray.value;
  begin
    global
    structType := newtype;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    CURR_STRUCT_PTR := ptrType;
    varptrType := varptr structType;
    elem_list := declare_elements(elem_decl);
    const boolean: isStructType (attr structType)                      is TRUE;
    const type: base_type (attr structType)                            is void;
    const creator: (ref structType: dest) ::= (in structType: source)  is action "SCT_CREATE";
    const destroyer: destroy (ref structType: aValue)                  is action "SCT_DESTR";
    const proc: (inout structType: dest) := (in structType: source)    is action "SCT_CPY";
    const func ptrType: alloc (in structType: aStruct)                 is action "SCT_ALLOC";
    const func varptrType: varalloc (in structType: aStruct)           is action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT: aStruct) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType: aStruct)     is action "SCT_CONV";
    for number range 1 to length(elem_list) do
      elem_obj := elem_list[number];
      if is_symb(elem_obj) then
        (* TRACE(elem_obj); PRINT("\n"); *)
        incl(struct_value, elem_obj);
        const func    getType(elem_obj):    (in structType: aStruct) .  (symb elem_obj) is action "SCT_SELECT";
        const varfunc getType(elem_obj): (inout structType: aStruct) .  (symb elem_obj) is action "SCT_SELECT";
        const func    getType(elem_obj):    (in ptrType:    aPtr)    -> (symb elem_obj) is action "REF_SELECT";
        const varfunc getType(elem_obj):    (in varptrType: aStruct) -> (symb elem_obj) is action "REF_SELECT";
        structElems &:= structElement(elem_obj);
      end if;
    end for;
    const structElementArray: elements (attr structType)               is structElems;
    const structType: (attr structType) . value                        is structType conv struct_value;
    end global;
  end func;

(**
 *  Structure type with no elements.
 *   const type: emptyStruct is new struct
 *     end struct;
 *)
const func type: new struct end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
  begin
    global
    structType := newtype;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    varptrType := varptr structType;
    const boolean: isStructType (attr structType)                      is TRUE;
    const type: base_type (attr structType)                            is void;
    const creator: (ref structType: dest) ::= (in structType: source)  is action "SCT_CREATE";
    const destroyer: destroy (ref structType: aValue)                  is action "SCT_DESTR";
    const proc: (inout structType: dest) := (in structType: source)    is action "SCT_CPY";
    const func ptrType: alloc (in structType: aStruct)                 is action "SCT_ALLOC";
    const func varptrType: varalloc (in structType: aStruct)           is action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT: aStruct) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType: aStruct)     is action "SCT_CONV";
    const structElementArray: elements (attr structType)               is structElementArray.value;
    const structType: (attr structType) . value                        is structType conv empty(STRUCT);
    end global;
  end func;

(**
 *  Derived structure type with elements defined in ''elem_decl''.
 *  Create new structure type as subtype of ''baseType'', which is not
 *  a structure.
 *   const type: point is new object struct
 *       var integer: xPos is 0;
 *       var integer: yPos is 0;
 *     end struct;
 *  @param baseType Base type from which the new type is derived.
 *  @param elem_decl Declarations of the struct elements.
 *)
const func type: new (in type: baseType) struct (ref proc: elem_decl) end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
    var ref_list: elem_list is ref_list.EMPTY;
    var STRUCT: struct_value is empty(STRUCT);
    var integer: number is 0;
    var reference: elem_obj is NIL;
    var structElementArray: structElems is structElementArray.value;
  begin
    global
    structType := subtype baseType;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    varptrType := varptr structType;
    elem_list := declare_elements(elem_decl);
    const boolean: isStructType (attr structType)                      is TRUE;
    const creator: (ref structType: dest) ::= (in structType: source)  is action "SCT_CREATE";
    const destroyer: destroy (ref structType: aValue)                  is action "SCT_DESTR";
    const proc: (inout structType: dest) := (in structType: source)    is action "SCT_CPY";
    const func ptrType: alloc (in structType: aStruct)                 is action "SCT_ALLOC";
    const func varptrType: varalloc (in structType: aStruct)           is action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT: aStruct) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType: aStruct)     is action "SCT_CONV";
    for number range 1 to length(elem_list) do
      elem_obj := elem_list[number];
      if is_symb(elem_obj) then
        incl(struct_value, elem_obj);
        const func    getType(elem_obj):    (in structType: aStruct) .  (symb elem_obj) is action "SCT_SELECT";
        const varfunc getType(elem_obj): (inout structType: aStruct) .  (symb elem_obj) is action "SCT_SELECT";
        const func    getType(elem_obj):    (in ptrType:    aPtr)    -> (symb elem_obj) is action "REF_SELECT";
        const varfunc getType(elem_obj):    (in varptrType: aStruct) -> (symb elem_obj) is action "REF_SELECT";
        structElems &:= structElement(elem_obj);
      end if;
    end for;
    const structElementArray: elements (attr structType)               is structElems;
    const structType: (attr structType) . value                        is structType conv struct_value;
    end global;
  end func;

(**
 *  Derived structure type with no elements.
 *  Create new empty structure type as subtype of ''baseType'', which is not
 *  a structure.
 *   const type: emptyStruct new object struct
 *     end struct;
 *  @param baseType Base type from which the new type is derived.
 *)
const func type: new (in type: baseType) struct end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
  begin
    global
    structType := subtype baseType;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    varptrType := varptr structType;
    const boolean: isStructType (attr structType)                      is TRUE;
    const creator: (ref structType: dest) ::= (in structType: source)  is action "SCT_CREATE";
    const destroyer: destroy (ref structType: aValue)                  is action "SCT_DESTR";
    const proc: (inout structType: dest) := (in structType: source)    is action "SCT_CPY";
    const func ptrType: alloc (in structType: aStruct)                 is action "SCT_ALLOC";
    const func varptrType: varalloc (in structType: aStruct)           is action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT: aStruct) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType: aStruct)     is action "SCT_CONV";
    const structElementArray: elements (attr structType)               is structElementArray.value;
    const structType: (attr structType) . value                        is structType conv empty(STRUCT);
    end global;
  end func;

(**
 *  Structure type with inherited elements and elements defined in ''elem_decl''.
 *  Create new structure type as subtype of ''baseType'', which is a
 *  structure type. The new structure type inherits all elements of
 *  the structure type ''baseType''.
 *   const type: null_file is new struct
 *       var char: bufferChar is '\n';
 *     end struct;
 *
 *   const type: external_file is sub null_file struct
 *       var clib_file: ext_file is CLIB_NULL_FILE;
 *       var string: name is "";
 *     end struct;
 *  @param baseType Base type from which the new type is derived and inherits
 *         all elements from baseType as well.
 *  @param elem_decl Declarations of the struct elements.
 *)
const func type: sub (in type: baseType) struct (ref proc: elem_decl) end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
    var ref_list: elem_list is ref_list.EMPTY;
    var STRUCT: struct_value is empty(STRUCT);
    var integer: number is 0;
    var reference: elem_obj is NIL;
    var structElementArray: structElems is structElementArray.value;
  begin
    global
    structType := subtype baseType;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    varptrType := varptr structType;
    elem_list := declare_elements(elem_decl);
    const boolean: isStructType (attr structType)                      is TRUE;
    const creator: (ref structType: dest) ::= (in structType: source)  is action "SCT_CREATE";
    const destroyer: destroy (ref structType: aValue)                  is action "SCT_DESTR";
    const proc: (inout structType: dest) := (in structType: source)    is action "SCT_CPY";
    const func ptrType: alloc (in structType: aStruct)                 is action "SCT_ALLOC";
    const func varptrType: varalloc (in structType: aStruct)           is action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT: aStruct) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType: aStruct)     is action "SCT_CONV";
    for number range 1 to length(elem_list) do
      elem_obj := elem_list[number];
      if is_symb(elem_obj) then
        incl(struct_value, elem_obj);
        const func    getType(elem_obj):    (in structType: aStruct) .  (symb elem_obj) is action "SCT_SELECT";
        const varfunc getType(elem_obj): (inout structType: aStruct) .  (symb elem_obj) is action "SCT_SELECT";
        const func    getType(elem_obj):    (in ptrType:    aPtr)    -> (symb elem_obj) is action "REF_SELECT";
        const varfunc getType(elem_obj):    (in varptrType: aStruct) -> (symb elem_obj) is action "REF_SELECT";
        structElems &:= structElement(elem_obj);
      end if;
    end for;
    const structElementArray: elements (attr structType)               is elements(baseType) & structElems;
    const structType: (attr structType) . value                        is structType conv (STRUCT conv (baseType.value) & struct_value);
    end global;
  end func;

(**
 *  Structure type with inherited elements and no own elements.
 *  Create new structure type as subtype of ''baseType'', which is a
 *  structure type. The new structure type has the same elements as
 *  the structure type ''baseType''.
 *   const type: null_file is new struct
 *       var char: bufferChar is '\n';
 *     end struct;
 *
 *   const type: special_file is sub null_file struct
 *     end struct;
 *  @param baseType Base type from which the new type is derived and inherits
 *         all elements from baseType as well.
 *)
const func type: sub (in type: baseType) struct end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
  begin
    global
    structType := subtype baseType;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    varptrType := varptr structType;
    const boolean: isStructType (attr structType)                      is TRUE;
    const creator: (ref structType: dest) ::= (in structType: source)  is action "SCT_CREATE";
    const destroyer: destroy (ref structType: aValue)                  is action "SCT_DESTR";
    const proc: (inout structType: dest) := (in structType: source)    is action "SCT_CPY";
    const func ptrType: alloc (in structType: aStruct)                 is action "SCT_ALLOC";
    const func varptrType: varalloc (in structType: aStruct)           is action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT: aStruct) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType: aStruct)     is action "SCT_CONV";
    const structElementArray: elements (attr structType)               is elements(baseType);
    const structType: (attr structType) . value                        is structType conv (STRUCT conv (baseType.value));
    end global;
  end func;