source: project/chicken/trunk/regex.scm @ 8390

Last change on this file since 8390 was 8390, checked in by Kon Lovett, 12 years ago

Removed regex-extras. More ugliness for using the platfrom PCRE header files in regex.

File size: 22.2 KB
Line 
1;;;; regex.scm - Unit for using the PCRE regex package
2;
3; Copyright (c) 2000-2007, Felix L. Winkelmann
4; Copyright (c) 2008, The Chicken Team
5; All rights reserved.
6;
7; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
8; conditions are met:
9;
10;   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
11;     disclaimer.
12;   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
13;     disclaimer in the documentation and/or other materials provided with the distribution.
14;   Neither the name of the author nor the names of its contributors may be used to endorse or promote
15;     products derived from this software without specific prior written permission.
16;
17; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
18; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
19; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
20; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
21; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
22; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
23; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
24; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
25; POSSIBILITY OF SUCH DAMAGE.
26
27
28(cond-expand
29 [chicken-compile-shared]
30 [else (declare (unit regex))] )
31
32(declare
33  (usual-integrations)
34  (disable-interrupts)
35  (generic) ; PCRE options use lotsa bits
36  (disable-warning var)
37  (bound-to-procedure
38    ;; Forward reference
39    make-anchored-pattern
40    ;; Imports
41    get-output-string open-output-string
42    string->list list->string string-length string-ref substring make-string string-append
43    reverse list-ref
44    char=? char-alphabetic? char-numeric? char->integer
45    set-finalizer!
46    ##sys#slot ##sys#setslot ##sys#size
47    ##sys#make-structure ##sys#structure?
48    ##sys#error ##sys#signal-hook
49    ##sys#substring ##sys#fragments->string ##sys#make-c-string ##sys#string-append
50    ##sys#write-char-0 )
51  (export
52    ##sys#regex-chardef-table?
53    regexp? regexp regexp*
54    regexp-optimize
55    regex-chardef-table?
56    make-anchored-pattern
57    string-match string-match-positions string-search string-search-positions
58    string-split-fields string-substitute string-substitute*
59    glob? glob->regexp
60    grep
61    regexp-escape ) )
62
63(cond-expand
64 [paranoia]
65 [else
66  (declare
67    (no-bound-checks)
68    (no-procedure-checks-for-usual-bindings) ) ] )
69
70(cond-expand
71 [unsafe
72  (eval-when (compile)
73    (define-macro (##sys#check-chardef-table . _) '(##core#undefined))
74    (define-macro (##sys#check-integer . _) '(##core#undefined))
75    (define-macro (##sys#check-blob . _) '(##core#undefined))
76    (define-macro (##sys#check-vector . _) '(##core#undefined))
77    (define-macro (##sys#check-structure . _) '(##core#undefined))
78    (define-macro (##sys#check-range . _) '(##core#undefined))
79    (define-macro (##sys#check-pair . _) '(##core#undefined))
80    (define-macro (##sys#check-list . _) '(##core#undefined))
81    (define-macro (##sys#check-symbol . _) '(##core#undefined))
82    (define-macro (##sys#check-string . _) '(##core#undefined))
83    (define-macro (##sys#check-char . _) '(##core#undefined))
84    (define-macro (##sys#check-exact . _) '(##core#undefined))
85    (define-macro (##sys#check-port . _) '(##core#undefined))
86    (define-macro (##sys#check-number . _) '(##core#undefined))
87    (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ]
88 [else
89  (declare
90    (export
91      ##sys#check-chardef-table)
92    (bound-to-procedure
93      ;; Imports
94      ##sys#check-string ##sys#check-list ##sys#check-exact ##sys#check-vector
95      ##sys#check-structure ##sys#check-symbol ##sys#check-blob ##sys#check-integer)
96    (emit-exports "regex.exports")) ] )
97
98
99;;;
100
101#>#include "pcre.h"<#
102
103
104;;;
105
106(register-feature! 'regex 'pcre)
107
108
109;;; From unit lolevel:
110
111(define-inline (%tagged-pointer? x tag)
112  (and (##core#inline "C_blockp" x)
113       (##core#inline "C_taggedpointerp" x)
114       (eq? tag (##sys#slot x 1)) ) )
115
116
117;;; Character Definition Tables:
118;;; See unit regex-extras
119
120(define (##sys#regex-chardef-table? x)
121  (%tagged-pointer? x 'chardef-table) )
122
123(cond-expand
124 [unsafe]
125 [else
126  (define (##sys#check-chardef-table x loc)
127    (unless (##sys#regex-chardef-table? x)
128      (##sys#error loc "invalid character definition tables structure" x) ) ) ] )
129
130
131;;; PCRE Types:
132
133(define-foreign-type pcre (c-pointer "pcre"))
134(define-foreign-type nonnull-pcre (nonnull-c-pointer "pcre"))
135
136(define-foreign-type pcre_extra (c-pointer "pcre_extra"))
137(define-foreign-type nonnull-pcre_extra (nonnull-c-pointer "pcre_extra"))
138
139(define-foreign-variable PCRE_CASELESS unsigned-integer)
140(define-foreign-variable PCRE_EXTENDED unsigned-integer)
141(define-foreign-variable PCRE_UTF8 unsigned-integer)
142
143;FIXME the use of 'define-foreign-enum' causes unused global variable warning!
144
145(define-foreign-enum (pcre-option unsigned-integer)
146  (caseless             PCRE_CASELESS)
147  (multiline            PCRE_MULTILINE)
148  (dotall               PCRE_DOTALL)
149  (extended             PCRE_EXTENDED)
150  (anchored             PCRE_ANCHORED)
151  (dollar-endonly       PCRE_DOLLAR_ENDONLY)
152  (extra                PCRE_EXTRA)
153  (notbol               PCRE_NOTBOL)
154  (noteol               PCRE_NOTEOL)
155  (ungreedy             PCRE_UNGREEDY)
156  (notempty             PCRE_NOTEMPTY)
157  (utf8                 PCRE_UTF8)
158  (no-auto-capture      PCRE_NO_AUTO_CAPTURE)
159  (no-utf8-check        PCRE_NO_UTF8_CHECK)
160  (auto-callout         PCRE_AUTO_CALLOUT)
161  (partial              PCRE_PARTIAL)
162  (dfa-shortest         PCRE_DFA_SHORTEST)
163  (dfa-restart          PCRE_DFA_RESTART)
164  (firstline            PCRE_FIRSTLINE)
165  (dupnames             PCRE_DUPNAMES)
166  (newline-cr           PCRE_NEWLINE_CR)
167  (newline-lf           PCRE_NEWLINE_LF)
168  (newline-crlf         PCRE_NEWLINE_CRLF)
169  (newline-any          PCRE_NEWLINE_ANY)
170  (newline-anycrlf      PCRE_NEWLINE_ANYCRLF)
171  (bsr-anycrlf          PCRE_BSR_ANYCRLF)
172  (bsr-unicode          PCRE_BSR_UNICODE) )
173
174
175;;; The regexp structure primitives:
176
177(define re-finalizer
178  (foreign-lambda void "pcre_free" c-pointer) )
179
180(define-inline (%make-regexp code)
181  (set-finalizer! code re-finalizer)
182  (##sys#make-structure 'regexp code #f 0) )
183
184(define-inline (%regexp? x)
185  (##sys#structure? x 'regexp) )
186
187(define-inline (%regexp-code rx)
188  (##sys#slot rx 1) )
189
190(define-inline (%regexp-extra rx)
191  (##sys#slot rx 2) )
192
193(define-inline (%regexp-options rx)
194  (##sys#slot rx 3) )
195
196(define-inline (%regexp-extra-set! rx extra)
197  (when extra (set-finalizer! extra re-finalizer))
198  (##sys#setslot rx 2 extra) )
199
200(define-inline (%regexp-options-set! rx options)
201  (##sys#setslot rx 3 options) )
202
203
204;;; Regexp record:
205
206(define (regexp? x)
207  (%regexp? x) )
208
209
210;;; PCRE errors:
211
212#>
213static const char *C_regex_error;
214static int C_regex_error_offset;
215<#
216
217(define-foreign-variable C_regex_error c-string)
218(define-foreign-variable C_regex_error_offset int)
219
220(define re-error
221  (let ([string-append string-append])
222    (lambda (loc msg . args)
223      (apply ##sys#error loc (string-append msg " - " C_regex_error) args) ) ) )
224
225;;; Compile regular expression:
226
227;FIXME nonnull-unsigned-c-string causes problems - converted string is too long!
228
229(define re-compile
230  (foreign-lambda* pcre ((nonnull-c-string patt) (unsigned-integer options) ((const (c-pointer unsigned-char)) tables))
231    "return(pcre_compile(patt, options, &C_regex_error, &C_regex_error_offset, tables));") )
232
233(define (re-checked-compile pattern options tables loc)
234  (##sys#check-string pattern loc)
235  (or (re-compile pattern options #f)
236      (re-error loc "cannot compile regular expression" pattern C_regex_error_offset) ) )
237
238;; Compile with subset of options and no tables
239
240(define (regexp pattern . options)
241  (let ([options->integer
242          (lambda ()
243            (if (null? options)
244                0
245                (+ (if (car options) PCRE_CASELESS 0)
246                   (let ((options (cdr options)))
247                     (if (null? options)
248                         0
249                         (+ (if (car options) PCRE_EXTENDED 0)
250                            (let ((options (cdr options)))
251                              (if (and (pair? options) (car options)) PCRE_UTF8 0 ) ) ) ) ) ) ) )])
252    (%make-regexp (re-checked-compile pattern (options->integer) #f 'regexp)) ) )
253
254;; Compile with full options and tables available
255
256(define (regexp* pattern . args)
257  (let-optionals args ([options '()] [tables #f])
258    (##sys#check-string pattern 'regexp*)
259    (##sys#check-list options 'regexp*)
260    (when tables (##sys#check-chardef-table tables 'regexp*))
261    (%make-regexp (re-checked-compile pattern (pcre-option->number options) tables 'regexp*)) ) )
262
263
264;;; Optimize compiled regular expression:
265
266;; Invoke optimizer
267
268(define re-study
269  (foreign-lambda* pcre_extra (((const nonnull-pcre) code))
270    "return(pcre_study(code, 0, &C_regex_error));"))
271
272;; Optimize compiled regular expression
273;; Returns whether optimization performed
274
275(define (regexp-optimize rx)
276  (##sys#check-structure rx 'regexp 'regexp-optimize)
277  (let ([extra (re-study (%regexp-code rx))])
278    (cond [C_regex_error
279            (re-error 'regexp-optimize "cannot optimize regular expression" rx)]
280          [extra
281            (%regexp-extra-set! rx extra)
282            #t]
283          [else
284            #f] ) ) )
285
286
287;;; Captured results vector:
288
289;; Match positions vector (PCRE ovector)
290
291#>
292#define OVECTOR_LENGTH_MULTIPLE 3
293#define STATIC_OVECTOR_LEN 256
294static int C_regex_ovector[OVECTOR_LENGTH_MULTIPLE * STATIC_OVECTOR_LEN];
295<#
296
297;;
298
299(define ovector-start-ref
300  (foreign-lambda* int ((int i))
301    "return(C_regex_ovector[i * 2]);") )
302
303(define ovector-end-ref
304  (foreign-lambda* int ((int i))
305    "return(C_regex_ovector[(i * 2) + 1]);") )
306
307
308;;; Gather matched result strings or positions:
309
310(define (gather-result-positions result)
311  (let ([mc (car result)]
312        [cc (cadr result)])
313    (and (fx> mc 0)
314         (let loop ([i 0])
315           (cond [(fx>= i cc)
316                   '()]
317                 [(fx>= i mc)
318                   (cons #f (loop (fx+ i 1)))]
319                 [else
320                  (let ([start (ovector-start-ref i)])
321                    (cons (and (fx>= start 0)
322                               (list start (ovector-end-ref i)))
323                          (loop (fx+ i 1)) ) ) ] ) ) ) ) )
324
325(define gather-results
326  (let ([substring substring])
327    (lambda (str result)
328      (let ([ps (gather-result-positions result)])
329        (and ps
330             (##sys#map (lambda (poss) (and poss (apply substring str poss))) ps) ) ) ) ) )
331
332
333;;; Common match string with compile regular expression:
334
335(define re-match
336  (foreign-lambda* int (((const nonnull-pcre) code) ((const pcre_extra) extra)
337                        (nonnull-c-string str) (int start) (int range)
338                        (unsigned-integer options))
339    "return(pcre_exec(code, extra, str, start + range, start, options, C_regex_ovector, STATIC_OVECTOR_LEN * OVECTOR_LENGTH_MULTIPLE));") )
340
341(define re-match-capture-count
342  (foreign-lambda* int (((const nonnull-pcre) code) ((const pcre_extra) extra))
343    "int cc;"
344    "pcre_fullinfo(code, extra, PCRE_INFO_CAPTURECOUNT, &cc);"
345    "return(cc + 1);") )
346
347(define (perform-match rgxp str si ri loc)
348  (let* ([extra #f]
349         [options 0]
350         [rx
351          (cond [(string? rgxp)
352                  (re-checked-compile rgxp 0 #f loc)]
353                [(%regexp? rgxp)
354                  (set! extra (%regexp-extra rgxp))
355                  (set! options (%regexp-options rgxp))
356                  (%regexp-code rgxp)]
357                [else
358                  (##sys#signal-hook #:type-error
359                                     loc
360                                     "bad argument type - not a string or compiled regular expression"
361                                     rgxp)] )]
362         [cc (re-match-capture-count rx extra)]
363         [mc (re-match rx extra str si ri options)])
364    (when (string? rgxp) (re-finalizer rx))
365    (list mc cc) ) )
366
367
368;;; Match string with regular expression:
369
370;; Note that start is a BYTE offset
371
372(define string-match)
373(define string-match-positions)
374(let ()
375
376  (define (prepare-match rgxp str start loc)
377    (##sys#check-string str loc)
378    (let ([si (if (pair? start) (car start) 0)])
379      (##sys#check-exact si loc)
380      (perform-match (if (string? rgxp)
381                         (make-anchored-pattern rgxp (fx< 0 si))
382                         rgxp)
383                     str si (fx- (##sys#size str) si)
384                     loc) ) )
385
386  (set! string-match
387    (lambda (rgxp str . start)
388      (gather-results str (prepare-match rgxp str start 'string-match)) ) )
389
390  (set! string-match-positions
391    (lambda (rgxp str . start)
392      (gather-result-positions (prepare-match rgxp str start 'string-match-positions)) ) ) )
393
394
395;;; Search string with regular expression:
396
397;; Note that start & range are BYTE offsets
398
399
400(define string-search)
401(define string-search-positions)
402(let ()
403
404  (define (prepare-search rgxp str start-and-range loc)
405    (##sys#check-string str loc)
406    (let* ([range (and (pair? start-and-range) (cdr start-and-range)) ]
407           [si (if range (car start-and-range) 0)]
408           [ri (if (pair? range) (car range) (fx- (##sys#size str) si))] )
409      (##sys#check-exact si loc)
410      (##sys#check-exact ri loc)
411      (perform-match rgxp str si ri loc) ) )
412
413  (set! string-search
414    (lambda (rgxp str . start-and-range)
415      (gather-results str (prepare-search rgxp str start-and-range 'string-search)) ) )
416
417  (set! string-search-positions
418    (lambda (rgxp str . start-and-range)
419      (gather-result-positions (prepare-search rgxp str start-and-range 'string-search-positions)) ) ) )
420
421
422;;; Split string into fields:
423
424(define string-split-fields
425  (let ([reverse reverse]
426        [substring substring]
427        [string-search-positions string-search-positions] )
428    (lambda (rgxp str . mode-and-start)
429      (##sys#check-string str 'string-split-fields)
430      (let* ([argc (length mode-and-start)]
431             [len (##sys#size str)]
432             [mode (if (fx> argc 0) (car mode-and-start) #t)]
433             [start (if (fx> argc 1) (cadr mode-and-start) 0)]
434             [fini (case mode
435                     [(#:suffix)
436                      (lambda (ms start)
437                        (if (fx< start len)
438                            (##sys#error 'string-split-fields
439                                         "record does not end with suffix" str rgxp)
440                            (reverse ms) ) ) ]
441                     [(#:infix)
442                      (lambda (ms start)
443                        (if (fx>= start len)
444                            (reverse (cons "" ms))
445                            (reverse (cons (substring str start len) ms)) ) ) ]
446                     [else (lambda (ms start) (reverse ms)) ] ) ]
447             [fetch (case mode
448                      [(#:infix #:suffix) (lambda (start from to) (substring str start from))]
449                      [else (lambda (start from to) (substring str from to))] ) ] )
450        (let loop ([ms '()] [start start])
451          (let ([m (string-search-positions rgxp str start)])
452            (if m
453                (let* ([mp (car m)]
454                       [from (car mp)]
455                       [to (cadr mp)] )
456                  (if (fx= from to)
457                      (if (fx= to len)
458                          (fini ms start)
459                          (loop (cons (fetch start (fx+ from 1) (fx+ to 2)) ms) (fx+ to 1)) )
460                      (loop (cons (fetch start from to) ms) to) ) )
461                (fini ms start) ) ) ) ) ) ) )
462
463
464;;; Substitute matching strings:
465
466(define string-substitute
467  (let ([substring substring]
468        [reverse reverse]
469        [make-string make-string]
470        [string-search-positions string-search-positions] )
471    (lambda (regex subst string . flag)
472      (##sys#check-string subst 'string-substitute)
473      (let* ([which (if (pair? flag) (car flag) 1)]
474             [substlen (##sys#size subst)]
475             [substlen-1 (fx- substlen 1)]
476             [result '()]
477             [total 0] )
478        (define (push x)
479          (set! result (cons x result))
480          (set! total (fx+ total (##sys#size x))) )
481        (define (substitute matches)
482          (let loop ([start 0] [index 0])
483            (if (fx>= index substlen-1)
484                (push (if (fx= start 0) subst (substring subst start substlen)))
485                (let ([c (##core#inline "C_subchar" subst index)]
486                      [index+1 (fx+ index 1)] )
487                  (if (char=? c #\\)
488                      (let ([c2 (##core#inline "C_subchar" subst index+1)])
489                        (if (and (not (char=? #\\ c2)) (char-numeric? c2))
490                            (let ([mi (list-ref matches (fx- (char->integer c2) 48))])
491                              (push (substring subst start index))
492                              (push (substring string (car mi) (cadr mi)))
493                              (loop (fx+ index 2) index+1) )
494                            (loop start (fx+ index+1 1)) ) )
495                      (loop start index+1) ) ) ) ) )
496        (let loop ([index 0] [count 1])
497          (let ([matches (string-search-positions regex string index)])
498            (cond [matches
499                   (let* ([range (car matches)]
500                          [upto (cadr range)] )
501                     (cond ((fx= 0 (fx- (cadr range) (car range)))
502                            (##sys#error
503                             'string-substitute "empty substitution match"
504                             regex) )
505                           ((or (not (fixnum? which)) (fx= count which))
506                            (push (substring string index (car range)))
507                            (substitute matches)
508                            (loop upto #f) )
509                           (else
510                            (push (substring string index upto))
511                            (loop upto (fx+ count 1)) ) ) ) ]
512                  [else
513                   (push (substring string index (##sys#size string)))
514                   (##sys#fragments->string total (reverse result)) ] ) ) ) ) ) ) )
515
516(define string-substitute*
517  (let ([string-substitute string-substitute])
518    (lambda (str smap . mode)
519      (##sys#check-string str 'string-substitute*)
520      (##sys#check-list smap 'string-substitute*)
521      (let ((mode (and (pair? mode) (car mode))))
522        (let loop ((str str) (smap smap))
523          (if (null? smap)
524              str
525              (let ((sm (car smap)))
526                (loop (string-substitute (car sm) (cdr sm) str mode)
527                      (cdr smap) ) ) ) ) ) ) ) )
528
529
530;;; Glob support:
531
532;FIXME is it worthwhile making this accurate?
533(define (glob? str)
534  (##sys#check-string str 'glob?)
535  (let loop ([idx (fx- (string-length str) 1)])
536    (and (fx<= 0 idx)
537         (case (string-ref str idx)
538           [(#\* #\] #\?)
539             (or (fx= 0 idx)
540                 (not (char=? #\\ (string-ref str (fx- idx 1))))
541                 (loop (fx- idx 2)))]
542           [else
543             (loop (fx- idx 1))]) ) ) )
544
545(define glob->regexp
546  (let ([list->string list->string]
547        [string->list string->list] )
548    (lambda (s)
549      (##sys#check-string s 'glob->regexp)
550      (list->string
551       (let loop ((cs (string->list s)))
552         (if (null? cs)
553             '()
554             (let ([c (car cs)]
555                   [rest (cdr cs)] )
556               (cond [(char=? c #\*)  `(#\. #\* ,@(loop rest))]
557                     [(char=? c #\?)  (cons '#\. (loop rest))]
558                     [(char=? c #\[)
559                      (cons
560                       #\[
561                       (let loop2 ((rest rest))
562                         (match rest
563                           [(#\] . more)        (cons #\] (loop more))]
564                           [(#\- c . more)      `(#\- ,c ,@(loop2 more))]
565                           [(c1 #\- c2 . more)  `(,c1 #\- ,c2 ,@(loop2 more))]
566                           [(c . more)          (cons c (loop2 more))]
567                           [()
568                            (error 'glob->regexp "unexpected end of character class" s)] ) ) ) ]
569                     [(or (char-alphabetic? c) (char-numeric? c)) (cons c (loop rest))]
570                     [else `(#\\ ,c ,@(loop rest))] ) ) ) ) ) ) ) )
571
572
573;;; Grep-like function on list:
574
575(define grep
576  (let ([string-search string-search])
577    (lambda (rgxp lst)
578      (##sys#check-list lst 'grep)
579      (let loop ([lst lst])
580        (if (null? lst)
581            '()
582            (let ([x (car lst)]
583                  [r (cdr lst)] )
584              (if (string-search rgxp x)
585                  (cons x (loop r))
586                  (loop r) ) ) ) ) ) ) )
587
588
589;;; Escape regular expression (suggested by Peter Bex):
590
591(define regexp-escape
592  (let ([open-output-string open-output-string]
593        [get-output-string get-output-string] )
594    (lambda (str)
595      (##sys#check-string str 'regexp-escape)
596      (let ([out (open-output-string)]
597            [len (##sys#size str)] )
598        (let loop ([i 0])
599          (cond [(fx>= i len) (get-output-string out)]
600                [(memq (##core#inline "C_subchar" str i)
601                       '(#\. #\\ #\? #\* #\+ #\^ #\$ #\( #\) #\[ #\] #\| #\{ #\}))
602                 (##sys#write-char-0 #\\ out)
603                 (##sys#write-char-0 (##core#inline "C_subchar" str i) out)
604                 (loop (fx+ i 1)) ]
605                [else
606                 (##sys#write-char-0 (##core#inline "C_subchar" str i) out)
607                 (loop (fx+ i 1)) ] ) ) ) ) ) )
608
609
610;;; Anchored pattern:
611
612(define make-anchored-pattern
613  (let ([string-append string-append])
614    (lambda (rgxp . args)
615      (let-optionals args ([nos #f] [noe #f])
616        (cond [(string? rgxp)
617                (string-append (if nos "" "^") rgxp (if noe "" "$"))]
618              [else
619                (##sys#check-structure rgxp 'regexp 'make-anchored-pattern)
620                (when (or nos noe)
621                  (warning 'make-anchored-pattern
622                           "cannot select partial anchor for compiled regular expression") )
623                (%regexp-options-set! rgxp
624                                      (bitwise-or (%regexp-options regexp)
625                                                  (pcre-option->number 'anchored)))
626                rgxp] ) ) ) ) )
Note: See TracBrowser for help on using the repository browser.