summaryrefslogtreecommitdiff
path: root/ipl/procs/lastc.icn
blob: c27929b5b83eb96ae2158dc6eaa6afaafb3a7f2c (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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
#############################################################################
#
#	File:     lastc.icn
#
#	Subject:  Procedures for string scanning
#
#	Author:   David A. Gamey
#
#	Date:     March 25, 2002
#
#############################################################################
#
#   This file is in the public domain.
#
#############################################################################
#
#     Descriptions:
#
#     lastc( c, s, i1, i2 ) : i3
#
#        succeeds and produces i1, provided either
#        -  i1 is 1, or
#        -  s[i1 - 1] is in c and i2 is greater than i1
#
#        defaults:   same as for any
#        errors:     same as for any
#
#     findp( c, s1, s2, i1, i2 ) : i3, i4, ..., in
#
#        generates the sequence of positions in s2 at which s1 occurs
#        provided that: 
#        -  s2 is preceded by a character in c,
#           or is found at the beginning of the string
#        i1 & i2 limit the search as in find
#
#        defaults:   same as for find
#        errors:     same as for find & lastc
#
#     findw( c1, s1, c2, s2, i1, i2 ) : i3, i4, ..., in
#
#        generates the sequence of positions in s2 at which s1 occurs
#        provided that:
#        -  s2 is preceded by a character in c1, 
#           or is found at the beginning of the string; 
#        and
#        -  s2 is succeeded by a character in c2,
#           or the end of the string
#        i1 & i2 limit the search as in find
#
#        defaults:   same as for find
#        errors:     same as for find & lastc
#
#############################################################################

procedure lastc( c, s, i1, i2 )

if /s  := &subject then /i1 := &pos
/i1 := 1
/i2 := 0

suspend ( ( i1 = 1 )  |  any( c, s, 0 < ( i1 - 1 ), i2 ) )
end

procedure findp( c, s1, s2, i1, i2 )

if /s2 := &subject then /i1 := &pos 
/i1 := 1
/i2 := 0

suspend lastc( c, s2, find( s1, s2, i1, i2 ), i2 )
end

procedure findw( c1, s1, c2, s2, i1, i2 )

local csr,csr2

if /s2 := &subject then /i1 := &pos 
/i1 := 1
/i2 := 0

suspend 1(  csr := findp( c1, s1, s2, i1, i2 ),
            csr2 := csr + *s1,
            ( csr2 = ( *s2 + 1 ) ) | any( c2, s2, csr2, i2 )
         )
end