summaryrefslogtreecommitdiff
path: root/ipl/procs/indices.icn
blob: a05e68bac750623969c8e157a5a5adb0d6cc781a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
############################################################################
#
#	File:     indices.icn
#
#	Subject:  Procedure to produce indices
#
#	Author:   Ralph E. Griswold
#
#	Date:     June 2, 1998
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#	indices(spec, last)
#			produces a list of the integers given by the
#			specification spec, which is a common separated list
#			of either positive integers or integer spans, as in
#
#				"1,3-10, ..."
#
#			If last is specified, it it used for a span of
#			the form "10-".
#
#			In an integer span, the low and high values need not
#			be in order.  For example, "1-10" and "10-1"
#			are equivalent.  Similarly, indices need not be
#			in order, as in "3-10, 1, ..."
#
#			And empty value, as in "10,,12" is ignored.
#
#			indices() fails if the specification is syntactically
#			erroneous or if it contains a value less than 1.
#
############################################################################

procedure indices(spec, last)		#: generate indices
   local item, hi, lo, result

   if \last then last := (0 < integer(last)) | fail

   result := set()

   spec ? {
      while item := tab(upto(',') | 0) do {
         if item := integer(item) then
            ((insert(result, 0 < item)) | fail)
         else if *item = 0 then {
             move(1) | break
             next
             }
         else item ? {
            (lo := (0 < integer(tab(upto('-')))) | fail)
            move(1)
            hi := (if pos(0) then last else
               ((0 < integer(tab(0)) | fail)))
            /hi := lo
            if lo > hi then lo :=: hi
            every insert(result, lo to hi)
            }
         move(1) | break
         }
      }

   return sort(result)

end