"Fossies" - the Fresh Open Source Software Archive

Member "seed7/lib/array.s7i" (29 Jan 2021, 21830 Bytes) of package /linux/misc/seed7_05_20210223.tgz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "array.s7i": 05_20210106_vs_05_20210130.

    1 
    2 (********************************************************************)
    3 (*                                                                  *)
    4 (*  array.s7i     Support for arrays with integer index             *)
    5 (*  Copyright (C) 1989 - 2012  Thomas Mertes                        *)
    6 (*                                                                  *)
    7 (*  This file is part of the Seed7 Runtime Library.                 *)
    8 (*                                                                  *)
    9 (*  The Seed7 Runtime Library is free software; you can             *)
   10 (*  redistribute it and/or modify it under the terms of the GNU     *)
   11 (*  Lesser General Public License as published by the Free Software *)
   12 (*  Foundation; either version 2.1 of the License, or (at your      *)
   13 (*  option) any later version.                                      *)
   14 (*                                                                  *)
   15 (*  The Seed7 Runtime Library is distributed in the hope that it    *)
   16 (*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
   17 (*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
   18 (*  PURPOSE.  See the GNU Lesser General Public License for more    *)
   19 (*  details.                                                        *)
   20 (*                                                                  *)
   21 (*  You should have received a copy of the GNU Lesser General       *)
   22 (*  Public License along with this program; if not, write to the    *)
   23 (*  Free Software Foundation, Inc., 51 Franklin Street,             *)
   24 (*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
   25 (*                                                                  *)
   26 (********************************************************************)
   27 
   28 
   29 const type: ARRAY_IDX_RANGE is new struct
   30     var integer: minIdx is 1;
   31     var integer: maxIdx is 0;
   32   end struct;
   33 
   34 const func ARRAY_IDX_RANGE: [ (in integer: minIdx) .. (in integer: maxIdx) ] is func
   35   result
   36     var ARRAY_IDX_RANGE: indexRange is ARRAY_IDX_RANGE.value;
   37   begin
   38     indexRange.minIdx := minIdx;
   39     indexRange.maxIdx := maxIdx;
   40   end func;
   41 
   42 
   43 (**
   44  *  Abstract data type, describing resizable arrays with [[integer]] index.
   45  *  Arrays with non-integer index are described in [[idxarray]].
   46  *)
   47 const func type: array (in type: baseType) is func
   48   result
   49     var type: arrayType is void;
   50   local
   51     var type: tupleType is void;
   52   begin
   53     arrayType := get_type(getfunc(array (attr baseType)));
   54     if arrayType = void then
   55       global
   56       arrayType := newtype;
   57       IN_PARAM_IS_REFERENCE(arrayType);
   58       tupleType := tuple(baseType);
   59       const type: array (attr baseType)                                       is arrayType;
   60       const type: base_type (attr arrayType)                                  is baseType;
   61 
   62       const proc: (ref arrayType: dest) ::= (in arrayType: source)            is action "ARR_CREATE";
   63       const proc: destroy (ref arrayType: aValue)                             is action "ARR_DESTR";
   64       const proc: (inout arrayType: dest) := (in arrayType: source)           is action "ARR_CPY";
   65 
   66       (**
   67        *  Append the array ''extension'' to the array ''arr''.
   68        *  @exception MEMORY_ERROR Not enough memory for the concatenated
   69        *             array.
   70        *)
   71       const proc: (inout arrayType: arr) &:= (in arrayType: extension)        is action "ARR_APPEND";
   72 
   73       (**
   74        *  Append the given ''element'' to the array ''arr''.
   75        *  @exception MEMORY_ERROR Not enough memory for the concatenated
   76        *             array.
   77        *)
   78       const proc: (inout arrayType: arr) &:= (in baseType: element)           is action "ARR_PUSH";
   79 
   80       const func arrayType: [] (in tupleType: aTuple)                         is action "ARR_ARRLIT";
   81       const func arrayType: [] (in baseType: anElement)                       is action "ARR_BASELIT";
   82       const func arrayType: [ (in integer: start) ] (in tupleType: aTuple)    is action "ARR_ARRLIT2";
   83       const func arrayType: [ (in integer: start) ] (in baseType: anElement)  is action "ARR_BASELIT2";
   84 
   85       (**
   86        *  Concatenate two arrays.
   87        *  @return the result of the concatenation.
   88        *)
   89       const func arrayType: (in arrayType: arr1) & (in arrayType: arr2)       is action "ARR_CAT";
   90 
   91       (**
   92        *  Access one element from the array ''arr''.
   93        *  @return the element with the specified ''index'' from ''arr''.
   94        *  @exception INDEX_ERROR If ''index'' is less than [[#minIdx(in_arrayType)|minIdx]](arr) or
   95        *                         greater than [[#minIdx(in_arrayType)|maxIdx]](arr)
   96        *)
   97       const func baseType: (in arrayType: arr) [ (in integer: index) ]        is action "ARR_IDX";
   98 
   99       const varfunc baseType: (inout arrayType: arr) [ (in integer: index) ]  is action "ARR_IDX";
  100 
  101       (**
  102        *  Get a sub array beginning at the position ''start''.
  103        *  @return the sub array beginning at the start position.
  104        *  @exception INDEX_ERROR The start position is less than minIdx(arr).
  105        *  @exception MEMORY_ERROR Not enough memory to represent the result.
  106        *)
  107       const func arrayType: (in arrayType: arr) [ (in integer: start) .. ]    is action "ARR_TAIL";
  108 
  109       (**
  110        *  Get a sub array ending at the position ''stop''.
  111        *  @return the sub array ending at the stop position.
  112        *  @exception INDEX_ERROR The stop position is less than pred(minIdx(arr)).
  113        *  @exception MEMORY_ERROR Not enough memory to represent the result.
  114        *)
  115       const func arrayType: (in arrayType: arr) [ .. (in integer: stop) ]     is action "ARR_HEAD";
  116 
  117       (**
  118        *  Get a sub array from the position ''start'' to the position ''stop''.
  119        *  @return the sub array from position ''start'' to ''stop''.
  120        *  @exception INDEX_ERROR The start position is less than minIdx(arr1), or
  121        *                         the stop position is less than pred(start).
  122        *  @exception MEMORY_ERROR Not enough memory to represent the result.
  123        *)
  124       const func arrayType: (in arrayType: arr) [ (in integer: start) ..
  125                                                   (in integer: stop) ]        is action "ARR_RANGE";
  126 
  127       (**
  128        *  Get a sub array from the position ''start'' with maximum length ''len''.
  129        *  @return the sub array from position ''start'' with maximum length ''len''.
  130        *  @exception INDEX_ERROR The start position is less than minIdx(arr), or
  131        *                         the length is negative.
  132        *  @exception MEMORY_ERROR Not enough memory to represent the result.
  133        *)
  134       const func arrayType: (in arrayType: arr) [ (in integer: start) len
  135                                                   (in integer: length) ]      is action "ARR_SUBARR";
  136 
  137       (**
  138        *  Insert ''element'' at ''index'' into ''arr''.
  139        *  Elements are moved backward to create space for the element to be
  140        *  inserted. This function is tuned for performance and the movement
  141        *  works without copying elements.
  142        *  @exception INDEX_ERROR If ''index'' is less than minIdx(arr) or
  143        *                         greater than succ(maxIdx(arr))
  144        *)
  145       const proc: insert (inout arrayType: arr, in integer: index,
  146                           in baseType: element)                               is action "ARR_INSERT";
  147 
  148       (**
  149        *  Insert ''elements'' at ''index'' into ''arr''.
  150        *  Elements are moved backward to create space for the elements to be
  151        *  inserted. This function is tuned for performance and the movement
  152        *  works without copying elements.
  153        *  @exception INDEX_ERROR If ''index'' is less than minIdx(arr) or
  154        *                         greater than succ(maxIdx(arr))
  155        *)
  156       const proc: insert (inout arrayType: arr, in integer: index,
  157                           in arrayType: elements)                             is action "ARR_INSERT_ARRAY";
  158 
  159       (**
  160        *  Remove the element with ''index'' from ''arr''.
  161        *  The elements after the removed element are moved forward.
  162        *  This function is tuned for performance and the movement works
  163        *  without copying elements.
  164        *  @return the removed element.
  165        *  @exception INDEX_ERROR If ''index'' is less than [[#minIdx(in_arrayType)|minIdx]](arr) or
  166        *                         greater than [[#minIdx(in_arrayType)|maxIdx]](arr)
  167        *)
  168       const func baseType: remove (inout arrayType: arr, in integer: index)   is action "ARR_REMOVE";
  169 
  170       (**
  171        *  Remove the sub-array with ''index'' and ''length'' from ''arr''.
  172        *  The elements after the removed sub-array are moved forward.
  173        *  This function is tuned for performance and the movement works
  174        *  without copying elements.
  175        *  @return the removed sub-array.
  176        *  @exception INDEX_ERROR If ''index'' is less than [[#minIdx(in_arrayType)|minIdx]](arr) or
  177        *                         greater than [[#minIdx(in_arrayType)|maxIdx]](arr)
  178        *)
  179       const func arrayType: remove (inout arrayType: arr, in integer: index,
  180                                     in integer: length)                       is action "ARR_REMOVE_ARRAY";
  181 
  182       (**
  183        *  Determine the length of the array ''arr''.
  184        *  @return the length of the array.
  185        *)
  186       const func integer: length (in arrayType: arr)                          is action "ARR_LNG";
  187 
  188       (**
  189        *  Minimum index of array ''arr''.
  190        *  @return the minimum index of the array.
  191        *)
  192       const func integer: minIdx (in arrayType: arr)                          is action "ARR_MINIDX";
  193 
  194       (**
  195        *  Maximum index of array ''arr''.
  196        *  @return the maximum index of the array.
  197        *)
  198       const func integer: maxIdx (in arrayType: arr)                          is action "ARR_MAXIDX";
  199 
  200       (**
  201        *  Generate an array by using ''factor'' ''elements''.
  202        *  @return an array with ''factor'' ''elements''.
  203        *  @exception RANGE_ERROR If ''factor'' is negative.
  204        *  @exception MEMORY_ERROR Not enough memory to represent the result.
  205        *)
  206       const func arrayType: (in integer: factor) times (in baseType: element) is action "ARR_TIMES";
  207 
  208       const func arrayType: (attr arrayType) . _GENERATE_EMPTY_ARRAY          is action "ARR_EMPTY";
  209       const arrayType: (attr arrayType) . value                               is arrayType._GENERATE_EMPTY_ARRAY;
  210 
  211       const func tupleType: (attr tupleType) conv (in arrayType: arr)         is action "ARR_CONV";
  212 
  213       (**
  214        *  Generate an array of ''elements'' with indices in a specified range.
  215        *  The range is specified with a bracketed range expression like [A .. B].
  216        *  An array with 5 char elements indexed from 0 to 4 is created with:
  217        *   [0 .. 4] times 'x'
  218        *  This is equivalent to
  219        *   [0] ('x', 'x', 'x', 'x', 'x')
  220        *  An empty array can be generated with
  221        *   [0 .. -1] times "asdf"
  222        *  @return an array with B - A + 1 ''elements''.
  223        *  @exception RANGE_ERROR If B - A is less than -1.
  224        *  @exception MEMORY_ERROR Not enough memory to represent the result.
  225        *)
  226       const func arrayType: (in ARRAY_IDX_RANGE: indexRange) times
  227           (in baseType: element) is func
  228         result
  229           var arrayType: anArray is arrayType.value;
  230         begin
  231           anArray := succ(indexRange.maxIdx - indexRange.minIdx) times element;
  232           anArray := [indexRange.minIdx] (tupleType conv anArray);
  233         end func;
  234 
  235       (**
  236        *  For-loop where ''forVar'' loops over the elements of the array ''arr''.
  237        *)
  238       const proc: for (inout baseType: forVar) range (in arrayType: arr) do
  239                     (in proc: statements)
  240                   end for is func
  241         local
  242           var integer: number is 0;
  243         begin
  244           for number range minIdx(arr) to maxIdx(arr) do
  245             forVar := arr[number];
  246             statements;
  247           end for;
  248         end func;
  249 
  250       (**
  251        *  For-loop where ''keyVar'' loops over the indices of the array ''arr''.
  252        *)
  253       const proc: for key (inout integer: keyVar) range (in arrayType: arr) do
  254                     (in proc: statements)
  255                   end for is func
  256         begin
  257           for keyVar range minIdx(arr) to maxIdx(arr) do
  258             statements;
  259           end for;
  260         end func;
  261 
  262       (**
  263        *  For-loop where ''forVar'' and ''keyVar' loop over the array ''arr''.
  264        *)
  265       const proc: for (inout baseType: forVar) key (inout integer: keyVar) range (in arrayType: arr) do
  266                     (in proc: statements)
  267                   end for is func
  268         begin
  269           for keyVar range minIdx(arr) to maxIdx(arr) do
  270             forVar := arr[keyVar];
  271             statements;
  272           end for;
  273         end func;
  274 
  275       (**
  276        *  For-loop where ''forVar'' loops over the elements of the array ''arr''.
  277        *  Additionally a condition is checked before the statements in
  278        *  the loop body are executed.
  279        *)
  280       const proc: for (inout baseType: forVar)
  281                   range (in arrayType: arr)
  282                   until (ref func boolean: condition) do
  283                     (in proc: statements)
  284                   end for is func
  285         local
  286           var integer: index is 0;
  287           var integer: maxIdx is 0;
  288         begin
  289           index := minIdx(arr);
  290           maxIdx := maxIdx(arr);
  291           if index <= maxIdx then
  292             forVar := arr[index];
  293             while index <= maxIdx and not condition do
  294               statements;
  295               incr(index);
  296               if index <= maxIdx then
  297                 forVar := arr[index];
  298               end if;
  299             end while;
  300           end if;
  301         end func;
  302 
  303       const proc: for (inout baseType: forVar)
  304                   range (in arrayType: arr)
  305                   until (ref boolean: condition) do
  306                     (in proc: statements)
  307                   end for is func
  308         local
  309           var integer: index is 0;
  310           var integer: maxIdx is 0;
  311         begin
  312           index := minIdx(arr);
  313           maxIdx := maxIdx(arr);
  314           if index <= maxIdx then
  315             forVar := arr[index];
  316             while index <= maxIdx and not condition do
  317               statements;
  318               incr(index);
  319               if index <= maxIdx then
  320                 forVar := arr[index];
  321               end if;
  322             end while;
  323           end if;
  324         end func;
  325 
  326       (**
  327        *  For-loop where ''keyVar'' loops over the indices of the array ''arr''.
  328        *  Additionally a condition is checked before the statements in
  329        *  the loop body are executed.
  330        *)
  331       const proc: for key (inout integer: keyVar)
  332                   range (in arrayType: arr)
  333                   until (ref func boolean: condition) do
  334                     (in proc: statements)
  335                   end for is func
  336         begin
  337           for keyVar range minIdx(arr) to maxIdx(arr) until condition do
  338             statements;
  339           end for;
  340         end func;
  341 
  342       const proc: for key (inout integer: keyVar)
  343                   range (in arrayType: arr)
  344                   until (ref boolean: condition) do
  345                     (in proc: statements)
  346                   end for is func
  347         begin
  348           for keyVar range minIdx(arr) to maxIdx(arr) until condition do
  349             statements;
  350           end for;
  351         end func;
  352 
  353       (**
  354        *  For-loop where ''forVar'' and ''keyVar' loop over the array ''arr''.
  355        *  Additionally a condition is checked before the statements in
  356        *  the loop body are executed.
  357        *)
  358       const proc: for (inout baseType: forVar)
  359                   key (inout integer: keyVar)
  360                   range (in arrayType: arr)
  361                   until (ref func boolean: condition) do
  362                     (in proc: statements)
  363                   end for is func
  364         local
  365           var integer: maxIdx is 0;
  366         begin
  367           keyVar := minIdx(arr);
  368           maxIdx := maxIdx(arr);
  369           if keyVar <= maxIdx then
  370             forVar := arr[keyVar];
  371             while keyVar <= maxIdx and not condition do
  372               statements;
  373               incr(keyVar);
  374               if keyVar <= maxIdx then
  375                 forVar := arr[keyVar];
  376               end if;
  377             end while;
  378           end if;
  379         end func;
  380 
  381       const proc: for (inout baseType: forVar)
  382                   key (inout integer: keyVar)
  383                   range (in arrayType: arr)
  384                   until (ref boolean: condition) do
  385                     (in proc: statements)
  386                   end for is func
  387         local
  388           var integer: maxIdx is 0;
  389         begin
  390           keyVar := minIdx(arr);
  391           maxIdx := maxIdx(arr);
  392           if keyVar <= maxIdx then
  393             forVar := arr[keyVar];
  394             while keyVar <= maxIdx and not condition do
  395               statements;
  396               incr(keyVar);
  397               if keyVar <= maxIdx then
  398                 forVar := arr[keyVar];
  399               end if;
  400             end while;
  401           end if;
  402         end func;
  403 
  404       (**
  405        *  Select a random element from ''arr''.
  406        *  The pseudo-random indices of the elements are uniform distributed.
  407        *  @return a random element from ''arr''.
  408        *  @exception RANGE_ERROR If ''arr'' is empty.
  409        *)
  410       const func baseType: rand (in arrayType: arr) is
  411         return arr[rand(minIdx(arr), maxIdx(arr))];
  412 
  413       if getobj((in baseType: element1) = (in baseType: element2)) <> NIL and
  414           getobj((in baseType: element1) <> (in baseType: element2)) <> NIL then
  415 
  416         const func boolean: (in arrayType: arr1) = (in arrayType: arr2) is func
  417           result
  418             var boolean: isEqual is FALSE;
  419           local
  420             var integer: number is 1;
  421           begin
  422             if minIdx(arr1) = minIdx(arr2) and maxIdx(arr1) = maxIdx(arr2) then
  423               isEqual := TRUE;
  424               number := minIdx(arr1);
  425               while number <= maxIdx(arr1) and isEqual do
  426                 isEqual := arr1[number] = arr2[number];
  427                 incr(number);
  428               end while;
  429             end if;
  430           end func;
  431 
  432         const func boolean: (in arrayType: arr1) <> (in arrayType: arr2) is func
  433           result
  434             var boolean: isNotEqual is TRUE;
  435           local
  436             var integer: number is 1;
  437           begin
  438             if minIdx(arr1) = minIdx(arr2) and maxIdx(arr1) = maxIdx(arr2) then
  439               isNotEqual := FALSE;
  440               number := minIdx(arr1);
  441               while number <= maxIdx(arr1) and not isNotEqual do
  442                 isNotEqual := arr1[number] <> arr2[number];
  443                 incr(number);
  444               end while;
  445             end if;
  446           end func;
  447 
  448       end if;
  449 
  450       if getobj((in baseType: element1) < (in baseType: element2)) <> NIL and
  451           getobj((in baseType: element1) > (in baseType: element2)) <> NIL then
  452 
  453         const proc: insert (inout arrayType: arr, in baseType: element) is func
  454           local
  455             var integer: number is 1;
  456           begin
  457             number := minIdx(arr);
  458             while number <= maxIdx(arr) and arr[number] < element do
  459               incr(number);
  460             end while;
  461             if number > maxIdx(arr) then
  462               arr := arr & [] (element);
  463             elsif arr[number] > element then
  464               arr := arr[.. pred(number)] & [] (element) & arr[number ..];
  465             end if;
  466           end func;
  467 
  468       end if;
  469 
  470       if getobj(compare(in baseType: element1, in baseType: element2)) <> NIL then
  471 
  472         const func integer: compare (in arrayType: arr1, in arrayType: arr2) is func
  473           result
  474             var integer: signumValue is 0;
  475           local
  476             var integer: idx1 is 0;
  477             var integer: idx2 is 0;
  478           begin
  479             idx1 := minIdx(arr1);
  480             idx2 := minIdx(arr2);
  481             while idx1 <= maxIdx(arr1) and idx2 <= maxIdx(arr2) and compare(arr1[idx1], arr2[idx2]) = 0 do
  482               incr(idx1);
  483               incr(idx2);
  484             end while;
  485             if idx1 <= maxIdx(arr1) and idx2 <= maxIdx(arr2) then
  486               signumValue := compare(arr1[idx1], arr2[idx2]);
  487             else
  488               signumValue := compare(length(arr1), length(arr2));
  489             end if;
  490           end func;
  491 
  492         const func boolean: (in arrayType: arr1) < (in arrayType: arr2) is
  493           return compare(arr1, arr2) < 0;
  494 
  495         const func boolean: (in arrayType: arr1) > (in arrayType: arr2) is
  496           return compare(arr1, arr2) > 0;
  497 
  498         const func boolean: (in arrayType: arr1) <= (in arrayType: arr2) is
  499           return compare(arr1, arr2) <= 0;
  500 
  501         const func boolean: (in arrayType: arr1) >= (in arrayType: arr2) is
  502           return compare(arr1, arr2) >= 0;
  503 
  504         const reference: (attr arrayType) . dataCompare  is getobj(compare(in baseType: element1, in baseType: element2));
  505 
  506         const func arrayType: SORT (in arrayType: arr, in reference: dataCompare) is   action "ARR_SORT";
  507 
  508         const func arrayType: sort (in arrayType: arr_obj) is
  509           return SORT(arr_obj, arrayType.dataCompare);
  510 
  511       end if;
  512       end global;
  513 
  514     end if;
  515   end func;
  516 
  517 const type: TEST_1 is array integer;
  518 const type: TEST_2 is array integer;
  519 const type: TEST_3 is array string;
  520 
  521 
  522 const proc: ENABLE_SORT (in type: arrayType) is func
  523   begin
  524     const reference: (attr arrayType) . dataCompare  is getobj(compare(in base_type(arrayType): element1, in base_type(arrayType): element2));
  525 
  526     const func arrayType: SORT (in arrayType: arr, in reference: dataCompare) is   action "ARR_SORT";
  527 
  528     const func arrayType: sort (in arrayType: arr_obj) is
  529       return SORT(arr_obj, arrayType.dataCompare);
  530   end func;