From d0b86a31d1c0520ed25f13879eb4b0e7b380ae82 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Tue, 18 Mar 2008 13:40:25 +0000
Subject: [PATCH] no need for the commented subtract-out, since it is swalloed
 by except-out now

svn: r9016
---
 collects/scheme/function.ss | 32 ++++++++++++++++++++++++++++++++
 collects/scheme/provide.ss  | 15 ---------------
 2 files changed, 32 insertions(+), 15 deletions(-)
 create mode 100644 collects/scheme/function.ss

diff --git a/collects/scheme/function.ss b/collects/scheme/function.ss
new file mode 100644
index 0000000000..fc9981a321
--- /dev/null
+++ b/collects/scheme/function.ss
@@ -0,0 +1,32 @@
+#lang scheme/base
+
+(provide negate curry)
+
+(define (negate f)
+  (unless (procedure? f) (raise-type-error 'negate "procedure" f))
+  (let-values ([(arity) (procedure-arity f)]
+               [(required-kws accepted-kws) (procedure-keywords f)])
+    (define negated
+      (if (and (null? required-kws) (null? accepted-kws))
+        ;; simple function
+        (if (equal? arity 1) ; optimize common case
+          (lambda (x) (not (f x)))
+          (lambda xs (not (apply f xs))))
+        ;; keyworded function
+        (make-keyword-procedure
+         (lambda (kws kw-args . rest)
+           (not (keyword-apply f kws kw-args rest))))))
+    negated))
+
+(define (curry f . args)
+  (unless (procedure? f) (raise-type-error 'curry "procedure" f))
+  (let loop ([args args])
+    (define curry
+      (if (null? args) ; always at least one step
+        (lambda more (loop more))
+        (lambda more
+          (let ([args (append args more)])
+            (if (procedure-arity-includes? f (length args))
+              (apply f args)
+              (loop args))))))
+    curry))
diff --git a/collects/scheme/provide.ss b/collects/scheme/provide.ss
index 9b5b212bf6..fe23f61825 100644
--- a/collects/scheme/provide.ss
+++ b/collects/scheme/provide.ss
@@ -13,18 +13,3 @@
           (filter (lambda (e)
                     (regexp-match? rx (symbol->string (export-out-sym e))))
                   (expand-export #'spec modes)))]))))
-
-#| Cute, and symmetric to subtract-in, but useless
-(provide subtract-out)
-(define-syntax subtract-out
-  (make-provide-transformer
-   (lambda (stx modes)
-     (syntax-case stx ()
-       [(_ spec specs ...)
-        (let* ([subs (map (lambda (spec) (expand-export spec modes))
-                          (syntax->list #'(specs ...)))]
-               [subs (map (lambda (i) (syntax-e (export-out-sym i)))
-                          (apply append subs))])
-          (filter (lambda (i) (not (memq (export-out-sym i) subs)))
-                  (expand-export #'spec modes)))]))))
-|#