*** empty log message ***

original commit: e61c2489ec178998bf4f13feb771e32b8e03655e

collects/parser-tools/private-lex/deriv.ss

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

collects/parser-tools/private-lex/re.ss

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