*** empty log message ***

original commit: 5dd6da264faeca1ce236684d9ec9ed32dffcc024

collects/parser-tools/lex.ss

@@ -124,8 +124,7 @@
 		  (else
 		   (vector-ref 
 		    trans-table
-		    (bitwise-ior (char->integer char)
+                    (+ (char->integer (string-ref char 0)) (* 256 state)))))))
-				 (arithmetic-shift state 8)))))))
             (cond
               ((not next-state)
                (do-match lb first-pos longest-match-length longest-match-action wrap?))
@@ -147,7 +146,7 @@
                              (if act
                                  length
                                  longest-match-length))))))))))
-
+  
   (define (do-match lb first-pos longest-match-length longest-match-action wrap?)
     (let* ((match (get-match lb longest-match-length))
            (end-pos (get-position lb)))
@@ -159,16 +158,24 @@
            (position-col first-pos)
            (position-offset first-pos)
            (- (position-offset end-pos) (position-offset first-pos))))
-      (let/ec ret
+      (cond
-        (let ((act (longest-match-action
+        (wrap?
-                    (lambda () first-pos)
+         (let/ec ret
-                    (lambda () end-pos)
+           (list (longest-match-action
-                    (lambda () match)
+                  (lambda () first-pos)
-                    ret
+                  (lambda () end-pos)
-                    lb)))
+                  (lambda () match)
-          (if wrap?
+                  ret
-              (list act first-pos end-pos)
+                  lb) 
-              act)))))
+                 first-pos 
+                 end-pos)))
+        (else 
+         (longest-match-action
+          (lambda () first-pos)
+          (lambda () end-pos)
+          (lambda () match)
+          (lambda (x) x)
+          lb)))))
   
   
   ;; Lex buffer is NOT thread safe
@@ -200,13 +207,12 @@
         (port-count-lines! ip)
 	(make-lex-buffer ip 0 (car offsets) (cadr offsets) (caddr offsets)))))))
 
+  ;; next-char: lex-buffer -> (string or eof)
   (define (next-char lb)
-    (let ((str (peek-string 1 (lex-buffer-peek-amt lb) (lex-buffer-ip lb))))
+    (let* ((peek-amt (lex-buffer-peek-amt lb))
-      (cond
+	   (str (peek-string 1 peek-amt (lex-buffer-ip lb))))
-       ((string? str)
+      (set-lex-buffer-peek-amt! lb (add1 peek-amt))
-	(set-lex-buffer-peek-amt! lb (add1 (lex-buffer-peek-amt lb)))
+      str))
-	(string-ref str 0))
-       (else eof))))
 
   ;; get-match: lex-buf * int -> string
   ;; reads the next i characters.