suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

changed the module lexer's strategy to be able to handle

Browse Source 
the part of the buffer before the #lang line properly
  closes PR 11381
This commit is contained in:
Robby Findler 2011-02-08 17:28:01 -06:00 committed by Robby Findler
parent 9f18589c4f
commit d659d2f0af
2 changed files with 71 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
collects/syntax-color/module-lexer.rkt
View File

@ -1,45 +1,71 @@
#lang scheme/base #lang scheme/base
(require scheme/port (require scheme/port
"scheme-lexer.rkt") "scheme-lexer.rkt")
(provide module-lexer) (provide module-lexer)
#|
mode : (or/c #f 'before-lang-line
'no-lang-line
(cons lexer mode)
lexer)
the module lexer tracks any white-space and comments before
the #lang line (if any) explicitly by wrapping calls to the
scheme-lexer (in #f or 'before-lang-line mode).
Once it finds a non-white-space and non-comment
token, it checks to see if there is a #lang line and, if so
changes the mode to be the lexer that the #lang indicates,
delegating to it (the last two modes listed above).
If there is no #lang line, then it continues
to delegate to the scheme-lexer (in the 'no-lang-line mode).
|#
(define (module-lexer in offset mode) (define (module-lexer in offset mode)
(cond (cond
[(not mode) [(or (not mode) (eq? mode 'before-lang-line))
;; Starting out: look for #lang: (define lexer-port (peeking-input-port in))
(let*-values ([(p) (peeking-input-port in)] (port-count-lines! lexer-port)
[(init) (file-position p)] (define-values (lexeme type data raw-new-token-start raw-new-token-end) (scheme-lexer lexer-port))
[(start-line start-col start-pos) (port-next-location p)]) (define new-token-start (and raw-new-token-start (+ raw-new-token-start (file-position in))))
(let ([get-info (with-handlers ([exn:fail? (lambda (exn) 'fail)]) (define new-token-end (and raw-new-token-end (+ raw-new-token-end (file-position in))))
(read-language p (lambda () #f)))] (cond
[sync-ports (lambda () [(or (eq? type 'comment) (eq? type 'white-space))
(read-bytes (- (file-position p) init) in))]) (define lexer-end (file-position lexer-port))
(read-string lexer-end in) ;; sync ports
(values lexeme type data new-token-start new-token-end 0 'before-lang-line)]
[else
;; look for #lang:
(define p (peeking-input-port in))
(port-count-lines! p)
(define get-info (with-handlers ([exn:fail:read? values]) (read-language p (λ () 'fail))))
(cond (cond
[(procedure? get-info) [(procedure? get-info)
(define end-pos (file-position p))
(read-string end-pos in) ;; sync ports
;; Produce language as first token: ;; Produce language as first token:
(sync-ports)
(let-values ([(end-line end-col end-pos) (port-next-location in)])
(values (values
"#lang" "#lang"
'other 'other
#f #f
start-pos 1 ;; start-pos
end-pos (+ end-pos 1)
0 0
(or (let ([v (get-info 'color-lexer #f)]) (or (let ([v (get-info 'color-lexer #f)])
(and v (and v
(if (procedure-arity-includes? v 3) (if (procedure-arity-includes? v 3)
(cons v #f) (cons v #f)
v))) v)))
scheme-lexer)))] scheme-lexer))]
[(eq? 'fail get-info)
(sync-ports)
(let*-values ([(end-line end-col end-pos) (port-next-location in)])
(values #f 'error #f start-pos end-pos 0 scheme-lexer))]
[else [else
;; Start over using the Scheme lexer (read-string (file-position lexer-port) in) ;; sync ports
(module-lexer in offset scheme-lexer)])))] (values lexeme type data new-token-start new-token-end 0 'no-lang-line)])])]
[(eq? mode 'no-lang-line)
(let-values ([(lexeme type data new-token-start new-token-end)
(scheme-lexer in)])
(values lexeme type data new-token-start new-token-end 0 'no-lang-line))]
[(pair? mode) [(pair? mode)
;; #lang-selected language consumes and produces a mode: ;; #lang-selected language consumes and produces a mode:
(let-values ([(lexeme type data new-token-start new-token-end backup-delta new-mode) (let-values ([(lexeme type data new-token-start new-token-end backup-delta new-mode)