From c586e46e548bd9d08c434af7473bea4deb925d5a Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 23 Jan 2008 18:11:02 +0000
Subject: [PATCH] scheme/bool and scheme/local

svn: r8394

original commit: 17d717a8baee404a1a88e10ba893fb943efb2653
---
 collects/mzlib/etc.ss | 81 +++----------------------------------------
 1 file changed, 5 insertions(+), 76 deletions(-)

diff --git a/collects/mzlib/etc.ss b/collects/mzlib/etc.ss
index 23d656c..d359662 100644
--- a/collects/mzlib/etc.ss
+++ b/collects/mzlib/etc.ss
@@ -2,6 +2,8 @@
 (module etc mzscheme
 
   (require (lib "main-collects.ss" "setup")
+           scheme/local
+           scheme/bool
            (only scheme/base 
                  build-string
                  build-list
@@ -12,16 +14,15 @@
   (require-for-syntax (lib "kerncase.ss" "syntax")
                       (lib "stx.ss" "syntax")
                       (lib "name.ss" "syntax")
-                      (lib "context.ss" "syntax")
                       (lib "main-collects.ss" "setup")
                       "private/stxset.ss")
 
-
-  (provide true false
-           boolean=? symbol=?
+  (provide boolean=? symbol=?
            identity
            compose
 
+           true false
+
            build-string
            build-vector
            build-list
@@ -49,9 +50,6 @@
 
            begin-lifted)
 
-  (define true #t)
-  (define false #f)
-
   (define identity (lambda (x) x))
 
   (define (loop-until start done? next body)
@@ -60,16 +58,6 @@
         (body i)
         (loop (next i)))))
 
-  (define (boolean=? x y)
-    (unless (and (boolean? x) (boolean? y))
-      (raise-type-error 'boolean=? "boolean" (if (boolean? x) y x)))
-    (eq? x y))
-
-  (define (symbol=? x y)
-    (unless (and (symbol? x) (symbol? y))
-      (raise-type-error 'symbol=? "symbol" (if (symbol? x) y x)))
-    (eq? x y))
-
  (define-syntax (opt-lambda stx)
    (with-syntax ([name (or (syntax-local-infer-name stx)
                            (quote-syntax opt-lambda-proc))])
@@ -118,65 +106,6 @@
             (syntax/loc stx
               (letrec ([name (case-lambda . clauses)]) name))))])))
 
- (define-syntax (local stx)
-   (syntax-case stx ()
-     [(_ (defn ...) body1 body ...)
-      (let ([defs (let ([expand-context (generate-expand-context)])
-                    (let loop ([defns (syntax->list (syntax (defn ...)))])
-                      (apply
-                       append
-                       (map
-                        (lambda (defn)
-                          (let ([d (local-expand
-                                    defn
-                                    expand-context
-                                    (kernel-form-identifier-list))]
-                                [check-ids (lambda (ids)
-                                             (for-each
-                                              (lambda (id)
-                                                (unless (identifier? id)
-                                                  (raise-syntax-error
-                                                   #f
-                                                   "not an identifier for definition"
-                                                   stx
-                                                   id)))
-                                              ids))])
-                            (syntax-case d (define-values define-syntaxes begin)
-                              [(begin defn ...)
-                               (loop (syntax->list (syntax (defn ...))))]
-                              [(define-values (id ...) body)
-                               (begin
-                                 (check-ids (syntax->list (syntax (id ...))))
-                                 (list d))]
-                              [(define-values . rest)
-                               (raise-syntax-error
-                                #f "ill-formed definition" stx d)]
-                              [(define-syntaxes (id ...) body)
-                               (begin
-                                 (check-ids (syntax->list (syntax (id ...))))
-                                 (list d))]
-                              [(define-syntaxes . rest)
-                               (raise-syntax-error
-                                #f "ill-formed definition" stx d)]
-                              [_else
-                               (raise-syntax-error
-                                #f "not a definition" stx defn)])))
-                        defns))))])
-        (let ([ids (apply append
-                          (map
-                           (lambda (d)
-                             (syntax-case d ()
-                               [(_ ids . __) (syntax->list (syntax ids))]))
-                           defs))])
-          (let ([dup (check-duplicate-identifier ids)])
-            (when dup
-              (raise-syntax-error #f "duplicate identifier" stx dup)))
-          (with-syntax ([(def ...) defs])
-            (syntax/loc stx
-              (let () def ... (let () body1 body ...))))))]
-     [(_ x body1 body ...)
-      (raise-syntax-error #f "not a definition sequence" stx (syntax x))]))
-
   ;; recur is another name for 'let' in a named let
   (define-syntax (recur stx)
     (syntax-case stx ()