From 8ce4e110e6acb6d98570c2eced823f66af88797c Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Mon, 21 Dec 2009 08:05:48 +0000
Subject: [PATCH] better names for keyword functions (avoid possible confusion)
 better error

svn: r17377
---
 collects/scheme/foreign.ss | 18 ++++++++----------
 1 file changed, 8 insertions(+), 10 deletions(-)

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