~ubuntu-branches/ubuntu/vivid/gcl/vivid

« back to all changes in this revision

Viewing changes to o/string.d

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2002-03-04 14:29:59 UTC
  • Revision ID: james.westby@ubuntu.com-20020304142959-dey14w08kr7lldu3
Tags: upstream-2.5.0.cvs20020219
ImportĀ upstreamĀ versionĀ 2.5.0.cvs20020219

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/*
 
2
 Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
 
3
 
 
4
This file is part of GNU Common Lisp, herein referred to as GCL
 
5
 
 
6
GCL is free software; you can redistribute it and/or modify it under
 
7
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
 
8
the Free Software Foundation; either version 2, or (at your option)
 
9
any later version.
 
10
 
 
11
GCL is distributed in the hope that it will be useful, but WITHOUT
 
12
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
13
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
 
14
License for more details.
 
15
 
 
16
You should have received a copy of the GNU Library General Public License 
 
17
along with GCL; see the file COPYING.  If not, write to the Free Software
 
18
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
19
*/
 
20
 
 
21
/*
 
22
        string.d
 
23
 
 
24
        string routines
 
25
*/
 
26
 
 
27
#include "include.h"
 
28
 
 
29
object sKstart1;
 
30
object sKend1;
 
31
object sKstart2;
 
32
object sKend2;
 
33
object sKinitial_element;
 
34
 
 
35
object
 
36
alloc_simple_string(l)
 
37
int l;
 
38
{
 
39
        object x;
 
40
 
 
41
        x = alloc_object(t_string);
 
42
        x->st.st_hasfillp = FALSE;
 
43
        x->st.st_adjustable = FALSE;
 
44
        x->st.st_displaced = Cnil;
 
45
        x->st.st_dim = x->st.st_fillp = l;
 
46
        x->st.st_self = NULL;
 
47
        return(x);
 
48
}
 
49
 
 
50
/*
 
51
        Make_simple_string(s) makes a simple string from C string s.
 
52
*/
 
53
object
 
54
make_simple_string(s)
 
55
char *s;
 
56
{
 
57
        int l, i;
 
58
        char *p;
 
59
        object x;
 
60
        vs_mark;
 
61
        {BEGIN_NO_INTERRUPT;    
 
62
        for (l = 0;  s[l] != '\0';  l++)
 
63
                ;
 
64
        x = alloc_simple_string(l);
 
65
        vs_push(x);
 
66
        p = alloc_relblock(l);
 
67
        for (i = 0;  i < l;  i++)
 
68
                p[i] = s[i];
 
69
        x->st.st_self = p;
 
70
        vs_reset;
 
71
        END_NO_INTERRUPT;}      
 
72
        return(x);
 
73
}
 
74
 
 
75
/*
 
76
        This correponds to string= (just the string equality).
 
77
*/
 
78
bool
 
79
string_eq(x, y)
 
80
object x, y;
 
81
{
 
82
        int i, j;
 
83
 
 
84
/*
 
85
        if (type_of(x) != t_string || type_of(y) != t_string)
 
86
                error("string expected");
 
87
*/
 
88
        i = x->st.st_fillp;
 
89
        j = y->st.st_fillp;
 
90
        if (i != j)
 
91
                return(FALSE);
 
92
        for (i = 0;  i < j;  i++)
 
93
                if (x->st.st_self[i] != y->st.st_self[i])
 
94
                        return(FALSE);
 
95
        return(TRUE);
 
96
}
 
97
 
 
98
/*
 
99
        This corresponds to string-equal
 
100
        (string equality ignoring the case).
 
101
*/
 
102
bool
 
103
string_equal(x, y)
 
104
object x, y;
 
105
{
 
106
        int i, j;
 
107
        char *p, *q;
 
108
 
 
109
/*
 
110
        if (type_of(x) != t_string || type_of(y) != t_string)
 
111
                error("string expected");
 
112
*/
 
113
        i = x->st.st_fillp;
 
114
        j = y->st.st_fillp;
 
115
        if (i != j)
 
116
                return(FALSE);
 
117
        p = x->st.st_self;
 
118
        q = y->st.st_self;
 
119
        for (i = 0;  i < j;  i++)
 
120
                if ((isLower(p[i]) ? p[i] - ('a' - 'A') : p[i])
 
121
                 != (isLower(q[i]) ? q[i] - ('a' - 'A') : q[i]))
 
122
                        return(FALSE);
 
123
        return(TRUE);
 
124
}
 
125
 
 
126
/*
 
127
        Copy_simple_string(x) copies string x to a simple string.
 
128
*/
 
129
object
 
130
copy_simple_string(x)
 
131
object x;
 
132
{
 
133
        object y;
 
134
        int i;
 
135
        vs_mark;
 
136
 
 
137
        vs_push(x);
 
138
/*
 
139
        if (type_of(x) != t_string)
 
140
                error("string expected");
 
141
*/
 
142
        {BEGIN_NO_INTERRUPT;    
 
143
        y = alloc_object(t_string);
 
144
        y->st.st_dim = y->st.st_fillp = x->st.st_fillp;
 
145
        y->st.st_hasfillp = FALSE;
 
146
        y->st.st_adjustable = FALSE;
 
147
        y->st.st_displaced = Cnil;
 
148
        y->st.st_self = NULL;
 
149
        vs_push(y);
 
150
        y->st.st_self = alloc_relblock(x->st.st_fillp);
 
151
        for (i = 0;  i < x->st.st_fillp;  i++)
 
152
                y->st.st_self[i] = x->st.st_self[i];
 
153
        vs_reset;
 
154
        END_NO_INTERRUPT;       }
 
155
        return(y);
 
156
}
 
157
 
 
158
object
 
159
coerce_to_string(x)
 
160
object x;
 
161
{
 
162
        object y;
 
163
        int i;
 
164
        vs_mark;
 
165
 
 
166
        switch (type_of(x)) {
 
167
        case t_symbol:
 
168
                {BEGIN_NO_INTERRUPT;    
 
169
                y = alloc_simple_string(x->s.s_fillp);
 
170
                vs_push(y);
 
171
                if (x->s.s_self < heap_end)
 
172
                        y->st.st_self = x->s.s_self;
 
173
                else {
 
174
                        y->st.st_self = alloc_relblock(x->s.s_fillp);
 
175
                        for (i = 0;  i < x->s.s_fillp;  i++)
 
176
                                y->st.st_self[i] = x->s.s_self[i];
 
177
                }
 
178
                vs_reset;
 
179
                END_NO_INTERRUPT;}
 
180
                return(y);
 
181
 
 
182
        case t_fixnum:
 
183
                x = coerce_to_character(x);
 
184
                vs_push(x);
 
185
 
 
186
        case t_character:
 
187
                {BEGIN_NO_INTERRUPT;    
 
188
                y = alloc_simple_string(1);
 
189
                vs_push(y);
 
190
                y->st.st_self = alloc_relblock(1);
 
191
                y->st.st_self[0] = char_code(x);
 
192
                vs_reset;
 
193
                END_NO_INTERRUPT;}      
 
194
                return(y);
 
195
 
 
196
        case t_string:
 
197
                return(x);
 
198
        }
 
199
        FEerror("~S cannot be coerced to a string.", 1, x);
 
200
}
 
201
 
 
202
@(defun char (s i)
 
203
        int j;
 
204
@
 
205
        check_type_string(&s);
 
206
        if (type_of(i) != t_fixnum)
 
207
                illegal_index(s, i);
 
208
        if ((j = fix(i)) < 0 || j >= s->st.st_fillp)
 
209
                illegal_index(s, i);
 
210
        @(return `code_char(s->ust.ust_self[j])`)
 
211
@)
 
212
 
 
213
siLchar_set()
 
214
{
 
215
        int j;
 
216
 
 
217
        check_arg(3);
 
218
        check_type_string(&vs_base[0]);
 
219
        if (type_of(vs_base[1]) != t_fixnum)
 
220
                illegal_index(vs_base[0], vs_base[1]);
 
221
        if ((j = fix(vs_base[1])) < 0 || j >= vs_base[0]->st.st_fillp)
 
222
                illegal_index(vs_base[0], vs_base[1]);
 
223
        check_type_character(&vs_base[2]);
 
224
        vs_base[0]->st.st_self[j] = char_code(vs_base[2]);
 
225
        vs_base += 2;
 
226
}
 
227
 
 
228
get_string_start_end(string, start, end, ps, pe)
 
229
object string, start, end;
 
230
int *ps, *pe;
 
231
{
 
232
        if (start == Cnil)
 
233
                *ps = 0;
 
234
        else if (type_of(start) != t_fixnum)
 
235
                goto E;
 
236
        else {
 
237
                *ps = fix(start);
 
238
                if (*ps < 0)
 
239
                        goto E;
 
240
        }
 
241
        if (end == Cnil) {
 
242
                *pe = string->st.st_fillp;
 
243
                if (*pe < *ps)
 
244
                        goto E;
 
245
        } else if (type_of(end) != t_fixnum)
 
246
                goto E;
 
247
        else {
 
248
                *pe = fix(end);
 
249
                if (*pe < *ps || *pe > string->st.st_fillp)
 
250
                        goto E;
 
251
        }
 
252
        return;
 
253
 
 
254
E:
 
255
        FEerror("~S and ~S are illegal as :START and :END~%\
 
256
for the string ~S.", 3, start, end, string);
 
257
}
 
258
 
 
259
@(defun string_eq (string1 string2
 
260
                   &key start1 end1 start2 end2)
 
261
        int s1, e1, s2, e2;
 
262
@
 
263
        string1 = coerce_to_string(string1);
 
264
        string2 = coerce_to_string(string2);
 
265
        get_string_start_end(string1, start1, end1, &s1, &e1);
 
266
        get_string_start_end(string2, start2, end2, &s2, &e2);
 
267
        if (e1 - s1 != e2 - s2)
 
268
                @(return Cnil)
 
269
        while (s1 < e1)
 
270
                if (string1->st.st_self[s1++] !=
 
271
                    string2->st.st_self[s2++])
 
272
                        @(return Cnil)
 
273
        @(return Ct)
 
274
@)
 
275
 
 
276
@(defun string_equal (string1 string2
 
277
                      &key start1 end1 start2 end2)
 
278
        int s1, e1, s2, e2;
 
279
        int i1, i2;
 
280
@
 
281
        string1 = coerce_to_string(string1);
 
282
        string2 = coerce_to_string(string2);
 
283
        get_string_start_end(string1, start1, end1, &s1, &e1);
 
284
        get_string_start_end(string2, start2, end2, &s2, &e2);
 
285
        if (e1 - s1 != e2 - s2)
 
286
                @(return Cnil)
 
287
        while (s1 < e1) {
 
288
                i1 = string1->st.st_self[s1++];
 
289
                i2 = string2->st.st_self[s2++];
 
290
                if (isLower(i1))
 
291
                        i1 -= 'a' - 'A';
 
292
                if (isLower(i2))
 
293
                        i2 -= 'a' - 'A';
 
294
                if (i1 != i2)
 
295
                        @(return Cnil)
 
296
        }
 
297
        @(return Ct)
 
298
@)
 
299
 
 
300
 
 
301
int string_sign, string_boundary;
 
302
 
 
303
@(defun string_cmp (string1 string2
 
304
                    &key start1 end1 start2 end2)
 
305
        int s1, e1, s2, e2;
 
306
        int i1, i2;
 
307
        int s;
 
308
@
 
309
        string1 = coerce_to_string(string1);
 
310
        string2 = coerce_to_string(string2);
 
311
        get_string_start_end(string1, start1, end1, &s1, &e1);
 
312
        get_string_start_end(string2, start2, end2, &s2, &e2);
 
313
        while (s1 < e1) {
 
314
                if (s2 == e2)
 
315
                        @(return `string_sign>0 ? Cnil : make_fixnum(s1)`)
 
316
                i1 = string1->ust.ust_self[s1];
 
317
                i2 = string2->ust.ust_self[s2];
 
318
                if (string_sign == 0) {
 
319
                        if (i1 != i2)
 
320
                                @(return `make_fixnum(s1)`)
 
321
                } else {
 
322
                        s = string_sign*(i2-i1);
 
323
                        if (s > 0)
 
324
                                @(return `make_fixnum(s1)`)
 
325
                        if (s < 0)
 
326
                                @(return Cnil)
 
327
                }
 
328
                s1++;
 
329
                s2++;
 
330
        }
 
331
        if (s2 == e2)
 
332
                @(return `string_boundary==0 ? make_fixnum(s1) : Cnil`)
 
333
        @(return `string_sign>=0 ? make_fixnum(s1) : Cnil`)
 
334
@)
 
335
 
 
336
Lstring_l()  { string_sign =  1;  string_boundary = 1;  Lstring_cmp(); }
 
337
Lstring_g()  { string_sign = -1;  string_boundary = 1;  Lstring_cmp(); }
 
338
Lstring_le() { string_sign =  1;  string_boundary = 0;  Lstring_cmp(); }
 
339
Lstring_ge() { string_sign = -1;  string_boundary = 0;  Lstring_cmp(); }
 
340
Lstring_neq() { string_sign = 0;  string_boundary = 1;  Lstring_cmp(); }
 
341
 
 
342
@(defun string_compare (string1 string2
 
343
                        &key start1 end1 start2 end2)
 
344
        int s1, e1, s2, e2;
 
345
        int i1, i2;
 
346
        int s;
 
347
@
 
348
        string1 = coerce_to_string(string1);
 
349
        string2 = coerce_to_string(string2);
 
350
        get_string_start_end(string1, start1, end1, &s1, &e1);
 
351
        get_string_start_end(string2, start2, end2, &s2, &e2);
 
352
        while (s1 < e1) {
 
353
                if (s2 == e2)
 
354
                        @(return `string_sign>0 ? Cnil : make_fixnum(s1)`)
 
355
                i1 = string1->ust.ust_self[s1];
 
356
                if (isLower(i1))
 
357
                        i1 -= 'a' - 'A';
 
358
                i2 = string2->ust.ust_self[s2];
 
359
                if (isLower(i2))
 
360
                        i2 -= 'a' - 'A';
 
361
                if (string_sign == 0) {
 
362
                        if (i1 != i2)
 
363
                                @(return `make_fixnum(s1)`)
 
364
                } else {
 
365
                        s = string_sign*(i2-i1);
 
366
                        if (s > 0)
 
367
                                @(return `make_fixnum(s1)`)
 
368
                        if (s < 0)
 
369
                                @(return Cnil)
 
370
                }
 
371
                s1++;
 
372
                s2++;
 
373
        }
 
374
        if (s2 == e2)
 
375
                @(return `string_boundary==0 ? make_fixnum(s1) : Cnil`)
 
376
        @(return `string_sign>=0 ? make_fixnum(s1) : Cnil`)
 
377
@)
 
378
 
 
379
Lstring_lessp()      { string_sign =  1; string_boundary = 1;  Lstring_compare(); }
 
380
Lstring_greaterp()   { string_sign = -1; string_boundary = 1;  Lstring_compare(); }
 
381
Lstring_not_greaterp(){ string_sign =  1; string_boundary = 0;  Lstring_compare(); }
 
382
Lstring_not_lessp()   { string_sign = -1; string_boundary = 0;  Lstring_compare(); }
 
383
Lstring_not_equal()   { string_sign =  0; string_boundary = 1;  Lstring_compare(); }
 
384
 
 
385
 
 
386
@(defun make_string (size
 
387
                     &key (initial_element `code_char(' ')`)
 
388
                     &aux x)
 
389
        int i;
 
390
@
 
391
        while (type_of(size) != t_fixnum || fix(size) < 0)
 
392
                size
 
393
                = wrong_type_argument(TSnon_negative_integer, size);
 
394
                /*  bignum not allowed, this is PRACTICAL!!  */
 
395
        while (type_of(initial_element) != t_character ||
 
396
               char_bits(initial_element) != 0 ||
 
397
               char_font(initial_element) != 0)
 
398
                initial_element
 
399
                = wrong_type_argument(sLstring_char, initial_element);
 
400
        {BEGIN_NO_INTERRUPT;    
 
401
        x = alloc_simple_string(fix(size));
 
402
        x->st.st_self = alloc_relblock(fix(size));
 
403
        for (i = 0;  i < fix(size);  i++)
 
404
                x->st.st_self[i] = char_code(initial_element);
 
405
        END_NO_INTERRUPT;       }
 
406
        @(return x)
 
407
@)
 
408
 
 
409
bool
 
410
member_char(c, char_bag)
 
411
int c;
 
412
object char_bag;
 
413
{
 
414
        object endp_temp;
 
415
 
 
416
        int i, f;
 
417
 
 
418
        switch (type_of(char_bag)) {
 
419
        case t_symbol:
 
420
        case t_cons:
 
421
                while (!endp(char_bag)) {
 
422
                        if (type_of(char_bag->c.c_car) == t_character
 
423
                            &&  c == char_code(char_bag->c.c_car))
 
424
                                return(TRUE);
 
425
                        char_bag = char_bag->c.c_cdr;
 
426
                }
 
427
                return(FALSE);
 
428
 
 
429
        case t_vector:
 
430
                for (i = 0, f = char_bag->v.v_fillp;  i < f;  i++) {
 
431
                        if (type_of(char_bag->v.v_self[i]) != t_character
 
432
                          && c == char_code(char_bag->v.v_self[i]))
 
433
                                return(TRUE);
 
434
                }
 
435
                return(FALSE);
 
436
 
 
437
        case t_string:
 
438
                for (i = 0, f = char_bag->st.st_fillp;  i < f;  i++) {
 
439
                        if (c == char_bag->st.st_self[i])
 
440
                                return(TRUE);
 
441
                }
 
442
                return(FALSE);
 
443
 
 
444
        case t_bitvector:
 
445
                return(FALSE);
 
446
 
 
447
        default:
 
448
                FEerror("~S is not a sequence.", 1, char_bag);
 
449
        }
 
450
}
 
451
 
 
452
 
 
453
Lstring_trim() { left_trim = right_trim = TRUE; Lstring_trim0(); }
 
454
Lstring_left_trim() { left_trim = TRUE; right_trim = FALSE; Lstring_trim0(); }
 
455
Lstring_right_trim() { left_trim = FALSE; right_trim = TRUE; Lstring_trim0();}
 
456
 
 
457
@(defun string_trim0 (char_bag strng &aux res)
 
458
        int i, j, k;
 
459
@
 
460
        strng = coerce_to_string(strng);
 
461
        i = 0;
 
462
        j = strng->st.st_fillp - 1;
 
463
        if (left_trim)
 
464
                for (;  i <= j;  i++)
 
465
                        if (!member_char(strng->st.st_self[i], char_bag))
 
466
                                break;
 
467
        if (right_trim)
 
468
                for (;  j >= i;  --j)
 
469
                        if (!member_char(strng->st.st_self[j], char_bag))
 
470
                                break;
 
471
        k = j - i + 1;
 
472
        {BEGIN_NO_INTERRUPT;    
 
473
        res = alloc_simple_string(k);
 
474
        res->st.st_self = alloc_relblock(k);
 
475
        for (j = 0;  j < k;  j++)
 
476
                res->st.st_self[j] = strng->st.st_self[i + j];
 
477
        END_NO_INTERRUPT;       }
 
478
        @(return res)
 
479
@)
 
480
 
 
481
static char_upcase(c, bp)
 
482
int c, *bp;
 
483
{
 
484
        if (isLower(c))
 
485
                return(c - ('a' - 'A'));
 
486
        else
 
487
                return(c);
 
488
}
 
489
 
 
490
static char_downcase(c, bp)
 
491
int c, *bp;
 
492
{
 
493
        if (isUpper(c))
 
494
                return(c + ('a' - 'A'));
 
495
        else
 
496
                return(c);
 
497
}
 
498
 
 
499
static char_capitalize(c, bp)
 
500
int c, *bp;
 
501
{
 
502
        if (isLower(c)) {
 
503
                if (*bp)
 
504
                        c -= 'a' - 'A';
 
505
                *bp = FALSE;
 
506
        } else if (isUpper(c)) {
 
507
                if (!*bp)
 
508
                        c += 'a' - 'A';
 
509
                *bp = FALSE;
 
510
        } else if (!isDigit(c))
 
511
                *bp = TRUE;
 
512
        return(c);
 
513
}
 
514
 
 
515
@(defun string_case (strng &key start end &aux conv)
 
516
        int s, e, i;
 
517
        bool b;
 
518
@
 
519
        strng = coerce_to_string(strng);
 
520
        get_string_start_end(strng, start, end, &s, &e);
 
521
        conv = copy_simple_string(strng);
 
522
        b = TRUE;
 
523
        for (i = s;  i < e;  i++)
 
524
                conv->st.st_self[i] =
 
525
                (*casefun)(conv->st.st_self[i], &b);
 
526
        @(return conv)
 
527
@)
 
528
 
 
529
Lstring_upcase()     { casefun =     char_upcase;  Lstring_case(); }
 
530
Lstring_downcase()   { casefun =   char_downcase;  Lstring_case(); }
 
531
Lstring_capitalize() { casefun = char_capitalize;  Lstring_case(); }
 
532
 
 
533
 
 
534
@(defun nstring_case (strng &key start end)
 
535
        int s, e, i;
 
536
        bool b;
 
537
@
 
538
        check_type_string(&strng);
 
539
        get_string_start_end(strng, start, end, &s, &e);
 
540
        b = TRUE;
 
541
        for (i = s;  i < e;  i++)
 
542
                strng->st.st_self[i] =
 
543
                (*casefun)(strng->st.st_self[i], &b);
 
544
        @(return strng)
 
545
@)
 
546
 
 
547
Lnstring_upcase()     { casefun =     char_upcase;  Lnstring_case(); }
 
548
Lnstring_downcase()   { casefun =   char_downcase;  Lnstring_case(); }
 
549
Lnstring_capitalize() { casefun = char_capitalize;  Lnstring_case(); }
 
550
 
 
551
 
 
552
@(defun string (x)
 
553
@
 
554
        @(return `coerce_to_string(x)`)
 
555
@)
 
556
 
 
557
siLstring_concatenate()
 
558
{
 
559
        int narg, i, l, m;
 
560
        object *v;
 
561
 
 
562
        narg = vs_top - vs_base;
 
563
        for (i = 0, l = 0;  i < narg;  i++) {
 
564
                vs_base[i] = coerce_to_string(vs_base[i]);
 
565
                l += vs_base[i]->st.st_fillp;
 
566
        }
 
567
        v = vs_top;
 
568
        {BEGIN_NO_INTERRUPT;    
 
569
        vs_push(alloc_simple_string(l));
 
570
        (*v)->st.st_self = alloc_relblock(l);
 
571
        for (i = 0, l = 0;  i < narg;  i++)
 
572
                for (m = 0;  m < vs_base[i]->st.st_fillp;  m++)
 
573
                        (*v)->st.st_self[l++]
 
574
                        = vs_base[i]->st.st_self[m];
 
575
        vs_base[0] = *v;
 
576
        vs_top = vs_base + 1;
 
577
        END_NO_INTERRUPT;}      
 
578
}
 
579
 
 
580
init_string_function()
 
581
{
 
582
        sKstart1 = make_keyword("START1");
 
583
        sKend1 = make_keyword("END1");
 
584
        sKstart2 = make_keyword("START2");
 
585
        sKend2 = make_keyword("END2");
 
586
        sKinitial_element = make_keyword("INITIAL-ELEMENT");
 
587
        sKstart = make_keyword("START");
 
588
        sKend = make_keyword("END");
 
589
 
 
590
        make_function("CHAR", Lchar);
 
591
        make_si_function("CHAR-SET", siLchar_set);
 
592
        make_function("SCHAR", Lchar);
 
593
        make_si_function("SCHAR-SET", siLchar_set);
 
594
        make_function("STRING=", Lstring_eq);
 
595
        make_function("STRING-EQUAL", Lstring_equal);
 
596
        make_function("STRING<", Lstring_l);
 
597
        make_function("STRING>", Lstring_g);
 
598
        make_function("STRING<=", Lstring_le);
 
599
        make_function("STRING>=", Lstring_ge);
 
600
        make_function("STRING/=", Lstring_neq);
 
601
        make_function("STRING-LESSP", Lstring_lessp);
 
602
        make_function("STRING-GREATERP", Lstring_greaterp);
 
603
        make_function("STRING-NOT-LESSP", Lstring_not_lessp);
 
604
        make_function("STRING-NOT-GREATERP", Lstring_not_greaterp);
 
605
        make_function("STRING-NOT-EQUAL", Lstring_not_equal);
 
606
        make_function("MAKE-STRING", Lmake_string);
 
607
        make_function("STRING-TRIM", Lstring_trim);
 
608
        make_function("STRING-LEFT-TRIM", Lstring_left_trim);
 
609
        make_function("STRING-RIGHT-TRIM", Lstring_right_trim);
 
610
        make_function("STRING-UPCASE", Lstring_upcase);
 
611
        make_function("STRING-DOWNCASE", Lstring_downcase);
 
612
        make_function("STRING-CAPITALIZE", Lstring_capitalize);
 
613
        make_function("NSTRING-UPCASE", Lnstring_upcase);
 
614
        make_function("NSTRING-DOWNCASE", Lnstring_downcase);
 
615
        make_function("NSTRING-CAPITALIZE", Lnstring_capitalize);
 
616
        make_function("STRING", Lstring);
 
617
 
 
618
        make_si_function("STRING-CONCATENATE",
 
619
                         siLstring_concatenate);
 
620
}