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

* Misc reformatting and improvements (using for loops now)

Browse Source 
* Removed (unused) toplevel op/oprintf, and switch to scheme/unit
  (=> code outdented, but remember `-x -w' for svn diff/blame/etc)
* Remove unused `get-module-name-prefix'

svn: r10289
This commit is contained in:
Eli Barzilay 2008-06-16 15:49:07 +00:00
parent 76b90e7947
commit 1386b63116
1 changed files with 504 additions and 579 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

361
collects/drscheme/private/module-language.ss
View File

@ -1,8 +1,8 @@
#lang scheme/base #lang scheme/unit
(provide module-language@)
(require scheme/unit (require scheme/unit
scheme/class scheme/class
scheme/list
mred mred
compiler/embed compiler/embed
launcher launcher
@ -11,23 +11,19 @@
"drsig.ss" "drsig.ss"
scheme/contract) scheme/contract)
(define op (current-output-port)) (import [prefix drscheme:language-configuration: drscheme:language-configuration/internal^]
(define (oprintf . args) (apply fprintf op args))
(define-unit module-language@
(import [prefix drscheme:language-configuration: drscheme:language-configuration/internal^]
[prefix drscheme:language: drscheme:language^] [prefix drscheme:language: drscheme:language^]
[prefix drscheme:unit: drscheme:unit^] [prefix drscheme:unit: drscheme:unit^]
[prefix drscheme:rep: drscheme:rep^]) [prefix drscheme:rep: drscheme:rep^])
(export drscheme:module-language^) (export drscheme:module-language^)
(define module-language<%> (define module-language<%>
(interface () (interface ()
)) ))
;; add-module-language : -> void ;; add-module-language : -> void
;; adds the special module-only language to drscheme ;; adds the special module-only language to drscheme
(define (add-module-language) (define (add-module-language)
(define module-language% (define module-language%
(module-mixin (module-mixin
((drscheme:language:get-default-mixin) ((drscheme:language:get-default-mixin)
@ -35,37 +31,36 @@
(drscheme:language:simple-module-based-language->module-based-language-mixin (drscheme:language:simple-module-based-language->module-based-language-mixin
drscheme:language:simple-module-based-language%))))) drscheme:language:simple-module-based-language%)))))
(drscheme:language-configuration:add-language (drscheme:language-configuration:add-language
(instantiate module-language% ()))) (new module-language%)))
;; collection-paths : (listof (union 'default string)) ;; collection-paths : (listof (union 'default string))
;; command-line-args : (vectorof string) ;; command-line-args : (vectorof string)
(define-struct (module-language-settings drscheme:language:simple-settings) (define-struct (module-language-settings drscheme:language:simple-settings)
(collection-paths command-line-args)) (collection-paths command-line-args))
;; module-mixin : (implements drscheme:language:language<%>) ;; module-mixin : (implements drscheme:language:language<%>)
;; -> (implements drscheme:language:language<%>) ;; -> (implements drscheme:language:language<%>)
(define (module-mixin %) (define (module-mixin %)
(class* % (drscheme:language:language<%> module-language<%>) (class* % (drscheme:language:language<%> module-language<%>)
(define/override (use-namespace-require/copy?) #t) (define/override (use-namespace-require/copy?) #t)
(field [iteration-number 0]) (field [iteration-number 0])
(define/augment (capability-value key) (define/augment (capability-value key)
(cond (if (eq? key 'drscheme:autocomplete-words)
[(eq? key 'drscheme:autocomplete-words) (drscheme:language-configuration:get-all-scheme-manual-keywords)
(drscheme:language-configuration:get-all-scheme-manual-keywords)] (drscheme:language:get-capability-default key)))
[else (drscheme:language:get-capability-default key)]))
;; config-panel : as in super class ;; config-panel : as in super class
;; uses drscheme:language:simple-module-based-language-config-panel ;; uses drscheme:language:simple-module-based-language-config-panel and
;; and adds a collection paths configuration to it. ;; adds a collection paths configuration to it.
(define/override (config-panel parent) (define/override (config-panel parent)
(module-language-config-panel parent)) (module-language-config-panel parent))
(define/override (default-settings) (define/override (default-settings)
(let ([super-defaults (super default-settings)]) (let ([super-defaults (super default-settings)])
(apply make-module-language-settings (apply make-module-language-settings
(append (append (vector->list (drscheme:language:simple-settings->vector
(vector->list (drscheme:language:simple-settings->vector super-defaults)) super-defaults))
(list '(default) (list '(default)
#()))))) #())))))
@ -106,15 +101,13 @@
(super on-execute settings run-in-user-thread) (super on-execute settings run-in-user-thread)
(run-in-user-thread (run-in-user-thread
(λ () (λ ()
(current-command-line-arguments (module-language-settings-command-line-args settings)) (current-command-line-arguments
(module-language-settings-command-line-args settings))
(let ([default (current-library-collection-paths)]) (let ([default (current-library-collection-paths)])
(current-library-collection-paths (current-library-collection-paths
(apply (append-map
append (λ (x) (if (symbol? x) default (list x)))
(map (λ (x) (if (symbol? x) (module-language-settings-collection-paths settings)))))))
default
(list x)))
(module-language-settings-collection-paths settings))))))))
(define/override (get-one-line-summary) (define/override (get-one-line-summary)
(string-constant module-language-one-line-summary)) (string-constant module-language-one-line-summary))
@ -122,8 +115,7 @@
(inherit get-reader) (inherit get-reader)
(define/override (front-end/interaction port settings) (define/override (front-end/interaction port settings)
(if (thread-cell-ref hopeless-repl) (if (thread-cell-ref hopeless-repl)
(begin (begin (display "Module Language: " (current-error-port))
(display "Module Language: " (current-error-port))
(display hopeless-message (current-error-port)) (display hopeless-message (current-error-port))
(newline (current-error-port)) (newline (current-error-port))
(λ x eof)) (λ x eof))
@ -133,8 +125,6 @@
(let* ([super-thunk (λ () ((get-reader) (object-name port) port))] (let* ([super-thunk (λ () ((get-reader) (object-name port) port))]
[path (get-filename port)] [path (get-filename port)]
[module-name #f] [module-name #f]
[module-name-prefix (get-module-name-prefix path)]
[get-require-module-name [get-require-module-name
(λ () (λ ()
;; "clearing out" the module-name via datum->syntax ensures ;; "clearing out" the module-name via datum->syntax ensures
@ -143,13 +133,13 @@
(datum->syntax #'here (syntax-e module-name)))]) (datum->syntax #'here (syntax-e module-name)))])
(λ () (λ ()
(set! iteration-number (+ iteration-number 1)) (set! iteration-number (+ iteration-number 1))
(cond (case iteration-number
[(= 1 iteration-number) [(1)
#`(current-module-declare-name #`(current-module-declare-name
(if #,path (if #,path
(make-resolved-module-path '#,path) (make-resolved-module-path '#,path)
#f))] #f))]
[(= 2 iteration-number) [(2)
(let ([super-result (super-thunk)]) (let ([super-result (super-thunk)])
(if (eof-object? super-result) (if (eof-object? super-result)
(raise-syntax-error 'Module\ Language hopeless-message) (raise-syntax-error 'Module\ Language hopeless-message)
@ -157,7 +147,7 @@
(transform-module path super-result)]) (transform-module path super-result)])
(set! module-name name) (set! module-name name)
new-module)))] new-module)))]
[(= 3 iteration-number) [(3)
(let ([super-result (super-thunk)]) (let ([super-result (super-thunk)])
(if (eof-object? super-result) (if (eof-object? super-result)
#`(begin #`(begin
@ -173,25 +163,18 @@
'module-language 'module-language
"there can only be one expression in the definitions window" "there can only be one expression in the definitions window"
super-result)))] super-result)))]
[(= 4 iteration-number) [(4)
(if path (if path
#`(#%app current-namespace (#%app module->namespace #,path))
#`(#%app current-namespace #`(#%app current-namespace
(#%app (#%app module->namespace
module->namespace
#,path))
#`(#%app current-namespace
(#%app
module->namespace
''#,(get-require-module-name))))] ''#,(get-require-module-name))))]
[else eof])))) [else eof]))))
;; printer settings are just ignored here. ;; printer settings are just ignored here.
(define/override (create-executable setting parent program-filename) (define/override (create-executable setting parent program-filename)
(let* ([executable-specs (drscheme:language:create-executable-gui (let* ([executable-specs (drscheme:language:create-executable-gui
parent parent program-filename #t #t)])
program-filename
#t
#t)])
(when executable-specs (when executable-specs
(let ([launcher? (eq? 'launcher (car executable-specs))] (let ([launcher? (eq? 'launcher (car executable-specs))]
[gui? (eq? 'mred (cadr executable-specs))] [gui? (eq? 'mred (cadr executable-specs))]
@ -231,12 +214,12 @@
executable-filename)))))))) executable-filename))))))))
(super-new (super-new
(module #f) [module #f]
(language-position (list "Module")) [language-position (list "Module")]
(language-numbers (list -32768))))) [language-numbers (list -32768)])))
(define hopeless-repl (make-thread-cell #t)) (define hopeless-repl (make-thread-cell #t))
(define hopeless-message (define hopeless-message
(string-append (string-append
"There must be a module in the\n" "There must be a module in the\n"
"definitions window. Try starting your program with\n" "definitions window. Try starting your program with\n"
@ -245,72 +228,73 @@
"\n" "\n"
"and clicking ‘Run’.")) "and clicking ‘Run’."))
;; module-language-config-panel : panel -> (case-> (-> settings) (settings -> void)) ;; module-language-config-panel : panel -> (case-> (-> settings) (settings -> void))
(define (module-language-config-panel parent) (define (module-language-config-panel parent)
(define new-parent (define new-parent
(instantiate vertical-panel% () (new vertical-panel%
(parent parent) [parent parent]
(alignment '(center center)) [alignment '(center center)]
(stretchable-height #f) [stretchable-height #f]
(stretchable-width #f))) [stretchable-width #f]))
(define simple-case-lambda (drscheme:language:simple-module-based-language-config-panel new-parent)) (define simple-case-lambda
(define cp-panel (instantiate group-box-panel% () (drscheme:language:simple-module-based-language-config-panel new-parent))
(parent new-parent) (define cp-panel (new group-box-panel%
(label (string-constant ml-cp-collection-paths)))) [parent new-parent]
[label (string-constant ml-cp-collection-paths)]))
(define args-panel (instantiate group-box-panel% () (define args-panel (new group-box-panel%
(parent new-parent) [parent new-parent]
(label (string-constant ml-command-line-arguments)))) [label (string-constant ml-command-line-arguments)]))
(define args-text-box (new text-field% (define args-text-box (new text-field%
(parent args-panel) [parent args-panel]
(label #f) [label #f]
(init-value "#()") [init-value "#()"]
(callback void))) [callback void]))
;; data associated with each item in listbox : boolean ;; data associated with each item in listbox : boolean
;; indicates if the entry is the default paths. ;; indicates if the entry is the default paths.
(define lb (instantiate list-box% () (define lb (new list-box%
(parent cp-panel) [parent cp-panel]
(choices '("a" "b" "c")) [choices '("a" "b" "c")]
(label #f) [label #f]
(callback (λ (x y) (update-buttons))))) [callback (λ (x y) (update-buttons))]))
(define button-panel (instantiate horizontal-panel% () (define button-panel (new horizontal-panel%
(parent cp-panel) [parent cp-panel]
(alignment '(center center)) [alignment '(center center)]
(stretchable-height #f))) [stretchable-height #f]))
(define add-button (make-object button% (string-constant ml-cp-add) button-panel (define add-button
(make-object button% (string-constant ml-cp-add) button-panel
(λ (x y) (add-callback)))) (λ (x y) (add-callback))))
(define add-default-button (make-object button% (string-constant ml-cp-add-default) button-panel (define add-default-button
(make-object button% (string-constant ml-cp-add-default) button-panel
(λ (x y) (add-default-callback)))) (λ (x y) (add-default-callback))))
(define remove-button (make-object button% (string-constant ml-cp-remove) button-panel (define remove-button
(make-object button% (string-constant ml-cp-remove) button-panel
(λ (x y) (remove-callback)))) (λ (x y) (remove-callback))))
(define raise-button (make-object button% (string-constant ml-cp-raise) button-panel (define raise-button
(λ (x y) (raise-callback)))) (make-object button% (string-constant ml-cp-raise) button-panel
(define lower-button (make-object button% (string-constant ml-cp-lower) button-panel (λ (x y) (move-callback -1))))
(λ (x y) (lower-callback)))) (define lower-button
(make-object button% (string-constant ml-cp-lower) button-panel
(λ (x y) (move-callback +1))))
(define (update-buttons) (define (update-buttons)
(let ([lb-selection (send lb get-selection)] (let ([lb-selection (send lb get-selection)]
[lb-tot (send lb get-number)]) [lb-tot (send lb get-number)])
(send remove-button enable lb-selection) (send remove-button enable lb-selection)
(send raise-button enable (send raise-button enable (and lb-selection (not (= lb-selection 0))))
(and lb-selection
(not (= lb-selection 0))))
(send lower-button enable (send lower-button enable
(and lb-selection (and lb-selection (not (= lb-selection (- lb-tot 1)))))))
(not (= lb-selection (- lb-tot 1)))))))
(define (add-callback) (define (add-callback)
(let ([dir (get-directory (let ([dir (get-directory (string-constant ml-cp-choose-a-collection-path)
(string-constant ml-cp-choose-a-collection-path)
(send parent get-top-level-window))]) (send parent get-top-level-window))])
(when dir (when dir
(send lb append (path->string dir) #f) (send lb append (path->string dir) #f)
(update-buttons)))) (update-buttons))))
(define (add-default-callback) (define (add-default-callback)
(cond (cond [(has-default?)
[(has-default?)
(message-box (string-constant drscheme) (message-box (string-constant drscheme)
(string-constant ml-cp-default-already-present) (string-constant ml-cp-default-already-present)
(send parent get-top-level-window))] (send parent get-top-level-window))]
@ -322,8 +306,7 @@
;; returns #t if the `default' entry has already been added ;; returns #t if the `default' entry has already been added
(define (has-default?) (define (has-default?)
(let loop ([n (send lb get-number)]) (let loop ([n (send lb get-number)])
(cond (cond [(= n 0) #f]
[(= n 0) #f]
[(send lb get-data (- n 1)) #t] [(send lb get-data (- n 1)) #t]
[else (loop (- n 1))]))) [else (loop (- n 1))])))
@ -331,84 +314,54 @@
(let ([to-delete (send lb get-selection)]) (let ([to-delete (send lb get-selection)])
(send lb delete to-delete) (send lb delete to-delete)
(unless (zero? (send lb get-number)) (unless (zero? (send lb get-number))
(send lb set-selection (min to-delete (send lb set-selection (min to-delete (- (send lb get-number) 1))))
(- (send lb get-number) 1))))
(update-buttons))) (update-buttons)))
(define (lower-callback) (define (move-callback d)
(let* ([sel (send lb get-selection)] (let* ([sel (send lb get-selection)]
[vec (get-lb-vector)] [vec (get-lb-vector)]
[below (vector-ref vec (+ sel 1))]) [new (+ sel d)]
(vector-set! vec (+ sel 1) (vector-ref vec sel)) [other (vector-ref vec new)])
(vector-set! vec sel below) (vector-set! vec new (vector-ref vec sel))
(vector-set! vec sel other)
(set-lb-vector vec) (set-lb-vector vec)
(send lb set-selection (+ sel 1)) (send lb set-selection new)
(update-buttons)))
(define (raise-callback)
(let* ([sel (send lb get-selection)]
[vec (get-lb-vector)]
[above (vector-ref vec (- sel 1))])
(vector-set! vec (- sel 1) (vector-ref vec sel))
(vector-set! vec sel above)
(set-lb-vector vec)
(send lb set-selection (- sel 1))
(update-buttons))) (update-buttons)))
(define (get-lb-vector) (define (get-lb-vector)
(list->vector (list->vector (for/list ([n (in-range (send lb get-number))])
(let loop ([n 0]) (cons (send lb get-string n) (send lb get-data n)))))
(cond
[(= n (send lb get-number)) null]
[else (cons (cons (send lb get-string n)
(send lb get-data n))
(loop (+ n 1)))]))))
(define (set-lb-vector vec) (define (set-lb-vector vec)
(send lb clear) (send lb clear)
(let loop ([n 0]) (for ([x (in-vector vec)] [n (in-naturals)])
(cond (send lb append (car x))
[(= n (vector-length vec)) (void)] (send lb set-data n (cdr x))))
[else (send lb append (car (vector-ref vec n)))
(send lb set-data n (cdr (vector-ref vec n)))
(loop (+ n 1))])))
(define (get-collection-paths) (define (get-collection-paths)
(let loop ([n 0]) (for/list ([n (in-range (send lb get-number))])
(cond
[(= n (send lb get-number)) null]
[else
(let ([data (send lb get-data n)]) (let ([data (send lb get-data n)])
(cons (if data (if data 'default (send lb get-string n)))))
'default
(send lb get-string n))
(loop (+ n 1))))])))
(define (install-collection-paths paths) (define (install-collection-paths paths)
(send lb clear) (send lb clear)
(for-each (λ (cp) (for ([cp paths])
(if (symbol? cp) (if (symbol? cp)
(send lb append (send lb append (string-constant ml-cp-default-collection-path) #t)
(string-constant ml-cp-default-collection-path) (send lb append cp #f))))
#t)
(send lb append cp #f)))
paths))
(define (get-command-line-args) (define (get-command-line-args)
(let ([str (send args-text-box get-value)]) (let* ([str (send args-text-box get-value)]
(let ([read-res (parameterize ([read-accept-graph #f]) [read-res (parameterize ([read-accept-graph #f])
(with-handlers ([exn:fail:read? (λ (x) #())]) (with-handlers ([exn:fail:read? (λ (x) #())])
(read (open-input-string str))))]) (read (open-input-string str))))])
(cond (if (and (vector? read-res) (andmap string? (vector->list read-res)))
[(and (vector? read-res) read-res
(andmap string? (vector->list read-res))) #())))
read-res]
[else #()]))))
(define (install-command-line-args vec) (define (install-command-line-args vec)
(send args-text-box set-value (send args-text-box set-value
(parameterize ([print-vector-length #f]) (parameterize ([print-vector-length #f]) (format "~s" vec))))
(format "~s" vec))))
(send lb set '()) (send lb set '())
(update-buttons) (update-buttons)
@ -417,22 +370,24 @@
[() [()
(let ([simple-settings (simple-case-lambda)]) (let ([simple-settings (simple-case-lambda)])
(apply make-module-language-settings (apply make-module-language-settings
(append (append (vector->list (drscheme:language:simple-settings->vector
(vector->list (drscheme:language:simple-settings->vector simple-settings)) simple-settings))
(list (get-collection-paths) (list (get-collection-paths)
(get-command-line-args)))))] (get-command-line-args)))))]
[(settings) [(settings)
(simple-case-lambda settings) (simple-case-lambda settings)
(install-collection-paths (module-language-settings-collection-paths settings)) (install-collection-paths
(install-command-line-args (module-language-settings-command-line-args settings)) (module-language-settings-collection-paths settings))
(install-command-line-args
(module-language-settings-command-line-args settings))
(update-buttons)])) (update-buttons)]))
;; transform-module : (union #f string) syntax syntax -> (values symbol[name-of-module] syntax[module]) ;; transform-module : (union #f string) syntax syntax -> (values symbol[name-of-module] syntax[module])
;; = User = ;; = User =
;; in addition to exporting everything, the result module's name ;; in addition to exporting everything, the result module's name
;; is the fully path-expanded name with a directory prefix, ;; is the fully path-expanded name with a directory prefix,
;; if the file has been saved ;; if the file has been saved
(define (transform-module filename stx) (define (transform-module filename stx)
(syntax-case* stx (module) (λ (x y) (eq? (syntax-e x) (syntax-e y))) (syntax-case* stx (module) (λ (x y) (eq? (syntax-e x) (syntax-e y)))
[(module . rest) [(module . rest)
(syntax-case stx () (syntax-case stx ()
@ -440,13 +395,11 @@
(let ([v-name (syntax name)]) (let ([v-name (syntax name)])
(when filename (check-filename-matches filename #'name stx)) (when filename (check-filename-matches filename #'name stx))
(thread-cell-set! hopeless-repl #f) (thread-cell-set! hopeless-repl #f)
(values v-name (values
v-name
;; rewrite the module to use the scheme/base version of `module' ;; rewrite the module to use the scheme/base version of `module'
(datum->syntax stx (datum->syntax stx
(cons (datum->syntax #'here (cons (datum->syntax #'here 'module #'form) #'rest)
'module
#'form)
#'rest)
stx)))] stx)))]
[_ [_
(raise-syntax-error 'module-language (raise-syntax-error 'module-language
@ -460,29 +413,9 @@
"only module expressions are allowed" "only module expressions are allowed"
stx)])) stx)]))
;; get-module-name-prefix : path -> string ;; get-filename : port -> (union string #f)
;; returns the symbol that gets passed the current-module-name-prefix ;; extracts the file the definitions window is being saved in, if any.
;; while evaluating/expanding the module. (define (get-filename port)
(define (get-module-name-prefix path)
(and path
(let-values ([(base name dir)
(split-path (normal-case-path (simplify-path (expand-user-path path) #f)))])
(string->symbol (format ",~a" (bytes->string/latin-1 (path->bytes base)))))))
;; build-name : path -> symbol
(define (build-name pre-path)
(let ([path (normal-case-path (simplify-path (expand-user-path pre-path) #f))])
(let-values ([(base name dir) (split-path path)])
(string->symbol (format ",~a"
(bytes->string/latin-1
(path->bytes
(build-path
base
(path-replace-suffix name #"")))))))))
;; get-filename : port -> (union string #f)
;; extracts the file the definitions window is being saved in, if any.
(define (get-filename port)
(let ([source (object-name port)]) (let ([source (object-name port)])
(cond (cond
[(path? source) source] [(path? source) source]
@ -500,16 +433,16 @@
filename))))))] filename))))))]
[else #f]))) [else #f])))
;; check-filename-matches : string datum syntax -> void ;; check-filename-matches : string datum syntax -> void
(define (check-filename-matches filename name unexpanded-stx) (define (check-filename-matches filename name unexpanded-stx)
(define datum (syntax-e name)) (define datum (syntax-e name))
(unless (symbol? datum) (unless (symbol? datum)
(raise-syntax-error 'module-language (raise-syntax-error 'module-language
"bad syntax in name position of module" "bad syntax in name position of module"
unexpanded-stx name)) unexpanded-stx name))
(let-values ([(base name dir?) (split-path filename)]) (let-values ([(base name dir?) (split-path filename)])
(let* ([expected (string->symbol (path->string (let ([expected (string->symbol
(path-replace-suffix name #"")))]) (path->string (path-replace-suffix name #"")))])
(unless (equal? expected datum) (unless (equal? expected datum)
(raise-syntax-error (raise-syntax-error
'module-language 'module-language
@ -518,13 +451,12 @@
expected) expected)
unexpanded-stx))))) unexpanded-stx)))))
(define module-language-put-file-mixin (define module-language-put-file-mixin
(mixin (text:basic<%>) () (mixin (text:basic<%>) ()
(inherit get-text last-position get-character get-top-level-window) (inherit get-text last-position get-character get-top-level-window)
(define/override (put-file directory default-name) (define/override (put-file directory default-name)
(let ([tlw (get-top-level-window)]) (let ([tlw (get-top-level-window)])
(if (and tlw (if (and tlw (is-a? tlw drscheme:unit:frame<%>))
(is-a? tlw drscheme:unit:frame<%>))
(let* ([definitions-text (send tlw get-definitions-text)] (let* ([definitions-text (send tlw get-definitions-text)]
[module-language? [module-language?
(is-a? (drscheme:language-configuration:language-settings-language (is-a? (drscheme:language-configuration:language-settings-language
@ -559,8 +491,7 @@
(define/private (matches start string) (define/private (matches start string)
(let ([last-pos (last-position)]) (let ([last-pos (last-position)])
(let loop ([i 0]) (let loop ([i 0])
(cond (cond [(and (i . < . (string-length string))
[(and (i . < . (string-length string))
((+ i start) . < . last-pos)) ((+ i start) . < . last-pos))
(and (char=? (string-ref string i) (and (char=? (string-ref string i)
(get-character (+ i start))) (get-character (+ i start)))
@ -571,24 +502,18 @@
(define/private (skip-whitespace start) (define/private (skip-whitespace start)
(let ([last-pos (last-position)]) (let ([last-pos (last-position)])
(let loop ([pos start]) (let loop ([pos start])
(cond (if (pos . >= . last-pos)
[(pos . >= . last-pos) last-pos] last-pos
[else
(let ([char (get-character pos)]) (let ([char (get-character pos)])
(cond (if (char-whitespace? char)
[(char-whitespace? char) (loop (+ pos 1))
(loop (+ pos 1))] pos))))))
[else pos]))]))))
(define/private (skip-to-whitespace start) (define/private (skip-to-whitespace start)
(let ([last-pos (last-position)]) (let ([last-pos (last-position)])
(let loop ([pos start]) (let loop ([pos start])
(cond (cond [(pos . >= . last-pos) last-pos]
[(pos . >= . last-pos) [(char-whitespace? (get-character pos)) pos]
last-pos] [else (loop (+ pos 1))]))))
[(char-whitespace? (get-character pos))
pos]
[else
(loop (+ pos 1))]))))
(super-new)))) (super-new)))