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

Fix reading a 'line argument: always succeeds and returns the line as-is.

Browse Source
This commit is contained in:
Eli Barzilay 2011-07-18 15:39:18 -04:00
parent 261288c394
commit 09c8880ea0
1 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/xrepl/xrepl.rkt
View File

@ -164,16 +164,20 @@
(apply cmderror #:default-who 'getarg fmt args)) (apply cmderror #:default-who 'getarg fmt args))
(define (missing) (argerror "missing ~a argument" kind)) (define (missing) (argerror "missing ~a argument" kind))
(define (get read) (define (get read)
(define 1st (if (eq? #\newline (skip-spaces/peek)) eof (read))) (define (get-one)
(cond [(eq? read read-line-arg) (read)]
[(eq? #\newline (skip-spaces/peek)) eof]
[else (read)]))
(define (get-list)
(let ([x (get-one)]) (if (eof-object? x) '() (cons x (get-list)))))
(define 1st (get-one))
(define 1st? (not (eof-object? 1st))) (define 1st? (not (eof-object? 1st)))
(define (dflt*) (let ([r (dflt)]) (if (eof-object? r) (missing) r))) (define (dflt*) (let ([r (dflt)]) (if (eof-object? r) (missing) r)))
(case flag (case flag
[(req opt) (cond [1st? 1st] [dflt (dflt*)] [(req opt) (cond [1st? 1st] [dflt (dflt*)]
[(eq? 'opt flag) #f] [else (missing)])] [(eq? 'opt flag) #f] [else (missing)])]
[(list list+) [(list list+)
(define (more) (cond [1st? (cons 1st (get-list))] [dflt (list (dflt*))]
(if (eq? #\newline (skip-spaces/peek)) '() (cons (read) (more))))
(cond [1st? (cons 1st (more))] [dflt (list (dflt*))]
[(eq? 'list flag) '()] [else (missing)])] [(eq? 'list flag) '()] [else (missing)])]
[else (error 'getarg "unknown flag: ~e" flag)])) [else (error 'getarg "unknown flag: ~e" flag)]))
(define (read-string-arg) (define (read-string-arg)