home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / ARRAY.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  1.5 KB  |  66 lines

  1. ############################################################################
  2. #
  3. #    File:     array.icn
  4. #
  5. #    Subject:  Procedures for n-dimensional arrays
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     August 23, 1992
  10. #
  11. ###########################################################################
  12. #
  13. #  create_array([lbs], [ubs], value) creates a n-dimensional array
  14. #  with the specified lower bounds, upper bounds, and with each array element
  15. #  having the specified initial value.
  16. #
  17. #  ref_array(A, i1, i2, ...) references the i1-th i2-th ... element of A.
  18. #
  19. ############################################################################
  20.  
  21. record array(structure, lbs)
  22.  
  23. procedure create_array(lbs, ubs, value)
  24.    local lengths, i
  25.  
  26.    if (*lbs ~= *ubs) | (*lbs = 0) then stop("*** bad specification")
  27.  
  28.    lengths :=list(*lbs)
  29.  
  30.    every i := 1 to *lbs do
  31.      lengths[i] := ubs[i] - lbs[i] + 1
  32.  
  33.    return array(create_struct(lengths, value), lbs)
  34.  
  35. end
  36.  
  37. procedure create_struct(lengths, value)
  38.    local A
  39.  
  40.    lengths := copy(lengths)
  41.  
  42.    A := list(get(lengths), value)
  43.  
  44.    if *lengths > 0 then
  45.       every !A := create_struct(lengths, value)
  46.  
  47.    return A
  48.  
  49. end
  50.  
  51. procedure ref_array(A, subscrs[])
  52.    local lbs, i
  53.  
  54.    if *A.lbs ~= *subscrs then
  55.       stop("*** bad specification")
  56.  
  57.    lbs := A.lbs
  58.    A1 := A.structure
  59.  
  60.    every i := 1 to *subscrs - 1 do
  61.       A1 := A1[subscrs[i] - lbs[i] + 1] | fail
  62.  
  63.    return A1[subscrs[-1] - lbs[-1] + 1]
  64.  
  65. end
  66.