*** empty log message ***

original commit: 22c2bf198f947fd0bc45ec25114b9e757a6942e7

collects/parser-tools/examples/calc.ss

@@ -31,7 +31,7 @@
    [(eof) 'EOF]
    ;; recursively call the lexer on the remaining input after a tab or space.  Returning the
    ;; result of that operation.  This effectively skips all whitespace.
-   [(: #\tab #\space) (calcl lex-buf)]
+   [(: #\tab #\space) (calcl input-port)]
    ;; The parser will treat the return of 'newline the same as (token-newline)
    [#\newline 'newline]
    [(: = + - * / ^) (string->symbol (get-lexeme))]
@@ -84,11 +84,9 @@
            
 ;; run the calculator on the given input-port       
 (define (calc ip)
-  ;; Make the lex-buffer
-  (let ((lb (make-lex-buf ip)))
   (letrec ((one-line
 	    (lambda ()
-                (let ((result (calcp (lambda () (calcl lb)))))
+	      (let ((result (calcp (lambda () (calcl ip)))))
 		(if result
 		    (begin
 		      (printf "~a~n" result)

collects/parser-tools/examples/read.ss

@@ -17,7 +17,7 @@
     (lexer-src-pos
      
      ;; Skip comments, without accumulating extra position information
-     [(: (whitespace) (comment)) (return-without-pos (scheme-lexer lex-buf))]
+     [(: (whitespace) (comment)) (return-without-pos (scheme-lexer input-port))]
 
      ["#t" (token-DATUM #t)]
      ["#f" (token-DATUM #f)]
@@ -25,7 +25,7 @@
      ["#\\space" (token-DATUM #\space)]
      ["#\\newline" (token-DATUM #\newline)]
      [(: (@ (initial) (* (subsequent))) + - "...") (token-DATUM (string->symbol (get-lexeme)))]
-     [#\" (token-DATUM (list->string (get-string-token lex-buf)))]
+     [#\" (token-DATUM (list->string (get-string-token input-port)))]
      [#\( 'OP]
      [#\) 'CP]
      [#\[ 'OP]
@@ -45,9 +45,9 @@
   (define get-string-token
     (lexer
      [(^ #\" #\\) (cons (car (string->list (get-lexeme)))
-			(get-string-token lex-buf))]
-     [(@ #\\ #\\) (cons #\\ (get-string-token lex-buf))]
-     [(@ #\\ #\") (cons #\" (get-string-token lex-buf))]
+			(get-string-token input-port))]
+     [(@ #\\ #\\) (cons #\\ (get-string-token input-port))]
+     [(@ #\\ #\") (cons #\" (get-string-token input-port))]
      [#\" null]))
   
   
@@ -233,8 +233,7 @@
                  [(sexp-list sexp) (cons $2 $1)]))))
   
   (define (rs sn ip off)
-    (let ((lb (make-lex-buf ip off)))
-      ((scheme-parser sn) (lambda () (scheme-lexer lb)))))
+    ((scheme-parser sn) (lambda () (scheme-lexer ip)))))
   
   (define readsyntax
     (case-lambda ((sn) (rs sn (current-input-port) (list 0 0 0)))

collects/parser-tools/lex.ss

@@ -11,11 +11,10 @@
 	   (lib "cffi.ss" "compiler"))
 
   (provide lexer lexer-src-pos define-lex-abbrev define-lex-abbrevs
-	   make-lex-buf
 	   get-position position-offset position-line position-col position?
            define-tokens define-empty-tokens)
   
-  (define-syntaxes (lexer lexer-src-pos)
+  (define-syntaxes (lexer-experiment lexer-src-pos-experiment)
     (let ((build-lexer
            (lambda (wrap?)
              (lambda (stx)
@@ -42,7 +41,7 @@
        (build-lexer #f)
        (build-lexer #t))))
 
-  (define-syntaxes (lexer-old lexer-src-pos-old)
+  (define-syntaxes (lexer lexer-src-pos)
     (let ((build-lexer
 	   (lambda (wrap?)
 	     (lambda (stx)
@@ -114,32 +113,32 @@
         stx))))
 
   (define (compiled-lexer-body lexer actions wrap?)
-    (lambda (lb)
-      (unless (lex-buffer? lb)
+    (lambda (ip)
+      (unless (input-port? ip)
         (raise-type-error 
          'lexer 
-         "lex-buf"
+         "input-port"
          0
-         lb))
-      (let ((first-pos (get-position lb)))
+         ip))
+      (let ((first-pos (get-position ip)))
         (let-values (((longest-match-length longest-match-action)
-                      (lexer lb next-char)))
-          (do-match lb first-pos longest-match-length (vector-ref actions longest-match-action) wrap?)))))
+                      (lexer ip peek-string)))
+          (do-match ip first-pos longest-match-length (vector-ref actions longest-match-action) wrap?)))))
   
   (define (lexer-body start-state trans-table eof-table actions no-lookahead wrap?)
-    (lambda (lb)
-      (unless (lex-buffer? lb)
+    (lambda (ip)
+      (unless (input-port? ip)
         (raise-type-error 
          'lexer 
-         "lex-buf"
+         "input-port"
          0
-         lb))
-      (let ((first-pos (get-position lb)))
+         ip))
+      (let ((first-pos (get-position ip)))
         (let lexer-loop (
                          ;; current-state
                          (state start-state)
                          ;; the character to transition on
-                         (char (next-char lb))
+                         (char (peek-string 1 0 ip))
                          ;; action for the longest match seen thus far
                          ;; including a match at the current state
                          (longest-match-action 
@@ -159,10 +158,10 @@
                     (+ (char->integer (string-ref char 0)) (* 256 state)))))))
             (cond
               ((not next-state)
-               (do-match lb first-pos longest-match-length longest-match-action wrap?))
+               (do-match ip first-pos longest-match-length longest-match-action wrap?))
               ((vector-ref no-lookahead next-state)
                (let ((act (vector-ref actions next-state)))
-                 (do-match lb 
+                 (do-match ip 
                            first-pos 
                            (if act length longest-match-length)
                            (if act act longest-match-action)
@@ -170,7 +169,7 @@
               (else
                (let ((act (vector-ref actions next-state)))
                  (lexer-loop next-state 
-                             (next-char lb)
+                             (peek-string 1 length ip)
                              (if act
                                  act
                                  longest-match-action)
@@ -180,7 +179,7 @@
                                  longest-match-length))))))))))
   
   (define (do-match lb first-pos longest-match-length longest-match-action wrap?)
-    (let* ((match (get-match lb longest-match-length))
+    (let* ((match (read-string longest-match-length lb))
            (end-pos (get-position lb)))
       (if (not longest-match-action)
           (raise-read-error
@@ -210,57 +209,9 @@
           lb)))))
   
   
-  ;; Lex buffer is NOT thread safe
-  ;; c = char | eof
-  ;; lex-buf = 
-  ;;   (make-lex-buffer input-port int int int int)
-  (define-struct lex-buffer (ip peek-amt line-start col-start offset-start))
-
-  ;; make-lex-buf: input-port -> lex-buf
-  (define make-lex-buf
-    (case-lambda 
-     ((ip) 
-      (cond
-       ((not (input-port? ip))
-	(raise-type-error 'make-lex-buf "input-port" 0 ip))
-       (else
-        (port-count-lines! ip)
-	(make-lex-buffer ip 0 0 0 0))))
-     ((ip offsets)
-      (cond
-       ((not (input-port? ip))
-	(raise-type-error 'make-lex-buf "input-port" 0 ip offsets))
-       ((or (not (= 3 (length offsets)))
-	    (not (andmap integer? offsets))
-	    (not (andmap exact? offsets))
-	    (not (andmap (lambda (x) (>= x 0)) offsets)))
-	(raise-type-error 'make-lex-buf "list of 3 non-negative exact integers" 1 ip offsets))
-       (else
-        (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* ((peek-amt (lex-buffer-peek-amt lb))
-	   (str (peek-string 1 peek-amt (lex-buffer-ip lb))))
-      (set-lex-buffer-peek-amt! lb (add1 peek-amt))
-      str))
-
-  ;; get-match: lex-buf * int -> string
-  ;; reads the next i characters.
-  (define (get-match lb i)
-    (set-lex-buffer-peek-amt! lb 0)
-    (read-string i (lex-buffer-ip lb)))
-
   (define-struct position (offset line col))
-  (define (get-position lb)
-    (let-values (((line col off) (port-next-location (lex-buffer-ip lb))))
-      (if (and line col)
-	  (make-position (+ (lex-buffer-offset-start lb) off)
-			 (+ (lex-buffer-line-start lb) line)
-			 (if (= line 1)
-			     (+ (lex-buffer-col-start lb) col)
-			     col))
-	  (make-position (+ (lex-buffer-offset-start lb) off) #f #f))))
+  (define (get-position ip)
+    (let-values (((line col off) (port-next-location ip)))
+      (make-position off line col)))
 
 )