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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
(* $Id: OakStrings.Mod,v 1.3 1999/10/03 11:44:53 ooc-devel Exp $ *)
MODULE OakStrings;
(* Oakwood compliant string manipulation facilities.
Copyright (C) 1998, 1999 Michael van Acken
This module 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 of
the License, or (at your option) any later version.
This module 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 OOC. If not, write to the Free Software Foundation,
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
(* see also [Oakwood Guidelines, revision 1A]
Module Strings provides a set of operations on strings (i.e., on string
constants and character arrays, both of wich contain the character 0X as a
terminator). All positions in strings start at 0.
Remarks
String assignments and string comparisons are already supported by the language
Oberon-2.
*)
PROCEDURE Length* (s: ARRAY OF CHAR): INTEGER;
(* Returns the number of characters in s up to and excluding the first 0X. *)
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (s[i] # 0X) DO
INC (i)
END;
RETURN i
END Length;
PROCEDURE Insert* (src: ARRAY OF CHAR; pos: INTEGER; VAR dst: ARRAY OF CHAR);
(* Inserts the string src into the string dst at position pos (0<=pos<=
Length(dst)). If pos=Length(dst), src is appended to dst. If the size of
dst is not large enough to hold the result of the operation, the result is
truncated so that dst is always terminated with a 0X. *)
VAR
lenSrc, lenDst, maxDst, i: INTEGER;
BEGIN
lenDst := Length (dst);
lenSrc := Length (src);
maxDst := SHORT (LEN (dst))-1;
IF (pos+lenSrc < maxDst) THEN
IF (lenDst+lenSrc > maxDst) THEN
(* 'dst' too long, truncate it *)
lenDst := maxDst-lenSrc;
dst[lenDst] := 0X
END;
(* 'src' is inserted inside of 'dst', move tail section *)
FOR i := lenDst TO pos BY -1 DO
dst[i+lenSrc] := dst[i]
END
ELSE
dst[maxDst] := 0X;
lenSrc := maxDst-pos
END;
(* copy characters from 'src' to 'dst' *)
FOR i := 0 TO lenSrc-1 DO
dst[pos+i] := src[i]
END
END Insert;
PROCEDURE Append* (s: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR);
(* Has the same effect as Insert(s, Length(dst), dst). *)
VAR
sp, dp, m: INTEGER;
BEGIN
m := SHORT (LEN(dst))-1; (* max length of dst *)
dp := Length (dst); (* append s at position dp *)
sp := 0;
WHILE (dp < m) & (s[sp] # 0X) DO (* copy chars from s to dst *)
dst[dp] := s[sp];
INC (dp);
INC (sp)
END;
dst[dp] := 0X (* terminate dst *)
END Append;
PROCEDURE Delete* (VAR s: ARRAY OF CHAR; pos, n: INTEGER);
(* Deletes n characters from s starting at position pos (0<=pos<=Length(s)).
If n>Length(s)-pos, the new length of s is pos. *)
VAR
lenStr, i: INTEGER;
BEGIN
lenStr := Length (s);
IF (pos+n < lenStr) THEN
FOR i := pos TO lenStr-n DO
s[i] := s[i+n]
END
ELSE
s[pos] := 0X
END
END Delete;
PROCEDURE Replace* (src: ARRAY OF CHAR; pos: INTEGER; VAR dst: ARRAY OF CHAR);
(* Has the same effect as Delete(dst, pos, Length(src)) followed by an
Insert(src, pos, dst). *)
VAR
sp, maxDst: INTEGER;
addNull: BOOLEAN;
BEGIN
maxDst := SHORT (LEN (dst))-1; (* max length of dst *)
addNull := FALSE;
sp := 0;
WHILE (src[sp] # 0X) & (pos < maxDst) DO (* copy chars from src to dst *)
(* set addNull=TRUE if we write over the end of dst *)
addNull := addNull OR (dst[pos] = 0X);
dst[pos] := src[sp];
INC (pos);
INC (sp)
END;
IF addNull THEN
dst[pos] := 0X (* terminate dst *)
END
END Replace;
PROCEDURE Extract* (src: ARRAY OF CHAR; pos, n: INTEGER; VAR dst: ARRAY OF CHAR);
(* Extracts a substring dst with n characters from position pos (0<=pos<=
Length(src)) in src. If n>Length(src)-pos, dst is only the part of src from
pos to the end of src, i.e. Length(src)-1. If the size of dst is not large
enough to hold the result of the operation, the result is truncated so that
dst is always terminated with a 0X. *)
VAR
i: INTEGER;
BEGIN
(* set n to Max(n, LEN(dst)-1) *)
IF (n > LEN(dst)) THEN
n := SHORT (LEN(dst))-1
END;
(* copy upto n characters into dst *)
i := 0;
WHILE (i < n) & (src[pos+i] # 0X) DO
dst[i] := src[pos+i];
INC (i)
END;
dst[i] := 0X
END Extract;
PROCEDURE Pos* (pat, s: ARRAY OF CHAR; pos: INTEGER): INTEGER;
(* Returns the position of the first occurrence of pat in s. Searching starts
at position pos. If pat is not found, -1 is returned. *)
VAR
posPat: INTEGER;
BEGIN
posPat := 0;
LOOP
IF (pat[posPat] = 0X) THEN (* reached end of pattern *)
RETURN pos-posPat
ELSIF (s[pos] = 0X) THEN (* end of string (but not of pattern) *)
RETURN -1
ELSIF (s[pos] = pat[posPat]) THEN (* characters identic, compare next one *)
INC (pos); INC (posPat)
ELSE (* difference found: reset indices and restart *)
pos := pos-posPat+1; posPat := 0
END
END
END Pos;
PROCEDURE Cap* (VAR s: ARRAY OF CHAR);
(* Replaces each lower case letter with s by its upper case equivalent. *)
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (s[i] # 0X) DO
s[i] := CAP (s[i]);
INC (i)
END
END Cap;
END OakStrings.
|
