mbutterick
/
br-parser-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

*** empty log message ***

Browse Source 
original commit: e61c2489ec178998bf4f13feb771e32b8e03655e
tokens
Scott Owens 21 years ago
parent 3b89f609cc
commit 7e603958b5
2 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File

4
collects/parser-tools/private-lex/deriv.ss
Unescape Escape View File

@ -308,6 +308,8 @@
(build-dfa (map (lambda (x) (cons (->re x c) 'action)) (build-dfa (map (lambda (x) (cons (->re x c) 'action))
rs) rs)
c))) c)))
#| #|
(define t1 (build-test-dfa null)) (define t1 (build-test-dfa null))
(define t2 (build-test-dfa `(#\a))) (define t2 (build-test-dfa `(#\a)))
@ -325,5 +327,7 @@
(@ "-" (+ "-")) (@ "-" (+ "-"))
"[" "["
"]"))) "]")))
(define y (build-test-dfa `((+ (: (@ "|" (* (^ "|")) "|")
(@ "|" (* (^ "|"))))))))
|# |#
) )

28
collects/parser-tools/private-lex/re.ss
Unescape Escape View File

@ -75,8 +75,6 @@
(if (re-nullable? c) (if (re-nullable? c)
c c
(build-or (list e c) cache)))) (build-or (list e c) cache))))
(`(: ,r)
(->re r cache))
(`(: ,rs ...) (`(: ,rs ...)
(build-or (flatten-res (map (lambda (r) (->re r cache)) rs) cache) (build-or (flatten-res (map (lambda (r) (->re r cache)) rs) cache)
cache)) cache))
@ -161,16 +159,11 @@
((eq? e r2) r1) ((eq? e r2) r1)
((or (eq? z r1) (eq? z r2)) z) ((or (eq? z r1) (eq? z r2)) z)
(else (else
(let* ((i1 (re-index r1)) (cache (cons 'concat (cons (re-index r1) (re-index r2)))
(i2 (re-index r2))
(key (if (< i1 i2)
(cons i1 i2)
(cons i2 i1))))
(cache (cons 'concat key)
(lambda () (lambda ()
(make-concatR (and (re-nullable? r1) (re-nullable? r2)) (make-concatR (and (re-nullable? r1) (re-nullable? r2))
(get-index) (get-index)
r1 r2))))))) r1 r2))))))
;; build-repeat : re cache -> re ;; build-repeat : re cache -> re
(define (build-repeat r cache) (define (build-repeat r cache)
@ -212,17 +205,25 @@
(test-block ((c (make-cache)) (test-block ((c (make-cache))
(r1 (->re #\1 c)) (r1 (->re #\1 c))
(r2 (->re #\2 c)) (r2 (->re #\2 c))
(r3 (->re #\3 c))
(rc (->re `(@ ,r1 ,r2) c)) (rc (->re `(@ ,r1 ,r2) c))
(rc2 (->re `(@ ,r2 ,r1) c)) (rc2 (->re `(@ ,r2 ,r1) c))
(rc3 (->re `(@ ,r1 ,r2 ,r3) c))
(rr (->re `(* ,rc) c)) (rr (->re `(* ,rc) c))
(ro (->re `(: ,rr ,rc ,rr) c)) (ro (->re `(: ,rr ,rc ,rr) c))
(ro2 (->re `(: ,rc ,rr ,z) c)) (ro2 (->re `(: ,rc ,rr ,z) c))
(ro3 (->re `(: ,rr ,rc) c))) (ro3 (->re `(: ,rr ,rc) c))
(rc rc2) (real1 (->re `(+ (: (@ "|" (* (^ "|")) "|")
(@ "|" (* (^ "|"))))) c)))
((char-setR-chars r1) `(#\1))
((char-setR-chars r2) `(#\2))
((char-setR-chars r3) `(#\3))
(ro ro2) (ro ro2)
(ro ro3) (ro ro3)
((->re `(* ,rc) c) rr) ((->re `(* ,rc) c) rr)
((build-char-set null c) z) ((build-char-set null c) z)
((->re `(@) c) e)
((->re `(:) c) z)
((->re `(@ ,r1 (epsilon)) c) r1) ((->re `(@ ,r1 (epsilon)) c) r1)
((->re `(@ (epsilon) ,r1) c) r1) ((->re `(@ (epsilon) ,r1) c) r1)
((->re `(@ ,r1 ,z) c) z) ((->re `(@ ,r1 ,z) c) z)
@ -237,8 +238,9 @@
(build-or (list rc rr) c)) (build-or (list rc rr) c))
c) c)
(build-or (list r1 r2 rc rr) c)) (build-or (list r1 r2 rc rr) c))
((concatR-re1 rc2) r1) ((concatR-re1 rc3) r1)
((concatR-re2 rc2) r2) ((concatR-re1 (concatR-re2 rc3)) r2)
((concatR-re2 (concatR-re2 rc3)) r3)
((orR-res ro) (list rc rr)) ((orR-res ro) (list rc rr))
((repeatR-re rr) rc) ((repeatR-re rr) rc)
((re-nullable? r1) #f) ((re-nullable? r1) #f)

Write Preview
Loading…
Cancel
Save