diff --git a/collects/parser-tools/examples/calc.ss b/collects/parser-tools/examples/calc.ss index 9a3245b..0d5583d 100644 --- a/collects/parser-tools/examples/calc.ss +++ b/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,13 +84,11 @@ ;; 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))))) - (if result - (begin - (printf "~a~n" result) - (one-line))))))) - (one-line)))) + (letrec ((one-line + (lambda () + (let ((result (calcp (lambda () (calcl ip))))) + (if result + (begin + (printf "~a~n" result) + (one-line))))))) + (one-line)))) diff --git a/collects/parser-tools/examples/read.ss b/collects/parser-tools/examples/read.ss index 4cfb4bd..35096e3 100644 --- a/collects/parser-tools/examples/read.ss +++ b/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))) diff --git a/collects/parser-tools/lex.ss b/collects/parser-tools/lex.ss index e955214..6824cd6 100644 --- a/collects/parser-tools/lex.ss +++ b/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))) )