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

better names for keyword functions (avoid possible confusion)

Browse Source 
better error

svn: r17377
This commit is contained in:
Eli Barzilay 2009-12-21 08:05:48 +00:00
parent 1530411d94
commit 8ce4e110e6
1 changed files with 8 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/scheme/foreign.ss
View File

@ -542,7 +542,7 @@
(define (bind! x) (set! bind (append bind (list x)))) (define (bind! x) (set! bind (append bind (list x))))
(define (pre! x) (set! pre (append pre (list x)))) (define (pre! x) (set! pre (append pre (list x))))
(define (post! x) (set! post (append post (list x)))) (define (post! x) (set! post (append post (list x))))
(define-values (getkey setkey!) (define-values (kwd-ref kwd-set!)
(let ([ks '()]) (let ([ks '()])
(values (values
(lambda (k) (lambda (k)
@ -551,10 +551,8 @@
[else (error '_fun "internal error: unknown keyword: ~e" k)])) [else (error '_fun "internal error: unknown keyword: ~e" k)]))
(lambda (k-stx v) (lambda (k-stx v)
(let ([k (syntax-e k-stx)]) (let ([k (syntax-e k-stx)])
(cond [(assq k ks) (cond [(assq k ks) (err "duplicate keyword" k-stx)]
(err (format "duplicate ~s keyword" k) k-stx)] [(assq k _fun-keywords) (set! ks (cons (cons k v) ks))]
[(assq k _fun-keywords)
(set! ks (cons (cons k v) ks))]
[else (err "unknown keyword" k-stx)])))))) [else (err "unknown keyword" k-stx)]))))))
(define ((t-n-e clause) type name expr) (define ((t-n-e clause) type name expr)
(let ([keys (custom-type->keys type err)]) (let ([keys (custom-type->keys type err)])
@ -601,7 +599,7 @@
(let loop () (let loop ()
(let ([k (and (pair? xs) (pair? (cdr xs)) (car xs))]) (let ([k (and (pair? xs) (pair? (cdr xs)) (car xs))])
(when (keyword? (syntax-e k)) (when (keyword? (syntax-e k))
(setkey! k (cadr xs)) (kwd-set! k (cadr xs))
(set! xs (cddr xs)) (set! xs (cddr xs))
(loop)))) (loop))))
;; parse known punctuation ;; parse known punctuation
@ -663,11 +661,11 @@
(lambda (wrapper) (lambda (wrapper)
#`(_cprocedure* (list #,@(filter-map car inputs)) #`(_cprocedure* (list #,@(filter-map car inputs))
#,(car output) #,(car output)
#,(getkey '#:abi) #,(kwd-ref '#:abi)
#,wrapper #,wrapper
#,(getkey '#:keep) #,(kwd-ref '#:keep)
#,(getkey '#:atomic?) #,(kwd-ref '#:atomic?)
#,(getkey '#:save-errno)))]) #,(kwd-ref '#:save-errno)))])
(if (or (caddr output) input-names (ormap caddr inputs) (if (or (caddr output) input-names (ormap caddr inputs)
(ormap (lambda (x) (not (car x))) inputs) (ormap (lambda (x) (not (car x))) inputs)
(pair? bind) (pair? pre) (pair? post)) (pair? bind) (pair? pre) (pair? post))