source: project/release/4/genturfahi/trunk/nunjavni.scm @ 25738

Last change on this file since 25738 was 25738, checked in by Alan Post, 9 years ago

genturfa'i: use list, rather than vector, for parser input.

This converts several of the now o(n) routines back to o(1). I
noticed the performance hit, just testing as I converted this
code.

Rather than storing a vector and an index, we store the current
position in the list and advance it as we parse. The grouping
code is now immeasurably slower. You won't notice.

File size: 25.9 KB
Line 
1;;;;
2;;;; genturfahi - lo la .ckim. ke pe'a jajgau ratcu ke'e genturfa'i
3;;;;            `-> A Scheme packrat parser.
4;;;;
5;;;; Copyright (c) 2010 ".alyn.post." <alyn.post@lodockikumazvati.org>
6;;;;
7;;;; Permission to use, copy, modify, and/or distribute this software for any
8;;;; purpose with or without fee is hereby granted, provided that the above
9;;;; copyright notice and this permission notice appear in all copies.
10;;;;
11;;;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12;;;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13;;;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14;;;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15;;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16;;;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17;;;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18;;;;
19
20;;;
21;;; nunjavni - javni generators
22;;;
23
24;; selci: parse a single specified character.
25;;
26(define (nunjavni-lerfu lerfu #!key cmene (nastura #t) porjahe)
27  (let ((nunvalsi-lerfu (make-nunvalsi cmene nastura porjahe)))
28    (define (javni-lerfu porsi mapti namapti)
29      (if (char=? lerfu (car porsi))
30          (mapti (cdr porsi) (nunvalsi-lerfu lerfu))
31          (namapti porsi)))
32    javni-lerfu))
33
34
35;; selci: parse any single character.
36;;
37(define (nunjavni-.* #!key cmene nastura porjahe)
38  (let ((nunvalsi-.* (make-nunvalsi cmene nastura porjahe)))
39    (define (javni-.* porsi mapti ignore-namapti)
40      (mapti '(#\nul) (nunvalsi-.* (lerfu-porsi-string porsi))))
41    javni-.*))
42
43(define (nunjavni-.+ #!key cmene nastura porjahe)
44  (let ((nunvalsi-.+ (make-nunvalsi cmene nastura porjahe)))
45    (define (javni-.+ porsi mapti namapti)
46      (if (lerfu-porsi-fanmo? porsi)
47          (namapti porsi)
48          (mapti '(#\nul) (nunvalsi-.+ (lerfu-porsi-string porsi)))))
49    javni-.+))
50
51(define (nunjavni-.kuspe #!key cmene
52                               nastura
53                               porjahe
54                               (my 0)
55                               (ny most-positive-fixnum))
56  (let ((nunvalsi-.kuspe (make-nunvalsi cmene nastura porjahe))
57        (na-fanmo? (lambda (porsi) (not (lerfu-porsi-fanmo?  porsi)))))
58    (define (javni-.kuspe porsi mapti namapti)
59      (define (mapti-.kuspe porsi valsi)
60        (mapti porsi (nunvalsi-.kuspe (list->string valsi))))
61
62      (span-kuspe na-fanmo?
63                  porsi
64                  mapti-.kuspe
65                  namapti
66                  my: my
67                  ny: ny))
68
69    javni-.kuspe))
70
71(define (nunjavni-. #!key cmene nastura porjahe)
72  (let ((nunvalsi-. (make-nunvalsi cmene nastura porjahe)))
73    (define (javni-. porsi mapti namapti)
74      (if (lerfu-porsi-fanmo? porsi)
75          (namapti porsi)
76          (mapti (cdr porsi) (nunvalsi-. (car porsi)))))
77    javni-.))
78
79
80;; empty-string: parse the empty string, which always succeeds without
81;;               advancing input.
82;;
83(define (nunjavni-e #!key cmene (nastura #t) porjahe (empty-string ""))
84  (let ((nunvalsi-e (make-nunvalsi cmene nastura porjahe)))
85    (define (javni-e porsi mapti ignore-namapti)
86      (mapti porsi (nunvalsi-e empty-string)))
87    javni-e))
88
89
90;; empty-list: parse the empty list, which always succeeds without
91;;             advancing input.
92;;
93(define (nunjavni-nil #!key cmene nastura porjahe (empty-list '()))
94  (let ((nunvalsi-nil (make-nunvalsi cmene nastura porjahe)))
95    (define (javni-nil porsi mapti ignore-namapti)
96      (mapti porsi (nunvalsi-nil empty-list)))
97    javni-nil))
98
99
100;; selci: parse the end of input.
101;;
102;; Should this rule return the sentinel character, or should there
103;; be a separate option for the value to return at the end of the file?
104;;
105(define (nunjavni-fanmo #!key cmene (nastura #t) porjahe (sentinel #\nul))
106  (let ((nunvalsi-fanmo (make-nunvalsi cmene nastura porjahe)))
107    (define (javni-fanmo porsi mapti namapti)
108      (if (lerfu-porsi-fanmo? porsi)
109          (mapti porsi (nunvalsi-fanmo sentinel))
110          (namapti porsi)))
111  javni-fanmo))
112
113
114;; selci: parse the specified string
115;;
116(define (nunjavni-valsi valsi #!key cmene (nastura #t) porjahe)
117  (define list-prefix?
118    (lambda (vla poi)
119      (cond ((null? vla) poi)
120            ((null? poi) #f)
121            ((char=? (car vla) (car poi)) (list-prefix? (cdr vla) (cdr poi)))
122            (else #f))))
123
124  (let ((vlapoi (string->list valsi))
125        (nunvalsi-valsi (make-nunvalsi cmene nastura porjahe)))
126    (define (javni-valsi porsi mapti namapti)
127      (let ((poi (list-prefix? vlapoi porsi)))
128        (if poi
129            (mapti poi (nunvalsi-valsi valsi))
130            (namapti porsi))))
131    javni-valsi))
132
133
134(define (nunjavni-char-set-* char-set #!key cmene nastura porjahe)
135  (let ((nunvalsi-char-set-* (make-nunvalsi cmene nastura porjahe))
136        (contains? (lambda (poi) (char-set-contains? char-set poi))))
137    (define (javni-char-set-* porsi
138                              mapti
139                              ignore-namapti
140                                     ; if we're matching one or
141                                     ; more, this will be advanced
142                                     ; by one.
143                              #!key (cfari (list '()))
144                                    (fanmo cfari))
145      (define (mapti-char-set-* porsi valsi)
146        (mapti porsi (nunvalsi-char-set-* valsi)))
147
148      (call-with-values
149         (lambda () (span contains? porsi))
150         (lambda (vla poi)
151           (set-cdr! fanmo vla)
152           (mapti-char-set-* poi (list->string (cdr cfari))))))
153    javni-char-set-*))
154
155
156(define (nunjavni-char-set-+ char-set #!key cmene nastura porjahe)
157  (let ((javni-char-set-* (nunjavni-char-set-* char-set
158                                               cmene:   cmene
159                                               nastura: nastura
160                                               porjahe: porjahe)))
161    (define (javni-char-set-+ porsi mapti namapti)
162      (if (char-set-contains? char-set (car porsi))
163          (let ((cfari `(() ,(car porsi))))
164            (javni-char-set-* (cdr porsi)
165                              mapti
166                              namapti
167                              cfari: cfari
168                              fanmo: (cdr cfari)))
169          (namapti porsi)))
170    javni-char-set-+))
171
172(define (nunjavni-char-set-kuspe char-set #!key cmene
173                                                nastura
174                                                porjahe
175                                                (my 0)
176                                                (ny most-positive-fixnum))
177  (let ((nunvalsi-char-set-kuspe (make-nunvalsi cmene nastura porjahe))
178        (contains? (lambda (porsi) (char-set-contains? char-set (car porsi)))))
179    (define (javni-char-set-kuspe porsi mapti namapti)
180      (define (mapti-char-set-kuspe porsi valsi)
181        (mapti porsi (nunvalsi-char-set-kuspe (list->string valsi))))
182
183      (span-kuspe contains?
184                  porsi
185                  mapti-char-set-kuspe
186                  namapti
187                  my: my
188                  ny: ny))
189
190    javni-char-set-kuspe))
191
192(define (nunjavni-char-set char-set #!key cmene nastura porjahe)
193  (let ((nunvalsi-char-set (make-nunvalsi cmene nastura porjahe)))
194    (define (javni-char-set porsi mapti namapti)
195      (let ((lerfu (car porsi)))
196        (if (char-set-contains? char-set lerfu)
197            (mapti (cdr porsi) (nunvalsi-char-set lerfu))
198            (namapti porsi))))
199    javni-char-set))
200
201;; zero-or-more: parse zero or more javni out of the |lerfu-porsi|.
202;;
203(define (nunjavni-* javni #!key cmene nastura porjahe porsumti (default '()))
204  (let ((vejmina   (venunjmina-rodavalsi-* cmene
205                                           nastura
206                                           porjahe
207                                           porsumti))
208        (novejmina (novejmina-nunvalsi cmene nastura porjahe default #f)))
209    (define (suhopa-javni-* porsi
210                            mapti
211                            namapti
212                                   ; a "dummy head" is a linked-list
213                                   ; optimization we'll return the cdr
214                                   ; of this list, but by using this
215                                   ; extra cons we avoid checking for
216                                   ; the beginning of the list below.
217                                   ;
218                            #!key (cfari (list '()))
219                                  (fanmo cfari))
220      (define (mapti-* porsi nunvalsi)
221        ; append this result to the result list
222        (set-cdr! fanmo (list nunvalsi))
223        (suhopa-javni-* porsi
224                        mapti
225                        namapti
226                        cfari: cfari
227                        fanmo: (cdr fanmo)))
228
229      (define (namapti-* porsi)
230        ; ignore the failure in |ignore-nunjavni|, as
231        ; this javni cannot fail.  |porsi| is not advanced
232        ; on failure, so we can use it, capturing any
233        ; cases that did succeed.
234        ;
235        (mapti porsi (vejmina (cdr cfari))))
236
237      (javni porsi mapti-* namapti-*))
238
239    (define (pamoi-javni-* porsi
240                           mapti
241                           namapti
242                                  ; a "dummy head" is a linked-list
243                                  ; optimization we'll return the cdr
244                                  ; of this list, but by using this
245                                  ; extra cons we avoid checking for
246                                  ; the beginning of the list below.
247                                  ;
248                           #!key (cfari (list '()))
249                                 (fanmo cfari))
250      (define (mapti-* porsi nunvalsi)
251        ; append this result to the result list
252        (set-cdr! fanmo (list nunvalsi))
253        (suhopa-javni-* porsi
254                        mapti
255                        namapti
256                        cfari: cfari
257                        fanmo: (cdr fanmo)))
258
259      (define (namapti-* porsi)
260        ; ignore the failure in |ignore-nunjavni|, as
261        ; this javni cannot fail.  |porsi| is not advanced
262        ; on failure, so we can use it, capturing any
263        ; cases that did succeed.
264        ;
265        (mapti porsi novejmina))
266
267      (javni porsi mapti-* namapti-*))
268
269    (values pamoi-javni-* suhopa-javni-*)))
270
271
272;; one-or-more: parse one or more javni out of the |lerfu-porsi|.
273;;
274(define (nunjavni-+ javni #!key cmene nastura porjahe porsumti)
275  (let ((javni-* (call-with-values
276                   (lambda ()
277                     (nunjavni-* javni
278                                 cmene:    cmene
279                                 nastura:  nastura
280                                 porjahe:  porjahe
281                                 porsumti: porsumti))
282                   (lambda (pamoi suhopa)
283                     suhopa))))
284    (define (javni-+ porsi mapti namapti)
285      (define (mapti-+ porsi nunvalsi)
286        (let ((fanmo (list nunvalsi)))
287          (javni-* porsi
288                   mapti
289                   namapti
290                   cfari:   (cons '() fanmo)
291                   fanmo:   fanmo)))
292      (javni porsi mapti-+ namapti))
293    javni-+))
294
295
296;; range: parse N,M javni out of the |lerfu-porsi|.
297;
298;; javni{n,m}                 => match at least m and no more than n times.
299;; javni{m}   => javni{n,n}   => match exactly m times.
300;; javni{m,}  => javni{n,inf} => match m or more times.
301;; javni{,n}  => javni{0,n}   => match zero to n times.
302;; javni{,}   => javni{0,inf} => match zero-or-more times.
303;; javni{}    => javni{0,inf} => match zero-or-more times.
304;;
305(define (nunjavni-kuspe javni #!key cmene
306                                    nastura
307                                    porjahe
308                                    porsumti
309                                    (default '())
310                                    (my 0)
311                                    (ny most-positive-fixnum))
312  (let ((vejmina (venunjmina-rodavalsi-* cmene
313                                         nastura
314                                         porjahe
315                                         porsumti))
316        (novejmina (novejmina-nunvalsi cmene nastura porjahe default #f)))
317    (define (suhopa-javni-kuspe porsi
318                                mapti
319                                namapti
320                                        ; a "dummy head" is a linked-list
321                                        ; optimization we'll return the cdr
322                                        ; of this list, but by using this
323                                        ; extra cons we avoid checking for
324                                        ; the beginning of the list below.
325                                        ;
326                                 #!key (cfari (list '()))
327                                       (fanmo cfari)
328                                       (klani 1))
329      (define (mapti-kuspe porsi nunvalsi)
330        ; append this result to the result list
331        (set-cdr! fanmo (list nunvalsi))
332
333        ; if we have matched up to our limit, succeed.
334        ; otherwise keep matching.
335        ;
336        (if (fx= ny klani)
337            (mapti porsi (vejmina (cdr cfari)))
338            (suhopa-javni-kuspe porsi
339                                mapti
340                                namapti
341                                cfari: cfari
342                                fanmo: (cdr fanmo)
343                                klani: (fx+ 1 klani))))
344
345      (define (namapti-kuspe porsi)
346        (if (fx> klani my)
347            (mapti porsi (vejmina (cdr cfari)))
348            (namapti porsi)))
349
350      (javni porsi mapti-kuspe namapti-kuspe))
351
352    (define (pamoi-javni-kuspe porsi
353                               mapti
354                               namapti
355                                       ; a "dummy head" is a linked-list
356                                       ; optimization we'll return the cdr
357                                       ; of this list, but by using this
358                                       ; extra cons we avoid checking for
359                                       ; the beginning of the list below.
360                                       ;
361                                #!key (cfari (list '()))
362                                      (fanmo cfari)
363                                      (klani 1))
364      (define (mapti-kuspe porsi nunvalsi)
365        ; append this result to the result list
366        (set-cdr! fanmo (list nunvalsi))
367
368        ; if we have matched up to our limit, succeed.
369        ; otherwise keep matching.
370        ;
371        (if (fx= ny klani)
372            (mapti porsi (vejmina (cdr cfari)))
373            (suhopa-javni-kuspe porsi
374                                mapti
375                                namapti
376                                cfari: cfari
377                                fanmo: (cdr fanmo)
378                                klani: (fx+ 1 klani))))
379
380      (define (namapti-kuspe porsi)
381        (if (fx> klani my)
382            (mapti porsi novejmina)
383            (namapti porsi)))
384
385      (javni porsi mapti-kuspe namapti-kuspe))
386
387    pamoi-javni-kuspe))
388
389
390
391;; optional: parse an optional javni out of the |lerfu-porsi|.
392;;
393(define (nunjavni-? javni #!key cmene
394                                nastura
395                                porjahe
396                                porsumti
397                                (default "")
398                                ni)
399  (let ((vejmina   (venunjmina-nunvalsi cmene nastura porjahe porsumti))
400        (novejmina (novejmina-nunvalsi cmene nastura porjahe default ni)))
401    (define (javni-? porsi mapti ignore-namapti)
402
403      (define (mapti-? porsi nunvalsi)
404        (mapti porsi (vejmina nunvalsi)))
405
406      (define (namapti-? porsi)
407        ; ignore the failure in |ignore-nunvalsi|, as
408        ; this javni cannot fail.  |porsi| is not advanced
409        ; on failure, so we can use it.
410        ;
411        (mapti porsi novejmina))
412
413      (javni porsi mapti-? namapti-?))
414    javni-?))
415
416
417;; and-predicate: succeed or fail without consuming input.
418;;
419(define (nunjavni-& javni #!key porjahe)
420  (let ((nunvalsi-& (make-nunvalsi-predicate porjahe)))
421    (define (javni-& porsi mapti namapti)
422      (define (mapti-& ignore-porsi ignore-nunvalsi)
423        (mapti porsi nunvalsi-&))
424
425      (define (namapti-& ignore-porsi)
426        (namapti porsi))
427
428      (javni porsi mapti-& namapti-&))
429    javni-&))
430
431
432;; not-predicate: require that |javni| is not able to be parsed from
433;;                the |lerfu-porsi|.
434;;
435(define (nunjavni-! javni #!key porjahe)
436  (let ((nunvalsi-! (make-nunvalsi-predicate porjahe)))
437    (define (javni-! porsi mapti namapti)
438      (define (mapti-! ignore-porsi ignore-nunvalsi)
439        (namapti porsi))
440
441      (define (namapti-! ignore-porsi)
442        (mapti porsi nunvalsi-!))
443
444      (javni porsi mapti-! namapti-!))
445    javni-!))
446
447
448;; sequence: parse |ro da javni| out of the |lerfu-porsi|.
449;;           if any of the do not match, none of them match.
450;;
451(define (nunjavni-je rodajavni #!key cmene nastura porjahe porsumti)
452  (let ((vejmina (venunjmina-rodavalsi-je cmene nastura porjahe porsumti)))
453    (define (javni-je porsi
454                      mapti
455                      namapti
456                                 ; capture the initial position, and
457                                 ; then continue to pass it as we
458                                 ; call ourselves recursively.
459                      #!key     (cfari-porsi porsi)
460                                 ; the current rule we're trying.
461                                (rodajavni rodajavni)
462                                 ; a "dummy head" is a linked-list
463                                 ; optimization we'll return the cdr
464                                 ; of this list, but by using this
465                                 ; extra cons we avoid checking for
466                                 ; the beginning of the list below.
467                                 ;
468                                (cfari (list '()))
469                                (fanmo cfari))
470      ; the (nun)valsi passed to us might
471      ; include previously matched javni.  If
472      ; we fail to match a javni, ignore the
473      ; porsi passed to us and use the one from
474      ; the start of this parse rule.
475      ;
476      (define (namapti-je ignore-porsi)
477        (namapti cfari-porsi))
478
479      (let ((javni (car rodajavni))
480            (rest (cdr rodajavni)))
481        (if (null? rest)
482
483            ; called at the end of the list
484            (let ((mapti-je (lambda (porsi nunvalsi)
485                               (set-cdr! fanmo (list nunvalsi))
486                               (mapti porsi (vejmina (cdr cfari))))))
487              (javni porsi mapti-je namapti-je))
488
489            ; called when there are still elements in the list
490            (let ((mapti-je (lambda (porsi nunvalsi)
491                               (set-cdr! fanmo (list nunvalsi))
492                               (javni-je porsi
493                                         mapti
494                                         namapti
495                                         cfari-porsi: cfari-porsi
496                                         rodajavni: rest
497                                         cfari: cfari
498                                         fanmo: (cdr fanmo)))))
499              (javni porsi mapti-je namapti-je)))))
500  javni-je))
501
502
503;; ordered-choice: parse the first matching javni out of the
504;;                 |lerfu-porsi|.
505;;
506(define (nunjavni-jonai rodajavni #!key cmene nastura porjahe porsumti)
507  (let ((vejmina   (venunjmina-nunvalsi cmene nastura porjahe porsumti)))
508    (define (javni-jonai porsi
509                         mapti
510                         namapti
511                         #!optional (rodajavni rodajavni))
512      (define (mapti-jonai porsi nunvalsi)
513        ;(pretty-print `(jonai ,nunvalsi ,(vejmina nunvalsi)))
514        (mapti porsi (vejmina nunvalsi)))
515
516      (let ((javni (car rodajavni))
517            (rest (cdr rodajavni)))
518        (if (null? rest)
519            ; called at the end of the list
520            (javni porsi mapti-jonai namapti)
521
522            ; called when there are still elements in the list
523            (let ((namapti-jonai (lambda (porsi)
524                                   (javni-jonai porsi
525                                                mapti
526                                                namapti
527                                                rest))))
528              (javni porsi mapti-jonai namapti-jonai)))))
529    javni-jonai))
530
531
532;; convert a single result to a list.  Called with non-terminal
533;; rules
534;;
535(define (nunjavni-porjahe javni)
536  (define (javni-porjahe porsi mapti namapti)
537    (define (mapti-porjahe porsi nunvalsi)
538      (mapti porsi `(,nunvalsi)))
539
540    (javni porsi mapti-porjahe namapti))
541
542  javni-porjahe)
543
544
545;; morji: memoization is done to ensure we run in linear time.
546;;        Any javni can be memoized, though the compiler only
547;;        memoizes non-terminals above a certain level of
548;;        complexity.
549;;
550(define-values (genturfahi-semorji genturfahi-tolmohi nunjavni-morji)
551  (let ((rodasemorji '())
552        (rodatolmohi '()))
553    (values
554      (lambda (nilcla)
555        (map (lambda (semorji) (semorji nilcla)) rodasemorji))
556
557      (lambda ()
558        (map (lambda (tolmohi) (tolmohi)) rodatolmohi))
559
560      (lambda (javni)
561        (let ((morji '()))
562          (define (semorji nilcla)
563            (let ((klani (quotient nilcla 2)))
564              (set! morji
565                    (make-hash-table eq? size: (if (= 0 klani) 1 klani)))))
566
567          (define (tolmohi)
568            (set! morji '()))
569
570          (define (javni-morji morji-porsi mapti namapti)
571            ;; mapti
572            (define (set-mapti-morji! porsi nunvalsi)
573              (define (mapti-morji mapti ignore-namapti)
574                (mapti porsi nunvalsi))
575
576              (hash-table-set! morji morji-porsi mapti-morji))
577
578            ;; namapti
579            (define (set-namapti-morji! porsi)
580              (define (namapti-morji ignore-mapti namapti)
581                (namapti porsi))
582
583              (hash-table-set! morji morji-porsi namapti-morji))
584
585            ;; recurse
586            (define (set-recurse-morji!)
587              (define (recurse-morji ignore-mapti namapti)
588                (namapti morji-porsi))
589
590              (hash-table-set! morji morji-porsi recurse-morji))
591
592            (define (javni-nomorji)
593              (define (mapti-morji porsi nunvalsi)
594                (set-mapti-morji! porsi nunvalsi)
595                (mapti porsi nunvalsi))
596
597              (define (namapti-morji porsi)
598                (set-namapti-morji! porsi)
599                (namapti porsi))
600
601              ; register this parse position to detect left
602              ; recursion.
603              (set-recurse-morji!)
604
605              (javni morji-porsi mapti-morji namapti-morji))
606
607            (let ((nunjalge
608                    (hash-table-ref/default morji morji-porsi #f)))
609              (if nunjalge (nunjalge mapti namapti) (javni-nomorji))))
610
611          ; register this cache so we can initialize and clear.
612          ; This routine customizes itself based on the input size,
613          ; and we can free up a substantial amount of memory if
614          ; we clear the caches after we're done parsing.
615          ;
616          (stack-push! rodasemorji (cons semorji (stack-pop! rodasemorji)))
617          (stack-push! rodatolmohi (cons tolmohi (stack-pop! rodatolmohi)))
618
619          javni-morji)))))
620
621(define (nunjavni-samselpla samselpla javni #!key cmene porjahe)
622  (let ((nunvalsi-samselpla (make-nunvalsi cmene #f porjahe)))
623    (define (javni-samselpla porsi mapti namapti)
624      (define (mapti-samselpla porsi nunvalsi)
625        (define (samselpla-sumti rodavalsi)
626          (call-with-values
627            (lambda ()
628              (partition javni-valsi? rodavalsi))
629         
630            (lambda (cmesumti sumti)
631              (let ((key (append-map
632                           (lambda (javni)
633                             (let ((cme (javni-valsi-cme javni))
634                                   (val (javni-valsi-val* javni)))
635                               `(,(string->keyword cme) ,val)))
636                           cmesumti))
637                    (rest (javni-rodavalsi-samselpla sumti)))
638                (append rest key)))))
639
640        (define (samselpla-nunvalsi)
641          (let* ((rodaval   (samselpla-sumti nunvalsi))
642                 (valsi     (apply samselpla rodaval)))
643             (nunvalsi-samselpla valsi)))
644
645        (mapti porsi (samselpla-nunvalsi)))
646
647      (javni porsi mapti-samselpla namapti))
648    javni-samselpla))
649
650(define (nunjavni-samselpla-cabna samselpla javni #!key cmene porjahe)
651  (let ((nunvalsi-samselpla-cabna (make-nunvalsi cmene #f porjahe))
652        (javni-samselpla (nunjavni-samselpla samselpla javni
653                                                       porjahe: porjahe)))
654    (define (javni-samselpla-cabna porsi mapti namapti)
655      (define (mapti-samselpla-cabna mapti-porsi nunvalsi)
656        (if (eq? (secuxna-nonmatch-token) nunvalsi)
657            (namapti porsi)
658            (mapti mapti-porsi
659                   (nunvalsi-samselpla-cabna nunvalsi))))
660
661      (javni-samselpla porsi mapti-samselpla-cabna namapti))
662    javni-samselpla-cabna))
663
664(define (nunjavni-cmene javni #!key cmene nastura porjahe)
665  (let ((nunvalsi-cmene (make-nunvalsi cmene nastura porjahe)))
666    (define (javni-cmene porsi mapti namapti)
667      (define (mapti-cmene porsi nunvalsi)
668        (mapti porsi
669               (nunvalsi-cmene nunvalsi)))
670      (javni porsi mapti-cmene namapti))
671    javni-cmene))
672
673;; backtick operator
674;;
675(define (nunjavni-nastura javni #!key porjahe)
676  (let ((nunvalsi-nastura (make-nunvalsi-predicate porjahe)))
677    (define (javni-nastura porsi mapti namapti)
678      (define (mapti-nastura porsi ignore-nunvalsi)
679        (mapti porsi nunvalsi-nastura))
680      (javni porsi mapti-nastura namapti))
681    javni-nastura))
682
683;; decorate each rule according to the options specified.
684;;
685(define (nunjavni-secuxna nuncmene javni #!rest cmene-sumti)
686  (define (cfisisku cmene javni)
687    (if (secuxna-debug)
688        (apply nunjavni-cfisisku cmene javni cmene-sumti)
689        javni))
690
691  (define (junla cmene javni)
692    (if (secuxna-profile)
693        (apply nunjavni-junla cmene javni cmene-sumti)
694        javni))
695
696  (if (or (secuxna-debug) (secuxna-profile))
697      (let ((cmene (nuncmene)))
698        (cfisisku cmene (junla cmene javni)))
699      javni))
Note: See TracBrowser for help on using the repository browser.