source: branches/working-0711/ccl/lib/chars.lisp @ 9359

Last change on this file since 9359 was 9359, checked in by mb, 11 years ago

Implement minor optimizations for string-equal.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 23.6 KB
Line 
1; -*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16;; chars.lisp
17
18(in-package "CCL")
19
20; If object is a character, it is returned.  If it is an integer, its INT-CHAR
21; is returned. If it is a string of length 1, then the sole element of the
22; string is returned.  If it is a symbol whose pname is of length 1, then
23; the sole element of the pname is returned. Else error.
24
25(defun character (arg)
26  "Coerce OBJECT into a CHARACTER if possible. Legal inputs are
27  characters, strings and symbols of length 1."
28  (if (typep arg 'character)
29    arg
30    (if (typep arg 'fixnum)
31      (code-char arg)
32      (if (and (typep arg 'string)
33               (= (the fixnum (length arg)) 1))
34        (char arg 0)
35        (let* ((pname (if (typep arg 'symbol) (symbol-name arg))))
36          (if (and pname (= (the fixnum (length pname)) 1))
37            (char pname 0)
38            (%err-disp $xcoerce arg 'character)))))))
39
40
41
42(defun digit-char (weight &optional radix)
43  "All arguments must be integers. Returns a character object that
44  represents a digit of the given weight in the specified radix. Returns
45  NIL if no such character exists."
46  (let* ((r (if radix (require-type radix 'integer) 10)))
47    (if (and (typep (require-type weight 'integer) 'fixnum)
48             (>= r 2)
49             (<= r 36)
50             (>= weight 0)
51             (< weight r))
52      (locally (declare (fixnum weight))
53        (if (< weight 10)
54          (code-char (the fixnum (+ weight (char-code #\0))))
55          (code-char (the fixnum (+ weight (- (char-code #\A) 10)))))))))
56
57
58
59;True for ascii codes 32-126 inclusive.
60; and for guys >= 128. Its really a function of the font of the moment.
61(defun graphic-char-p (c)
62  "The argument must be a character object. GRAPHIC-CHAR-P returns T if the
63  argument is a printing character (space through ~ in ASCII), otherwise
64  returns NIL."
65  (let* ((code (char-code c)))
66    (unless (eq c #\rubout)
67      (>= code (char-code #\space)))))
68
69
70;True for ascii codes 10 and 32-126 inclusive.
71(defun standard-char-p (c)
72  "The argument must be a character object. STANDARD-CHAR-P returns T if the
73   argument is a standard character -- one of the 95 ASCII printing characters
74   or <return>."
75  (let* ((code (char-code c)))
76    (or (eq c #\newline)
77        (and 
78         (>= code (char-code #\space))
79         (< code (char-code #\rubout))))))
80
81
82
83(defun %non-standard-lower-case-equivalent (char)
84  (gethash char *non-standard-upper-to-lower*))
85
86
87
88(defun upper-case-p (c)
89  "The argument must be a character object; UPPER-CASE-P returns T if the
90   argument is an upper-case character, NIL otherwise."
91  (let* ((code (char-code c)))
92    (declare (type (mod #x110000) code))
93    (or (and (>= code (char-code #\A))
94             (<= code (char-code #\Z)))
95        (and (>= code #x80)
96             (not (null (%non-standard-lower-case-equivalent c)))))))
97
98
99
100
101(defun both-case-p (c)
102  "The argument must be a character object. BOTH-CASE-P returns T if the
103  argument is an alphabetic character and if the character exists in
104  both upper and lower case. For ASCII, this is the same as ALPHA-CHAR-P."
105  (let* ((code (char-code c)))
106    (declare (type (mod #x110000) code))
107    (or (and (>= code (char-code #\A))
108             (<= code (char-code #\Z)))
109        (and (>= code (char-code #\a))
110             (<= code (char-code #\z)))
111        (and (>= code #x80)
112             (or (not (null (%non-standard-upper-case-equivalent c)))
113                 (not (null (%non-standard-lower-case-equivalent c))))))))
114 
115(defun alphanumericp (c)
116  "Given a character-object argument, ALPHANUMERICP returns T if the
117   argument is either numeric or alphabetic."
118  (let ((code (char-code c)))
119    (declare (type (mod #x110000) code))
120    (or
121     (and (>= code (char-code #\0))
122          (<= code (char-code #\9)))
123     (and (>= code (char-code #\a))
124          (<= code (char-code #\z)))
125     (and (>= code (char-code #\A))
126          (<= code (char-code #\Z)))
127     (and (> code #x80)
128          (or (not (null (%non-standard-upper-case-equivalent c)))
129              (not (null (%non-standard-lower-case-equivalent c))))))))
130
131(defun char= (ch &rest others)
132  "Return T if all of the arguments are the same character."
133  (declare (dynamic-extent others))
134  (unless (typep ch 'character)
135    (setq ch (require-type ch 'character)))
136  (dolist (other others t)
137    (unless (eq other ch)
138      (unless (typep other 'character)
139        (setq other (require-type other 'character)))
140      (return))))
141
142(defun char/= (ch &rest others)
143  "Return T if no two of the arguments are the same character."
144  (declare (dynamic-extent others))
145  (unless (typep ch 'character)
146    (setq ch (require-type ch 'character)))
147  (do* ((rest others (cdr rest)))
148       ((null rest) t)
149    (let ((other (car rest)))
150      (if (eq other ch) (return))
151      (unless (typep other 'character)
152        (setq other (require-type other 'character)))
153      (dolist (o2 (cdr rest))
154        (if (eq o2 other)(return-from char/= nil))))))
155
156
157(defun char-equal (char &rest others)
158  "Return T if all of the arguments are the same character.
159  Font, bits, and case are ignored."
160  (declare (dynamic-extent others))
161  (locally (declare (optimize (speed 3)(safety 0)))
162    (dolist (c others t)
163      (when (not (eq c char))
164        (unless (eq (char-upcase char) (char-upcase c))
165          (return))))))
166
167;;; Compares each char against all following chars, not just next one. Tries
168;;; to be fast for one or two args.
169(defun char-not-equal (char &rest others)
170  "Return T if no two of the arguments are the same character.
171   Font, bits, and case are ignored."
172  (declare (dynamic-extent others))
173  (locally (declare (optimize (speed 3) (safety 0)))
174    (let* ((rest (cdr others)))
175      (cond 
176       (rest                   
177        (setq char (char-code (char-upcase char)))
178        (do ((list others (cdr list)))
179            ((null list))
180          (rplaca list (char-code (char-upcase (car list)))))
181        (while others
182          (when (memq char others)
183            (return-from char-not-equal nil))
184          (setq char (car others)
185                others rest
186                rest (cdr others)))
187        t)
188       (others                     ;  2 args, no table
189        (not (eq (char-upcase char) (char-upcase (car others)))))
190       (t t)))))
191
192
193(defun char-lessp (char &rest others)
194  "Return T if the arguments are in strictly increasing alphabetic order.
195   Font, bits, and case are ignored."
196  (declare (dynamic-extent others))
197  (locally (declare (optimize (speed 3)(safety 0)))
198    (let* ((code (char-code (char-upcase char))))
199      (dolist (c others t)
200        (unless (< code (setq code (char-code (char-upcase c))))
201          (return))))))
202
203(defun char-not-lessp (char &rest others)
204  "Return T if the arguments are in strictly non-increasing alphabetic order.
205   Font, bits, and case are ignored."
206  (declare (dynamic-extent others))
207  (locally (declare (optimize (speed 3)(safety 0)))
208    (let* ((code (char-code (char-upcase char))))
209      (dolist (c others t)
210        (when (< code (setq code (char-code (char-upcase c))))
211          (return))))))
212
213(defun char-greaterp (char &rest others)
214  "Return T if the arguments are in strictly decreasing alphabetic order.
215   Font, bits, and case are ignored."
216  (declare (dynamic-extent others))
217  (locally (declare (optimize (speed 3)(safety 0)))
218    (let* ((code (char-code (char-upcase char))))
219      (dolist (c others t)
220        (unless (> code (setq code (char-code (char-upcase c))))
221          (return))))))
222
223(defun char-not-greaterp (char &rest others)
224  "Return T if the arguments are in strictly non-decreasing alphabetic order.
225   Font, bits, and case are ignored."
226  (declare (dynamic-extent others))
227  (locally (declare (optimize (speed 3)(safety 0)))
228    (let* ((code (char-code (char-upcase char))))
229      (dolist (c others t)
230        (when (> code (setq code (char-code (char-upcase c))))
231          (return))))))
232
233
234(defun char> (char &rest others)
235  "Return T if the arguments are in strictly decreasing alphabetic order."
236  (declare (dynamic-extent others))
237  (locally (declare (optimize (speed 3)(safety 0)))
238    (let* ()     
239      (setq char (char-code char))
240      (dolist (c others t)
241        (let ((code (char-code c)))
242          (when (not (%i> char (setq char code)))
243            (return)))))))
244
245(defun char>= (char &rest others)
246  "Return T if the arguments are in strictly non-increasing alphabetic order."
247  (declare (dynamic-extent others))
248  (locally (declare (optimize (speed 3)(safety 0)))
249    (let* ()     
250      (setq char (char-code char))
251      (dolist (c others t)
252        (let ((code (char-code c)))
253          (when (not (%i>= char (setq char code)))
254            (return)))))))
255
256
257(defun char< (char &rest others)
258  "Return T if the arguments are in strictly increasing alphabetic order."
259  (declare (dynamic-extent others))
260  (locally (declare (optimize (speed 3)(safety 0)))
261    (let* ()     
262      (setq char (char-code char))
263      (dolist (c others t)
264        (let ((code (char-code c)))
265          (when (not (%i< char (setq char code)))
266            (return)))))))
267
268(defun char<= (char &rest others)
269  "Return T if the arguments are in strictly non-decreasing alphabetic order."
270  (declare (dynamic-extent others))
271  (locally (declare (optimize (speed 3)(safety 0)))
272    (let* ()     
273      (setq char (char-code char))
274      (dolist (c others t)
275        (let ((code (char-code c)))
276          (when (not (%i<= char (setq char code)))
277            (return)))))))
278
279; This is Common Lisp
280(defun char-int (c)
281  "Return the integer code of CHAR."
282  (char-code c))
283
284
285;If char has an entry in the *NAME-CHAR-ALIST*, return first such entry.
286;Otherwise, if char is a graphics character, return NIL
287;Otherwise, if char code is < 128, return "^C", otherwise "1nn"
288
289(defun char-name (c)
290  "Return the name (a STRING) for a CHARACTER object."
291  (let* ((code (char-code c)))
292    (declare (type (mod #x110000) code))
293    (or (gethash c *char->name*)
294        (cond ((< code #x7f)
295               (when (< code (char-code #\space))
296                 (let ((str (make-string 2 :element-type 'base-char)))
297                   (declare (simple-base-string str))
298                   (setf (schar str 0) #\^)
299                   (setf (schar str 1)(code-char (logxor code #x40)))
300                   str)))
301              ((and (< code #x100)(graphic-char-p c)) nil)
302              (t (format nil "U+~4,'0x" code))))))
303
304
305(defun string-downcase (string &key start end)
306  (setq string (copy-string-arg string))
307  (if (not start) (setq start 0)(require-type start 'fixnum))
308  (if (not end)(setq end (length string))(require-type end 'fixnum))
309  (%strdown string start end))
310
311
312(defun %strdown (string start end)
313  (declare (fixnum start end)
314           (optimize (speed 3) (safety 0)))
315  (unless (typep string 'simple-string)
316    (check-type string simple-string))
317  (do* ((i start (1+ i)))
318       ((>= i end) string)
319    (declare (fixnum i))
320    (let* ((ch (schar string i))
321           (code (char-code ch))
322           (lower (if (and (char<= ch #\Z)
323                           (char>= ch #\A))
324                    (%code-char (the (unsigned-byte 8)
325                                  (+ code (- (char-code #\a)(char-code #\A)))))
326                    (if (>= code #x80)
327                      (%non-standard-lower-case-equivalent ch)))))
328      (declare (character ch) (type (mod #x11000) code))
329      (when lower
330        (setf (schar string i) lower)))))
331
332
333
334
335(defun copy-string-arg (string &aux (org 0) len)
336  (etypecase string
337    (string
338     (setq len (length string))
339     (multiple-value-setq (string org)(array-data-and-offset string)))
340    (symbol
341     (setq string (symbol-name string))
342     (setq len (length string)))
343    (character
344     (return-from copy-string-arg
345                    (make-string 1 :initial-element string :element-type (type-of string)))))
346  (%substr string org (+ len org)))     
347
348(defun string-upcase (string &key start end)
349  (setq string (copy-string-arg string))
350  (if (not start) (setq start 0)(require-type start 'fixnum))
351  (if (not end)(setq end (length string))(require-type end 'fixnum))
352  (%strup string start end))
353
354(defun %strup (string start end)
355  (declare (fixnum start end)
356           (optimize (speed 3) (safety 0)))
357  (unless (typep string 'simple-string)
358    (check-type string simple-string))
359  (do* ((i start (1+ i)))
360       ((>= i end) string)
361    (declare (fixnum i))
362    (let* ((ch (schar string i))
363           (code (char-code ch))
364           (upper (if (and (char<= ch #\z)
365                           (char>= ch #\a))
366                    (%code-char (the (unsigned-byte 8)
367                                  (- code (- (char-code #\a)(char-code #\A)))))
368                    (if (>= code #x80)
369                      (%non-standard-upper-case-equivalent ch)))))
370      (declare (character ch) (type (mod #x11000) code))
371      (when upper
372        (setf (schar string i) upper)))))
373
374
375
376(defun string-capitalize (string &key start end)
377  (setq string (copy-string-arg string))
378  (if (not start) (setq start 0)(require-type start 'fixnum))
379  (if (not end)(setq end (length string))(require-type end 'fixnum))
380  (%strcap string start end))
381
382(defun %strcap (string start end)
383  (declare (fixnum start end))
384  (let ((state :up)
385        (i start))
386    (declare (fixnum i))
387    (while (< i end)
388      (let* ((c (%schar string i))
389             (alphap (alphanumericp c))) ; makes no sense
390        (if alphap
391          (progn
392            (setf (%schar string i)
393                  (case state
394                    (:up (char-upcase c))
395                    (t (char-downcase c))))
396            (setq state :down))
397          (setq state :up)))
398      (setq i (1+ i)))
399    string))
400
401
402
403
404(defun nstring-downcase (string &key start end)
405  (etypecase string
406    (string
407     (if (not start) (setq start 0)(require-type start 'fixnum))
408     (if (not end)(setq end (length string))(require-type end 'fixnum))
409     (multiple-value-bind (sstring org) (array-data-and-offset string)
410       (%strdown sstring (+ start org)(+ end org)))
411     string)))
412
413(defun nstring-upcase (string &key start end)
414  (etypecase string
415    (string
416     (if (not start) (setq start 0)(require-type start 'fixnum))
417     (if (not end)(setq end (length string))(require-type end 'fixnum))
418     (multiple-value-bind (sstring org) (array-data-and-offset string)
419       (%strup sstring (+ start org)(+ end org)))
420     string)))
421
422
423(defun nstring-capitalize (string &key start end)
424  (etypecase string
425    (string
426     (if (not start) (setq start 0)(require-type start 'fixnum))
427     (if (not end)(setq end (length string))(require-type end 'fixnum))
428     (multiple-value-bind (sstring org) (array-data-and-offset string)
429       (%strcap sstring (+ start org)(+ end org)))
430     string)))
431
432
433
434(defun nstring-studlify (string &key start end)
435  (declare (ignore start end))
436  string)
437
438 
439(defun string-compare (string1 start1 end1 string2 start2 end2)
440  (let ((istart1 (or start1 0)))
441    (if (and (typep string1 'simple-string)(null start1)(null end1))
442      (setq start1 0 end1 (length string1))
443      (multiple-value-setq (string1 start1 end1)(string-start-end string1 start1 end1)))
444    (if (and (typep string2 'simple-string)(null start2)(null end2))
445      (setq start2 0 end2 (length string2))
446      (multiple-value-setq (string2 start2 end2)(string-start-end string2 start2 end2)))
447    (setq istart1 (%i- start1 istart1))
448    (let* ((val t))
449      (declare (optimize (speed 3)(safety 0)))
450      (do* ((i start1 (%i+ 1 i))
451            (j start2 (%i+ 1 j)))
452           ()
453        (when (eq i end1)
454          (when (neq j end2)
455            (setq val -1))
456          (return))
457        (when (eq j end2)
458          (setq end1 i)
459          (setq val 1)
460          (return))
461        (let ((code1 (%scharcode string1 i))
462              (code2 (%scharcode string2 j)))
463          (declare (fixnum code1 code2))
464          (if (and (>= code1 (char-code #\a))
465                   (<= code1 (char-code #\z)))
466            (setq code1 (- code1 (- (char-code #\a) (char-code #\A)))))
467          (if (and (>= code2 (char-code #\a))
468                   (<= code2 (char-code #\z)))
469            (setq code2 (- code2 (- (char-code #\a) (char-code #\A)))))
470          (unless (= code1 code2)           
471            (setq val (if (%i< code1 code2) -1 1))
472            (setq end1 i)
473            (return))))
474      (values val (%i- end1 istart1)))))
475
476
477(defun string-greaterp (string1 string2 &key start1 end1 start2 end2)
478  "Given two strings, if the first string is lexicographically greater than
479  the second string, returns the longest common prefix (using char-equal)
480  of the two strings. Otherwise, returns ()."
481  (multiple-value-bind (result pos) (string-compare string1 start1 end1 string2 start2 end2)
482    (if (eq result 1) pos nil)))
483
484(defun string-not-greaterp (string1 string2 &key start1 end1 start2 end2)
485  "Given two strings, if the first string is lexicographically less than
486  or equal to the second string, returns the longest common prefix
487  (using char-equal) of the two strings. Otherwise, returns ()."
488  (multiple-value-bind (result pos) (string-compare string1 start1 end1 string2 start2 end2)
489    (if (eq result 1) nil pos)))
490
491(defun string-not-equal (string1 string2 &key start1 end1 start2 end2)
492  "Given two strings, if the first string is not lexicographically equal
493  to the second string, returns the longest common prefix (using char-equal)
494  of the two strings. Otherwise, returns ()."
495  (multiple-value-bind (result pos) (string-compare string1 start1 end1 string2 start2 end2)
496    (if (eq result t) nil pos)))
497
498(defun string-not-lessp (string1 string2 &key start1 end1 start2 end2)
499  "Given two strings, if the first string is lexicographically greater
500  than or equal to the second string, returns the longest common prefix
501  (using char-equal) of the two strings. Otherwise, returns ()."
502  (multiple-value-bind (result pos) (string-compare string1 start1 end1 string2 start2 end2)
503    (if (eq result -1) nil pos)))
504
505(defun string-equal (string1 string2 &key (start1 0) (end1 (length (string string1)))
506                                          (start2 0) (end2 (length (string string2))))
507  "Given two strings (string1 and string2), and optional integers start1,
508  start2, end1 and end2, compares characters in string1 to characters in
509  string2 (using char-equal)."
510  (%string-equal (if (typep string1 'simple-string)
511                   string1
512                   (multiple-value-setq (string1 start1 end1)
513                     (string-start-end string1 start1 end1)))
514                 start1 end1
515                 (if (typep string2 'simple-string)
516                   string2
517                   (multiple-value-setq (string2 start2 end2)
518                     (string-start-end string2 start2 end2)))
519                 start2 end2))
520
521(defun %string-equal (simple-string-1 start1 end1 simple-string-2 start2 end2)
522  (declare (type simple-string simple-string-1 simple-string-2)
523           (type fixnum start1 end1 start2 end2)
524           (optimize (speed 3) (safety 0) (debug 0)))
525  (let* ((len1 (- end1 start1))
526         (len2 (- end2 start2)))
527    (when (/= len1 len2)
528      (return-from %string-equal nil))
529    (macrolet ((.char-equal (a b)
530                 ;; not a typo. it's faster to make the char= check and, only if that fails, run the
531                 ;; char-equal check.
532                 `(or (char= ,a ,b) (char-equal ,a ,b)))
533               (s1 (index)
534                 `(uvref simple-string-1 ,index))
535               (s2 (index)
536                 `(uvref simple-string-2 ,index)))
537     
538      (do* ((index1 start1 (%i+ 1 index1))
539            (index2 start2 (%i+ 1 index2))
540            (char1  (s1 index1) (s1 index1))
541            (char2  (s2 index2) (s2 index2)))
542          ()
543        (declare (type fixnum index1 index2)
544                 (type character char1 char2))
545        (when (eq index1 end1)
546          (return-from %string-equal t))
547        (when (not (.char-equal char1 char2))
548          (return-from %string-equal nil))))))
549
550(defun string-lessp (string1 string2 &key start1 end1 start2 end2)
551  "Given two strings, if the first string is lexicographically less than
552  the second string, returns the longest common prefix (using char-equal)
553  of the two strings. Otherwise, returns ()."
554  (multiple-value-bind (result pos)(string-compare string1 start1 end1 string2 start2 end2)
555    (if (eq result -1) pos nil)))
556
557; forget script-manager - just do codes
558(defun string-cmp (string1 start1 end1 string2 start2 end2)
559  (let ((istart1 (or start1 0)))
560    (if (and (typep string1 'simple-string)(null start1)(null end1))
561      (setq start1 0 end1 (length string1))
562      (multiple-value-setq (string1 start1 end1)(string-start-end string1 start1 end1)))
563    (if (and (typep string2 'simple-string)(null start2)(null end2))
564      (setq start2 0 end2 (length string2))
565      (multiple-value-setq (string2 start2 end2)(string-start-end string2 start2 end2)))
566    (setq istart1 (%i- start1 istart1))       
567    (let* ((val t))
568      (declare (optimize (speed 3)(safety 0)))
569      (do* ((i start1 (%i+ 1 i))
570            (j start2 (%i+ 1 j)))
571           ()
572        (when (eq i end1)
573          (when (neq j end2)(setq val -1))
574          (return))
575        (when (eq j end2)
576          (setq end1 i)
577          (setq val 1)(return))
578        (let ((code1 (%scharcode string1 i))
579              (code2 (%scharcode string2 j)))
580          (declare (fixnum code1 code2))
581          (unless (= code1 code2)           
582            (setq val (if (%i< code1 code2) -1 1))
583            (setq end1 i)
584            (return))))
585      (values val (%i- end1 istart1)))))
586
587(defun string> (string1 string2 &key start1 end1 start2 end2)
588  "Given two strings, if the first string is lexicographically greater than
589  the second string, returns the longest common prefix (using char=)
590  of the two strings. Otherwise, returns ()."
591  (multiple-value-bind (result pos) (string-cmp string1 start1 end1 string2 start2 end2)
592    (if (eq result 1) pos nil)))
593
594(defun string>= (string1 string2 &key start1 end1 start2 end2)
595  "Given two strings, if the first string is lexicographically greater
596  than or equal to the second string, returns the longest common prefix
597  (using char=) of the two strings. Otherwise, returns ()."
598  (multiple-value-bind (result pos) (string-cmp string1 start1 end1 string2 start2 end2)
599    (if (eq result -1) nil pos)))
600
601(defun string< (string1 string2 &key start1 end1 start2 end2)
602  "Given two strings, if the first string is lexicographically less than
603  the second string, returns the longest common prefix (using char=)
604  of the two strings. Otherwise, returns ()."
605  (multiple-value-bind (result pos) (string-cmp string1 start1 end1 string2 start2 end2)
606    (if (eq result -1) pos nil)))
607
608(defun string<= (string1 string2 &key start1 end1 start2 end2)
609  "Given two strings, if the first string is lexicographically less than
610  or equal to the second string, returns the longest common prefix
611  (using char=) of the two strings. Otherwise, returns ()."
612  (multiple-value-bind (result pos) (string-cmp string1 start1 end1 string2 start2 end2)
613    (if (eq result 1) nil pos)))
614
615; this need not be so fancy?
616(defun string/= (string1 string2 &key start1 end1 start2 end2)
617  "Given two strings, if the first string is not lexicographically equal
618  to the second string, returns the longest common prefix (using char=)
619  of the two strings. Otherwise, returns ()."
620  (multiple-value-bind (result pos) (string-cmp string1 start1 end1 string2 start2 end2)
621    (if (eq result t) nil pos)))
622
623
624
625(provide 'chars)
Note: See TracBrowser for help on using the repository browser.