From 59d90b279d860e00688dcb1723e265e36e594740 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 21 Apr 2010 12:14:17 -0400
Subject: [PATCH 01/16] improved support for #lang planet (in drscheme)

---
 .../drscheme/private/module-language-tools.ss | 41 ++++++++++-------
 collects/drscheme/private/module-language.ss  | 11 +----
 collects/planet/lang/reader.ss                | 45 ++++++++++++-------
 collects/planet/planet.scrbl                  | 28 ++++++++++++
 collects/planet/resolver.ss                   | 18 ++++++--
 collects/planet/util.ss                       |  7 ++-
 collects/syntax-color/module-lexer.ss         | 11 +----
 collects/syntax/module-reader.ss              |  2 +-
 8 files changed, 104 insertions(+), 59 deletions(-)

diff --git a/collects/drscheme/private/module-language-tools.ss b/collects/drscheme/private/module-language-tools.ss
index 8baaff58b2..73bc52053d 100644
--- a/collects/drscheme/private/module-language-tools.ss
+++ b/collects/drscheme/private/module-language-tools.ss
@@ -9,6 +9,9 @@
          scheme/gui/base
          "drsig.ss")
 
+(define op (current-output-port))
+(define (oprintf . args) (apply fprintf op args))
+
 (define-unit module-language-tools@
   (import [prefix drscheme:unit: drscheme:unit^]
           [prefix drscheme:module-language: drscheme:module-language^]
@@ -18,7 +21,7 @@
 
   (define-local-member-name initialized? move-to-new-language)
 
-  (define-struct opt-out-toolbar-button (make-button id))
+  (define-struct opt-out-toolbar-button (make-button id) #:transparent)
   (define opt-out-toolbar-buttons '())
   
   (define (add-opt-out-toolbar-button make-button id) 
@@ -98,18 +101,18 @@
       
       (define/public (move-to-new-language)
         (let* ([port (open-input-text-editor this)]
+               ;; info-result : (or/c #f   [#lang without a known language]
+               ;;                     (vector <get-info-proc>) [no #lang line, so we use the '#lang racket' info proc]
+               ;;                     <get-info-proc>  [the get-info proc for the program in the definitions]
                [info-result (with-handlers ((exn:fail? (λ (x) #f)))
-                              (parameterize ([current-reader-guard
-                                              (let ([old (current-reader-guard)])
-                                                (lambda (g)
-                                                  (if (and (pair? g)
-                                                           (eq? (car g) 'planet))
-                                                      (error "#lang planet disbled")
-                                                      (old g))))])
-                                ;; FIXME: do something so that we don't
-                                ;; have to disable all planet packages.
-                                (read-language port (lambda () #f))))])
-          ;; sometimes I get eof here, but I don't know why and can't seem to 
+                              (read-language 
+                               port
+                               (lambda () 
+                                 ;; fall back to whatever #lang racket does if
+                                 ;; we don't have a #lang line present in the file
+                                 (vector (read-language (open-input-string "#lang racket"))))))])
+          
+          ; sometimes I get eof here, but I don't know why and can't seem to 
           ;; make it happen outside of DrScheme
           (when (eof-object? info-result)
             (fprintf (current-error-port) "file ~s produces eof from read-language\n"
@@ -128,10 +131,18 @@
                  (contract (or/c #f (listof (list/c string?
                                                     (is-a?/c bitmap%)
                                                     (-> (is-a?/c drscheme:unit:frame<%>) any))))
-                           (info-result 'drscheme:toolbar-buttons #f)
-                           (get-lang-name pos)
+                           ((if (vector? info-result)
+                                (vector-ref info-result 0)
+                                info-result)
+                            'drscheme:toolbar-buttons #f)
+                           (if (vector? info-result)
+                               'hash-lang-racket
+                               (get-lang-name pos))
                            'drscheme/private/module-language-tools)
-                 (info-result 'drscheme:opt-out-toolbar-buttons '())))))))
+                 ((if (vector? info-result)
+                      (vector-ref info-result 0)
+                      info-result)
+                  'drscheme:opt-out-toolbar-buttons '())))))))
 
       (inherit get-tab)
       
diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss
index 98ab117a4d..7c09d02989 100644
--- a/collects/drscheme/private/module-language.ss
+++ b/collects/drscheme/private/module-language.ss
@@ -63,15 +63,8 @@
         (let* ([defs-port (open-input-text-editor defs-text)]
                [read-successfully?
                 (with-handlers ((exn:fail? (λ (x) #f)))
-                  (let/ec k
-                    (let ([orig-security (current-security-guard)])
-                      (parameterize ([current-security-guard
-                                      (make-security-guard
-                                       orig-security
-                                       (lambda (what path modes) #t)
-                                       (lambda (what host port mode) (k #f)))])
-                        (read-language defs-port (λ () (void)))
-                        #t))))])
+                  (read-language defs-port (λ () #f))
+                  #t)])
           (cond
             [read-successfully?
              (let* ([str (send defs-text get-text 0 (file-position defs-port))]
diff --git a/collects/planet/lang/reader.ss b/collects/planet/lang/reader.ss
index 09a8aaf71c..2b5e5ea212 100644
--- a/collects/planet/lang/reader.ss
+++ b/collects/planet/lang/reader.ss
@@ -1,19 +1,30 @@
-(module reader scheme/base
-  (require syntax/module-reader)
+#lang scheme/base
+(require syntax/module-reader
+         "../resolver.ss")
 
-  (provide (rename-out [planet-read read]
-                       [planet-read-syntax read-syntax]
-                       [planet-get-info get-info]))
+(provide (rename-out [planet-read read]
+                     [planet-read-syntax read-syntax]
+                     [planet-get-info get-info]))
+
+(define (str->spec str)
+  (let ([str (bytes->string/latin-1 str)])
+    (if (module-path? `(planet ,(string->symbol str)))
+        `(planet ,(string->symbol (string-append str "/lang/reader")))
+        #f)))
+
+(define-values (planet-read planet-read-syntax real-planet-get-info)
+  (make-meta-reader
+   'planet
+   "planet path"
+   str->spec
+   values
+   values
+   values))
+
+(define op (current-output-port))
+
+(define (planet-get-info inport module-path line col pos)
+  (parameterize ([install? #f]
+                 [download? #f])
+    (real-planet-get-info inport module-path line col pos)))
 
-  (define-values (planet-read planet-read-syntax planet-get-info)
-    (make-meta-reader
-     'planet
-     "planet path"
-     (lambda (str)
-       (let ([str (bytes->string/latin-1 str)])
-         (if (module-path? `(planet ,(string->symbol str)))
-           `(planet ,(string->symbol (string-append str "/lang/reader")))
-           #f)))
-     values
-     values
-     values)))
diff --git a/collects/planet/planet.scrbl b/collects/planet/planet.scrbl
index b134c2c96f..511b4f1b05 100644
--- a/collects/planet/planet.scrbl
+++ b/collects/planet/planet.scrbl
@@ -463,6 +463,30 @@ The @schememodname[planet] module (as opposed to the reader used with
 
 The planet collection provides configuration and utilities for using PLaneT. 
 
+@subsection{Resolver}
+
+@defmodule[planet/resolver]
+
+The primary purpose of this library to for @scheme[require] to find
+@PLaneT packages. It also, however, provides some utilities for manipulating
+the resolvers behavior.
+
+@defproc[(resolve-planet-path [planet-path any/c]) path?]{
+  Returns the path where the file named by the require spec @scheme[planet-path] is located in the current installation.
+}
+
+@defparam[download? dl? boolean?]{
+  A parameter that controls if @PLaneT attempts to download a planet package that isn't already present.
+  If the package isn't present, the resolver will raise the @scheme[exn:fail:planet?] exception
+  instead of downloading it.
+}
+
+@defparam[install? inst? boolean?]{
+  A parameter that controls if @PLaneT attempts to install a planet package that isn't already installed.                                  
+  If the package isn't installed, the resolver will raise the @scheme[exn:fail:planet?] exception
+  instead of installing it.
+}
+
 @subsection{Client Configuration}
 
 @defmodule[planet/config]
@@ -659,6 +683,10 @@ context of a package. The others are convenience macros that
 select out the relevant field, or return @scheme[#f] if the expression
 appears outside the context of a PLaneT package.}
 
+@defproc[(exn:fail:planet? [val any/c]) boolean?]{
+  Returns @scheme[#t] if @scheme[val] is                                                   
+}
+
 @subsection{Terse Status Updates}
 
 @defmodule[planet/terse-info]
diff --git a/collects/planet/resolver.ss b/collects/planet/resolver.ss
index ddedc5be34..e7bc4fa9c4 100644
--- a/collects/planet/resolver.ss
+++ b/collects/planet/resolver.ss
@@ -212,10 +212,16 @@ subdirectory.
          pkg-promise->pkg
          install-pkg
          get-planet-module-path/pkg
-         install?)
+         download?
+         install?
+         exn:fail:planet?
+         make-exn:fail:planet)
 
-;; if #f, will not install packages and instead give an error
+;; if #f, will not install packages and instead raise a exn:fail:install? error
 (define install? (make-parameter #t))
+;; if #f, will not download packages and instead raise a exn:fail:install? error
+(define download? (make-parameter #t))
+(define-struct (exn:fail:planet exn:fail) ())
 
 ;; update doc index only once for a set of installs:
 (define planet-nested-install (make-parameter #f))
@@ -511,6 +517,12 @@ subdirectory.
      (string-append "PLaneT could not download the requested package: " s)]))
 
 (define (download-package pkg)
+  (unless (download?)
+    (raise (make-exn:fail:planet
+            (format
+             "PLaneT error: cannot download package ~s since the download? parameter is set to #f"
+             (list (car (pkg-spec-path pkg)) (pkg-spec-name pkg)))
+            (current-continuation-marks))))
   ((if (USE-HTTP-DOWNLOADS?) download-package/http download-package/planet)
    pkg))
 
@@ -539,7 +551,7 @@ subdirectory.
 ;; installed file
 (define (install-pkg pkg path maj min)
   (unless (install?)
-    (raise (make-exn:fail
+    (raise (make-exn:fail:planet
             (format
              "PLaneT error: cannot install package ~s since the install? parameter is set to #f"
              (list (car (pkg-spec-path pkg)) (pkg-spec-name pkg) maj min))
diff --git a/collects/planet/util.ss b/collects/planet/util.ss
index 275afacb56..f4cf303d95 100644
--- a/collects/planet/util.ss
+++ b/collects/planet/util.ss
@@ -41,12 +41,13 @@
  unlink-all
  lookup-package-by-keys
  resolve-planet-path
- (struct-out exn:fail:planet)
  display-plt-file-structure
  display-plt-archived-file
  get-package-from-cache
  install-pkg
- pkg->download-url)
+ pkg->download-url
+ exn:fail:planet?
+ make-exn:fail:planet)
 
 (provide/contract
  [get-package-spec
@@ -103,8 +104,6 @@
 ;;   -- remove any existing linkage for package
 ;; returns void if the removal worked; raises an exception if no package existed.
 
-(define-struct (exn:fail:planet exn:fail) ())
-
 (define (remove-pkg owner name maj min)
   (let ((p (get-installed-package owner name maj min)))
     (unless p
diff --git a/collects/syntax-color/module-lexer.ss b/collects/syntax-color/module-lexer.ss
index 9d476f48d5..4c4d015e37 100644
--- a/collects/syntax-color/module-lexer.ss
+++ b/collects/syntax-color/module-lexer.ss
@@ -12,16 +12,7 @@
                   [(init) (file-position p)]
                   [(start-line start-col start-pos) (port-next-location p)])
       (let ([get-info (with-handlers ([exn:fail? (lambda (exn) 'fail)])
-                        (parameterize ([current-reader-guard
-                                        (let ([old (current-reader-guard)])
-                                          (lambda (g)
-                                            (if (and (pair? g)
-                                                     (eq? (car g) 'planet))
-                                                (error "#lang planet disbled")
-                                                (old g))))])
-                          ;; FIXME: do something so that we don't
-                          ;; have to disable all planet packages.
-                          (read-language p (lambda () #f))))]
+                        (read-language p (lambda () #f)))]
             [sync-ports (lambda ()
                           (read-bytes (- (file-position p) init) in))])
         (cond
diff --git a/collects/syntax/module-reader.ss b/collects/syntax/module-reader.ss
index 063d9fd239..4105778ce7 100644
--- a/collects/syntax/module-reader.ss
+++ b/collects/syntax/module-reader.ss
@@ -216,7 +216,7 @@
            #:read-spec
            [read-spec
             (lambda (in)
-              (let ([spec (regexp-try-match #px"^[ \t]+(.*?)(?=\\s|$)" in)])
+              (let ([spec (regexp-try-match #px"^[ \t]+(.*?)(?=\\s|$)" in)]) ;; if this changes, the regexp in planet's lang/reader.ss must also change
                 (and spec (let ([s (cadr spec)])
                             (if (equal? s "") #f s)))))])
     (define (get in export-sym src line col pos spec-as-stx? mk-fail-thunk)

From 3c761371248f2600286b54b0c55658ad910ce1bd Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Wed, 21 Apr 2010 16:24:59 -0600
Subject: [PATCH 02/16] Moving to Git

---
 collects/meta/drdr/analyze.ss                 |   2 +-
 collects/meta/drdr/config.ss                  |   6 +-
 collects/meta/drdr/dirstruct.ss               |   6 +-
 collects/meta/drdr/main.ss                    |  18 +--
 collects/meta/drdr/metadata.ss                |  14 +-
 .../drdr/{monitor-svn.ss => monitor-scm.ss}   |  25 ++--
 collects/meta/drdr/plt-build.ss               |  17 +--
 collects/meta/drdr/render.ss                  |   6 +-
 collects/meta/drdr/scm.ss                     | 136 ++++++++++++++++++
 collects/meta/drdr/svn.ss                     | 119 ---------------
 10 files changed, 174 insertions(+), 175 deletions(-)
 rename collects/meta/drdr/{monitor-svn.ss => monitor-scm.ss} (61%)
 create mode 100644 collects/meta/drdr/scm.ss

diff --git a/collects/meta/drdr/analyze.ss b/collects/meta/drdr/analyze.ss
index 9785346f3b..fa79f0e7f5 100644
--- a/collects/meta/drdr/analyze.ss
+++ b/collects/meta/drdr/analyze.ss
@@ -1,7 +1,7 @@
 #lang scheme
 (require scheme/file
          "diff.ss"
-         "svn.ss"
+         "scm.ss"
          "list-count.ss"
          "notify.ss"
          "cache.ss"
diff --git a/collects/meta/drdr/config.ss b/collects/meta/drdr/config.ss
index 0cf9b5416b..b14497b73d 100644
--- a/collects/meta/drdr/config.ss
+++ b/collects/meta/drdr/config.ss
@@ -2,12 +2,12 @@
 
 (require "cache.ss"
          "dirstruct.ss"
-         "svn.ss"
-         "monitor-svn.ss")
+         "scm.ss"
+         "monitor-scm.ss")
 
 (plt-directory "/opt/plt")
 (drdr-directory "/opt/svn/drdr")
-(svn-path "/usr/bin/svn")
+(git-path "/usr/bin/git")
 (Xvfb-path "/usr/bin/Xvfb")
 (current-make-install-timeout-seconds (* 60 60))
 (current-make-timeout-seconds (* 60 60))                                       
diff --git a/collects/meta/drdr/dirstruct.ss b/collects/meta/drdr/dirstruct.ss
index 4d04353d23..dbd1767c53 100644
--- a/collects/meta/drdr/dirstruct.ss
+++ b/collects/meta/drdr/dirstruct.ss
@@ -31,8 +31,8 @@
 (define fluxbox-path
   (make-parameter "/usr/bin/fluxbox"))
 
-(define plt-repository 
-  (make-parameter "http://svn.plt-scheme.org/plt/trunk"))
+(define (plt-repository)
+  (build-path (plt-directory) "repo"))
 
 (define current-make-timeout-seconds
   (make-parameter (* 60 30)))
@@ -96,7 +96,7 @@
  [make-path (parameter/c string?)]
  [Xvfb-path (parameter/c string?)]
  [fluxbox-path (parameter/c string?)]
- [plt-repository (parameter/c string?)]
+ [plt-repository (-> path?)]
  [path-timing-log (path-string? . -> . path?)]
  [path-timing-png (path-string? . -> . path?)]
  [path-timing-png-prefix (path-string? . -> . path?)]
diff --git a/collects/meta/drdr/main.ss b/collects/meta/drdr/main.ss
index a8fb374126..2a8e074201 100644
--- a/collects/meta/drdr/main.ss
+++ b/collects/meta/drdr/main.ss
@@ -3,12 +3,12 @@
 (require scheme/system
          "dirstruct.ss"
          "analyze.ss"
-         "monitor-svn.ss"
+         "monitor-scm.ss"
          "notify.ss"
          "retry.ss"
          "config.ss"
          "plt-build.ss"
-         "svn.ss"
+         "scm.ss"
          "cache.ss"
          "path-utils.ss")
 
@@ -55,15 +55,15 @@
 
 (notify! "Last revision is r~a" cur-rev)
 (handle-revision prev-rev cur-rev)
-(notify! "Starting to monitor SVN @ r~a" cur-rev)
-(monitor-svn (plt-repository)
+(notify! "Starting to monitor @ r~a" cur-rev)
+(monitor-scm (plt-repository)
              cur-rev
              (lambda (newer)
-               (for ([l (in-list newer)])
-                 (write-cache! (future-record-path (svn-rev-log-num l)) l)))
-             (lambda (prev-rev cur-rev _log)
+               (for ([rev (in-list newer)])
+                 (write-cache! (future-record-path rev)
+                               (get-scm-commit-msg rev (plt-repository)))))
+             (lambda (prev-rev cur-rev)
                (handle-revision prev-rev cur-rev)
                
                ; We have problems running for a long time so just restart after each rev
-               (exit 0)
-               ))
\ No newline at end of file
+               (exit 0)))
\ No newline at end of file
diff --git a/collects/meta/drdr/metadata.ss b/collects/meta/drdr/metadata.ss
index 3b3aaa1457..f9d1428eac 100644
--- a/collects/meta/drdr/metadata.ss
+++ b/collects/meta/drdr/metadata.ss
@@ -1,8 +1,7 @@
 #lang scheme
 (require "path-utils.ss"
          "dirstruct.ss"
-         "svn.ss"
-         scheme/system)
+         "scm.ss")
 
 (define (testable-file? pth)
   (define suffix (filename-extension pth))
@@ -54,12 +53,11 @@
                  (define tmp-file (make-temporary-file "props~a.ss"))
                  (and
                   ; Checkout the props file
-                  (system* (svn-path) 
-                           "export"
-                           "--quiet"
-                           "-r" (number->string rev)
-                           (format "~a/collects/meta/props" (plt-repository))
-                           (path->string tmp-file))
+                  (scm-export
+                   rev
+                   (plt-repository)
+                   "collects/meta/props" 
+                   tmp-file)
                   ; Dynamic require it
                   (begin0
                     (dynamic-require `(file ,(path->string tmp-file))
diff --git a/collects/meta/drdr/monitor-svn.ss b/collects/meta/drdr/monitor-scm.ss
similarity index 61%
rename from collects/meta/drdr/monitor-svn.ss
rename to collects/meta/drdr/monitor-scm.ss
index 7684d9f8ab..458c1cf011 100644
--- a/collects/meta/drdr/monitor-svn.ss
+++ b/collects/meta/drdr/monitor-scm.ss
@@ -1,30 +1,25 @@
 #lang scheme
-(require "svn.ss"
+(require "scm.ss"
          "retry.ss")
 
 (define current-monitoring-interval-seconds
   (make-parameter 60))
 
-(define (monitor-svn repos start-rev notify-newer! notify-user!)
+(define (monitor-scm repos start-rev notify-newer! notify-user!)
   (define (monitor-w/o-wait prev-rev)
-    (define all-logs
-      (svn-revision-logs-after prev-rev repos))
-    (define new-logs
-      (filter-not 
-       (lambda (l) (= (svn-rev-log-num l) prev-rev))
-       all-logs))
-    (match new-logs
+    (define new-revs
+      (scm-revisions-after prev-rev repos))
+    (match new-revs
       [(list)
        ; There has not yet been more revisions
        (monitor prev-rev)]
-      [(cons log newer)
-       (define new-rev (svn-rev-log-num log))
+      [(cons new-rev newer)
        ; Notify of newer ones
        (notify-newer! newer)
        ; There was a commit that we care about. Notify, then recur
        (retry-until-success
         (format "Notifying of revision ~a" new-rev)
-        (notify-user! prev-rev new-rev log))       
+        (notify-user! prev-rev new-rev))       
        (monitor new-rev)]))
   (define (monitor prev-rev)
     (sleep (current-monitoring-interval-seconds))
@@ -34,8 +29,8 @@
 (provide/contract
  [current-monitoring-interval-seconds 
   (parameter/c exact-nonnegative-integer?)]
- [monitor-svn 
+ [monitor-scm
   (string? exact-nonnegative-integer? 
-           ((listof svn-rev-log?) . -> . void)
-           (exact-nonnegative-integer? exact-nonnegative-integer? svn-rev-log? . -> . void)
+           ((listof exact-nonnegative-integer?) . -> . void)
+           (exact-nonnegative-integer? exact-nonnegative-integer? . -> . void)
            . -> . any)])
\ No newline at end of file
diff --git a/collects/meta/drdr/plt-build.ss b/collects/meta/drdr/plt-build.ss
index d8d93cef3b..10ecd143d9 100644
--- a/collects/meta/drdr/plt-build.ss
+++ b/collects/meta/drdr/plt-build.ss
@@ -10,7 +10,7 @@
          "notify.ss"
          "path-utils.ss"
          "sema.ss"
-         "svn.ss")
+         "scm.ss")
 
 (define current-env (make-parameter (make-immutable-hash empty)))
 (define-syntax-rule (with-env ([env-expr val-expr] ...) expr ...)
@@ -43,18 +43,7 @@
                (path->string co-dir))]
        (notify! "Checking out ~a@~a into ~a"
                 repo rev to-dir)
-       (run/collect/wait/log
-        ; XXX Give it its own timeout
-        #:timeout (current-make-install-timeout-seconds)
-        #:env (current-env)
-        (build-path log-dir "svn-checkout")
-        (svn-path)
-        (list 
-         "checkout"
-         "--quiet"
-         "-r" (number->string rev)
-         repo
-         to-dir)))))
+       (scm-checkout rev repo to-dir))))
   ;; Make the build directory
   (make-directory* build-dir)
   ;; Run Configure, Make, Make Install
@@ -285,7 +274,7 @@
                   ["HOME" (path->string home-dir)])
          (unless (read-cache* (revision-commit-msg rev))
            (write-cache! (revision-commit-msg rev)
-                         (svn-revision-log rev (plt-repository))))
+                         (get-scm-commit-msg rev (plt-repository))))
          (build-revision rev)
          (recur-many (number-of-cpus)
                      (lambda (j inner)
diff --git a/collects/meta/drdr/render.ss b/collects/meta/drdr/render.ss
index 4f1ca701ae..de282ff11a 100644
--- a/collects/meta/drdr/render.ss
+++ b/collects/meta/drdr/render.ss
@@ -5,12 +5,11 @@
          "config.ss"
          "diff.ss"
          "list-count.ss"
-         "svn.ss"
          "cache.ss"
          (except-in "dirstruct.ss"
                     revision-trunk-dir)
          "status.ss"
-         "monitor-svn.ss"
+         "monitor-scm.ss"
          (only-in "metadata.ss"
                   PROP:command-line
                   PROP:timeout)
@@ -489,7 +488,8 @@
 
 (require web-server/servlet-env
          web-server/http
-         web-server/dispatch)
+         web-server/dispatch
+         "scm.ss")
 (define how-many-revs 45)
 (define (show-revisions req)
   (define builds-pth (plt-build-directory))
diff --git a/collects/meta/drdr/scm.ss b/collects/meta/drdr/scm.ss
new file mode 100644
index 0000000000..2008af5e4b
--- /dev/null
+++ b/collects/meta/drdr/scm.ss
@@ -0,0 +1,136 @@
+#lang scheme
+(require "svn.ss"
+         net/url
+         scheme/system)
+(provide
+ (all-from-out "svn.ss"))
+
+(define git-path (make-parameter "/opt/local/bin/git"))
+(provide/contract
+ [git-path (parameter/c string?)])
+
+(define git-url-base "http://git.racket-lang.org/plt.git")
+
+(define (newest-push)
+  (string->number (port->string (get-pure-port (string->url (format "~a/push-counter" git-url-base))))))
+
+(define (pad2zeros n)
+  (format "~a~a"
+          (if (n . < . 10)
+              "0" "")
+          (number->string n)))
+
+(define-struct push-data (who start-commit end-commit branches) #:prefab)
+
+(define (push-info push-n)
+  (define push-n100s (quotient push-n 100))
+  (define push-nrem (pad2zeros (modulo push-n 100)))
+  (define ls 
+    (port->lines 
+     (get-pure-port 
+      (string->url 
+       (format "~a/pushes/~a/~a" git-url-base push-n100s push-nrem)))))
+  (match ls
+    [(list (regexp #rx"^([^ ]+) +([0-9abcdef]+) +([0-9abcdef]+)$" (list _ who start-commit end-commit))
+           (regexp #rx"^([0-9abcdef]+) +([0-9abcdef]+) +(.+)$" (list _ _ _ branch))
+           ...)
+     (make-push-data who start-commit end-commit branch)]
+    [_
+     #f]))
+
+(define (system/output-port #:stdout [init-stdout #f] . as)
+  (define-values (sp stdout stdin stderr)
+    (apply subprocess init-stdout #f #f as))
+  (subprocess-wait sp)
+  stdout)
+
+(define-struct git-push (num author commits) #:prefab)
+(define-struct git-commit (hash author date msg mfiles) #:prefab)
+
+(define (read-until-empty-line in-p)
+  (let loop ()
+    (let ([l (read-line in-p)])
+      (cond
+        [(eof-object? l)
+         (close-input-port in-p)
+         empty]
+        [(string=? l "")
+         empty]
+        [else
+         (list* (regexp-replace #rx"^ +" l "") (loop))]))))
+
+(define (read-commit in-p)
+  (match-define (regexp #rx"^commit +(.+)$" (list _ hash)) (read-line in-p))
+  (match-define (regexp #rx"^Author: +(.+)$" (list _ author)) (read-line in-p))
+  (match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
+  (define _1 (read-line in-p))
+  (define msg (read-until-empty-line in-p))
+  (define mfiles (read-until-empty-line in-p))
+  (make-git-commit hash author date msg mfiles))
+
+(define port-empty? port-closed?)
+
+(define (read-commits in-p)
+  (if (port-empty? in-p)
+      empty
+      (list* (read-commit in-p)
+             (read-commits in-p))))
+
+(define (parse-push num author in-p)
+  (make-git-push num author (read-commits in-p)))
+
+(define (get-scm-commit-msg rev repo)
+  (match-define (struct push-data (who start-commit end-commit branches)) (push-info rev))
+  (scm-update repo)
+  (parse-push 
+   rev who 
+   (parameterize ([current-directory repo])
+     (system/output-port (git-path) "log" "--date=iso" "--name-only" (format "~a..~a" start-commit end-commit)))))
+(provide/contract
+ [struct git-push ([num exact-nonnegative-integer?]
+                   [author string?]
+                   [commits (listof git-commit?)])]
+ [struct git-commit ([hash string?]
+                     [author string?]
+                     [date string?]
+                     [msg (listof string?)]
+                     [mfiles (listof string?)])]
+ [get-scm-commit-msg (exact-nonnegative-integer? string? . -> . git-push?)])
+
+(define (scm-export rev repo file dest)
+  (define commit
+    (push-data-end-commit (push-info rev)))
+  (scm-update repo)
+  (call-with-output-file* 
+   dest
+   #:exists 'truncate/replace
+   (lambda (file-port)
+     (parameterize ([current-directory repo])
+       (system/output-port #:stdout file-port
+                           (git-path)
+                           "archive" commit file))))
+  (void))
+
+(define (scm-checkout rev repo dest)
+  (scm-update repo)
+  (system* (git-path) "clone" (path->string repo) (path->string dest))
+  (parameterize ([current-directory dest])
+    (system* (git-path) "checkout" (push-data-end-commit (push-info rev)))))
+
+(define (scm-update repo)
+  (parameterize ([current-directory repo])
+    (system* (git-path) "fetch" git-url-base)))
+
+(define (scm-revisions-after cur-rev repo)
+  (define newest-rev (newest-push))
+  (for/list ([rev (in-range (add1 cur-rev) newest-rev)]
+             #:when
+             (let ([info (push-info rev)])
+               (and info
+                    (member "refs/heads/master" (push-data-branches info)))))
+    rev))
+
+(provide/contract
+ [scm-revisions-after (exact-nonnegative-integer? path? . -> . void?)]
+ [scm-export (exact-nonnegative-integer? path? string? path? . -> . void?)]
+ [scm-checkout (exact-nonnegative-integer? path? path? . -> . void?)])
\ No newline at end of file
diff --git a/collects/meta/drdr/svn.ss b/collects/meta/drdr/svn.ss
index 7a286376fe..56ee231d07 100644
--- a/collects/meta/drdr/svn.ss
+++ b/collects/meta/drdr/svn.ss
@@ -1,130 +1,11 @@
 #lang scheme
-(require xml
-         "notify.ss")
-
-(define svn-path 
-  (make-parameter "/opt/local/bin/svn"))
-
-;; Running SVN w/ XML parsing
-(define (svn/xml-parse . in-args)
-  (define args
-    (list* "--xml" in-args))     
-  (define-values
-    (the-process stdout stdin stderr)
-    (apply
-     subprocess
-     #f #f #f 
-     (svn-path)
-     args))
-  #;(notify! "Parsing SVN XML output: ~a ~a" (svn-path) args)
-  (begin0
-    (dynamic-wind void
-                  (lambda () 
-                    (with-handlers ([exn:xml? (lambda (x) x)])
-                      (parameterize ([collapse-whitespace #t]
-                                     [xexpr-drop-empty-attributes #t])
-                        (xml->xexpr (document-element (read-xml stdout))))))
-                  (lambda ()
-                    (close-input-port stdout)))
-    (close-output-port stdin)
-    (close-input-port stderr)
-    (sync the-process
-          (handle-evt (alarm-evt (+ (current-inexact-milliseconds) (* 1000 2)))
-                      (lambda (_)
-                        (subprocess-kill the-process #t)
-                        #f)))))
-
-;;; Finding out about SVN revisions
 
 (define-struct svn-rev () #:prefab)
 (define-struct (svn-rev-nolog svn-rev) () #:prefab)
 (define-struct (svn-rev-log svn-rev) (num author date msg changes) #:prefab)
 (define-struct svn-change (action path) #:prefab)
 
-(define (svn-revision-log-xml rev trunk)
-  (notify! "Getting log file for r~a in ~a" rev trunk)
-  (svn/xml-parse 
-   "log"
-   "-r" rev
-   "-v"
-   #;"--with-all-revprops" ; v1.5
-   trunk))
-
-(define parse-log-entry
-  (match-lambda
-    [`(logentry ((revision ,rev)) " "
-                (author ,author) " "
-                (date ,date) " "
-                (paths ,path ...)
-                " " (msg . ,msg) " ")
-     (make-svn-rev-log
-      (string->number rev)
-      author date (apply string-append msg) 
-      (filter-map (match-lambda
-                    [`(path ((action ,action) . ,any) ,file)
-                     (make-svn-change (string->symbol action) file)]
-                    [" " 
-                     #f])
-                  path))]
-    [" " #f]))
-
-(define parse-svn-log-xml
-  (match-lambda
-    [(? exn:fail? x)
-     (fprintf (current-error-port) "Error: ~a" (exn-message x))
-     #f]
-    [`(log " ")
-     (make-svn-rev-nolog)]
-    [`(log 
-       " " ,le " ")
-     (parse-log-entry le)]))
-
-(define (svn-revision-log rev trunk)
-  (define rev-string
-    (cond
-      [(number? rev) (number->string rev)]
-      [(symbol? rev)
-       (case rev
-         [(HEAD) "HEAD"])]))
-  (parse-svn-log-xml
-   (svn-revision-log-xml rev-string trunk)))
-
-(define (svn-revision-logs-after-xml rev trunk)
-  (notify! "Getting logs for revision after r~a in ~a" rev trunk)
-  (svn/xml-parse 
-   "log"
-   "-r" (format "~a:HEAD" rev)
-   "-v"
-   #;"--with-all-revprops" ; v1.5
-   trunk))
-
-(define (parse-svn-logs-xml xexpr)
-  (match xexpr
-    [(? exn:fail? x)
-     (fprintf (current-error-port) "Error: ~a" (exn-message x))
-     empty]
-    [`(log " ")
-     empty]
-    [`(log . ,les)
-     (filter-map parse-log-entry les)]))
-
-(define (svn-revision-logs-after rev trunk)
-  (parse-svn-logs-xml
-   (svn-revision-logs-after-xml rev trunk)))
-
 (provide/contract
- [svn-path (parameter/c string?)]
- [svn-revision-log 
-  ((or/c exact-nonnegative-integer? (symbols 'HEAD))
-   string?
-   . -> .
-   (or/c false/c
-         svn-rev?))]
- [svn-revision-logs-after 
-  (exact-nonnegative-integer?
-   string?
-   . -> .
-   (listof svn-rev-log?))]
  [struct svn-rev ()]
  [struct (svn-rev-nolog svn-rev) ()]
  [struct (svn-rev-log svn-rev)

From 3833459d4f55057b534ae63ee22e680940b36cb6 Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@racket-lang.org>
Date: Thu, 22 Apr 2010 10:10:40 -0400
Subject: [PATCH 03/16] added [htp] to begin{figure}

---
 collects/scriblib/figure.tex | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/collects/scriblib/figure.tex b/collects/scriblib/figure.tex
index 429e996d3d..04e90facd9 100644
--- a/collects/scriblib/figure.tex
+++ b/collects/scriblib/figure.tex
@@ -9,7 +9,7 @@
 \newlength{\FigOrigskip}
 \FigOrigskip=\parskip
 
-\newenvironment{CenterfigureMulti}{\begin{figure*}\centering}{\end{figure*}}
+\newenvironment{CenterfigureMulti}{\begin{figure*}[htp]\centering}{\end{figure*}}
 \newenvironment{CenterfigureMultiWide}{\begin{CenterfigureMulti}}{\end{CenterfigureMulti}}
-\newenvironment{Centerfigure}{\begin{figure}\centering}{\end{figure}}
+\newenvironment{Centerfigure}{\begin{figure}[htp]\centering}{\end{figure}}
 \newenvironment{FigureInside}{\begin{list}{}{\leftmargin=0pt\topsep=0pt\parsep=\FigOrigskip\partopsep=0pt}\item}{\end{list}}

From 457a6c16c3d77a4658db2cb37c547459d29eb85e Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 22 Apr 2010 10:48:58 -0400
Subject: [PATCH 04/16] make completion work for racket-tool

---
 collects/meta/contrib/completion/racket-completion.bash | 1 +
 1 file changed, 1 insertion(+)

diff --git a/collects/meta/contrib/completion/racket-completion.bash b/collects/meta/contrib/completion/racket-completion.bash
index 6ecfd4a248..5640565d03 100644
--- a/collects/meta/contrib/completion/racket-completion.bash
+++ b/collects/meta/contrib/completion/racket-completion.bash
@@ -133,3 +133,4 @@ _rico()
 }
 
 complete -F _rico rico
+complete -F _rico racket-tool

From 49a42fd089bd1154cdb6c89c89c5f30e63d9b571 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 21 Apr 2010 16:55:30 -0400
Subject: [PATCH 05/16] fix to handle multiple value return

---
 collects/unstable/debug.ss | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/collects/unstable/debug.ss b/collects/unstable/debug.ss
index dd48296c8b..750c573cd8 100644
--- a/collects/unstable/debug.ss
+++ b/collects/unstable/debug.ss
@@ -15,7 +15,9 @@
               (let ([e (with-handlers ([values (lambda (exn)
                                                  (printf "~a raised exception ~a~n" 'f exn)
                                                  (raise exn))])
-                         (apply f l))])
-                (printf "~a result was ~a~n" 'f e)
-                e)))]
+                         (call-with-values (lambda () (apply f l)) list))])
+                (if (and (pair? e) (null? (cdr e)))
+                    (printf "~a result was ~a~n" 'f (car e))
+                    (printf "~a results were ~a~n" 'f e))
+                (apply values e))))]
     [(_ f . args) (debug (f . args))]))
\ No newline at end of file

From c8d5f5cc1208c32ea9e8651601db6f6d9204d8ab Mon Sep 17 00:00:00 2001
From: John Clements <clements@racket-lang.org>
Date: Thu, 22 Apr 2010 09:31:30 -0700
Subject: [PATCH 06/16] Initial add of all schelog files

---
 collects/schelog/COPYING                      |    7 +
 collects/schelog/INSTALL                      |   77 +
 collects/schelog/README                       |   45 +
 .../schelog/dialects/dialects-supported.scm   |   16 +
 .../schelog/dialects/files-to-be-ported.scm   |    1 +
 collects/schelog/dialects/gambit-schelog.scm  |    6 +
 collects/schelog/examples/bible.scm           |  119 ++
 collects/schelog/examples/england.scm         |   52 +
 collects/schelog/examples/england2.scm        |   74 +
 collects/schelog/examples/games.scm           |   87 +
 collects/schelog/examples/holland.scm         |   36 +
 collects/schelog/examples/houses.scm          |  148 ++
 collects/schelog/examples/mapcol.scm          |   79 +
 collects/schelog/examples/puzzle.scm          |   47 +
 collects/schelog/examples/toys.scm            |   84 +
 collects/schelog/history                      |  109 ++
 collects/schelog/makefile                     |   44 +
 collects/schelog/manifest                     |   20 +
 collects/schelog/schelog-version.tex          |    1 +
 collects/schelog/schelog.bib                  |   95 +
 collects/schelog/schelog.scm                  |  772 ++++++++
 collects/schelog/schelog.tex                  | 1572 +++++++++++++++++
 22 files changed, 3491 insertions(+)
 create mode 100644 collects/schelog/COPYING
 create mode 100644 collects/schelog/INSTALL
 create mode 100644 collects/schelog/README
 create mode 100644 collects/schelog/dialects/dialects-supported.scm
 create mode 100644 collects/schelog/dialects/files-to-be-ported.scm
 create mode 100644 collects/schelog/dialects/gambit-schelog.scm
 create mode 100644 collects/schelog/examples/bible.scm
 create mode 100644 collects/schelog/examples/england.scm
 create mode 100644 collects/schelog/examples/england2.scm
 create mode 100644 collects/schelog/examples/games.scm
 create mode 100644 collects/schelog/examples/holland.scm
 create mode 100644 collects/schelog/examples/houses.scm
 create mode 100644 collects/schelog/examples/mapcol.scm
 create mode 100644 collects/schelog/examples/puzzle.scm
 create mode 100644 collects/schelog/examples/toys.scm
 create mode 100644 collects/schelog/history
 create mode 100644 collects/schelog/makefile
 create mode 100644 collects/schelog/manifest
 create mode 100644 collects/schelog/schelog-version.tex
 create mode 100644 collects/schelog/schelog.bib
 create mode 100644 collects/schelog/schelog.scm
 create mode 100644 collects/schelog/schelog.tex

diff --git a/collects/schelog/COPYING b/collects/schelog/COPYING
new file mode 100644
index 0000000000..50aebd4fa6
--- /dev/null
+++ b/collects/schelog/COPYING
@@ -0,0 +1,7 @@
+Copyright (c) 1993-2001, Dorai Sitaram.
+All rights reserved.
+
+Permission to distribute and use this work for any
+purpose is hereby granted provided this copyright
+notice is included in the copy.  This work is provided
+as is, with no warranty of any kind.
diff --git a/collects/schelog/INSTALL b/collects/schelog/INSTALL
new file mode 100644
index 0000000000..0217f5d278
--- /dev/null
+++ b/collects/schelog/INSTALL
@@ -0,0 +1,77 @@
+Installing Schelog
+
+-
+
+First, obtain the Schelog distribution.  This is
+available at
+
+http://www.ccs.neu.edu/~dorai/schelog/schelog.html
+
+Gunzipping and untarring this file produces a directory
+called "schelog".  This directory contains, among other
+subsidiary files:
+
+the Schelog code file "schelog.scm";
+
+the file INSTALL, which you are now reading.
+
+-
+
+The file schelog.scm in the distribution loads in
+MzScheme (and some other Scheme dialects) without
+configuration.  If it does not load in your
+dialect, you can configure Schelog for it using
+the scmxlate package, which is available at
+http://www.ccs.neu.edu/~dorai/scmxlate/scmxlate.html 
+
+Start your Scheme in the schelog directory, and load
+the file scmxlate/scmxlate.scm , using the correct
+relative or full pathname.  You will be asked what your
+Scheme dialect is.  Answer appropriately.  The
+following symbols are used by the porting
+mechanism to identify the corresponding Scheme
+dialects: bigloo (Bigloo); gambit (Gambit); guile
+(Guile); mitscheme (MIT Scheme); mzscheme (MzScheme);
+petite (Petite Chez Scheme); pscheme (Pocket Scheme);
+scm (SCM); stk (STk).
+
+scmxlate will generate a file called
+"my-schelog.scm", which you may rename to
+"schelog.scm".
+
+Load schelog.scm into your Scheme in order to use
+Schelog. 
+ 
+The distribution comes with an "examples" subdirectory
+containing some sample Schelog programs.  In order to
+try an example file, load it into your Scheme after
+ensuring that "schelog.scm" has already been loaded.
+Follow the instructions in the example file.
+
+-
+
+The file "schelog.tex" contains a tutorial on Schelog.  Run it
+through (plain) TeX to obtain viewable/printable
+documentation.  (You will need to run TeX twice to resolve
+cross references.)
+
+You can get a browsable version of the document by
+calling
+
+tex2page schelog.tex
+
+This browsable version is also available for Web
+viewing at
+
+http://www.ccs.neu.edu/~dorai/schelog/schelog.html
+
+tex2page is available at
+
+http://www.ccs.neu.edu/~dorai/tex2page/tex2page-doc.html
+
+-
+
+Concise bug reports, questions, and suggestions
+may be emailed to
+
+ds26 at gte dot com
diff --git a/collects/schelog/README b/collects/schelog/README
new file mode 100644
index 0000000000..03fefa5851
--- /dev/null
+++ b/collects/schelog/README
@@ -0,0 +1,45 @@
+README
+Schelog
+Dorai Sitaram
+ds26@gte.com
+
+                          ...
+
+Schelog is for you if you are interested in any or all
+of the following: Scheme, Prolog, logic, logic
+programming, AI, and expert systems.
+
+Schelog is an embedding of logic programming a la
+Prolog in Scheme.  "Embedding" means you don't lose
+Scheme: You can use Prolog-style and conventional
+Scheme code fragments alongside each other.  Schelog
+contains the full repertoire of Prolog features,
+including meta-logical and second-order ("set")
+predicates, leaving out only those features that could
+be more easily and more efficiently done with Scheme
+subexpressions.  The Schelog distribution includes
+examples and comprehensive documentation.
+
+Schelog has been tested successfully on the following
+Scheme dialects:
+
+Bigloo, Gambit, Guile, MIT Scheme, MzScheme, Petite
+Chez Scheme, Pocket Scheme, SCM, and STk.
+
+                          ...
+
+The Schelog distribution is available at the URL:
+
+  http://www.cs.rice.edu/CS/PLT/packages/schelog/
+
+Unpacking (using gunzip and tar xf) the Schelog distribution
+produces a directory called "schelog".  In it is a file
+called INSTALL which contains detailed installation
+instructions.  Read INSTALL now.
+
+*** this package has been TAMPERED WITH in an unscrupulous and undisciplined
+way by John Clements 2010-04-22 in order to see how difficult it would be to
+get it to compile in PLT 4.2.5.  The answer is "not hard", but it's certainly
+not portable any more, and crucially the two macros that cause capture of 
+the ! symbol now require uses of the macro to supply the bang, thus making them
+non-capturing.
diff --git a/collects/schelog/dialects/dialects-supported.scm b/collects/schelog/dialects/dialects-supported.scm
new file mode 100644
index 0000000000..84974dd1b1
--- /dev/null
+++ b/collects/schelog/dialects/dialects-supported.scm
@@ -0,0 +1,16 @@
+;last change: 2003-06-01
+
+bigloo
+gambit
+gauche
+guile
+mitscheme
+mzscheme
+petite
+pscheme
+scheme48
+scm
+scsh
+stk
+sxm
+umbscheme
diff --git a/collects/schelog/dialects/files-to-be-ported.scm b/collects/schelog/dialects/files-to-be-ported.scm
new file mode 100644
index 0000000000..3c2ffa5dab
--- /dev/null
+++ b/collects/schelog/dialects/files-to-be-ported.scm
@@ -0,0 +1 @@
+schelog.scm
diff --git a/collects/schelog/dialects/gambit-schelog.scm b/collects/schelog/dialects/gambit-schelog.scm
new file mode 100644
index 0000000000..a01f8298aa
--- /dev/null
+++ b/collects/schelog/dialects/gambit-schelog.scm
@@ -0,0 +1,6 @@
+(declare (standard-bindings) (extended-bindings) (block) (not safe))
+
+;if all your arithmetic is going to be fixnum-only,
+;you might want to
+
+;(declare (fixnum))
diff --git a/collects/schelog/examples/bible.scm b/collects/schelog/examples/bible.scm
new file mode 100644
index 0000000000..020b1990c8
--- /dev/null
+++ b/collects/schelog/examples/bible.scm
@@ -0,0 +1,119 @@
+;The following is the "Biblical" database from "The Art of
+;Prolog", Sterling & Shapiro, ch. 1.
+
+;(%father X Y) :- X is the father of Y.
+
+(define %father
+  (%rel ()
+    (('terach 'abraham)) (('terach 'nachor)) (('terach 'haran))
+    (('abraham 'isaac)) (('haran 'lot)) (('haran 'milcah))
+    (('haran 'yiscah))))
+
+;(%mother X Y) :- X is the mother of Y.
+
+(define %mother
+  (%rel () (('sarah 'isaac))))
+
+(define %male
+  (%rel ()
+    (('terach)) (('abraham)) (('isaac)) (('lot)) (('haran)) (('nachor))))
+
+(define %female
+  (%rel ()
+    (('sarah)) (('milcah)) (('yiscah))))
+
+;AoP, ch. 17.  Finding all the children of a particular
+;father.  (%children F CC) :- CC is the list of children
+;whose father is F.  First approach: %children-1 uses an
+;auxiliary predicate %children-aux, which uses an
+;accumulator.
+
+(define %children-1
+
+  (letrec ((children-aux
+	     (%rel (x a cc c)
+	       ((x a cc)
+                 (%father x c) (%not (%member c a)) !
+                 (children-aux x (cons c a) cc))
+	       ((x cc cc)))))
+
+    (%rel (x cc)
+      ((x cc) (children-aux x '() cc)))))
+
+(define terachs-kids-test
+  ;find all the children of Terach.  Returns
+  ;cc = (abraham nachor haran)
+  (lambda ()
+    (%which (cc)
+      (%children-1 'terach cc))))
+
+(define dad-kids-test
+  ;find a father and all his children.  Returns
+  ;f = terach, cc = (haran nachor abraham).
+  ;(%more) fails, showing flaw in %children-1.
+  ;see AoP, ch. 17, p. 267
+  (lambda ()
+    (%which (f cc)
+      (%children-1 f cc))))
+
+(define terachs-kids-test-2
+  ;find all the kids of Terach, using %set-of.
+  ;returns kk = (abraham nachor haran)
+  (lambda ()
+    (%let (k)
+      (%which (kk)
+        (%set-of k (%father 'terach k) kk)))))
+
+;This is a better definition of the %children predicate.
+;Uses set predicate %bag-of
+
+(define %children
+  (%rel (x kids c)
+    ((kids) (%set-of c (%father x c) kids))))
+
+(define dad-kids-test-2
+  ;find each dad-kids combo.
+  ;1st soln: dad = terach, kids = (abraham nachor haran)
+  ;(%more) gives additional solutions.
+  (lambda ()
+    (%let (x)
+      (%which (dad kids)
+        (%set-of x (%free-vars (dad)
+                     (%father dad x))
+          kids)))))
+
+(define dad-kids-test-3
+  ;looks like dad-kids-test-2, but dad is now
+  ;existentially quantified.  returns a set of
+  ;kids (i.e., anything with a father)
+  (lambda ()
+    (%let (x)
+      (%which (dad kids)
+        (%set-of x (%father dad x)
+          kids)))))
+
+(define dad-kids-test-4
+  ;find the set of dad-kids.
+  ;since dad is existentially quantified,
+  ;this gives the wrong answer: it gives
+  ;one set containing all the kids
+  (lambda ()
+    (%let (dad kids x)
+      (%which (dad-kids)
+	(%set-of (list dad kids)
+	  (%set-of x (%father dad x) kids)
+	  dad-kids)))))
+
+(define dad-kids-test-5
+  ;the correct solution.  dad is
+  ;identified as a free var.
+  ;returns a set of dad-kids, one for
+  ;each dad
+  (lambda ()
+    (%let (dad kids x)
+      (%which (dad-kids)
+	(%set-of (list dad kids)
+	  (%set-of x (%free-vars (dad)
+                       (%father dad x))
+            kids)
+	  dad-kids)))))
diff --git a/collects/schelog/examples/england.scm b/collects/schelog/examples/england.scm
new file mode 100644
index 0000000000..658f7a8348
--- /dev/null
+++ b/collects/schelog/examples/england.scm
@@ -0,0 +1,52 @@
+;The following is a simple database about a certain family in England.
+;Should be a piece of cake, but given here so that you can hone
+;your ability to read the syntax.
+
+;This file is written using `%rel' for a more Prolog-like syntax.
+;The file england2.scm uses a Scheme-like syntax.
+
+(define %male
+  (%rel ()
+    (('philip)) (('charles)) (('andrew)) (('edward))
+    (('mark)) (('william)) (('harry)) (('peter))))
+
+(define %female
+  (%rel ()
+    (('elizabeth)) (('anne)) (('diana)) (('sarah)) (('zara))))
+
+(define %husband-of
+  (%rel ()
+    (('philip 'elizabeth)) (('charles 'diana))
+    (('mark 'anne)) (('andrew 'sarah))))
+
+(define %wife-of
+  (%rel (w h)
+    ((w h) (%husband-of h w))))
+
+(define %married-to
+  (%rel (x y)
+    ((x y) (%husband-of x y))
+    ((x y) (%wife-of x y))))
+
+(define %father-of
+  (%rel ()
+   (('philip 'charles)) (('philip 'anne)) (('philip 'andrew))
+   (('philip 'edward)) (('charles 'william)) (('charles 'harry))
+   (('mark 'peter)) (('mark 'zara))))
+
+(define %mother-of
+  (%rel (m c f)
+    ((m c) (%wife-of m f) (%father-of f c))))
+
+(define %child-of
+  (%rel (c p)
+    ((c p) (%father-of p c))
+    ((c p) (%mother-of p c))))
+
+(define %parent-of
+  (%rel (p c)
+    ((p c) (%child-of c p))))
+
+(define %brother-of
+  (%rel (b x f)
+    ((b x) (%male b) (%father-of f b) (%father-of f x) (%/= b x))))
diff --git a/collects/schelog/examples/england2.scm b/collects/schelog/examples/england2.scm
new file mode 100644
index 0000000000..c3adf64846
--- /dev/null
+++ b/collects/schelog/examples/england2.scm
@@ -0,0 +1,74 @@
+;The following is a simple database about a certain family in England.
+;Should be a piece of cake, but given here so that you can hone
+;your ability to read the syntax.
+
+;This file is written using goal combinations like %or, %and
+;like you would use Scheme procedures.  For a more Prolog-like
+;syntax of the same program, see england.scm.
+
+(define %male
+  (lambda (x)
+    (%or (%= x 'philip)
+	 (%= x 'charles)
+	 (%= x 'andrew)
+	 (%= x 'edward)
+	 (%= x 'mark)
+	 (%= x 'william)
+	 (%= x 'harry)
+	 (%= x 'peter))))
+
+(define %female
+  (lambda (x)
+    (%or (%= x 'elizabeth)
+	 (%= x 'anne)
+	 (%= x 'diana)
+	 (%= x 'sarah)
+	 (%= x 'zara))))
+
+(define %husband-of
+  (lambda (h w)
+    (%or (%and (%= h 'philip) (%= w 'elizabeth))
+	 (%and (%= h 'charles) (%= w 'diana))
+	 (%and (%= h 'mark) (%= w 'anne))
+	 (%and (%= h 'andrew) (%= w 'sarah)))))
+
+(define %wife-of
+  (lambda (w h)
+    (%husband-of h w)))
+
+(define %married-to
+  (lambda (x y)
+    (%or (%husband-of x y) (%wife-of x y))))
+
+(define %father-of
+  (lambda (x y)
+    (%or (%and (%= x 'philip) (%= y 'charles))
+	 (%and (%= x 'philip) (%= y 'anne))
+	 (%and (%= x 'philip) (%= y 'andrew))
+	 (%and (%= x 'philip) (%= y 'edward))
+	 (%and (%= x 'charles) (%= y 'william))
+	 (%and (%= x 'charles) (%= y 'harry))
+	 (%and (%= x 'mark) (%= y 'peter))
+	 (%and (%= x 'mark) (%= y 'zara)))))
+
+(define %mother-of
+  (lambda (m c)
+    (%let (f)
+      (%and (%wife-of m f) (%father-of f c)))))
+
+(define %child-of
+  (lambda (c p)
+    (%or (%father-of p c) (%mother-of p c))))
+
+(define %parent-of
+  (lambda (p c)
+    (%child-of c p)))
+
+(define %brother-of
+  (lambda (b x)
+    (%let (f)
+      (%and (%male b)
+	    (%father-of f b)
+	    (%father-of f x)
+	    (%/= b x)))))
+
diff --git a/collects/schelog/examples/games.scm b/collects/schelog/examples/games.scm
new file mode 100644
index 0000000000..8abdd0889a
--- /dev/null
+++ b/collects/schelog/examples/games.scm
@@ -0,0 +1,87 @@
+#lang scheme
+
+(require "../schelog.scm" "./puzzle.scm")
+
+;;This example is from Sterling & Shapiro, p. 214.
+;;
+;;The problem reads: Three friends came first, second and
+;;third in a competition.  Each had a different name, liked a
+;;different sport, and had a different nationality.  Michael
+;;likes basketball, and did better than the American.  Simon,
+;;the Israeli, did better than the tennis player.  The
+;;cricket player came first.  Who's the Australian?  What
+;;sport does Richard play?
+
+(define person
+  ;;a structure-builder for persons
+  (lambda (name country sport)
+    (list 'person name country sport)))
+
+(define %games
+  (%rel ! (clues queries solution the-men
+	 n1 n2 n3 c1 c2 c3 s1 s2 s3)
+    ((clues queries solution)
+     (%= the-men
+       (list (person n1 c1 s1) (person n2 c2 s2) (person n3 c3 s3)))
+     (%games-clues the-men clues)
+     (%games-queries the-men queries solution))))
+    
+(define %games-clues
+  (%rel ! (the-men clue1-man1 clue1-man2 clue2-man1 clue2-man2 clue3-man)
+    ((the-men
+       (list
+	 (%did-better clue1-man1 clue1-man2 the-men)
+	 (%name clue1-man1 'michael)
+	 (%sport clue1-man1 'basketball)
+	 (%country clue1-man2 'usa)
+
+	 (%did-better clue2-man1 clue2-man2 the-men)
+	 (%name clue2-man1 'simon)
+	 (%country clue2-man1 'israel)
+	 (%sport clue2-man2 'tennis)
+
+	 (%first the-men clue3-man)
+	 (%sport clue3-man 'cricket))))))
+
+(define %games-queries
+  (%rel ! (the-men man1 man2 aussies-name dicks-sport)
+    ((the-men
+       (list
+	 (%member man1 the-men)
+	 (%country man1 'australia)
+	 (%name man1 aussies-name)
+
+	 (%member man2 the-men)
+	 (%name man2 'richard)
+	 (%sport man2 dicks-sport))
+       (list
+	 (list aussies-name 'is 'the 'australian)
+	 (list 'richard 'plays dicks-sport))))))
+	 
+(define %did-better
+  (%rel ! (a b c)
+    ((a b (list a b c)))
+    ((a c (list a b c)))
+    ((b c (list a b c)))))
+
+(define %name
+  (%rel ! (name country sport)
+    (((person name country sport) name))))
+
+(define %country
+  (%rel ! (name country sport)
+    (((person name country sport) country))))
+
+(define %sport
+  (%rel ! (name country sport)
+    (((person name country sport) sport))))
+
+(define %first
+  (%rel ! (car cdr)
+    (((cons car cdr) car))))
+
+;;With the above as the database, and also loading the file
+;;puzzle.scm containing the puzzle solver, we merely need to
+;;ask (solve-puzzle %games) to get the solution, which is
+;;
+;;((michael is the australian) (richard plays tennis))
diff --git a/collects/schelog/examples/holland.scm b/collects/schelog/examples/holland.scm
new file mode 100644
index 0000000000..5a39e77eec
--- /dev/null
+++ b/collects/schelog/examples/holland.scm
@@ -0,0 +1,36 @@
+;This is a very trivial program.  In Prolog, it would be:
+;
+;    city(amsterdam).
+;    city(brussels).
+;    country(holland).
+;    country(belgium).
+
+(define %city
+  (lambda (x)
+    (%or (%= x 'amsterdam)
+	 (%= x 'brussels))))
+
+(define %country
+  (lambda (x)
+    (%or (%= x 'holland)
+	 (%= x 'belgium))))
+
+;For a more Prolog-style syntax, you can rewrite the same thing,
+;using the `%rel' macro, as the following:
+
+'(define %city
+  (%rel ()
+    (('amsterdam))
+    (('brussels))))
+
+'(define %country
+  (%rel ()
+    (('holland))
+    (('belgium))))
+
+;Typical easy queries:
+;
+; (%which (x) (%city x)) succeeds twice
+; (%which (x) (%country x)) succeeds twice
+; (%which () (%city 'amsterdam)) succeeds
+; (%which () (%country 'amsterdam)) fails
diff --git a/collects/schelog/examples/houses.scm b/collects/schelog/examples/houses.scm
new file mode 100644
index 0000000000..663216bf94
--- /dev/null
+++ b/collects/schelog/examples/houses.scm
@@ -0,0 +1,148 @@
+;Exercise 14.1 (iv) from Sterling & Shapiro, p. 217-8  
+
+;There are 5 houses, each of a different color and inhabited
+;by a man of a different nationality, with a different pet,
+;drink and cigarette choice.
+;
+;1. The Englishman lives in the red house
+;2. The Spaniard owns the dog
+;3. Coffee is drunk in the green house
+;4. The Ukrainian drinks tea
+;5. The green house is to the immediate right of the ivory house
+;6. The Winston smoker owns snails
+;7. Kools are smoked in the yellow house
+;8. Milk is drunk in the middle house
+;9. The Norwegian lives in the first house on the left
+;10. The Chesterfield smoker lives next to the man with the fox
+;11. Kools are smoked in the house adjacent to the horse's place
+;12. The Lucky Strike smoker drinks orange juice
+;13. The Japanese smokes Parliaments
+;14. The Norwegian lives next to the blue house
+
+;Who owns the zebra?  Who drinks water?
+
+(define house
+  (lambda (hue nation pet drink cigarette)
+    (list 'house hue nation pet drink cigarette)))
+
+(define %hue (%rel (h) (((house h (_) (_) (_) (_)) h))))
+(define %nation (%rel (n) (((house (_) n (_) (_) (_)) n))))
+(define %pet (%rel (p) (((house (_) (_) p (_) (_)) p))))
+(define %drink (%rel (d) (((house (_) (_) (_) d (_)) d))))
+(define %cigarette (%rel (c) (((house (_) (_) (_) (_) c) c))))
+
+(define %adjacent
+  (%rel (a b)
+    ((a b (list a b (_) (_) (_))))
+    ((a b (list (_) a b (_) (_))))
+    ((a b (list (_) (_) a b (_))))
+    ((a b (list (_) (_) (_) a b)))))
+
+(define %middle
+  (%rel (a)
+    ((a (list (_) (_) a (_) (_))))))
+
+(define %houses
+  (%rel (row-of-houses clues queries solution
+	 h1 h2 h3 h4 h5 n1 n2 n3 n4 n5 p1 p2 p3 p4 p5
+	 d1 d2 d3 d4 d5 c1 c2 c3 c4 c5)
+    ((clues queries solution)
+     (%= row-of-houses
+       (list
+	 (house h1 n1 p1 d1 c1)
+	 (house h2 n2 p2 d2 c2)
+	 (house h3 n3 p3 d3 c3)
+	 (house h4 n4 p4 d4 c4)
+	 (house h5 n5 p5 d5 c5)))
+     (%houses-clues row-of-houses clues)
+     (%houses-queries row-of-houses queries solution))))
+
+(define %houses-clues
+  (%rel (row-of-houses abode1 abode2 abode3 abode4 abode5 abode6 abode7
+	 abode8 abode9 abode10 abode11 abode12 abode13 abode14 abode15)
+    ((row-of-houses
+       (list
+	 (%member abode1 row-of-houses)
+	 (%nation abode1 'english)
+	 (%hue abode1 'red)
+
+	 (%member abode2 row-of-houses)
+	 (%nation abode2 'spain)
+	 (%pet abode2 'dog)
+
+	 (%member abode3 row-of-houses)
+	 (%drink abode3 'coffee)
+	 (%hue abode3 'green)
+
+	 (%member abode4 row-of-houses)
+	 (%nation abode4 'ukraine)
+	 (%drink abode4 'tea)
+
+	 (%member abode5 row-of-houses)
+	 (%adjacent abode5 abode3 row-of-houses)
+	 (%hue abode5 'ivory)
+
+	 (%member abode6 row-of-houses)
+	 (%cigarette abode6 'winston)
+	 (%pet abode6 'snail)
+
+	 (%member abode7 row-of-houses)
+	 (%cigarette abode7 'kool)
+	 (%hue abode7 'yellow)
+
+	 (%= (list (_) (_) abode8 (_) (_)) row-of-houses)
+	 (%drink abode8 'milk)
+
+	 (%= (list abode9 (_) (_) (_) (_)) row-of-houses)
+	 (%nation abode9 'norway)
+
+	 (%member abode10 row-of-houses)
+	 (%member abode11 row-of-houses)
+	 (%or (%adjacent abode10 abode11 row-of-houses)
+	   (%adjacent abode11 abode10 row-of-houses))
+	 (%cigarette abode10 'chesterfield)
+	 (%pet abode11 'fox)
+
+	 (%member abode12 row-of-houses)
+	 (%or (%adjacent abode7 abode12 row-of-houses) 
+	   (%adjacent abode12 abode7 row-of-houses))
+	 (%pet abode12 'horse)
+
+	 (%member abode13 row-of-houses)
+	 (%cigarette abode13 'lucky-strike)
+	 (%drink abode13 'oj)
+
+	 (%member abode14 row-of-houses)
+	 (%nation abode14 'japan)
+	 (%cigarette abode14 'parliament)
+
+	 (%member abode15 row-of-houses)
+	 (%or (%adjacent abode9 abode15 row-of-houses) 
+	   (%adjacent abode15 abode9 row-of-houses))
+	 (%hue abode15 'blue))))))
+
+(define %houses-queries
+  (%rel (row-of-houses abode1 abode2 zebra-owner water-drinker)
+    ((row-of-houses
+       (list
+	 (%member abode1 row-of-houses)
+	 (%pet abode1 'zebra)
+	 (%nation abode1 zebra-owner)
+
+	 (%member abode2 row-of-houses)
+	 (%drink abode2 'water)
+	 (%nation abode2 water-drinker))
+
+       (list (list zebra-owner 'owns 'the 'zebra)
+	 (list water-drinker 'drinks 'water))))))
+
+;Load puzzle.scm and type (solve-puzzle %houses)
+
+;Note: This program, as written, requires
+;the occurs check.  Make sure the global
+;*schelog-use-occurs-check?* is set to #t before
+;calling solve-puzzle.  If not, you will get into
+;an infinite loop.
+
+;Note 2: Perhaps there is a way to rewrite the 
+;program so that it doesn't rely on the occurs check.
diff --git a/collects/schelog/examples/mapcol.scm b/collects/schelog/examples/mapcol.scm
new file mode 100644
index 0000000000..5970cd6050
--- /dev/null
+++ b/collects/schelog/examples/mapcol.scm
@@ -0,0 +1,79 @@
+;map coloring, example from Sterling & Shapiro, p. 212
+
+;(%member x y) holds if x is in y
+
+(define %member
+  (%rel (X Xs Y Ys)
+    ((X (cons X Xs)))
+    ((X (cons Y Ys)) (%member X Ys))))
+
+;(%members x y) holds if x is a subset of y
+
+(define %members
+  (%rel (X Xs Ys)
+    (((cons X Xs) Ys) (%member X Ys) (%members Xs Ys))
+    (('() Ys))))
+
+;(%select x y z) holds if z is y with one less occurrence of x
+
+(define %select
+  (%rel (X Xs Y Ys Zs)
+    ((X (cons X Xs) Xs))
+    ((X (cons Y Ys) (cons Y Zs))
+     (%select X Ys Zs))))
+
+;region is a structure-builder
+
+(define region
+  (lambda (name color neighbors)
+    (list 'region name color neighbors)))
+
+(define %color-map
+  (%rel (Region Regions Colors)
+    (((cons Region Regions) Colors)
+     (%color-region Region Colors) (%color-map Regions Colors))
+    (('() Colors))))
+
+(define %color-region
+  (%rel (Name Color Neighbors Colors Colors1)
+    (((region Name Color Neighbors) Colors)
+     (%select Color Colors Colors1)
+     (%members Neighbors Colors1))))
+
+(define %test-color
+  (%rel (Name Map Colors)
+    ((Name Map)
+     (%map Name Map)
+     (%colors Colors)
+     (%color-map Map Colors))))
+
+(define %map
+  (%rel (A B C D E F G H I L P S)
+    (('test (list
+	      (region 'a A (list B C D))
+	      (region 'b B (list A C E))
+	      (region 'c C (list A B D E F))
+	      (region 'd D (list A C F))
+	      (region 'e E (list B C F))
+	      (region 'f F (list C D E)))))
+    (('western-europe
+       (list
+	 (region 'portugal P (list E))
+	 (region 'spain E (list F P))
+	 (region 'france F (list E I S B G L))
+	 (region 'belgium B (list F H L G))
+	 (region 'holland H (list B G))
+	 (region 'germany G (list F A S H B L))
+	 (region 'luxembourg L (list F B G))
+	 (region 'italy I (list F A S))
+	 (region 'switzerland S (list F I A G))
+	 (region 'austria A (list I S G)))))))
+
+(define %colors
+  (%rel ()
+    (('(red yellow blue white)))))
+
+;ask (%which (M) (%test-color 'test M)) or
+;ask (%which (M) (%test-color 'western-europe M)) for the
+;respective (non-unique) colorings.
+
diff --git a/collects/schelog/examples/puzzle.scm b/collects/schelog/examples/puzzle.scm
new file mode 100644
index 0000000000..d58717e605
--- /dev/null
+++ b/collects/schelog/examples/puzzle.scm
@@ -0,0 +1,47 @@
+#lang scheme
+
+(require "../schelog.scm")
+
+(provide (all-defined-out))
+
+;This is the puzzle solver described in Sterling & Shapiro, p. 214
+
+;As S & S say, it is a "trivial" piece of code
+;that successively solves each clue and query, which are expressed
+;as Prolog goals and are executed with the meta-variable facility.
+
+;The code in "real" Prolog, for comparison, is:
+;
+;  solve_puzzle(Clues, Queries, Solution) 
+;                 :- solve(Clues), solve(Queries).
+;
+;  solve([Clue|Clues]) :- Clue, solve(Clues).
+;  solve([]).
+
+(define %solve-puzzle
+  (%rel ! (clues queries solution)
+    ((clues queries solution)
+      (%solve clues)
+      (%solve queries))))
+
+(define %solve
+  (%rel ! (clue clues)
+    (((cons clue clues))
+      clue 
+      (%solve clues))
+    (('()))))
+
+;evaluate (solve-puzzle %puzzle) to get the solution to
+;%puzzle.  Here %puzzle is a relation that is defined to
+;hold for the three arguments clues, queries and solution=,
+;iff they satisfy the constraints imposed by the puzzle.
+;solve-puzzle finds an (the?) instantiation for the solution=
+;variable.
+
+(define solve-puzzle
+  (lambda (%puzzle)
+    (%let (clues queries)
+      (%which (solution=)
+	(%and
+	  (%puzzle clues queries solution=)
+	  (%solve-puzzle clues queries solution=))))))
diff --git a/collects/schelog/examples/toys.scm b/collects/schelog/examples/toys.scm
new file mode 100644
index 0000000000..41f1af22f9
--- /dev/null
+++ b/collects/schelog/examples/toys.scm
@@ -0,0 +1,84 @@
+;A list of trivial programs in Prolog, just so you can get used
+;to schelog syntax.
+
+;(%length l n) holds if length(l) = n
+
+(define %length
+  (%rel (h t n m)
+    (('() 0))
+    (((cons h t) n) (%length t m) (%is n (+ m 1)))))
+
+;(%delete x y z) holds if z is y with all x's removed
+
+(define %delete
+  (%rel (x y z w)
+    ((x '() '()))
+    ((x (cons x w) y) (%delete x w y))
+    ((x (cons z w) (cons z y)) (%not (%= x z)) (%delete x w y))))
+
+;(%remdup x y) holds if y is x without duplicates
+
+(define %remdup
+  (%rel (x y z w)
+    (('() '()))
+    (((cons x y) (cons x z)) (%delete x y w) (%remdup w z))))
+
+;(%count x n) holds if n is the number of elements in x without
+;counting duplicates
+
+'(define %count
+  (%rel (x n y)
+    ((x n) (%remdup x y) (%length y n))))
+
+;same thing
+
+(define %count
+  (letrec ((countaux
+	     (%rel (m n m+1 x y z)
+	       (('() m m))
+	       (((cons x y) m n)
+		(%delete x y z) (%is m+1 (+ m 1)) (countaux z m+1 n)))))
+    (%rel (x n)
+      ((x n) (countaux x 0 n)))))
+
+;(%append x y z) holds if z is the concatenation of x and y
+
+(define %append
+  (%rel (x y z w)
+    (('() x x))
+    (((cons x y) z (cons x w)) (%append y z w))))
+
+;(%reverse x y) holds if the y is the reversal of x
+
+'(define %reverse
+  (%rel (x y z yy)
+    (('() '()))
+    (((cons x y) z) (%reverse y yy) (%append yy (list x) z))))
+
+;same thing, but tailcall optimizing
+
+(define %reverse
+  (letrec ((revaux
+	     (%rel (x y z w)
+	       (('() y y))
+	       (((cons x y) z w) (revaux y (cons x z) w)))))
+    (%rel (x y)
+      ((x y) (revaux x '() y)))))
+
+;(%fact n m) holds if m = n!
+
+'(define %fact
+  (%rel (n n! n-1 n-1!)
+    ((0 1))
+    ((n n!) (%is n-1 (- n 1)) (%fact n-1 n-1!) (%is n! (* n n-1!)))))
+
+;same thing, but tailcall optimizing
+
+(define %fact
+  (letrec ((factaux
+	     (%rel (n! m x m-1 xx)
+	       ((0 n! n!))
+	       ((m x n!) (%is m-1 (- m 1)) (%is xx (* x m))
+		(factaux m-1 xx n!)))))
+    (%rel (n n!)
+      ((n n!) (factaux n 1 n!)))))
diff --git a/collects/schelog/history b/collects/schelog/history
new file mode 100644
index 0000000000..e5796f988f
--- /dev/null
+++ b/collects/schelog/history
@@ -0,0 +1,109 @@
+June 1, 2003
+
+Include Gauche as a target dialect.  Alex Shinn 
+provided Gauche recognition to scmxlate (q.v.).
+
+3h5
+
+Mar 25, 2003
+
+%assert documentation bugfix.  From Steve Pothier.
+
+3h4
+
+15 Jul 2001
+
+Added optional Occurs Check, suggested by Brad Lucier.
+Brad also points out that the examples/houses.scm
+puzzle, as written, needs the Occurs Check.  ("as
+written"...?  Well, Prolog doesn't have the Occurs
+Check, and this famous puzzle is offered as an exercise
+in the Prolog textbook _The Art of Prolog_ (Sterling &
+Shapiro).  So I'm thinking perhaps there is a
+less naive solution that doesn't rely on the Occurs
+Check.)
+
+3h3
+
+Feb 28, 2000
+
+Gambit port improvement from Brad Lucier: eval
+define-macro explicitly to make macros usable after
+loading
+
+Sep 20, 1999
+
+3h
+
+Ported to Pocket Scheme (Ben Goetter) and Petite Chez Scheme.
+
+Jan 31, 1999
+
+3g1
+
+Minor bugfix for Gambit install
+
+May 2, 1998
+
+3g
+
+Ported to STk
+
+April 19, 1998
+
+3f
+
+Porting mechanism refined: ports to mzscheme, scm,
+guile, gambit, mitscheme, bigloo.
+
+April 1997
+
+3e
+
+Extensible mechanism added for porting to various
+Scheme dialects
+
+3d
+
+maybeini4gambit.scm (Brad Lucier)
+
+Corrected () in evaluable positions to '(), as Gambit
+won't accept unquoted ()s.  (Brad Lucier)
+
+3c
+
+maybeini4mzscheme.scm.
+
+Equal strings unify (Paul Prescod).
+
+HTML version of doc included.
+
+v. 3b
+
+Fixed bug in %and and %or.  (Using macros for now -- these were
+procedures in v. 3, 3a.)
+
+v. 3a
+
+Added maybeini4mitscheme.scm (for Tore Amble).
+
+March 1997
+
+v. 3
+
+Added syntax for asserting additional clauses to an existing
+relation.
+
+Set-predicates rewritten.  (Free variables given choice of
+treatment as in Prolog.  Previously they had all been
+assumed to be existentially quantified.)
+
+Improved tutorial documentation.
+
+Feb 1993
+
+Second release.
+
+1989
+
+First release.
diff --git a/collects/schelog/makefile b/collects/schelog/makefile
new file mode 100644
index 0000000000..a1340d2eb8
--- /dev/null
+++ b/collects/schelog/makefile
@@ -0,0 +1,44 @@
+
+TRIGGER_FILES = history manifest makefile version.tex \
+		schelog.scm schelog.tex
+
+default: 
+	@echo Please read the file INSTALL.
+
+%.html: %.tex 
+	tex2page $(@:%.html=%)
+	while grep -i "rerun: tex2page" $(@:%.html=%.hlog); do \
+	tex2page $(@:%.html=%); \
+	done
+
+schelog.pdf: schelog.tex
+	pdftex $^
+
+schelog.tar: 
+	echo tar cf schelog.tar schelog/manifest > .tarscript
+	for f in `grep "^[^;]" manifest`; do \
+	echo tar uf schelog.tar schelog/$$f >> .tarscript; \
+	done
+	chmod +x .tarscript
+	cd ..; schelog/.tarscript
+	mv ../schelog.tar .
+
+schelog.tar.bz2: $(TRIGGER_FILES)
+	make schelog.tar
+	bzip2 -f schelog.tar
+
+schelog.tar.gz: $(TRIGGER_FILES)
+	make schelog.tar
+	gzip -f schelog.tar
+
+html: schelog.html 
+
+pdf: schelog.pdf
+
+dist: schelog.tar.bz2
+
+webdist: schelog.tar.gz html
+
+clean:
+	@rm -f *~ *.bak
+	cd dialects; rm -f *~ *.bak
diff --git a/collects/schelog/manifest b/collects/schelog/manifest
new file mode 100644
index 0000000000..5d3091d762
--- /dev/null
+++ b/collects/schelog/manifest
@@ -0,0 +1,20 @@
+COPYING
+README
+manifest
+makefile
+schelog-version.tex
+INSTALL
+history
+schelog.tex
+schelog.scm
+schelog.bib
+dialects/*.scm
+examples/bible.scm
+examples/england.scm
+examples/england2.scm
+examples/games.scm
+examples/holland.scm
+examples/houses.scm
+examples/mapcol.scm
+examples/puzzle.scm
+examples/toys.scm
diff --git a/collects/schelog/schelog-version.tex b/collects/schelog/schelog-version.tex
new file mode 100644
index 0000000000..5dca9b0e71
--- /dev/null
+++ b/collects/schelog/schelog-version.tex
@@ -0,0 +1 @@
+2003-06-01% last change
diff --git a/collects/schelog/schelog.bib b/collects/schelog/schelog.bib
new file mode 100644
index 0000000000..98e6a41ba1
--- /dev/null
+++ b/collects/schelog/schelog.bib
@@ -0,0 +1,95 @@
+
+@book{sicp,
+    author = "Harold Abelson and Gerald Jay {Sussman with Julie Sussman}",
+    title = "\urlp{Structure and Interpretation of
+ Computer Programs (``SICP'')}{http://mitpress.mit.edu/sicp/full-text/book/book.html}",
+    edition = "2nd",
+    publisher = "MIT Press",
+    year = 1996,
+}
+
+@book{aop,
+    author = "Leon Sterling and Ehud Shapiro",
+    title = "\urlh{http://mitpress.mit.edu/book-home.tcl?isbn=0262193388}{The Art 
+ of Prolog}",
+    publisher = "MIT Press",
+    year = 1994,
+    edition = "2nd",
+}
+
+@book{tls,
+    author = "Daniel P Friedman and Matthias Felleisen",
+    title = "\urlh{http://www.ccs.neu.edu/~matthias/BTLS}{The Little Schemer}",
+    publisher = "MIT Press",
+    year = 1996,
+    edition = "4th",
+}
+
+@book{tss,
+    author = "Daniel P Friedman and Matthias Felleisen",
+    title = "\urlh{http://www.ccs.neu.edu/~matthias/BTSS}{The Seasoned Schemer}",
+    publisher = "MIT Press",
+    year = 1996,
+}
+
+@book{eopl,
+    author = "Daniel P Friedman and Mitchell Wand and Christopher T Haynes",
+    title = "\urlh{http://mitpress.mit.edu/book-home.tcl?isbn=0262061457}{Essentials
+ of Programming Languages}",
+    publisher = "MIT Press, McGraw-Hill",
+    year = 1992,
+}
+
+@book{bratko,
+    author = "Ivan Bratko",
+    title = "Prolog Programming for Artificial Intelligence",
+    publisher = "Addison-Wesley",
+    year = 1986,
+}
+
+@book{campbell,
+    editor = "J A Campbell",
+    title = "Implementations of Prolog",
+    publisher = "Ellis Horwood",
+    year = 1984,
+}
+
+@book{ok:prolog,
+    author = "Richard A O'Keefe",
+    title = "\urlh{http://mitpress.mit.edu/book-home.tcl?isbn=0262150395}{The
+ Craft of Prolog}",
+    publisher = "MIT Press",
+    year = 1990,
+}
+
+@inproceedings{logick,
+    author = "Christopher T Haynes",
+    title = "{Logic continuations}",
+    booktitle = "{J Logic Program}",
+    year = 1987,
+    note = "vol 4",
+    pages = "157--176",
+}
+
+@misc{r5rs,
+    author = "Richard Kelsey and William Clinger and
+ Jonathan {Rees (eds)}",
+    title = "\urlp{Revised\^{}5
+ Report on the Algorithmic Language Scheme
+ (``R5RS'')}{http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs.html}",
+    year = 1998,
+}
+
+@misc{t-y-scheme,
+    author = "Dorai Sitaram",
+    title = "\urlp{Teach Yourself Scheme
+ in Fixnum Days}{http://www.ccs.neu.edu/~dorai/t-y-scheme/t-y-scheme.html}",
+}
+
+@techreport{mf:prolog,
+    author = "Matthias Felleisen",
+    title = "{Transliterating Prolog into Scheme}",
+    institution = "{Indiana U Comp Sci Dept}",
+    year = 1985,
+    number = 182,
+}
diff --git a/collects/schelog/schelog.scm b/collects/schelog/schelog.scm
new file mode 100644
index 0000000000..dfad8ffb60
--- /dev/null
+++ b/collects/schelog/schelog.scm
@@ -0,0 +1,772 @@
+#lang scheme
+
+(provide (all-defined-out))
+
+
+;MzScheme version of
+;schelog.scm
+;Schelog
+;An embedding of Prolog in Scheme
+;Dorai Sitaram
+;1989, revised Feb. 1993, Mar. 1997
+
+;logic variables and their manipulation
+
+(define schelog:*ref* "ref")
+
+(define schelog:*unbound* '_)
+
+(define schelog:make-ref
+  ;;makes a fresh unbound ref;
+  ;;unbound refs point to themselves
+  (lambda opt
+    (vector schelog:*ref*
+      (if (null? opt) schelog:*unbound*
+	(car opt)))))
+
+(define _ schelog:make-ref)
+
+(define schelog:ref?
+  (lambda (r)
+    (and (vector? r)
+	 (eq? (vector-ref r 0) schelog:*ref*))))
+
+(define schelog:deref
+  (lambda (r)
+    (vector-ref r 1)))
+
+(define schelog:set-ref!
+  (lambda (r v)
+    (vector-set! r 1 v)))
+
+(define schelog:unbound-ref?
+  (lambda (r)
+    (eq? (schelog:deref r) schelog:*unbound*)))
+
+(define schelog:unbind-ref!
+  (lambda (r)
+    (schelog:set-ref! r schelog:*unbound*)))
+
+;frozen logic vars
+
+(define schelog:*frozen* "frozen")
+
+(define schelog:freeze-ref
+  (lambda (r)
+    (schelog:make-ref (vector schelog:*frozen* r))))
+
+(define schelog:thaw-frozen-ref
+  (lambda (r)
+    (vector-ref (schelog:deref r) 1)))
+
+(define schelog:frozen-ref?
+  (lambda (r)
+    (let ((r2 (schelog:deref r)))
+      (and (vector? r2)
+	   (eq? (vector-ref r2 0) schelog:*frozen*)))))
+
+;deref a structure completely (except the frozen ones, i.e.)
+
+(define schelog:deref*
+  (lambda (s)
+    (cond ((schelog:ref? s)
+	   (if (schelog:frozen-ref? s) s
+	     (schelog:deref* (schelog:deref s))))
+	  ((pair? s) (cons (schelog:deref* (car s))
+                       (schelog:deref* (cdr s))))
+	  ((vector? s)
+	   (list->vector (map schelog:deref* (vector->list s))))
+	  (else s))))
+
+;%let introduces new logic variables
+
+(define-syntax %let
+  (syntax-rules ()
+    ((%let (x ...) . e)
+      (let ((x (schelog:make-ref)) ...)
+        . e))))
+
+#;(define-macro %let
+  (lambda (xx . ee)
+    `(let ,(map (lambda (x) `(,x (schelog:make-ref))) xx)
+       ,@ee)))
+
+;the unify predicate
+
+(define *schelog-use-occurs-check?* #f)
+
+(define schelog:occurs-in? 
+  (lambda (var term)
+    (and *schelog-use-occurs-check?*
+         (let loop ((term term))
+           (cond ((eqv? var term) #t)
+                 ((schelog:ref? term)
+                  (cond ((schelog:unbound-ref? term) #f)
+                        ((schelog:frozen-ref? term) #f)
+                        (else (loop (schelog:deref term)))))
+                 ((pair? term)
+                  (or (loop (car term)) (loop (cdr term))))
+                 ((vector? term)
+                  (loop (vector->list term)))
+                 (else #f))))))
+
+(define schelog:unify
+  (lambda (t1 t2)
+    (lambda (fk)
+      (letrec
+        ((cleanup-n-fail
+           (lambda (s)
+             (for-each schelog:unbind-ref! s)
+             (fk 'fail)))
+         (unify1
+           (lambda (t1 t2 s)
+             ;(printf "unify1 ~s ~s~%" t1 t2)
+             (cond ((eqv? t1 t2) s)
+                   ((schelog:ref? t1)
+                    (cond ((schelog:unbound-ref? t1)
+                           (cond ((schelog:occurs-in? t1 t2)
+                                  (cleanup-n-fail s))
+                                 (else 
+                                   (schelog:set-ref! t1 t2)
+                                   (cons t1 s))))
+                          ((schelog:frozen-ref? t1)
+                           (cond ((schelog:ref? t2)
+                                  (cond ((schelog:unbound-ref? t2)
+                                         ;(printf "t2 is unbound~%")
+                                         (unify1 t2 t1 s))
+                                        ((schelog:frozen-ref? t2)
+                                         (cleanup-n-fail s))
+                                        (else
+                                          (unify1 t1 (schelog:deref t2) s))))
+                                 (else (cleanup-n-fail s))))
+                          (else 
+                            ;(printf "derefing t1~%") 
+                            (unify1 (schelog:deref t1) t2 s))))
+                   ((schelog:ref? t2) (unify1 t2 t1 s))
+                   ((and (pair? t1) (pair? t2))
+                    (unify1 (cdr t1) (cdr t2)
+                            (unify1 (car t1) (car t2) s)))
+                   ((and (string? t1) (string? t2))
+                    (if (string=? t1 t2) s
+                        (cleanup-n-fail s)))
+                   ((and (vector? t1) (vector? t2))
+                    (unify1 (vector->list t1)
+                            (vector->list t2) s))
+                   (else
+                     (for-each schelog:unbind-ref! s)
+                     (fk 'fail))))))
+        (let ((s (unify1 t1 t2 '())))
+          (lambda (d)
+            (cleanup-n-fail s)))))))
+
+(define %= schelog:unify)
+
+;disjunction
+
+(define-syntax %or
+  (syntax-rules ()
+    ((%or g ...)
+     (lambda (__fk)
+       (call-with-current-continuation
+	 (lambda (__sk)
+	   (call-with-current-continuation
+	     (lambda (__fk)
+	       (__sk ((schelog:deref* g) __fk))))
+	   ...
+	   (__fk 'fail)))))))
+
+#;(define-macro %or
+  (lambda gg
+    `(lambda (__fk)
+       (call-with-current-continuation
+        (lambda (__sk)
+          ,@(map (lambda (g)
+                   `(call-with-current-continuation
+                     (lambda (__fk)
+                       (__sk ((schelog:deref* ,g) __fk)))))
+                 gg)
+          (__fk 'fail))))))
+
+;conjunction
+
+(define-syntax %and
+  (syntax-rules ()
+    ((%and g ...)
+     (lambda (__fk)
+       (let* ((__fk ((schelog:deref* g) __fk))
+	      ...)
+	 __fk)))))
+
+#;(define-macro %and
+  (lambda gg
+    `(lambda (__fk)
+       (let* ,(map (lambda (g) `(__fk ((schelog:deref* ,g) __fk))) gg)
+         __fk))))
+
+;cut
+
+;; rather arbitrarily made this macro non-
+;; capturing by requiring ! to be supplied at
+;; macro use... not changing docs... -- JBC 2010
+(define-syntax %cut-delimiter
+  (syntax-rules ()
+    ((%cut-delimiter ! g)
+     (lambda (__fk)
+       (let ((! (lambda (__fk2) __fk)))
+	 ((schelog:deref* g) __fk))))))
+
+#;(define-macro %cut-delimiter
+  (lambda (g)
+    `(lambda (__fk)
+       (let ((! (lambda (__fk2) __fk)))
+         ((schelog:deref* ,g) __fk)))))
+
+;Prolog-like sugar
+
+(define-syntax %rel
+  (syntax-rules ()
+    ((%rel ! (v ...) ((a ...) subgoal ...) ...)
+      (lambda __fmls
+        (lambda (__fk)
+          (call-with-current-continuation
+            (lambda (__sk)
+              (let ((! (lambda (fk1) __fk)))
+                (%let (v ...)
+                  (call-with-current-continuation
+                    (lambda (__fk)
+                      (let* ((__fk ((%= __fmls (list a ...)) __fk))
+                              (__fk ((schelog:deref* subgoal) __fk))
+                              ...)
+                        (__sk __fk))))
+                  ...
+                  (__fk 'fail))))))))))
+
+#;(define-macro %rel
+  (lambda (vv . cc)
+    `(lambda __fmls
+       (lambda (__fk)
+         (call-with-current-continuation
+          (lambda (__sk)
+            (let ((! (lambda (fk1) __fk)))
+              (%let ,vv
+                    ,@(map (lambda (c)
+                             `(call-with-current-continuation
+                               (lambda (__fk)
+                                 (let* ((__fk ((%= __fmls (list ,@(car c)))
+                                               __fk))
+                                        ,@(map (lambda (sg)
+                                                 `(__fk ((schelog:deref* ,sg)
+                                                         __fk)))
+                                               (cdr c)))
+                                   (__sk __fk)))))
+                           cc)
+                    (__fk 'fail)))))))))
+
+;the fail and true preds
+
+(define %fail
+  (lambda (fk) (fk 'fail)))
+
+(define %true
+  (lambda (fk) fk))
+
+;for structures ("functors"), use Scheme's list and vector
+;functions and anything that's built using them.
+
+;arithmetic
+
+(define-syntax %is
+  (syntax-rules (quote)
+    ((%is v e)
+     (lambda (__fk)
+       ((%= v (%is (1) e __fk)) __fk)))
+
+    ((%is (1) (quote x) fk) (quote x))
+    ((%is (1) (x ...) fk)
+     ((%is (1) x fk) ...))
+    ((%is (1) x fk)
+     (if (and (schelog:ref? x) (schelog:unbound-ref? x))
+	 (fk 'fail) (schelog:deref* x)))))
+
+#;(define-macro %is
+  (lambda (v e)
+    (letrec ((%is-help (lambda (e fk)
+                         (cond ((pair? e)
+                                (cond ((eq? (car e) 'quote) e)
+                                      (else
+                                       (map (lambda (e1)
+                                              (%is-help e1 fk)) e))))
+                               (else
+                                `(if (and (schelog:ref? ,e)
+                                          (schelog:unbound-ref? ,e))
+                                     (,fk 'fail) (schelog:deref* ,e)))))))
+      `(lambda (__fk)
+         ((%= ,v ,(%is-help e '__fk)) __fk)))))
+
+;defining arithmetic comparison operators
+
+(define schelog:make-binary-arithmetic-relation
+  (lambda (f)
+    (lambda (x y)
+      (%is #t (f x y)))))
+
+(define %=:= (schelog:make-binary-arithmetic-relation =))
+(define %> (schelog:make-binary-arithmetic-relation >))
+(define %>= (schelog:make-binary-arithmetic-relation >=))
+(define %< (schelog:make-binary-arithmetic-relation <))
+(define %<= (schelog:make-binary-arithmetic-relation <=))
+(define %=/= (schelog:make-binary-arithmetic-relation
+               (lambda (m n) (not (= m n)))))
+
+;type predicates
+
+(define schelog:constant?
+  (lambda (x)
+    (cond ((schelog:ref? x)
+	   (cond ((schelog:unbound-ref? x) #f)
+		 ((schelog:frozen-ref? x) #t)
+		 (else (schelog:constant? (schelog:deref x)))))
+	  ((pair? x) #f)
+	  ((vector? x) #f)
+	  (else #t))))
+
+(define schelog:compound?
+  (lambda (x)
+    (cond ((schelog:ref? x) (cond ((schelog:unbound-ref? x) #f)
+			  ((schelog:frozen-ref? x) #f)
+			  (else (schelog:compound? (schelog:deref x)))))
+	  ((pair? x) #t)
+	  ((vector? x) #t)
+	  (else #f))))
+
+(define %constant
+  (lambda (x)
+    (lambda (fk)
+      (if (schelog:constant? x) fk (fk 'fail)))))
+
+(define %compound
+  (lambda (x)
+    (lambda (fk)
+      (if (schelog:compound? x) fk (fk 'fail)))))
+
+;metalogical type predicates
+
+(define schelog:var?
+  (lambda (x)
+    (cond ((schelog:ref? x)
+	   (cond ((schelog:unbound-ref? x) #t)
+		 ((schelog:frozen-ref? x) #f)
+		 (else (schelog:var? (schelog:deref x)))))
+	  ((pair? x) (or (schelog:var? (car x)) (schelog:var? (cdr x))))
+	  ((vector? x) (schelog:var? (vector->list x)))
+	  (else #f))))
+
+(define %var
+  (lambda (x)
+    (lambda (fk) (if (schelog:var? x) fk (fk 'fail)))))
+
+(define %nonvar
+  (lambda (x)
+    (lambda (fk) (if (schelog:var? x) (fk 'fail) fk))))
+
+; negation of unify
+
+(define schelog:make-negation ;basically inlined cut-fail
+  (lambda (p)
+    (lambda args
+      (lambda (fk)
+	(if (call-with-current-continuation
+	      (lambda (k)
+		((apply p args) (lambda (d) (k #f)))))
+	    (fk 'fail)
+	    fk)))))
+
+(define %/=
+  (schelog:make-negation %=))
+
+;identical
+
+(define schelog:ident?
+  (lambda (x y)
+    (cond ((schelog:ref? x)
+	   (cond ((schelog:unbound-ref? x)
+		  (cond ((schelog:ref? y)
+			 (cond ((schelog:unbound-ref? y) (eq? x y))
+			       ((schelog:frozen-ref? y) #f)
+			       (else (schelog:ident? x (schelog:deref y)))))
+			(else #f)))
+		 ((schelog:frozen-ref? x)
+		  (cond ((schelog:ref? y)
+			 (cond ((schelog:unbound-ref? y) #f)
+			       ((schelog:frozen-ref? y) (eq? x y))
+			       (else (schelog:ident? x (schelog:deref y)))))
+			(else #f)))
+		 (else (schelog:ident? (schelog:deref x) y))))
+	  ((pair? x)
+	   (cond ((schelog:ref? y)
+		  (cond ((schelog:unbound-ref? y) #f)
+			((schelog:frozen-ref? y) #f)
+			(else (schelog:ident? x (schelog:deref y)))))
+		 ((pair? y)
+		  (and (schelog:ident? (car x) (car y))
+		       (schelog:ident? (cdr x) (cdr y))))
+		 (else #f)))
+	  ((vector? x)
+	   (cond ((schelog:ref? y)
+		  (cond ((schelog:unbound-ref? y) #f)
+			((schelog:frozen-ref? y) #f)
+			(else (schelog:ident? x (schelog:deref y)))))
+		 ((vector? y)
+		  (schelog:ident? (vector->list x)
+		    (vector->list y)))
+		 (else #f)))
+	  (else
+	    (cond ((schelog:ref? y)
+		   (cond ((schelog:unbound-ref? y) #f)
+			 ((schelog:frozen-ref? y) #f)
+			 (else (schelog:ident? x (schelog:deref y)))))
+		  ((pair? y) #f)
+		  ((vector? y) #f)
+		  (else (eqv? x y)))))))
+
+(define %==
+  (lambda (x y)
+    (lambda (fk) (if (schelog:ident? x y) fk (fk 'fail)))))
+
+(define %/==
+  (lambda (x y)
+    (lambda (fk) (if (schelog:ident? x y) (fk 'fail) fk))))
+
+;variables as objects
+
+(define schelog:freeze
+  (lambda (s)
+    (let ((dict '()))
+      (let loop ((s s))
+	(cond ((schelog:ref? s)
+	       (cond ((or (schelog:unbound-ref? s) (schelog:frozen-ref? s))
+		      (let ((x (assq s dict)))
+			(if x (cdr x)
+			    (let ((y (schelog:freeze-ref s)))
+			      (set! dict (cons (cons s y) dict))
+			      y))))
+		     ;((schelog:frozen-ref? s) s) ;?
+		     (else (loop (schelog:deref s)))))
+	      ((pair? s) (cons (loop (car s)) (loop (cdr s))))
+	      ((vector? s)
+	       (list->vector (map loop (vector->list s))))
+	      (else s))))))
+
+(define schelog:melt
+  (lambda (f)
+    (cond ((schelog:ref? f)
+	   (cond ((schelog:unbound-ref? f) f)
+		 ((schelog:frozen-ref? f) (schelog:thaw-frozen-ref f))
+		 (else (schelog:melt (schelog:deref f)))))
+	  ((pair? f)
+	   (cons (schelog:melt (car f)) (schelog:melt (cdr f))))
+	  ((vector? f)
+	   (list->vector (map schelog:melt (vector->list f))))
+	  (else f))))
+
+(define schelog:melt-new
+  (lambda (f)
+    (let ((dict '()))
+      (let loop ((f f))
+	(cond ((schelog:ref? f)
+	       (cond ((schelog:unbound-ref? f) f)
+		     ((schelog:frozen-ref? f)
+		      (let ((x (assq f dict)))
+			(if x (cdr x)
+			    (let ((y (schelog:make-ref)))
+			      (set! dict (cons (cons f y) dict))
+			      y))))
+		     (else (loop (schelog:deref f)))))
+	      ((pair? f) (cons (loop (car f)) (loop (cdr f))))
+	      ((vector? f)
+	       (list->vector (map loop (vector->list f))))
+	      (else f))))))
+
+(define schelog:copy
+  (lambda (s)
+    (schelog:melt-new (schelog:freeze s))))
+
+(define %freeze
+  (lambda (s f)
+    (lambda (fk)
+      ((%= (schelog:freeze s) f) fk))))
+
+(define %melt
+  (lambda (f s)
+    (lambda (fk)
+      ((%= (schelog:melt f) s) fk))))
+
+(define %melt-new
+  (lambda (f s)
+    (lambda (fk)
+      ((%= (schelog:melt-new f) s) fk))))
+
+(define %copy
+  (lambda (s c)
+    (lambda (fk)
+      ((%= (schelog:copy s) c) fk))))
+
+;negation as failure
+
+(define %not
+  (lambda (g)
+    (lambda (fk)
+      (if (call-with-current-continuation
+	    (lambda (k)
+	      ((schelog:deref* g) (lambda (d) (k #f)))))
+	  (fk 'fail) fk))))
+
+;assert, asserta
+
+(define %empty-rel
+  (lambda args
+    %fail))
+
+(define-syntax %assert
+  (syntax-rules (!)
+    ((%assert rel-name (v ...) ((a ...) subgoal ...) ...)
+      (set! rel-name
+        (let ((__old-rel rel-name)
+               (__new-addition (%rel (v ...) ((a ...) subgoal ...) ...)))
+          (lambda __fmls
+            (%or (apply __old-rel __fmls)
+              (apply __new-addition __fmls))))))))
+
+(define-syntax %assert-a
+  (syntax-rules (!)
+    ((%assert-a rel-name (v ...) ((a ...) subgoal ...) ...)
+      (set! rel-name
+        (let ((__old-rel rel-name)
+               (__new-addition (%rel (v ...) ((a ...) subgoal ...) ...)))
+          (lambda __fmls
+            (%or (apply __new-addition __fmls)
+              (apply __old-rel __fmls))))))))
+
+#;(define-macro %assert
+  (lambda (rel-name vv . cc)
+    `(set! ,rel-name
+           (let ((__old-rel ,rel-name)
+                 (__new-addition (%rel ,vv ,@cc)))
+             (lambda __fmls
+               (%or (apply __old-rel __fmls)
+                    (apply __new-addition __fmls)))))))
+
+#;(define-macro %assert-a
+  (lambda (rel-name vv . cc)
+    `(set! ,rel-name
+           (let ((__old-rel ,rel-name)
+                 (__new-addition (%rel ,vv ,@cc)))
+             (lambda __fmls
+               (%or (apply __new-addition __fmls)
+                    (apply __old-rel __fmls)))))))
+
+;set predicates
+
+(define schelog:set-cons
+  (lambda (e s)
+    (if (member e s) s (cons e s))))
+
+(define-syntax %free-vars
+  (syntax-rules ()
+    ((%free-vars (v ...) g)
+      (cons 'schelog:goal-with-free-vars
+        (cons (list v ...) g)))))
+
+#;(define-macro %free-vars
+  (lambda (vv g)
+    `(cons 'schelog:goal-with-free-vars
+           (cons (list ,@vv) ,g))))
+
+(define schelog:goal-with-free-vars?
+  (lambda (x)
+    (and (pair? x) (eq? (car x) 'schelog:goal-with-free-vars))))
+
+(define schelog:make-bag-of
+  (lambda (kons)
+    (lambda (lv goal bag)
+      (let ((fvv '()))
+        (when (schelog:goal-with-free-vars? goal)
+          (set! fvv (cadr goal))
+          (set! goal (cddr goal)))
+        (schelog:make-bag-of-aux kons fvv lv goal bag)))))
+
+(define schelog:make-bag-of-aux
+  (lambda (kons fvv lv goal bag)
+    (lambda (fk)
+      (call-with-current-continuation
+        (lambda (sk)
+          (let ((lv2 (cons fvv lv)))
+            (let* ((acc '())
+                    (fk-final
+                      (lambda (d)
+                        ;;(set! acc (reverse! acc))
+                        (sk ((schelog:separate-bags fvv bag acc) fk))))
+                    (fk-retry (goal fk-final)))
+              (set! acc (kons (schelog:deref* lv2) acc))
+              (fk-retry 'retry))))))))
+
+(define schelog:separate-bags
+  (lambda (fvv bag acc)
+    ;;(format #t "Accum: ~s~%" acc)
+    (let ((bags (let loop ((acc acc)
+                            (current-fvv #f) (current-bag '())
+                            (bags '()))
+                  (if (null? acc)
+                    (cons (cons current-fvv current-bag) bags)
+                    (let ((x (car acc)))
+                      (let ((x-fvv (car x)) (x-lv (cdr x)))
+                        (if (or (not current-fvv) (equal? x-fvv current-fvv))
+                          (loop (cdr acc) x-fvv (cons x-lv current-bag) bags)
+                          (loop (cdr acc) x-fvv (list x-lv)
+                            (cons (cons current-fvv current-bag) bags)))))))))
+      ;;(format #t "Bags: ~a~%" bags)
+      (if (null? bags) (%= bag '())
+        (let ((fvv-bag (cons fvv bag)))
+          (let loop ((bags bags))
+            (if (null? bags) %fail
+              (%or (%= fvv-bag (car bags))
+                (loop (cdr bags))))))))))
+
+(define %bag-of (schelog:make-bag-of cons))
+(define %set-of (schelog:make-bag-of schelog:set-cons))
+
+;%bag-of-1, %set-of-1 hold if there's at least one solution
+
+(define %bag-of-1
+  (lambda (x g b)
+    (%and (%bag-of x g b)
+      (%= b (cons (_) (_))))))
+
+(define %set-of-1
+  (lambda (x g s)
+    (%and (%set-of x g s)
+      (%= s (cons (_) (_))))))
+
+;user interface
+
+;(%which (v ...) query) returns #f if query fails and instantiations
+;of v ... if query succeeds.  In the latter case, type (%more) to
+;retry query for more instantiations.
+
+(define schelog:*more-k* (box 'forward))
+(define schelog:*more-fk* (box 'forward))
+
+(define-syntax %which
+  (syntax-rules ()
+    ((%which (v ...) g)
+     (%let (v ...)
+       (call-with-current-continuation
+         (lambda (__qk)
+           (set-box! schelog:*more-k* __qk)
+           (set-box! schelog:*more-fk*
+             ((schelog:deref* g)
+              (lambda (d)
+                (set-box! schelog:*more-fk* #f)
+                ((unbox schelog:*more-k*) #f))))
+           ((unbox schelog:*more-k*)
+             (map (lambda (nam val) (list nam (schelog:deref* val)))
+                  '(v ...)
+                  (list v ...)))))))))
+
+#;(define-macro %which
+  (lambda (vv g)
+    `(%let ,vv
+           (call-with-current-continuation
+            (lambda (__qk)
+              (set! schelog:*more-k* __qk)
+              (set! schelog:*more-fk*
+                    ((schelog:deref* ,g)
+                     (lambda (d)
+                       (set! schelog:*more-fk* #f)
+                       (schelog:*more-k* #f))))
+              (schelog:*more-k*
+               (map (lambda (nam val) (list nam (schelog:deref* val)))
+                    ',vv
+                    (list ,@vv))))))))
+
+(define %more
+  (lambda ()
+    (call-with-current-continuation
+      (lambda (k)
+	(set-box! schelog:*more-k* k)
+	(if (unbox schelog:*more-fk*) ((unbox schelog:*more-fk*) 'more)
+	  #f)))))
+
+;end of embedding code.  The following are
+;some utilities, written in Schelog
+
+(define %member
+  (lambda (x y)
+    (%let (xs z zs)
+      (%or
+	(%= y (cons x xs))
+	(%and (%= y (cons z zs))
+	  (%member x zs))))))
+
+(define %if-then-else
+  (lambda (p q r)
+    (%cut-delimiter !
+      (%or
+	(%and p ! q)
+	r))))
+
+;the above could also have been written in a more
+;Prolog-like fashion, viz.
+
+'(define %member
+  (%rel ! (x xs y ys)
+    ((x (cons x xs)))
+    ((x (cons y ys)) (%member x ys))))
+
+'(define %if-then-else
+  (%rel ! (p q r)
+    ((p q r) p ! q)
+    ((p q r) r)))
+
+(define %append
+  (%rel ! (x xs ys zs)
+    (('() ys ys))
+    (((cons x xs) ys (cons x zs))
+      (%append xs ys zs))))
+
+(define %repeat
+  ;;failure-driven loop
+  (%rel ! ()
+    (())
+    (() (%repeat))))
+
+; deprecated names -- retained here for backward-compatibility
+
+(define == %=)
+(define %notunify %/=)
+
+#;(define-macro %cut
+  (lambda e
+    `(%cur-delimiter ,@e)))
+
+#;(define-macro rel
+  (lambda e
+    `(%rel ,@e)))
+(define %eq %=:=)
+(define %gt %>)
+(define %ge %>=)
+(define %lt %<)
+(define %le %<=)
+(define %ne %=/=)
+(define %ident %==)
+(define %notident %/==)
+;(define-syntax %exists (syntax-rules () ((%exists vv g) g)))
+
+#;(define-macro %exists (lambda (vv g) g))
+
+#;(define-macro which
+  (lambda e
+    `(%which ,@e)))
+(define more %more)
+
+;end of file
diff --git a/collects/schelog/schelog.tex b/collects/schelog/schelog.tex
new file mode 100644
index 0000000000..ce7f3b4f55
--- /dev/null
+++ b/collects/schelog/schelog.tex
@@ -0,0 +1,1572 @@
+\magnification\magstephalf
+
+\input tex2page
+\input btxmac
+\texonly
+%\input 2col
+
+\sidemargin 1.75 true in
+
+%\input defun
+
+% avoiding overfull boxes, without making
+% paragraphs too bad
+
+\pretolerance -1
+\emergencystretch 5pt
+\tolerance 3000
+
+\hfuzz 1pt
+
+\hyphenpenalty -1000
+\exhyphenpenalty -1000
+\doublehyphendemerits -100000
+\finalhyphendemerits  -100000
+
+% ! is special char for makeindex
+%\def\bang{!}
+
+\let\n\noindent
+
+\let\origverb\verb
+
+\def\verb{\def\verbatimhook{\parindent0pt \relax}\origverb}
+
+\def\p{\let\verbatimhook\relax\origverb}
+
+%sign for ``evaluates to''
+\def\y{$\Rightarrow$}
+
+%notation for true nil
+\def\t{{\tt()}$^{\rm true}$}
+
+\overfullrule 0pt
+
+
+\def\ar/#1{{\it/#1\/}}
+
+\hyphenation{sche-log}
+
+\let\ab\allowbreak
+
+
+%that's all
+%\input ptm
+
+\endtexonly
+
+\htmlonly
+\def\defun#1#2{%
+\evalh{(do-end-para)}%
+\rawhtml<table bgcolor="#e5e5e5"  width=90% cellpadding=0 cellspacing=0><tr ><td align=left>\endrawhtml
+#2%
+\rawhtml</td><td align=right>\endrawhtml{#1}%
+\rawhtml</td></tr></table>\endrawhtml
+\evalh{(do-para)}}
+
+\def\t{()\rawhtml<sup><small>true</small></sup>\endrawhtml}
+\def\y{{\tt =>}}
+
+
+\endhtmlonly
+
+\let\byline\centerline
+
+\def\defproc{\defun{[{\it procedure}]}}
+\def\defpred{\defun{[{\it predicate}]}}
+\def\defmac{\defun{[{\it macro}]}}
+\def\defgoal{\defun{[{\it goal}]}}
+\def\defflag{\defun{[{\it flag}]}}
+
+\def\newsection{\htmlpagebreak\section}
+
+\let\q\scm
+\let\sverbatim\scm
+
+\scmkeyword{%which %rel %assert %assert-a %let %and %or %is
+! %free-vars
+}
+
+\texonly
+\def\t{()$^t$}
+\def\y{$\Rightarrow$}
+\endtexonly
+
+\title{Programming in Schelog}
+
+\byline{\urlh{http://www.ccs.neu.edu/~dorai}{Dorai
+Sitaram}}
+%\byline{\urlh{mailto:ds26@gte.com}{ds26@gte.com}}
+\byline{\urlh{schelog.tar.gz}{\htmlonly Download
+\endhtmlonly Version \input ./schelog-version }}
+\htmlonly
+\byline{\urlh{INSTALL}{Installation instructions}}
+\endhtmlonly
+
+\bigskip
+
+\n Schelog is an {\em embedding} of
+Prolog-style logic programming in Scheme.  ``Embedding''
+means you don't lose Scheme: You can use Prolog-style and
+conventional Scheme code fragments alongside each other.
+Schelog contains the full repertoire of Prolog features,
+including meta-logical and second-order (``set'')
+predicates, leaving out only those features that could more
+easily and more efficiently be done with Scheme
+subexpressions.
+
+The Schelog implementation uses the approach to logic
+programming described in Felleisen \cite{mf:prolog} and
+Haynes \cite{logick}.  In contrast to earlier Lisp simulations of
+Prolog \cite{campbell},
+which used explicit continuation
+arguments to store failure (backtrack) information, the
+Felleisen and Haynes model uses the implicit reified
+continuations of Scheme as provided by the operator
+\q{call-with-current-continuation} (aka \q{call/cc}).  This
+allows Schelog to be an {\em embedding}, ie, logic
+programming is not built as a new language on top of Scheme,
+but is used alongside Scheme's other features.  Both styles
+of programming may be mixed to any extent that a project
+needs.
+
+The Schelog user does not need to know about the
+implementation mechanism or about \q{call/cc} and
+continuations to get on with the business of
+doing logic programming with Schelog.
+
+This text is a gentle introduction to Schelog syntax
+and programming.  It assumes a working knowledge of
+Scheme and an awareness of, if not actual programming
+experience with, Prolog.  If you need assistance in
+either language, you may consult
+\cite{sicp,tls,tss,eopl,r5rs,t-y-scheme} for Scheme, and
+\cite{bratko,ok:prolog,aop} for Prolog.
+There are doubtless many other excellent books and
+online documents available.
+
+\beginsection Contents
+
+\tableofcontents
+
+\newsection{Simple Goals and Queries}
+\label{simple}
+
+Schelog objects are the same as Scheme objects.  However, there
+are two subsets of these objects that are of special
+interest to Schelog: {\em goals} and {\em predicates}.  We
+will first look at some simple goals.
+Section \ref{predicates} will introduce predicates and ways
+of making  complex goals using predicates.
+
+A goal is an object whose truth or falsity we can check.  A
+goal that turns out to be true is said to succeed.
+A goal that turns out to be false is said to
+fail.
+
+Two simple goals that are provided in Schelog are:
+
+\sverbatim{
+%true
+%fail
+}
+
+\n The  goal \q{%true} succeeds.  The goal \q{%fail}
+always fails.
+
+(The names of all Schelog primitive objects
+start with \q{%}.  This is to avoid clashes with the names
+of conventional Scheme objects of related meaning.
+User-created objects in Schelog are not required to
+follow this convention.)
+
+A Schelog user can {\em query} a goal by wrapping it in a
+\q{%which}-form.
+
+\sverbatim{
+(%which () %true)
+}
+
+\n evaluates to \q{()}, indicating success, whereas:
+
+\sverbatim{
+(%which () %fail)
+}
+
+\n evaluates to \q{#f}, indicating failure.
+
+Note 1: The second subexpression of the \q{%which}-form
+is the empty list \q{()}.  Later (sec \ref{solving-goals}),
+we will see \q{%which}es
+with other lists as the second subform.
+
+Note 2: The distinction between successful and failing goals
+depends on Scheme's distinguishing \q{#f} from
+\q{()}.  We will see later (sec \ref{false-vs-nil})
+what to do in Scheme dialects where \q{#f} and \q{()} are
+identical.  For the moment, we will use the annotation
+\q{|t} to signal that \q{()} is being used as a true
+value.
+
+Henceforth, we will use the notation:
+
+\sverbatim{
+E |y F
+}
+
+\n to say that \q{E}  {\em evaluates to} \q{F}.   Thus,
+
+\sverbatim{
+(%which () %true) |y |t
+}
+
+\newsection{Predicates}
+\label{predicates}
+
+More interesting goals are created by applying a special
+kind of Schelog object called a {\em predicate} (or
+{\em relation}) to other
+Schelog objects.  Schelog comes with some primitive
+predicates, such as the arithmetic operators
+\q{%=:=} and \q{%<},
+standing for arithmetic ``equal'' and ``less than''
+respectively.  For example, the following are some goals
+involving these predicates:
+
+\sverbatim{
+(%which () (%=:= 1 1)) |y |t
+(%which () (%< 1 2))   |y |t
+(%which () (%=:= 1 2)) |y #f
+(%which () (%< 1 1))   |y #f
+}
+
+\n Other arithmetic predicates are
+\q{%>} (``greater than''),
+\q{%<=} (``less than or equal''),
+\q{%>=} (``greater than or equal''), and
+\q{%=/=} (``not equal'').
+
+Schelog predicates are not to be confused with conventional
+Scheme predicates (such as \q{<} and \q{=}).  Schelog
+predicates, when applied to arguments, produce goals
+that
+may either succeed or fail.  Scheme predicates, when applied
+to arguments, yield a boolean value.  Henceforth, we will
+use the term ``predicate'' to mean Schelog predicates.
+Conventional predicates will be explicitly called ``Scheme
+predicates''.
+
+\subsection{Predicates Introducing Facts}
+\label{facts}
+
+Users can create their own predicates using the Schelog form
+\q{%rel}.  For example, let's
+define the predicate \q{%knows}:
+
+\sverbatim{
+(define %knows
+  (%rel ()
+    [('Odysseus 'TeX)]
+    [('Odysseus 'Scheme)]
+    [('Odysseus 'Prolog)]
+    [('Odysseus 'Penelope)]
+    [('Penelope 'TeX)]
+    [('Penelope 'Prolog)]
+    [('Penelope 'Odysseus)]
+    [('Telemachus 'TeX)]
+    [('Telemachus 'calculus)]))
+}
+
+\n The expression has the expected meaning.  Each
+{\em clause} in the \q{%rel} establishes a {\em fact}:
+Odysseus
+knows TeX, Telemachus knows calculus, \&c.  In general, if we
+apply the predicate to the arguments in any one of its
+clauses, we will get a successful goal.  Thus, since
+\q{%knows} has a clause that reads
+\q{[('Odysseus 'TeX)]}, the goal
+\q{(%knows 'Odysseus 'TeX)}
+will be true.
+
+(In the code in
+this text, brackets have the same behavior as parentheses.
+We use a mix of brackets and parentheses solely to improve
+the readability of the code for humans.]
+
+We can now get answers for the following types of queries:
+
+\sverbatim{
+(%which ()
+  (%knows 'Odysseus 'TeX))
+|y |t
+
+(%which ()
+  (%knows 'Telemachus 'Scheme))
+|y #f
+}
+
+\subsection{Predicates with Rules}
+\label{rules}
+
+Predicates can be more complicated than the above bald
+recitation of facts.  The predicate clauses can be {\em rules}, eg,
+
+\sverbatim{
+(define %computer-literate
+  (%rel (person)
+    [(person)
+      (%knows person 'TeX)
+      (%knows person 'Scheme)]
+    [(person)
+      (%knows person 'TeX)
+      (%knows person 'Prolog)]))
+}
+
+\n This defines the predicate
+\q{%computer-literate} in
+terms of the predicate \q{%knows}.  In effect, a person is
+defined as computer-literate if they know TeX and
+Scheme, {\em or} TeX and Prolog.
+
+Note that this use of
+\q{%rel} employs a local {\em logic variable} called \q{person}.
+In general, a \q{%rel}-expression can have a list of symbols
+as its second subform.  These name new logic variables that
+can be used within the body of the \q{%rel}.
+
+The following query can now be answered:
+
+\sverbatim{
+(%which ()
+  (%computer-literate 'Penelope))
+|y |t
+}
+
+\n Since Penelope knows TeX and Prolog, she is computer-literate.
+
+\subsection{Solving Goals}
+\label{solving-goals}
+
+The above queries are yes/no questions.  Logic programming
+allows more: We can formulate a goal with {\em uninstantiated}
+logic variables and then ask the querying process to
+provide, if possible, values for these variables that cause
+the goal to succeed.  For instance, the query:
+
+\sverbatim{
+(%which (what)
+  (%knows 'Odysseus what))
+}
+
+\n asks for an instantiation of the logic variable \q{what}
+that satisfies the goal \q{(%knows 'Odysseus what)}.
+In other words, we are asking, ``What does Odysseus know?''
+
+Note that this use of \q{%which} --- like \q{%rel}
+in the definition of \q{%computer-literate} ---
+uses a local logic
+variable, \q{what}.  In general, the second subform of
+\q{%which} can be a list of local logic variables.  The
+\q{%which}-query returns an answer that is a list of
+bindings, one for each logic variable mentioned in its
+second subform.  Thus,
+
+\sverbatim{
+(%which (what)
+  (%knows 'Odysseus what))
+|y ([what TeX])
+}
+
+\n But that is not all that wily Odysseus knows.  Schelog
+provides a zero-argument procedure (``thunk'') called
+\q{%more}
+that {\em retries} the goal in the last
+\q{%which}-query for a different solution.
+
+\sverbatim{
+(%more) |y ([what Scheme])
+}
+
+\n We can keep pumping for more solutions:
+
+\sverbatim{
+(%more) |y ([what Prolog])
+(%more) |y ([what Penelope])
+(%more) |y #f
+}
+
+\n The final \q{#f} shows that there are no more
+solutions.  This is because there are no more clauses in the
+\q{%knows} predicate that list Odysseus as knowing anything
+else.
+
+\subsubsection{A Note on {\tt\#f} vs {\tt()}}
+\label{false-vs-nil}
+
+It is now clear why \q{|t} was the right choice for truth in
+the previous yes/no \q{%which}-queries that had no logic
+variables (sec \ref{simple}).  \q{%which} returns a
+list of bindings
+for true
+goals: the list is empty when there are no variables.
+
+For such Schemes as don't distinguish between \q{()} and
+\q{#f}, we can still ask fruitful yes/no queries.  Simply
+use a dummy local
+variable in the
+\q{%which}-expression.  Truth will give an (ignorable)
+binding for the dummy variable, while falsity will, as
+usual, produce \q{#f}.
+
+\sverbatim{
+(%which (bingo)
+  (%knows 'Odysseus 'TeX))
+|y ([bingo _])
+
+(%which (bingo)
+  (%knows 'Odysseus 'calculus))
+|y #f
+}
+
+\subsection{ Asserting Extra Clauses}
+\label{assert}
+
+We can add more clauses to a predicate after it has already
+been defined with a \q{%rel}.  Schelog provides the
+\q{%assert} form for this purpose.  Eg,
+
+\sverbatim{
+(%assert %knows ()
+  [('Odysseus 'archery)])
+}
+
+\n tacks on a new clause at the end of the existing clauses
+of the \q{%knows}
+predicate.  Now, the query:
+
+\sverbatim{
+(%which (what)
+  (%knows 'Odysseus what))
+}
+
+\n gives TeX, Scheme, Prolog, and Penelope, as before, but
+a subsequent \q{(%more)} yields a new result: \q{archery}.
+
+The Schelog form \q{%assert-a} is similar to \q{%assert} but
+adds clauses {\em before} any of the current clauses.
+
+Both \q{%assert} and \q{%assert-a} assume that the variable
+they are adding to already names a predicate (presumably
+defined using \q{%rel}).
+In order to allow defining a predicate entirely through
+\q{%assert}s,  Schelog provides an empty predicate value
+\q{%empty-rel}.  \q{%empty-rel} takes any number of arguments
+and always fails.  A typical use of the
+\q{%empty-rel} and \q{%assert} combination:
+
+\sverbatim{
+(define %parent %empty-rel)
+
+(%assert %parent ()
+  [('Laertes 'Odysseus)])
+
+(%assert %parent ()
+  [('Odysseus 'Telemachus)]
+  [('Penelope 'Telemachus)])
+}
+
+(Schelog does not provide a predicate for {\em retracting}
+assertions, since we can keep track of older versions of
+predicates using conventional Scheme features (\q{let} and \q{set!}).)
+
+\subsection{Local Variables}
+\label{local-vars}
+
+The local logic variables of \q{%rel}- and
+\q{%which}-expressions are in reality introduced by the
+Schelog syntactic form called \q{%let}.  (\q{%rel} and
+\q{%which} are macros written using \q{%let}.)
+
+\q{%let} introduces new lexically scoped logic variables.
+Supposing, instead of
+
+\sverbatim{
+(%which (what)
+  (%knows 'Odysseus what))
+}
+
+\n we had asked
+
+\sverbatim{
+(%let (what)
+  (%which ()
+    (%knows 'Odysseus what)))
+}
+
+\n This query, too, succeeds five times, since
+Odysseus knows five things.  However, \q{%which} emits
+bindings only for the local variables that {\em it}
+introduces.  Thus, this query emits \q{|t} five times before
+\q{(%more)} finally returns \q{#f}.
+
+\newsection{Using Conventional Scheme Expressions in Schelog}
+\label{scheme-w-schelog}
+
+The arguments of Schelog predicates can be any Scheme
+objects.  In particular, composite structures such as lists,
+vectors and strings can be used, as also Scheme expressions
+using the full array of Scheme's construction and
+decomposition operators.  For instance, consider the
+following goal:
+
+\sverbatim{
+(%member x '(1 2 3))
+}
+
+\n Here, \q{%member} is a predicate, \q{x} is a logic
+variable, and \q{'(1 2 3)} is a structure.  Given a suitably
+intuitive definition for \q{%member}, the above goal
+succeeds for \q{x} = \q{1}, \q{2}, and \q{3}.
+
+Now to defining predicates like \q{%member}:
+
+\sverbatim{
+(define %member
+  (%rel (x y xs)
+    [(x (cons x xs))]
+    [(x (cons y xs))
+      (%member x xs)]))
+}
+
+\n Ie, \q{%member} is defined with three local variables:
+\q{x},  \q{y}, \q{xs}.  It  has two
+clauses, identifying the two ways of determining membership.
+
+The first clause of \q{%member} states a fact: For any
+\q{x}, \q{x} is a member of a list whose head is also \q{x}.
+
+The second clause of \q{%member} is a rule: \q{x} is a
+member of a list if we can show that it is a member of the
+{\em tail} of that list.  In other words, the original
+\q{%member} goal is translated into a {\em sub}goal, which is also
+a \q{%member} goal.
+
+Note that the variable \q{y} in the definition of
+\q{%member} occurs only once in the second clause.  As such,
+it doesn't need you to make the effort of naming it.  (Names
+help only in matching a second occurrence to a first.)  Schelog
+lets you use the expression \q{(_)} to denote an anonymous
+variable.  (Ie, \q{_} is a thunk that generates a fresh
+anonymous variable at each call.)  The predicate \q{%member} can be
+rewritten as
+
+\sverbatim{
+(define %member
+  (%rel (x xs)
+    [(x (cons x (_)))]
+    [(x (cons (_) xs))
+      (%member x xs)]))
+}
+
+\subsection{Constructors}
+\label{constructors}
+
+We can use constructors --- Scheme procedures for creating
+structures --- to simulate data types in Schelog.  For
+instance, let's define a natural-number data-type where
+\q{0} denotes zero, and \q{(succ x)} denotes the natural number
+whose immediate predecessor is \q{x}.   The constructor
+\q{succ} can
+be defined in Scheme as:
+
+\sverbatim{
+(define succ
+  (lambda (x)
+    (vector 'succ x)))
+}
+
+\n Addition and multiplication can be defined as:
+
+\sverbatim{
+(define %add
+  (%rel (x y z)
+    [(0 y y)]
+    [((succ x) y (succ z))
+      (%add x y z)]))
+
+(define %times
+  (%rel (x y z z1)
+    [(0 y 0)]
+    [((succ x) y z)
+     (%times x y z1)
+     (%add y z1 z)]))
+}
+
+\n We can do a lot of arithmetic with this in place.  For
+instance, the factorial predicate looks like:
+
+\sverbatim{
+(define %factorial
+  (%rel (x y y1)
+    [(0 (succ 0))]
+    [((succ x) y)
+      (%factorial x y1)
+      (%times (succ x) y1 y)]))
+}
+
+\subsection{\tt\%is}
+\label{is}
+
+The above is a very inefficient way to do arithmetic,
+especially when the underlying language Scheme offers
+excellent arithmetic facilities (including a comprehensive
+number ``tower'' and exact rational arithmetic).  One
+problem with using Scheme calculations directly in Schelog
+clauses is that the expressions used may contain logic
+variables that need to be dereferenced.  Schelog provides
+the predicate \q{%is} that takes care of this.  The goal
+
+\sverbatim{
+(%is X E)
+}
+
+\n unifies \q{X} with the value of \q{E} considered as a
+Scheme expression.  \q{E} can have logic variables, but
+usually they should at least be bound, as unbound variables
+may not be palatable values to the Scheme operators used in
+\q{E}.
+
+We can now directly use the numbers of Scheme to write a
+more efficient \q{%factorial} predicate:
+
+\sverbatim{
+(define %factorial
+  (%rel (x y x1 y1)
+    [(0 1)]
+    [(x y) (%is x1 (- x 1))
+           (%factorial x1 y1)
+           (%is y (* y1 x))]))
+}
+
+\n A price that this efficiency comes with is that we can
+use \q{%factorial} only with its first argument already
+instantiated.  In many cases, this is not an unreasonable
+constraint.  In fact, given this limitation, there is
+nothing to prevent us from using Scheme's factorial
+directly:
+
+\sverbatim{
+(define %factorial
+  (%rel (x y)
+    [(x y)
+     (%is y (scheme-factorial
+	      x))]))
+}
+
+\n or better yet, ``in-line'' any calls to \q{%factorial} with
+\q{%is}-expressions calling \q{scheme-factorial}, where the
+latter is defined in the usual manner:
+
+\sverbatim{
+(define scheme-factorial
+  (lambda (n)
+    (if (= n 0) 1
+        (* n (factorial
+	       (- n 1))))))
+}
+
+\subsection{Lexical Scoping}
+\label{lexical-scoping}
+
+One can use Scheme's lexical scoping to enhance predicate
+definition.  Here is a list-reversal predicate defined using
+a hidden auxiliary predicate:
+
+\sverbatim{
+(define %reverse
+  (letrec
+    ([revaux
+       (%rel (x y z w)
+	 [('() y y)]
+	 [((cons x y) z w)
+	   (revaux y
+	     (cons x z) w)])])
+    (%rel (x y)
+      [(x y) (revaux x '() y)])))
+}
+
+\n \q{(revaux X Y Z)} uses \q{Y} as an accumulator for
+reversing \q{X} into \q{Z}.  (\q{Y} starts out as \q{()}.
+Each head of \q{X} is \q{cons}ed on to \q{Y}.  Finally, when
+\q{X} has wound down to \q{()}, \q{Y} contains the reversed
+list and can be returned as \q{Z}.)
+
+\q{revaux} is used purely as a helper predicate for
+\q{%reverse}, and so it can be concealed within a lexical
+contour.  We use \q{letrec} instead of \q{let} because
+\q{revaux} is a recursive procedure.
+
+\subsection{Type Predicates}
+\label{type-predicates}
+
+Schelog provides a couple of predicates that let the user
+probe the type of objects.
+
+The goal
+
+\sverbatim{
+(%constant X)
+}
+
+\n succeeds if \q{X} is an {\em atomic} object, ie, not a
+list or vector.
+
+The predicate \q{%compound}, the negation of \q{%constant},
+checks if its argument is  indeed a list or a vector.
+
+The above are merely the logic-program\-ming equivalents of
+corresponding Scheme predicates.  Users can use the
+predicate \q{%is} and Scheme predicates to write more type
+checks in Schelog.  Thus, to test if \q{X} is a string, the
+following goal could be used:
+
+\sverbatim{
+(%is #t (string? X))
+}
+
+\n User-defined Scheme predicates, in addition to primitive Scheme
+predicates, can be thus imported.
+
+\newsection{Backtracking}
+\label{backtracking}
+
+It is helpful to go into the following evaluation (sec \ref{rules})
+in a
+little detail:
+
+\sverbatim{
+(%which ()
+  (%computer-literate 'Penelope))
+|y |t
+}
+
+\n  The starting goal
+is:
+
+\sverbatim{
+G0 = (%computer-literate Penelope)
+}
+
+\n (I've taken out the quote because \q{Penelope} is the result
+of evaluating \q{'Penelope}.)
+
+Schelog tries to match this with the head of the first
+clause of \q{%computer-literate}.  It succeeds, generating a
+binding  \q{[person Penelope]}.
+
+But this means it now has two new goals --- {\em subgoals}
+--- to solve.  These are the goals in the body of the
+matching clause, with the logic variables substituted by
+their instantiations:
+
+\sverbatim{
+G1 = (%knows Penelope TeX)
+G2 = (%knows Penelope Scheme)
+}
+
+\n For \q{G1}, Schelog attempts matches with the clauses of
+\q{%knows}, and succeeds at the fifth try.  (There are no
+subgoals in this case, because the bodies of these ``fact''
+clauses are empty, in contrast to the ``rule'' clauses of
+\q{%computer-literate}.)
+Schelog then tries to solve \q{G2} against the clauses of
+\q{%knows}, and since there is no clause stating that
+Penelope knows Scheme, it fails.
+
+All is not lost though.  Schelog now {\em backtracks} to the
+goal that was solved just before, viz., \q{G1}.  It
+{\em retries} \q{G1}, ie, tries to solve it in a
+different way.
+This entails searching down the previously unconsidered
+\q{%knows}
+clauses for \q{G1}, ie, the sixth onwards.  Obviously,
+Schelog fails again, because the fact that Penelope knows
+TeX occurs only once.
+
+Schelog now backtracks to the goal before \q{G1}, ie,
+\q{G0}.  We abandon the current successful match with the
+first clause-head of \q{%computer-literate}, and try the
+next clause-head.  Schelog succeeds, again producing a binding
+\q{[person Penelope]}, and two new subgoals:
+
+\sverbatim{
+G3 = (%knows Penelope TeX)
+G4 = (%knows Penelope Prolog)
+}
+
+\n It is now easy to trace that Schelog finds both \q{G3} and \q{G4} to be
+true.  Since both of \q{G0}'s subgoals are true, \q{G0} is
+itself considered true.  And this is what Schelog reports.  The
+interested reader can now trace  why the
+following query has a different denouement:
+
+\sverbatim{
+(%which ()
+  (%computer-literate 'Telemachus))
+|y #f
+}
+
+\newsection{Unification}
+\label{unification}
+
+When we say that a goal matches with a clause-head, we mean
+that the predicate and argument positions line up.  Before
+making this comparison, Schelog dereferences all already
+bound logic variables.  The resulting structures are then
+compared to see if they are recursively identical.  Thus,
+\q{1} unifies with \q{1}, and \q{(list 1 2)} with \q{'(1
+2)}; but \q{1} and
+\q{2} do not unify, and neither do \q{'(1 2)} and \q{'(1
+3)}.
+
+In general, there could be quite a few uninstantiated logic
+variables in the compared objects.  Unification will then
+endeavor to find the most natural way of binding these
+variables so that we arrive at structurally identical
+objects.  Thus, \q{(list x 1)}, where \q{x} is an unbound logic
+variable, unifies with \q{'(0 1)}, producing the
+binding
+\q{[x 0]}.
+
+Unification is thus a goal, and Schelog makes the unification predicate
+available  to the user as \q{%=}.   Eg,
+
+\sverbatim{
+(%which (x)
+  (%= (list x 1) '(0 1))
+|y ([x 0])
+}
+
+\n Schelog also provides the predicate \q{%/=}, the {\em negation} of
+\q{%=}.  \q{(%/= X Y)} succeeds if and only if \q{X} does
+{\em not} unify with \q{Y}.
+
+Unification goals constitute the basic subgoals that all
+Schelog goals devolve to.  A goal succeeds because all the
+eventual unification subgoals that it decomposes to in at
+least one of its subgoal-branching succeeded.  It fails
+because every possible subgoal-branching was thwarted by the
+failure of a crucial unification subgoal.
+
+Going back to the example in sec \ref{backtracking}, the goal
+\q{(%computer-literate 'Penelope)} succeeds because
+(a) it unified with
+\q{(%computer-literate person)}; and then (b) with the binding
+\q{[person Penelope]} in place, \q{(%knows person 'TeX)}
+unified with \q{(%knows 'Penelope 'TeX)} and
+\q{(%knows person 'Prolog)} unified with \q{(%knows 'Penelope
+'Prolog)}.
+
+In contrast, the goal \q{(%computer-literate 'Telemachus)}
+fails because, with \q{[person Telemachus]},
+the subgoals \q{(%knows person 'Scheme)} and
+\q{(%knows person 'Prolog)} have no facts they can
+unify with.
+
+\subsection{The Occurs Check}
+
+A robust unification algorithm uses the {\em
+occurs check}, which ensures that a logic variable
+isn't bound to a structure that contains itself.  
+Not performing the check can cause the unification
+to go into an infinite loop in some cases.  On the
+other hand, performing the occurs check greatly
+increases the time taken by unification, even in cases
+that wouldn't require the check.
+
+Schelog uses the global variable
+\q{*schelog-use-occurs-check?*} to decide whether to
+use the occurs check.  By default, this variable is 
+\q{#f}, ie, Schelog disables the occurs check.  To
+enable the check, 
+
+\q{
+(set! *schelog-use-occurs-check?* #t)
+}
+
+\newsection{Conjuctions and Disjunctions}
+\label{and-or}
+
+Goals may be combined using the forms \q{%and}
+and \q{%or}
+to form compound goals.  (For \q{%not}, see sec \ref{not}.)
+Eg,
+
+\sverbatim{
+(%which (x)
+  (%and (%member x '(1 2 3))
+        (%< x 3)))
+}
+
+\n gives solutions for \q{x} that satisfy both the
+argument goals of the \q{%and}.
+Ie, \q{x} should both be a member of \q{'(1 2 3)}
+{\em and}  be less than \q{3}.    The first
+solution is
+
+\sverbatim{
+([x 1])
+}
+
+\n Typing \q{(%more)} gives another solution:
+
+\sverbatim{
+([x 2])
+}
+
+\n There are no more solutions, because \q{[x 3]} satisfies
+the first but not the second goal.
+
+Similarly, the query
+
+\sverbatim{
+(%which (x)
+  (%or (%member x '(1 2 3))
+       (%member x '(3 4 5))))
+}
+
+\n lists all \q{x} that are members of either list.
+
+\sverbatim{
+           ([x 1])
+(%more) |y ([x 2])
+(%more) |y ([x 3])
+(%more) |y ([x 3])
+(%more) |y ([x 4])
+(%more) |y ([x 5])
+}
+
+\n (Yes, \q{([x 3])} is listed twice.)
+
+We can rewrite the predicate \q{%computer-literate}
+from sec \ref{rules} using \q{%and} and \q{%or}:
+
+\sverbatim{
+(define %computer-literate
+  (%rel (person)
+    [(person)
+     (%or
+       (%and (%knows person
+	       'TeX)
+	     (%knows person
+	       'Scheme))
+       (%and (%knows person
+	       'TeX)
+	     (%knows person
+	       'Prolog)))]))
+}
+
+\n Or,  more succinctly:
+
+\sverbatim{
+(define %computer-literate
+  (%rel (person)
+    [(person)
+      (%and (%knows person
+	      'TeX)
+        (%or (%knows person
+	       'Scheme)
+	     (%knows person
+	       'Prolog)))]))
+}
+
+\n We can even dispense with the \q{%rel} altogether:
+
+\sverbatim{
+(define %computer-literate
+  (lambda (person)
+    (%and (%knows person
+	    'TeX)
+      (%or (%knows person
+	     'Scheme)
+	(%knows person
+	  'Prolog)))))
+}
+
+\n This last looks like a conventional Scheme predicate
+definition, and is arguably
+the most readable format for a Scheme programmer.
+
+\newsection{Manipulating Logic Variables}
+\label{lv-manip}
+
+Schelog provides special predicates for probing logic
+variables, without risking their getting bound.
+
+\subsection{Checking for Variables}
+\label{var}
+
+The goal
+
+\sverbatim{
+(%== X Y)
+}
+
+\n succeeds if \q{X} and \q{Y} are {\em identical} objects.  This
+is not quite the unification predicate \q{%=}, for \q{%==}
+doesn't touch unbound objects the way \q{%=} does.  Eg,
+\q{%==} will not equate an unbound logic variable with a
+bound one, nor will it equate two unbound logic variables
+unless they are the {\em same} variable.
+
+The predicate \q{%/==} is the negation of \q{%==}.
+
+The goal
+
+\sverbatim{
+(%var X)
+}
+
+\n succeeds if \q{X} isn't completely bound --- ie, it has at
+least one unbound logic variable in its innards.
+
+The predicate \q{%nonvar} is the negation of \q{%var}.
+
+\subsection{Preserving Variables}
+\label{freeze}
+
+Schelog lets the user protect a term with variables from
+unification by allowing that term to be treated as a
+(completely) bound object.  The predicates provided for this
+purpose are
+\q{%freeze},
+\q{%melt}, \q{%melt-new}, and \q{%copy}.
+
+The goal
+
+\sverbatim{
+(%freeze S F)
+}
+
+\n unifies \q{F} to the frozen version of \q{S}.  Any lack
+of bindings in \q{S} are preserved no matter how much you
+toss \q{F} about.
+
+The goal
+
+\sverbatim{
+(%melt F S)
+}
+
+\n retrieves the object frozen in \q{F} into \q{S}.
+
+The goal
+
+\sverbatim{
+(%melt-new F S)
+}
+
+\n is similar to \q{%melt},
+except that when \q{S} is made,  the unbound variables in
+\q{F} are replaced by brand-new unbound variables.
+
+The goal
+
+\sverbatim{
+(%copy S C)
+}
+
+\n is an abbreviation for \q{(%freeze S F)}
+followed by \q{(%melt-new F C)}.
+
+\newsection{The Cut ({\tt!})}
+\label{cut}
+
+The cut (called \q{!}) is a special goal that is used to
+prune backtracking options.  Like the \q{%true} goal, the
+cut goal too succeeds, when accosted by the Schelog
+subgoaling engine.  However, when a further subgoal down the
+line fails, and time comes to retry the cut goal, Schelog
+will refuse to try alternate clauses for the predicate in
+whose definition the cut occurs.  In other words, the cut
+causes Schelog to commit to all the decisions made from the
+time that the predicate was selected to match a subgoal till
+the time the cut was satisfied.
+
+For example, consider again the \q{%factorial}
+predicate, as defined in sec \ref{is}:
+
+\sverbatim{
+(define %factorial
+  (%rel (x y x1 y1)
+    [(0 1)]
+    [(x y) (%is x1 (- x 1))
+           (%factorial x1 y1)
+           (%is y (* y1 x))]))
+}
+
+\n Clearly,
+
+\sverbatim{
+(%which ()
+  (%factorial 0 1)) |y |t
+(%which (n)
+  (%factorial 0 n)) |y ([n 1])
+}
+
+\n But what if we asked for \q{(%more)} for either query?
+Backtracking will try
+the second clause of \q{%factorial}, and sure enough the
+clause-head unifies, producing binding \q{[x 0]}.
+We now get three subgoals.  Solving the first, we get \q{[x1
+-1]}, and then we have to solve \q{(%factorial -1 y1)}.  It
+is easy to see there is no end to this, as we fruitlessly
+try to get the factorials of numbers that get more and more
+negative.
+
+If we placed a cut at the first clause:
+
+\sverbatim{
+...
+[(0 1) !]
+...
+}
+
+\n the attempt to find more solutions for \q{(%factorial 0
+1)} is nipped in the bud.
+
+Calling \q{%factorial} with a {\em negative} number would  still cause an
+infinite loop.   To take care of that problem as well, we
+use another cut:
+
+\sverbatim{
+(define %factorial
+  (%rel (x y x1 y1)
+    [(0 1) !]
+    [(x y) (< x 0) ! %fail]
+    [(x y) (%is x1 (- x 1))
+           (%factorial x1 y1)
+           (%is y (* y1 x))]))
+}
+
+Using {\em raw} cuts as above can get very confusing.  For this
+reason, it is advisable to use it hidden away in
+well-understood abstractions.  Two such common abstractions
+are the conditional and negation.
+
+\subsection{Conditional Goals}
+\label{if-then-else}
+
+An ``if ... then ... else ...'' predicate can be defined
+as follows
+
+\sverbatim{
+(define %if-then-else
+  (%rel (p q r)
+    [(p q r) p ! q]
+    [(p q r) r]))
+}
+
+\n (Note that for the first time we have predicate arguments that
+are themselves goals.)
+
+Consider the goal
+
+\sverbatim{
+G0 = (%if-then-else Gbool
+		Gthen Gelse)
+}
+
+\n We first unify \q{G0} with the first clause-head,
+giving
+\q{[p Gbool]}, \q{[q Gthen]}, \q{[r Gelse]}.  \q{Gbool} can
+now either succeed or fail.
+
+Case 1:  If \q{Gbool} fails, backtracking will cause the
+\q{G0} to unify with the second clause-head.  \q{r} is bound
+to \q{Gelse}, and so \q{Gelse} is tried, as expected.
+
+Case 2: If \q{Gbool} succeeds, the cut commits to this
+clause of the \q{%if-then-else}.  We now try \q{Gthen}.  If
+\q{Gthen} should now fail --- or even if we simply retry for
+more solutions --- we are guaranteed that the second
+clause-head will not be tried.  If it were not for the cut,
+\q{G0} would attempt to unify with the second clause-head, which will
+of course succeed, and \q{Gelse} {\em will} be tried.
+
+\subsection{Negation as Failure}
+\label{not}
+
+Another common abstraction using the cut is {\em negation}.
+The negation of goal \q{G} is defined as \q{(%not G)}, where
+the predicate \q{%not} is defined as follows:
+
+\sverbatim{
+(define %not
+  (%rel ()
+    [(g) g ! %fail]
+    [(g) %true]))
+}
+
+\n Thus, \q{g}'s negation is deemed a failure if \q{g}
+succeeds, and a success if \q{g} fails.  This is of course
+confusing goal failure with falsity.  In some cases, this
+view of negation is actually helpful.
+
+\newsection{Set Predicates}
+\label{set-of}
+
+The goal
+
+\sverbatim{
+(%bag-of X G Bag)
+}
+
+\n unifies with \q{Bag} the list of all instantiations of
+\q{X} for which \q{G} succeeds.  Thus, the following query
+asks for all the things known --- ie, the collection of things
+such that someone knows them:
+
+\sverbatim{
+(%which (things-known)
+  (%let (someone x)
+    (%bag-of x (%knows someone x)
+      things-known)))
+|y ([things-known
+      (TeX Scheme Prolog
+       Penelope TeX Prolog
+       Odysseus TeX calculus)])
+}
+
+\n This is the only solution for this goal:
+
+\sverbatim{
+(%more) |y #f
+}
+
+\n Note that some things --- eg, TeX --- are enumerated
+more than once.  This is because more than one person knows
+TeX.  To remove duplicates, use the predicate
+\q{%set-of}
+instead of \q{%bag-of}:
+
+\sverbatim{
+(%which (things-known)
+  (%let (someone x)
+    (%set-of x (%knows someone x)
+      things-known)))
+|y ([things-known
+      (TeX Scheme Prolog
+       Penelope Odysseus calculus)])
+}
+
+\n In the above, the free variable \q{someone} in the
+\q{%knows}-goal is used as if it
+were existentially quantified.  In contrast, Prolog's
+versions of
+\q{%bag-of} and \q{%set-of} fix it for each solution of the
+set-predicate goal.  We can do it too with some additional
+syntax that identifies the free variable.
+Eg,
+
+\sverbatim{
+(%which (someone things-known)
+  (%let (x)
+    (%bag-of x
+      (%free-vars (someone)
+        (%knows someone x))
+      things-known)))
+|y ([someone Odysseus]
+    [things-known
+      (TeX Scheme Prolog
+       Penelope)])
+}
+
+\n The bag of things known by {\em one} someone is
+returned.  That someone is Odysseus.  The query can be
+retried for more solutions, each listing the things known by
+a different someone:
+
+\sverbatim{
+(%more) |y ([someone Penelope]
+            [things-known
+              (TeX Prolog
+	       Odysseus)])
+(%more) |y ([someone Telemachus]
+            [things-known
+              (TeX calculus)])
+(%more) |y #f
+}
+
+Schelog also provides two variants of these set predicates,
+viz., \q{%bag-of-1} and \q{%set-of-1}.  These act like \q{%bag-of}
+and \q{%set-of} but fail if the resulting bag or set is empty.
+
+\newsection{Glossary of Schelog Primitives}
+\label{glossary}
+
+This section lists, in ascii order, all the Schelog
+primitives, with a brief explanation for each.  Each entry is
+identified
+\texonly
+ --- on the right-hand side of its entry title ---
+\endtexonly
+as either {\em procedure}, {\em macro}, {\em predicate}, 
+{\em goal}, or {\em flag}.  (Note that predicates and goals are also
+procedures.  We nevertheless use the more specific names
+because of their importance to Schelog programming.)
+
+Following Prolog style, a predicate's arity is also noted in
+its title.  Thus, \q{%<}\ar/2 means that \q{%<} takes two
+arguments.  Variable-arity predicates use an asterisk
+instead of a number, eg, \q{%and}\ar/*.
+
+\defpred{\q{%/=}\ar/2}
+
+\q{%/=} is the negation of \q{%=}.
+The goal \q{(%/= E1 E2)} succeeds if \q{E1} can not be unified
+with \q{E2}.
+
+\defpred{\q{%/==}\ar/2}
+
+\q{%/==} is the negation of \q{%==}.
+The goal \q{(%/== E1 E2)} succeeds if \q{E1} and \q{E2} are not
+identical.
+
+\defpred{\q{%<}\ar/2}
+
+The goal \q{(%< E1 E2)} succeeds if \q{E1} and \q{E2} are bound to
+numbers and \q{E1} is less than \q{E2}.
+
+\defpred{\q{%<=}\ar/2}
+
+The goal \q{(%<= E1 E2)} succeeds if \q{E1} and \q{E2} are bound to
+numbers and \q{E1} is less than or equal to \q{E2}.
+
+\defpred{\q{%=}\ar/2}
+
+The goal \q{(%= E1 E2)} succeeds if \q{E1} can be unified with
+\q{E2}.  Any resulting bindings for logic variables are kept.
+
+\defpred{\q{%=/=}\ar/2}
+
+The goal \q{(%=/= E1 E2)} succeeds if \q{E1} and \q{E2} are bound to
+numbers and \q{E1} is not equal to \q{E2}.
+
+\defpred{\q{%=:=}\ar/2}
+
+The goal \q{(%=:= E1 E2)} succeeds if \q{E1} and \q{E2} are bound to
+numbers and \q{E1} is equal to \q{E2}.
+
+\defpred{\q{%==}\ar/2}
+
+The goal \q{(%== E1 E2)} succeeds if \q{E1} is {\em identical}
+to \q{E2}.  They should be structurally equal.  If containing
+logic variables, they should have the same variables in the
+same position.  Unlike a \q{%=}-call, this goal will not bind
+any logic variables.
+
+\defpred{\q{%>}\ar/2}
+
+The goal \q{(%> E1 E2)} succeeds if \q{E1} and \q{E2} are bound to
+numbers and \q{E1} is greater than \q{E2}.
+
+\defpred{\q{%>=}\ar/2}
+
+The goal \q{(%>= E1 E2)} succeeds if \q{E1} and \q{E2} are bound to
+numbers and \q{E1} is greater than or equal to \q{E2}.
+
+\defmac{\q{%and}\ar/*}
+
+The goal \q{(%and G ...)} succeeds if all the goals
+\q{G}, ..., succeed.
+
+\defpred{\q{%append}\ar/3}
+
+The goal \q{(%append E1 E2 E3)} succeeds if \q{E3} is unifiable
+with the list obtained by appending \q{E1} and \q{E2}
+
+\defmac{\q{%assert}}
+
+The form  \q{(%assert Pname (V ...) C ...)} adds the clauses
+\q{C}, ..., to the {\em end} of the predicate that is the value of
+the Scheme variable \q{Pname}.  The variables \q{V}, ..., are
+local logic variables for \q{C}, ...
+
+\defmac{\q{%assert-a}}
+
+Like \q{%assert}, but adds the new clauses to the {\em front}
+of the existing predicate.
+
+\defpred{\q{%bag-of}\ar/3}
+
+The goal \q{(%bag-of E1 G E2)} unifies with \q{E2} the {\em bag}
+(multiset)
+of all the
+instantiations of \q{E1} for which goal \q{G} succeeds.
+
+\defpred{\q{%bag-of-1}\ar/3}
+
+Similar to \q{%bag-of}, but fails if the bag is empty.
+
+\defpred{\q{%compound}\ar/1}
+
+The goal \q{(%compound E)} succeeds if \q{E} is a non-atomic
+structure, ie, a vector or a list.
+
+\defpred{\q{%constant}\ar/1}
+
+The goal \q{(%compound E)} succeeds if \q{E} is an atomic
+structure, ie, not a vector or a list.
+
+\defpred{\q{%copy}\ar/2}
+
+The goal \q{(%copy F S)} unifies with \q{S} a copy of the
+frozen structure in \q{F}.
+
+\defpred{\q{%empty-rel}\ar/*}
+
+The goal \q{(%empty-rel E ...)} always fails.  The {\em value}
+\q{%empty-rel} is used as a starting value for predicates
+that can later be enhanced with \q{%assert} and \q{%assert-a}.
+
+\defgoal{\q{%fail}}
+
+The goal \q{%fail} always fails.
+
+\defmac{\q{%free-vars}}
+
+The form \q{(%free-vars (V ...) G)} identifies
+the occurrences of the variables \q{V}, ..., in goal
+\q{G} as free.  It is used to avoid existential quantification
+in calls to set predicates (\q{%bag-of}, \q{%set-of}, \&c.).
+
+\defpred{\q{%freeze}\ar/2}
+
+The goal \q{(%freeze S F)} unifies with \q{F} a new frozen
+version of the structure in \q{S}.  Freezing implies that all
+the unbound variables are preserved.  \q{F} can henceforth be
+used as {\em bound} object with no fear of its variables
+getting bound by unification.
+
+\defpred{\q{%if-then-else}\ar/3}
+
+The goal \q{(%if-then-else G1 G2 G3)} tries \q{G1} first: if it
+succeeds, tries \q{G2}; if not, tries \q{G3}.
+
+\defpred{\q{%is}\ar/2}
+
+The goal \q{(%is E1 E2)} unifies with \q{E1} the result of
+evaluating \q{E2} as a Scheme expression.  \q{E2} may contain
+logic variables, which are dereferenced automatically.
+Fails if \q{E2} contains unbound logic variables.
+(Note: Unlike other Schelog predicates, \q{%is} is implemented
+as a macro and not a procedure.)
+
+\defmac{\q{%let}}
+
+The form \q{(%let (V ...) E ...)} introduces \q{V}, ..., as
+lexically scoped logic variables to be used in \q{E}, ...
+
+\defpred{\q{%melt}\ar/2}
+
+The goal \q{(%melt F S)} unifies  \q{S} with the thawed
+(original) form of the frozen structure in \q{F}.
+
+\defpred{\q{%melt-new}\ar/2}
+
+The goal \q{(%melt-new F S)} unifies \q{S} with a thawed
+{\em copy} of the frozen structure in \q{F}.  This means
+new logic variables are used for unbound logic variables in
+\q{F}
+
+\defpred{\q{%member}\ar/2}
+
+The goal \q{(%member E1 E2)} succeeds if \q{E1} is a member
+of the list in \q{E2}.
+
+\defpred{\q{%nonvar}\ar/1}
+
+\q{%nonvar} is the negation of \q{%var}.
+The goal \q{(%nonvar E)} succeeds if \q{E} is completely
+instantiated, ie, it has no unbound variable in it.
+
+\defpred{\q{%not}\ar/1}
+
+The goal \q{(%not G)} succeeds if \q{G} fails.
+
+\defproc{\q{%more}}
+
+The thunk \q{%more} produces more instantiations of the
+variables in the most recent \q{%which}-form that satisfy the
+goals in that \q{%which}-form.  If no more solutions can
+be found, \q{%more} returns \q{#f}.
+
+\defmac{\q{%or}\ar/*}
+
+The goal \q{(%or G ...)} succeeds if one of \q{G}, ..., tried
+in that order, succeeds.
+
+\defmac{\q{%rel}}
+
+The form \q{(%rel (V ...) C ...)} creates a predicate object.
+Each clause \q{C} is of the form \q{[(E ...) G ...]}, signifying
+that the goal created by applying the predicate object to
+anything that matches \q{(E ...)} is deemed to succeed if all
+the goals \q{G}, ..., can, in their turn, be shown to succeed.
+
+\defpred{\q{%repeat}\ar/0}
+
+The goal \q{(%repeat)} always succeeds (even on retries).
+Used for failure-driven loops.
+
+\defflag{\q{*schelog-use-occurs-check?*}}
+
+If the global flag
+\q{*schelog-use-occurs-check?*} is false (the default), 
+Schelog's unification will not use the occurs check.
+If it is true, the occurs check is enabled.
+
+\defpred{\q{%set-of}\ar/3}
+
+The goal \q{(%set-of E1 G E2)} unifies with \q{E2} the {\em set}
+of all the
+instantiations of \q{E1} for which goal \q{G} succeeds.
+
+\defpred{\q{%set-of-1}\ar/3}
+
+Similar to \q{%set-of}, but fails if the set is empty.
+
+\defgoal{\q{%true}}
+
+The goal \q{%true} succeeds.  Fails on retry.
+
+\defpred{\q{%var}\ar/1}
+
+The goal \q{(%var E)} succeeds if \q{E} is not completely
+instantiated, ie, it has at least one unbound variable in
+it.
+
+\defmac{\q{%which}}
+
+The form \q{(%which (V ...) G ...)} returns an instantiation
+of the variables \q{V}, ..., that satisfies all of \q{G},
+...  If \q{G}, ..., cannot be satisfied, returns \q{#f}.
+Calling the thunk \q{%more} produces more
+instantiations, if available.
+
+\defproc{\q{_} ~~(underscore)}
+
+A thunk that produces a new logic variable.  Can be
+used in situations where we want a logic variable but
+don't want to name it.  (\q{%let}, in contrast, introduces new
+lexical names for the logic variables it creates.)
+
+\newsection{References}
+\label{references}
+
+
+\bibliographystyle{plain}
+\bibliography{schelog}
+
+\bye

From 5119987409a7cbad034678d6ba1fde4fbeb467a3 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 22 Apr 2010 10:44:40 -0600
Subject: [PATCH 07/16] Working version of Git scm functions and render front
 page

---
 collects/meta/drdr/monitor-scm.ss |   3 +-
 collects/meta/drdr/render.ss      |  36 +++++---
 collects/meta/drdr/scm.ss         | 143 +++++++++++++++++++-----------
 3 files changed, 115 insertions(+), 67 deletions(-)

diff --git a/collects/meta/drdr/monitor-scm.ss b/collects/meta/drdr/monitor-scm.ss
index 458c1cf011..267cc7b4e8 100644
--- a/collects/meta/drdr/monitor-scm.ss
+++ b/collects/meta/drdr/monitor-scm.ss
@@ -8,12 +8,13 @@
 (define (monitor-scm repos start-rev notify-newer! notify-user!)
   (define (monitor-w/o-wait prev-rev)
     (define new-revs
-      (scm-revisions-after prev-rev repos))
+      (scm-revisions-after prev-rev))
     (match new-revs
       [(list)
        ; There has not yet been more revisions
        (monitor prev-rev)]
       [(cons new-rev newer)
+       (scm-update repos)
        ; Notify of newer ones
        (notify-newer! newer)
        ; There was a commit that we care about. Notify, then recur
diff --git a/collects/meta/drdr/render.ss b/collects/meta/drdr/render.ss
index de282ff11a..65683b1bf6 100644
--- a/collects/meta/drdr/render.ss
+++ b/collects/meta/drdr/render.ss
@@ -104,6 +104,7 @@
   (define pth (revision-commit-msg (current-rev)))
   (define msg-v (read-cache* pth))
   (match msg-v
+    ; XXX git push
     [(struct svn-rev-log (num author date msg changes))
      (define url (format "http://svn.plt-scheme.org/view?view=rev&revision=~a" num))
      (define (timestamp pth)
@@ -183,6 +184,7 @@
         (define-values (title breadcrumb) (path->breadcrumb log-pth #f))
         (define the-base-path
           (base-path log-pth))
+        ; XXX git url
         (define svn-url
           (format "http://svn.plt-scheme.org/view/trunk/~a?view=markup&pathrev=~a"
                   the-base-path
@@ -486,6 +488,23 @@
   (if (eof-object? v)
       "" v))
 
+(define log->committer+title 
+  (match-lambda
+    [(struct git-push (num author commits))
+     (define lines (append-map git-commit-msg commits))
+     (define title
+       (if (empty? lines)
+           ""
+           (first lines)))
+     (values author title)]
+    [(struct svn-rev-log (num author date msg changes))
+     (define commit-msg (string-first-line msg))
+     (define title 
+       (format "~a - ~a"
+               (svn-date->nice-date date)
+               commit-msg))
+     (values author title)]))
+
 (require web-server/servlet-env
          web-server/http
          web-server/dispatch
@@ -540,13 +559,8 @@
                             (define name (path->string rev-pth))
                             (define rev (string->number name))
                             (define log (read-cache (future-record-path rev)))
-                            (define committer (svn-rev-log-author log))
-                            (define commit-msg (string-first-line (svn-rev-log-msg log)))
-                            (define title 
-                              (format "~a - ~a"
-                                      (svn-date->nice-date (svn-rev-log-date log))
-                                      commit-msg))
-                            
+                            (define-values (committer title)
+                              (log->committer+title log))                            
                             `(tr ([class "dir"]
                                   [title ,title])
                                  (td (a ([href ,(revision-svn-url name)]) ,name))
@@ -559,12 +573,8 @@
                             (define rev (string->number name))
                             (define log-pth (revision-commit-msg rev))
                             (define log (read-cache log-pth))
-                            (define committer (svn-rev-log-author log))
-                            (define commit-msg (string-first-line (svn-rev-log-msg log)))
-                            (define title 
-                              (format "~a - ~a"
-                                      (svn-date->nice-date (svn-rev-log-date log))
-                                      commit-msg))
+                            (define-values (committer title)
+                              (log->committer+title log))
                             (define (no-rendering-row)
                               (define mtime 
                                 (file-or-directory-modify-seconds log-pth))
diff --git a/collects/meta/drdr/scm.ss b/collects/meta/drdr/scm.ss
index 2008af5e4b..9932289f4b 100644
--- a/collects/meta/drdr/scm.ss
+++ b/collects/meta/drdr/scm.ss
@@ -1,5 +1,6 @@
 #lang scheme
 (require "svn.ss"
+         "path-utils.ss"
          net/url
          scheme/system)
 (provide
@@ -20,7 +21,7 @@
               "0" "")
           (number->string n)))
 
-(define-struct push-data (who start-commit end-commit branches) #:prefab)
+(define-struct push-data (who end-commit branches) #:prefab)
 
 (define (push-info push-n)
   (define push-n100s (quotient push-n 100))
@@ -31,21 +32,27 @@
       (string->url 
        (format "~a/pushes/~a/~a" git-url-base push-n100s push-nrem)))))
   (match ls
-    [(list (regexp #rx"^([^ ]+) +([0-9abcdef]+) +([0-9abcdef]+)$" (list _ who start-commit end-commit))
-           (regexp #rx"^([0-9abcdef]+) +([0-9abcdef]+) +(.+)$" (list _ _ _ branch))
+    [(list (regexp #rx"^([^ ]+) +([0-9abcdef]+)$" (list _ who end-commit))
+           (regexp #rx"^([0-9abcdef]+) +([0-9abcdef]+) +(.+)$" (list _ bstart bend branch))
            ...)
-     (make-push-data who start-commit end-commit branch)]
+     (make-push-data who end-commit 
+                     (make-immutable-hash
+                      (map (lambda (b bs be) (cons b (vector bs be)))
+                           branch bstart bend)))]
     [_
      #f]))
 
-(define (system/output-port #:stdout [init-stdout #f] . as)
+(define (system/output-port #:k k #:stdout [init-stdout #f] . as)
+  (define _ (printf "~S~n" as))
   (define-values (sp stdout stdin stderr)
     (apply subprocess init-stdout #f #f as))
-  (subprocess-wait sp)
-  stdout)
+  (begin0 (k stdout)
+          (subprocess-wait sp)))
 
 (define-struct git-push (num author commits) #:prefab)
-(define-struct git-commit (hash author date msg mfiles) #:prefab)
+(define-struct git-commit (hash author date msg) #:prefab)
+(define-struct (git-diff git-commit) (mfiles) #:prefab)
+(define-struct (git-merge git-commit) (from to) #:prefab)
 
 (define (read-until-empty-line in-p)
   (let loop ()
@@ -60,77 +67,107 @@
          (list* (regexp-replace #rx"^ +" l "") (loop))]))))
 
 (define (read-commit in-p)
-  (match-define (regexp #rx"^commit +(.+)$" (list _ hash)) (read-line in-p))
-  (match-define (regexp #rx"^Author: +(.+)$" (list _ author)) (read-line in-p))
-  (match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
-  (define _1 (read-line in-p))
-  (define msg (read-until-empty-line in-p))
-  (define mfiles (read-until-empty-line in-p))
-  (make-git-commit hash author date msg mfiles))
+  (match (read-line in-p)
+    [(? eof-object?)
+     #f]
+    [(regexp #rx"^commit +(.+)$" (list _ hash))
+     (match (read-line in-p)
+       [(regexp #rx"^Merge: +(.+) +(.+)$" (list _ from to))
+        (match-define (regexp #rx"^Author: +(.+)$" (list _ author)) (read-line in-p))
+        (match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
+        (define _1 (read-line in-p))
+        (define msg (read-until-empty-line in-p))
+        (make-git-merge hash author date msg from to)]
+       [(regexp #rx"^Author: +(.+)$" (list _ author))
+        (match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
+        (define _1 (read-line in-p))
+        (define msg (read-until-empty-line in-p))
+        (define mfiles (read-until-empty-line in-p))
+        (make-git-diff hash author date msg mfiles)])]))
 
 (define port-empty? port-closed?)
 
 (define (read-commits in-p)
-  (if (port-empty? in-p)
-      empty
-      (list* (read-commit in-p)
-             (read-commits in-p))))
+  (cond
+    [(port-empty? in-p)
+     empty]
+    [(read-commit in-p)
+     => (lambda (c) 
+          (printf "~S~n" c)
+          (list* c (read-commits in-p)))]
+    [else
+     empty]))
 
 (define (parse-push num author in-p)
   (make-git-push num author (read-commits in-p)))
 
 (define (get-scm-commit-msg rev repo)
-  (match-define (struct push-data (who start-commit end-commit branches)) (push-info rev))
-  (scm-update repo)
-  (parse-push 
-   rev who 
-   (parameterize ([current-directory repo])
-     (system/output-port (git-path) "log" "--date=iso" "--name-only" (format "~a..~a" start-commit end-commit)))))
+  (match-define (struct push-data (who _ branches)) (push-info rev))
+  (match-define (vector start-commit end-commit) (hash-ref branches master-branch))
+  (parameterize ([current-directory repo])
+    (system/output-port 
+     #:k (curry parse-push rev who)
+     (git-path)
+     "--no-pager" "log" "--date=iso" "--name-only"
+     (format "~a..~a" start-commit end-commit))))
 (provide/contract
- [struct git-push ([num exact-nonnegative-integer?]
-                   [author string?]
-                   [commits (listof git-commit?)])]
- [struct git-commit ([hash string?]
-                     [author string?]
-                     [date string?]
-                     [msg (listof string?)]
-                     [mfiles (listof string?)])]
- [get-scm-commit-msg (exact-nonnegative-integer? string? . -> . git-push?)])
+ [struct git-push 
+         ([num exact-nonnegative-integer?]
+          [author string?]
+          [commits (listof git-commit?)])]
+ [struct git-commit 
+         ([hash string?]
+          [author string?]
+          [date string?]
+          [msg (listof string?)])]
+ [struct git-diff 
+         ([hash string?]
+          [author string?]
+          [date string?]
+          [msg (listof string?)]
+          [mfiles (listof string?)])]
+ [struct git-merge 
+         ([hash string?]
+          [author string?]
+          [date string?]
+          [msg (listof string?)]
+          [from string?]
+          [to string?])]
+ [get-scm-commit-msg (exact-nonnegative-integer? path-string? . -> . git-push?)])
 
 (define (scm-export rev repo file dest)
   (define commit
     (push-data-end-commit (push-info rev)))
-  (scm-update repo)
-  (call-with-output-file* 
-   dest
-   #:exists 'truncate/replace
-   (lambda (file-port)
-     (parameterize ([current-directory repo])
-       (system/output-port #:stdout file-port
-                           (git-path)
-                           "archive" commit file))))
+  (define cmd
+    (format "~S archive --format=tar ~S ~S | tar -O -xf - ~S > ~S"
+            (git-path) commit file file dest))
+  (parameterize ([current-directory repo])
+    (system cmd))
   (void))
 
 (define (scm-checkout rev repo dest)
-  (scm-update repo)
-  (system* (git-path) "clone" (path->string repo) (path->string dest))
+  (system* (git-path) "clone" (path->string* repo) (path->string* dest))
   (parameterize ([current-directory dest])
-    (system* (git-path) "checkout" (push-data-end-commit (push-info rev)))))
+    (system* (git-path) "checkout" (push-data-end-commit (push-info rev))))
+  (void))
 
 (define (scm-update repo)
   (parameterize ([current-directory repo])
-    (system* (git-path) "fetch" git-url-base)))
+    (system* (git-path) "fetch" git-url-base))
+  (void))
 
-(define (scm-revisions-after cur-rev repo)
+(define master-branch "refs/heads/master")
+
+(define (scm-revisions-after cur-rev)
   (define newest-rev (newest-push))
   (for/list ([rev (in-range (add1 cur-rev) newest-rev)]
              #:when
              (let ([info (push-info rev)])
-               (and info
-                    (member "refs/heads/master" (push-data-branches info)))))
+               (and info (hash-has-key? (push-data-branches info) master-branch))))
     rev))
 
 (provide/contract
- [scm-revisions-after (exact-nonnegative-integer? path? . -> . void?)]
- [scm-export (exact-nonnegative-integer? path? string? path? . -> . void?)]
- [scm-checkout (exact-nonnegative-integer? path? path? . -> . void?)])
\ No newline at end of file
+ [scm-update (path? . -> . void?)]
+ [scm-revisions-after (exact-nonnegative-integer? . -> . void?)]
+ [scm-export (exact-nonnegative-integer? path-string? string? path-string? . -> . void?)]
+ [scm-checkout (exact-nonnegative-integer? path-string? path-string? . -> . void?)])
\ No newline at end of file

From b86d90a46a055f0618b53f15f19b7d76a1476da1 Mon Sep 17 00:00:00 2001
From: Kevin Tew <tewk@racket-lang.org>
Date: Thu, 22 Apr 2010 10:43:41 -0600
Subject: [PATCH 08/16] [Places] made functions static

---
 src/racket/src/places.c  | 15 ++++++++-------
 src/racket/src/schpriv.h |  5 -----
 2 files changed, 8 insertions(+), 12 deletions(-)

diff --git a/src/racket/src/places.c b/src/racket/src/places.c
index bdfcc6ff86..5bddbdef1c 100644
--- a/src/racket/src/places.c
+++ b/src/racket/src/places.c
@@ -11,7 +11,7 @@ READ_ONLY static Scheme_Object *scheme_def_place_exit_proc;
 
 SHARED_OK mz_proc_thread *scheme_master_proc_thread;
 THREAD_LOCAL_DECL(mz_proc_thread *proc_thread_self);
-Scheme_Object *scheme_place(int argc, Scheme_Object *args[]);
+static Scheme_Object *scheme_place(int argc, Scheme_Object *args[]);
 static Scheme_Object *scheme_place_wait(int argc, Scheme_Object *args[]);
 static Scheme_Object *scheme_place_sleep(int argc, Scheme_Object *args[]);
 static Scheme_Object *scheme_place_p(int argc, Scheme_Object *args[]);
@@ -21,15 +21,16 @@ static Scheme_Object *scheme_place_recv(int argc, Scheme_Object *args[]);
 static Scheme_Object *scheme_place_channel_p(int argc, Scheme_Object *args[]);
 static Scheme_Object *def_place_exit_handler_proc(int argc, Scheme_Object *args[]);
 
-Scheme_Object *scheme_place_async_channel_create();
-Scheme_Object *scheme_place_bi_channel_create();
-Scheme_Object *scheme_place_bi_peer_channel_create(Scheme_Object *orig);
+static Scheme_Object *scheme_place_async_channel_create();
+static Scheme_Object *scheme_place_bi_channel_create();
+static Scheme_Object *scheme_place_bi_peer_channel_create(Scheme_Object *orig);
 static void scheme_place_bi_channel_set_signal(Scheme_Object *cho);
 static int scheme_place_channel_ready(Scheme_Object *so);
 
-void scheme_place_async_send(Scheme_Place_Async_Channel *ch, Scheme_Object *o);
-Scheme_Object *scheme_place_async_recv(Scheme_Place_Async_Channel *ch);
-Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table *ht);
+
+static void scheme_place_async_send(Scheme_Place_Async_Channel *ch, Scheme_Object *o);
+static Scheme_Object *scheme_place_async_recv(Scheme_Place_Async_Channel *ch);
+static Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table *ht);
 
 # ifdef MZ_PRECISE_GC
 static void register_traversers(void);
diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h
index 93a7b2abe0..955bc63f79 100644
--- a/src/racket/src/schpriv.h
+++ b/src/racket/src/schpriv.h
@@ -3470,11 +3470,6 @@ typedef struct Scheme_Place_Async_Channel {
   void *wakeup_signal;
 } Scheme_Place_Async_Channel;
 
-Scheme_Object *scheme_place_async_channel_create();
-void scheme_place_async_send(Scheme_Place_Async_Channel *ch, Scheme_Object *o);
-Scheme_Object *scheme_place_async_recv(Scheme_Place_Async_Channel *ch);
-
-
 Scheme_Env *scheme_place_instance_init();
 void scheme_place_instance_destroy();
 void scheme_kill_green_thread_timer();

From aff19733d3d397329c6f081056266971363b13f0 Mon Sep 17 00:00:00 2001
From: Kevin Tew <tewk@racket-lang.org>
Date: Thu, 22 Apr 2010 10:44:33 -0600
Subject: [PATCH 09/16] [Places] allow creation and communication of arbitrary
 place channels

---
 src/racket/src/places.c | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/src/racket/src/places.c b/src/racket/src/places.c
index 5bddbdef1c..3b6bc7e67b 100644
--- a/src/racket/src/places.c
+++ b/src/racket/src/places.c
@@ -20,6 +20,8 @@ static Scheme_Object *scheme_place_send(int argc, Scheme_Object *args[]);
 static Scheme_Object *scheme_place_recv(int argc, Scheme_Object *args[]);
 static Scheme_Object *scheme_place_channel_p(int argc, Scheme_Object *args[]);
 static Scheme_Object *def_place_exit_handler_proc(int argc, Scheme_Object *args[]);
+static Scheme_Object *scheme_place_channel(int argc, Scheme_Object *args[]);
+static Scheme_Object *scheme_place_channel_receiver_channel(int argc, Scheme_Object *args[]);
 
 static Scheme_Object *scheme_place_async_channel_create();
 static Scheme_Object *scheme_place_bi_channel_create();
@@ -74,6 +76,8 @@ void scheme_init_place(Scheme_Env *env)
   PLACE_PRIM_W_ARITY("place-sleep",    scheme_place_sleep, 1, 1, plenv);
   PLACE_PRIM_W_ARITY("place-wait",     scheme_place_wait,  1, 1, plenv);
   PLACE_PRIM_W_ARITY("place?",         scheme_place_p,     1, 1, plenv);
+  PLACE_PRIM_W_ARITY("place-channel",  scheme_place_channel,  0, 0, plenv);
+  PLACE_PRIM_W_ARITY("place-channel->receiver-channel",  scheme_place_channel_receiver_channel, 1, 1, plenv);
   PLACE_PRIM_W_ARITY("place-channel-send",  scheme_place_send,  1, 2, plenv);
   PLACE_PRIM_W_ARITY("place-channel-recv",  scheme_place_recv,  1, 1, plenv);
   PLACE_PRIM_W_ARITY("place-channel?",      scheme_place_channel_p,  1, 1, plenv);
@@ -451,6 +455,8 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
     case scheme_true_type:
     case scheme_false_type:
     case scheme_null_type:
+    /* place_bi_channels are allocated in the master and can be passed along as is */
+    case scheme_place_bi_channel_type:
       new_so = so;
       break;
     case scheme_char_type:
@@ -946,6 +952,32 @@ Scheme_Object *scheme_place_bi_peer_channel_create(Scheme_Object *orig) {
   return (Scheme_Object *)ch;
 }
 
+static Scheme_Object *scheme_place_channel(int argc, Scheme_Object *args[]) {
+  if (argc == 0) {
+    return scheme_place_bi_channel_create();
+  }
+  else {
+    scheme_wrong_count_m("place-channel", 0, 0, argc, args, 0);
+  }
+  return scheme_true;
+}
+
+static Scheme_Object *scheme_place_channel_receiver_channel(int argc, Scheme_Object *args[]) {
+  if (argc == 1) {
+    if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_bi_channel_type)) {
+      return scheme_place_bi_peer_channel_create(args[0]);
+    }
+    else {
+      scheme_wrong_type("place-channel->receive-channel", "place-channel?", 0, argc, args);
+    }
+  }
+  else {
+    scheme_wrong_count_m("place-channel-send", 1, 1, argc, args, 0);
+  }
+  return scheme_true;
+}
+
+
 static void scheme_place_bi_channel_set_signal(Scheme_Object *cho) {
   Scheme_Place_Async_Channel *ch;
   void *signaldescr;

From 3a1fe8722f45a87aa32ec6bfeb33c6579169d5b0 Mon Sep 17 00:00:00 2001
From: John Clements <clements@racket-lang.org>
Date: Thu, 22 Apr 2010 09:52:48 -0700
Subject: [PATCH 10/16] Updates to files, about to reshuffle names

---
 collects/schelog/INSTALL            |  8 +++++++
 collects/schelog/README             | 14 ++++++------
 collects/schelog/examples/bible.scm | 25 ++++++++++++++++------
 collects/schelog/makefile           |  4 ++++
 collects/schelog/schelog.scm        | 33 ++++++++++++++++++++++++-----
 5 files changed, 66 insertions(+), 18 deletions(-)

diff --git a/collects/schelog/INSTALL b/collects/schelog/INSTALL
index 0217f5d278..3acb4689a2 100644
--- a/collects/schelog/INSTALL
+++ b/collects/schelog/INSTALL
@@ -1,5 +1,13 @@
 Installing Schelog
 
+
+*** JBC, 2010-04-22: I conjecture that (as a collection
+within the PLT tree) installation directions are now
+superfluous.  The below is preserved for posterity.
+
+
+
+
 -
 
 First, obtain the Schelog distribution.  This is
diff --git a/collects/schelog/README b/collects/schelog/README
index 03fefa5851..a5b7156bfa 100644
--- a/collects/schelog/README
+++ b/collects/schelog/README
@@ -3,6 +3,14 @@ Schelog
 Dorai Sitaram
 ds26@gte.com
 
+
+*** JBC 2010-04-22: this package has been TAMPERED WITH in an unscrupulous and
+undisciplined way by John Clements 2010-04-22 in order to see how difficult it
+would be to get it to compile in PLT 4.2.5.  The answer is "not hard", but it's
+certainly not portable any more, and crucially the two macros that cause
+capture of the ! symbol now require uses of the macro to supply the bang, thus
+making them non-capturing.
+
                           ...
 
 Schelog is for you if you are interested in any or all
@@ -37,9 +45,3 @@ produces a directory called "schelog".  In it is a file
 called INSTALL which contains detailed installation
 instructions.  Read INSTALL now.
 
-*** this package has been TAMPERED WITH in an unscrupulous and undisciplined
-way by John Clements 2010-04-22 in order to see how difficult it would be to
-get it to compile in PLT 4.2.5.  The answer is "not hard", but it's certainly
-not portable any more, and crucially the two macros that cause capture of 
-the ! symbol now require uses of the macro to supply the bang, thus making them
-non-capturing.
diff --git a/collects/schelog/examples/bible.scm b/collects/schelog/examples/bible.scm
index 020b1990c8..c71163e0e8 100644
--- a/collects/schelog/examples/bible.scm
+++ b/collects/schelog/examples/bible.scm
@@ -1,10 +1,15 @@
+#lang racket
+
+(require "../schelog.scm"
+         schemeunit)
+
 ;The following is the "Biblical" database from "The Art of
 ;Prolog", Sterling & Shapiro, ch. 1.
 
 ;(%father X Y) :- X is the father of Y.
 
 (define %father
-  (%rel ()
+  (%rel ! ()
     (('terach 'abraham)) (('terach 'nachor)) (('terach 'haran))
     (('abraham 'isaac)) (('haran 'lot)) (('haran 'milcah))
     (('haran 'yiscah))))
@@ -12,14 +17,14 @@
 ;(%mother X Y) :- X is the mother of Y.
 
 (define %mother
-  (%rel () (('sarah 'isaac))))
+  (%rel ! () (('sarah 'isaac))))
 
 (define %male
-  (%rel ()
+  (%rel ! ()
     (('terach)) (('abraham)) (('isaac)) (('lot)) (('haran)) (('nachor))))
 
 (define %female
-  (%rel ()
+  (%rel ! ()
     (('sarah)) (('milcah)) (('yiscah))))
 
 ;AoP, ch. 17.  Finding all the children of a particular
@@ -31,13 +36,13 @@
 (define %children-1
 
   (letrec ((children-aux
-	     (%rel (x a cc c)
+	     (%rel ! (x a cc c)
 	       ((x a cc)
                  (%father x c) (%not (%member c a)) !
                  (children-aux x (cons c a) cc))
 	       ((x cc cc)))))
 
-    (%rel (x cc)
+    (%rel ! (x cc)
       ((x cc) (children-aux x '() cc)))))
 
 (define terachs-kids-test
@@ -47,6 +52,9 @@
     (%which (cc)
       (%children-1 'terach cc))))
 
+(check-equal? (terachs-kids-test)
+              `((cc (haran nachor abraham))))
+
 (define dad-kids-test
   ;find a father and all his children.  Returns
   ;f = terach, cc = (haran nachor abraham).
@@ -56,6 +64,9 @@
     (%which (f cc)
       (%children-1 f cc))))
 
+(check-equal? (dad-kids-test)
+              `((f terach) (cc (haran nachor abraham))))
+
 (define terachs-kids-test-2
   ;find all the kids of Terach, using %set-of.
   ;returns kk = (abraham nachor haran)
@@ -68,7 +79,7 @@
 ;Uses set predicate %bag-of
 
 (define %children
-  (%rel (x kids c)
+  (%rel ! (x kids c)
     ((kids) (%set-of c (%father x c) kids))))
 
 (define dad-kids-test-2
diff --git a/collects/schelog/makefile b/collects/schelog/makefile
index a1340d2eb8..69d8cb0ce5 100644
--- a/collects/schelog/makefile
+++ b/collects/schelog/makefile
@@ -1,3 +1,7 @@
+# JBC, 2010-04-22:
+# this makefile could probably be usefully rendered in scheme... but
+# I'm not going to try.
+
 
 TRIGGER_FILES = history manifest makefile version.tex \
 		schelog.scm schelog.tex
diff --git a/collects/schelog/schelog.scm b/collects/schelog/schelog.scm
index dfad8ffb60..b18a68903e 100644
--- a/collects/schelog/schelog.scm
+++ b/collects/schelog/schelog.scm
@@ -1,7 +1,27 @@
-#lang scheme
+#lang racket
+
+
+;; TODO: figure out what should actually be 'provide'd.
 
 (provide (all-defined-out))
 
+;; A Note on changes: define-macro isn't so nice, but 
+;; someone (Dorai?) helpfully provided commented-out
+;; versions of each macro in syntax-rules style.  
+;; Unfortunately, they didn't compile, but this seemed
+;; related to an inability to capture the '!' name.
+;; The easiest way to fix this was just to take the 
+;; classic "make 'em put the identifier in there" approach,
+;; which means that uses of cut and rel must now include 
+;; a bang explicitly.  It wouldn't be too hard to change
+;; back to a capturing macro; I know syntax-case can do
+;; it, I don't know if syntax-rules can. 
+
+;; Also, I changed a few top-level mutable bindings into
+;; boxed bindings. 
+
+;;-- JBC, 2010-04-22
+
 
 ;MzScheme version of
 ;schelog.scm
@@ -718,12 +738,12 @@
 ;the above could also have been written in a more
 ;Prolog-like fashion, viz.
 
-'(define %member
+#;'(define %member
   (%rel ! (x xs y ys)
     ((x (cons x xs)))
     ((x (cons y ys)) (%member x ys))))
 
-'(define %if-then-else
+#;'(define %if-then-else
   (%rel ! (p q r)
     ((p q r) p ! q)
     ((p q r) r)))
@@ -742,8 +762,11 @@
 
 ; deprecated names -- retained here for backward-compatibility
 
-(define == %=)
-(define %notunify %/=)
+;; JBC, 2010-04-22 -- don't think backward compatibility counts any more. commenting 
+;; these out.
+
+#;(define == %=)
+#;(define %notunify %/=)
 
 #;(define-macro %cut
   (lambda e

From 58991ebe9581df894f60265ed9e7eab4229e9f38 Mon Sep 17 00:00:00 2001
From: John Clements <clements@racket-lang.org>
Date: Thu, 22 Apr 2010 10:17:18 -0700
Subject: [PATCH 11/16] Names changed, looks like everything builds except the
 files in dialects/

---
 .../schelog/dialects/dialects-supported.scm   |  5 +++-
 .../schelog/dialects/files-to-be-ported.scm   |  5 +++-
 .../schelog/examples/{bible.scm => bible.rkt} |  2 +-
 .../examples/{england.scm => england.rkt}     | 25 +++++++++-------
 .../examples/{england2.scm => england2.rkt}   |  4 +++
 .../schelog/examples/{games.scm => games.rkt} |  7 ++++-
 .../examples/{holland.scm => holland.rkt}     |  4 +++
 .../examples/{houses.scm => houses.rkt}       | 24 ++++++++-------
 .../examples/{mapcol.scm => mapcol.rkt}       | 22 +++++++++-----
 .../examples/{puzzle.scm => puzzle.rkt}       |  2 +-
 .../schelog/examples/{toys.scm => toys.rkt}   | 30 +++++++++++--------
 collects/schelog/info.ss                      |  2 ++
 collects/schelog/{schelog.scm => schelog.rkt} |  0
 13 files changed, 86 insertions(+), 46 deletions(-)
 rename collects/schelog/examples/{bible.scm => bible.rkt} (99%)
 rename collects/schelog/examples/{england.scm => england.rkt} (84%)
 rename collects/schelog/examples/{england2.scm => england2.rkt} (97%)
 rename collects/schelog/examples/{games.scm => games.rkt} (92%)
 rename collects/schelog/examples/{holland.scm => holland.rkt} (94%)
 rename collects/schelog/examples/{houses.scm => houses.rkt} (87%)
 rename collects/schelog/examples/{mapcol.scm => mapcol.rkt} (83%)
 rename collects/schelog/examples/{puzzle.scm => puzzle.rkt} (97%)
 rename collects/schelog/examples/{toys.scm => toys.rkt} (82%)
 create mode 100644 collects/schelog/info.ss
 rename collects/schelog/{schelog.scm => schelog.rkt} (100%)

diff --git a/collects/schelog/dialects/dialects-supported.scm b/collects/schelog/dialects/dialects-supported.scm
index 84974dd1b1..1e35bc5329 100644
--- a/collects/schelog/dialects/dialects-supported.scm
+++ b/collects/schelog/dialects/dialects-supported.scm
@@ -1,4 +1,6 @@
-;last change: 2003-06-01
+#lang racket
+
+#|;last change: 2003-06-01
 
 bigloo
 gambit
@@ -14,3 +16,4 @@ scsh
 stk
 sxm
 umbscheme
+|#
\ No newline at end of file
diff --git a/collects/schelog/dialects/files-to-be-ported.scm b/collects/schelog/dialects/files-to-be-ported.scm
index 3c2ffa5dab..0ea28bc9cb 100644
--- a/collects/schelog/dialects/files-to-be-ported.scm
+++ b/collects/schelog/dialects/files-to-be-ported.scm
@@ -1 +1,4 @@
-schelog.scm
+#lang racket
+
+#|schelog.scm
+|#
diff --git a/collects/schelog/examples/bible.scm b/collects/schelog/examples/bible.rkt
similarity index 99%
rename from collects/schelog/examples/bible.scm
rename to collects/schelog/examples/bible.rkt
index c71163e0e8..7a055e10ea 100644
--- a/collects/schelog/examples/bible.scm
+++ b/collects/schelog/examples/bible.rkt
@@ -1,6 +1,6 @@
 #lang racket
 
-(require "../schelog.scm"
+(require "../schelog.rkt"
          schemeunit)
 
 ;The following is the "Biblical" database from "The Art of
diff --git a/collects/schelog/examples/england.scm b/collects/schelog/examples/england.rkt
similarity index 84%
rename from collects/schelog/examples/england.scm
rename to collects/schelog/examples/england.rkt
index 658f7a8348..3a911d6400 100644
--- a/collects/schelog/examples/england.scm
+++ b/collects/schelog/examples/england.rkt
@@ -1,3 +1,8 @@
+#lang racket
+
+(require "../schelog.rkt"
+         schemeunit)
+
 ;The following is a simple database about a certain family in England.
 ;Should be a piece of cake, but given here so that you can hone
 ;your ability to read the syntax.
@@ -6,47 +11,47 @@
 ;The file england2.scm uses a Scheme-like syntax.
 
 (define %male
-  (%rel ()
+  (%rel ! ()
     (('philip)) (('charles)) (('andrew)) (('edward))
     (('mark)) (('william)) (('harry)) (('peter))))
 
 (define %female
-  (%rel ()
+  (%rel ! ()
     (('elizabeth)) (('anne)) (('diana)) (('sarah)) (('zara))))
 
 (define %husband-of
-  (%rel ()
+  (%rel ! ()
     (('philip 'elizabeth)) (('charles 'diana))
     (('mark 'anne)) (('andrew 'sarah))))
 
 (define %wife-of
-  (%rel (w h)
+  (%rel ! (w h)
     ((w h) (%husband-of h w))))
 
 (define %married-to
-  (%rel (x y)
+  (%rel ! (x y)
     ((x y) (%husband-of x y))
     ((x y) (%wife-of x y))))
 
 (define %father-of
-  (%rel ()
+  (%rel ! ()
    (('philip 'charles)) (('philip 'anne)) (('philip 'andrew))
    (('philip 'edward)) (('charles 'william)) (('charles 'harry))
    (('mark 'peter)) (('mark 'zara))))
 
 (define %mother-of
-  (%rel (m c f)
+  (%rel ! (m c f)
     ((m c) (%wife-of m f) (%father-of f c))))
 
 (define %child-of
-  (%rel (c p)
+  (%rel ! (c p)
     ((c p) (%father-of p c))
     ((c p) (%mother-of p c))))
 
 (define %parent-of
-  (%rel (p c)
+  (%rel ! (p c)
     ((p c) (%child-of c p))))
 
 (define %brother-of
-  (%rel (b x f)
+  (%rel ! (b x f)
     ((b x) (%male b) (%father-of f b) (%father-of f x) (%/= b x))))
diff --git a/collects/schelog/examples/england2.scm b/collects/schelog/examples/england2.rkt
similarity index 97%
rename from collects/schelog/examples/england2.scm
rename to collects/schelog/examples/england2.rkt
index c3adf64846..aecc98f3aa 100644
--- a/collects/schelog/examples/england2.scm
+++ b/collects/schelog/examples/england2.rkt
@@ -1,3 +1,7 @@
+#lang racket
+
+(require "../schelog.rkt")
+
 ;The following is a simple database about a certain family in England.
 ;Should be a piece of cake, but given here so that you can hone
 ;your ability to read the syntax.
diff --git a/collects/schelog/examples/games.scm b/collects/schelog/examples/games.rkt
similarity index 92%
rename from collects/schelog/examples/games.scm
rename to collects/schelog/examples/games.rkt
index 8abdd0889a..9575a08595 100644
--- a/collects/schelog/examples/games.scm
+++ b/collects/schelog/examples/games.rkt
@@ -1,6 +1,8 @@
 #lang scheme
 
-(require "../schelog.scm" "./puzzle.scm")
+(require "../schelog.rkt" 
+         "./puzzle.rkt"
+         schemeunit)
 
 ;;This example is from Sterling & Shapiro, p. 214.
 ;;
@@ -85,3 +87,6 @@
 ;;ask (solve-puzzle %games) to get the solution, which is
 ;;
 ;;((michael is the australian) (richard plays tennis))
+
+(check-equal? (solve-puzzle %games)
+              '((solution= ((michael is the australian) (richard plays tennis)))))
diff --git a/collects/schelog/examples/holland.scm b/collects/schelog/examples/holland.rkt
similarity index 94%
rename from collects/schelog/examples/holland.scm
rename to collects/schelog/examples/holland.rkt
index 5a39e77eec..c7aa0b8be1 100644
--- a/collects/schelog/examples/holland.scm
+++ b/collects/schelog/examples/holland.rkt
@@ -1,3 +1,7 @@
+#lang racket
+
+(require "../schelog.rkt")
+
 ;This is a very trivial program.  In Prolog, it would be:
 ;
 ;    city(amsterdam).
diff --git a/collects/schelog/examples/houses.scm b/collects/schelog/examples/houses.rkt
similarity index 87%
rename from collects/schelog/examples/houses.scm
rename to collects/schelog/examples/houses.rkt
index 663216bf94..08e4601215 100644
--- a/collects/schelog/examples/houses.scm
+++ b/collects/schelog/examples/houses.rkt
@@ -1,3 +1,7 @@
+#lang racket
+
+(require "../schelog.rkt")
+
 ;Exercise 14.1 (iv) from Sterling & Shapiro, p. 217-8  
 
 ;There are 5 houses, each of a different color and inhabited
@@ -25,25 +29,25 @@
   (lambda (hue nation pet drink cigarette)
     (list 'house hue nation pet drink cigarette)))
 
-(define %hue (%rel (h) (((house h (_) (_) (_) (_)) h))))
-(define %nation (%rel (n) (((house (_) n (_) (_) (_)) n))))
-(define %pet (%rel (p) (((house (_) (_) p (_) (_)) p))))
-(define %drink (%rel (d) (((house (_) (_) (_) d (_)) d))))
-(define %cigarette (%rel (c) (((house (_) (_) (_) (_) c) c))))
+(define %hue (%rel ! (h) (((house h (_) (_) (_) (_)) h))))
+(define %nation (%rel ! (n) (((house (_) n (_) (_) (_)) n))))
+(define %pet (%rel ! (p) (((house (_) (_) p (_) (_)) p))))
+(define %drink (%rel ! (d) (((house (_) (_) (_) d (_)) d))))
+(define %cigarette (%rel ! (c) (((house (_) (_) (_) (_) c) c))))
 
 (define %adjacent
-  (%rel (a b)
+  (%rel ! (a b)
     ((a b (list a b (_) (_) (_))))
     ((a b (list (_) a b (_) (_))))
     ((a b (list (_) (_) a b (_))))
     ((a b (list (_) (_) (_) a b)))))
 
 (define %middle
-  (%rel (a)
+  (%rel ! (a)
     ((a (list (_) (_) a (_) (_))))))
 
 (define %houses
-  (%rel (row-of-houses clues queries solution
+  (%rel ! (row-of-houses clues queries solution
 	 h1 h2 h3 h4 h5 n1 n2 n3 n4 n5 p1 p2 p3 p4 p5
 	 d1 d2 d3 d4 d5 c1 c2 c3 c4 c5)
     ((clues queries solution)
@@ -58,7 +62,7 @@
      (%houses-queries row-of-houses queries solution))))
 
 (define %houses-clues
-  (%rel (row-of-houses abode1 abode2 abode3 abode4 abode5 abode6 abode7
+  (%rel ! (row-of-houses abode1 abode2 abode3 abode4 abode5 abode6 abode7
 	 abode8 abode9 abode10 abode11 abode12 abode13 abode14 abode15)
     ((row-of-houses
        (list
@@ -122,7 +126,7 @@
 	 (%hue abode15 'blue))))))
 
 (define %houses-queries
-  (%rel (row-of-houses abode1 abode2 zebra-owner water-drinker)
+  (%rel ! (row-of-houses abode1 abode2 zebra-owner water-drinker)
     ((row-of-houses
        (list
 	 (%member abode1 row-of-houses)
diff --git a/collects/schelog/examples/mapcol.scm b/collects/schelog/examples/mapcol.rkt
similarity index 83%
rename from collects/schelog/examples/mapcol.scm
rename to collects/schelog/examples/mapcol.rkt
index 5970cd6050..3c0de24d9c 100644
--- a/collects/schelog/examples/mapcol.scm
+++ b/collects/schelog/examples/mapcol.rkt
@@ -1,23 +1,29 @@
+#lang racket
+
+(require (except-in "../schelog.rkt" %member))
+
 ;map coloring, example from Sterling & Shapiro, p. 212
 
 ;(%member x y) holds if x is in y
 
+;; is this different from the %member provided by schelog? fencing that one out.
+
 (define %member
-  (%rel (X Xs Y Ys)
+  (%rel ! (X Xs Y Ys)
     ((X (cons X Xs)))
     ((X (cons Y Ys)) (%member X Ys))))
 
 ;(%members x y) holds if x is a subset of y
 
 (define %members
-  (%rel (X Xs Ys)
+  (%rel ! (X Xs Ys)
     (((cons X Xs) Ys) (%member X Ys) (%members Xs Ys))
     (('() Ys))))
 
 ;(%select x y z) holds if z is y with one less occurrence of x
 
 (define %select
-  (%rel (X Xs Y Ys Zs)
+  (%rel ! (X Xs Y Ys Zs)
     ((X (cons X Xs) Xs))
     ((X (cons Y Ys) (cons Y Zs))
      (%select X Ys Zs))))
@@ -29,26 +35,26 @@
     (list 'region name color neighbors)))
 
 (define %color-map
-  (%rel (Region Regions Colors)
+  (%rel ! (Region Regions Colors)
     (((cons Region Regions) Colors)
      (%color-region Region Colors) (%color-map Regions Colors))
     (('() Colors))))
 
 (define %color-region
-  (%rel (Name Color Neighbors Colors Colors1)
+  (%rel ! (Name Color Neighbors Colors Colors1)
     (((region Name Color Neighbors) Colors)
      (%select Color Colors Colors1)
      (%members Neighbors Colors1))))
 
 (define %test-color
-  (%rel (Name Map Colors)
+  (%rel ! (Name Map Colors)
     ((Name Map)
      (%map Name Map)
      (%colors Colors)
      (%color-map Map Colors))))
 
 (define %map
-  (%rel (A B C D E F G H I L P S)
+  (%rel ! (A B C D E F G H I L P S)
     (('test (list
 	      (region 'a A (list B C D))
 	      (region 'b B (list A C E))
@@ -70,7 +76,7 @@
 	 (region 'austria A (list I S G)))))))
 
 (define %colors
-  (%rel ()
+  (%rel ! ()
     (('(red yellow blue white)))))
 
 ;ask (%which (M) (%test-color 'test M)) or
diff --git a/collects/schelog/examples/puzzle.scm b/collects/schelog/examples/puzzle.rkt
similarity index 97%
rename from collects/schelog/examples/puzzle.scm
rename to collects/schelog/examples/puzzle.rkt
index d58717e605..302fcd9594 100644
--- a/collects/schelog/examples/puzzle.scm
+++ b/collects/schelog/examples/puzzle.rkt
@@ -1,6 +1,6 @@
 #lang scheme
 
-(require "../schelog.scm")
+(require "../schelog.rkt")
 
 (provide (all-defined-out))
 
diff --git a/collects/schelog/examples/toys.scm b/collects/schelog/examples/toys.rkt
similarity index 82%
rename from collects/schelog/examples/toys.scm
rename to collects/schelog/examples/toys.rkt
index 41f1af22f9..628a071dea 100644
--- a/collects/schelog/examples/toys.scm
+++ b/collects/schelog/examples/toys.rkt
@@ -1,17 +1,21 @@
+#lang racket
+
+(require (except-in "../schelog.rkt" %append))
+
 ;A list of trivial programs in Prolog, just so you can get used
 ;to schelog syntax.
 
 ;(%length l n) holds if length(l) = n
 
 (define %length
-  (%rel (h t n m)
+  (%rel !  (h t n m)
     (('() 0))
     (((cons h t) n) (%length t m) (%is n (+ m 1)))))
 
 ;(%delete x y z) holds if z is y with all x's removed
 
 (define %delete
-  (%rel (x y z w)
+  (%rel !  (x y z w)
     ((x '() '()))
     ((x (cons x w) y) (%delete x w y))
     ((x (cons z w) (cons z y)) (%not (%= x z)) (%delete x w y))))
@@ -19,7 +23,7 @@
 ;(%remdup x y) holds if y is x without duplicates
 
 (define %remdup
-  (%rel (x y z w)
+  (%rel !  (x y z w)
     (('() '()))
     (((cons x y) (cons x z)) (%delete x y w) (%remdup w z))))
 
@@ -27,31 +31,31 @@
 ;counting duplicates
 
 '(define %count
-  (%rel (x n y)
+  (%rel !  (x n y)
     ((x n) (%remdup x y) (%length y n))))
 
 ;same thing
 
 (define %count
   (letrec ((countaux
-	     (%rel (m n m+1 x y z)
+	     (%rel !  (m n m+1 x y z)
 	       (('() m m))
 	       (((cons x y) m n)
 		(%delete x y z) (%is m+1 (+ m 1)) (countaux z m+1 n)))))
-    (%rel (x n)
+    (%rel !  (x n)
       ((x n) (countaux x 0 n)))))
 
 ;(%append x y z) holds if z is the concatenation of x and y
 
 (define %append
-  (%rel (x y z w)
+  (%rel !  (x y z w)
     (('() x x))
     (((cons x y) z (cons x w)) (%append y z w))))
 
 ;(%reverse x y) holds if the y is the reversal of x
 
 '(define %reverse
-  (%rel (x y z yy)
+  (%rel !  (x y z yy)
     (('() '()))
     (((cons x y) z) (%reverse y yy) (%append yy (list x) z))))
 
@@ -59,16 +63,16 @@
 
 (define %reverse
   (letrec ((revaux
-	     (%rel (x y z w)
+	     (%rel !  (x y z w)
 	       (('() y y))
 	       (((cons x y) z w) (revaux y (cons x z) w)))))
-    (%rel (x y)
+    (%rel !  (x y)
       ((x y) (revaux x '() y)))))
 
 ;(%fact n m) holds if m = n!
 
 '(define %fact
-  (%rel (n n! n-1 n-1!)
+  (%rel !  (n n! n-1 n-1!)
     ((0 1))
     ((n n!) (%is n-1 (- n 1)) (%fact n-1 n-1!) (%is n! (* n n-1!)))))
 
@@ -76,9 +80,9 @@
 
 (define %fact
   (letrec ((factaux
-	     (%rel (n! m x m-1 xx)
+	     (%rel !  (n! m x m-1 xx)
 	       ((0 n! n!))
 	       ((m x n!) (%is m-1 (- m 1)) (%is xx (* x m))
 		(factaux m-1 xx n!)))))
-    (%rel (n n!)
+    (%rel !  (n n!)
       ((n n!) (factaux n 1 n!)))))
diff --git a/collects/schelog/info.ss b/collects/schelog/info.ss
new file mode 100644
index 0000000000..13a63c4835
--- /dev/null
+++ b/collects/schelog/info.ss
@@ -0,0 +1,2 @@
+#lang setup/infotab
+
diff --git a/collects/schelog/schelog.scm b/collects/schelog/schelog.rkt
similarity index 100%
rename from collects/schelog/schelog.scm
rename to collects/schelog/schelog.rkt

From 9f87f58a559caebf0ac009a47f8fb887c5bcb0cd Mon Sep 17 00:00:00 2001
From: John Clements <clements@racket-lang.org>
Date: Thu, 22 Apr 2010 10:20:02 -0700
Subject: [PATCH 12/16] Looks clean.  Ready to merge.

---
 collects/schelog/README                       |  8 ++++++++
 .../schelog/dialects/dialects-supported.scm   | 19 -------------------
 .../schelog/dialects/files-to-be-ported.scm   |  4 ----
 collects/schelog/dialects/gambit-schelog.scm  |  6 ------
 4 files changed, 8 insertions(+), 29 deletions(-)
 delete mode 100644 collects/schelog/dialects/dialects-supported.scm
 delete mode 100644 collects/schelog/dialects/files-to-be-ported.scm
 delete mode 100644 collects/schelog/dialects/gambit-schelog.scm

diff --git a/collects/schelog/README b/collects/schelog/README
index a5b7156bfa..2fc9397a94 100644
--- a/collects/schelog/README
+++ b/collects/schelog/README
@@ -11,6 +11,14 @@ certainly not portable any more, and crucially the two macros that cause
 capture of the ! symbol now require uses of the macro to supply the bang, thus
 making them non-capturing.
 
+TODO:
+- pull some part of the docs across from their tex format
+- figure out what to do with the makefile (delete it?)
+- turn more of the implicit test cases into explicit test cases
+- clean up this README file
+- figure out whether there are copyright issues
+
+
                           ...
 
 Schelog is for you if you are interested in any or all
diff --git a/collects/schelog/dialects/dialects-supported.scm b/collects/schelog/dialects/dialects-supported.scm
deleted file mode 100644
index 1e35bc5329..0000000000
--- a/collects/schelog/dialects/dialects-supported.scm
+++ /dev/null
@@ -1,19 +0,0 @@
-#lang racket
-
-#|;last change: 2003-06-01
-
-bigloo
-gambit
-gauche
-guile
-mitscheme
-mzscheme
-petite
-pscheme
-scheme48
-scm
-scsh
-stk
-sxm
-umbscheme
-|#
\ No newline at end of file
diff --git a/collects/schelog/dialects/files-to-be-ported.scm b/collects/schelog/dialects/files-to-be-ported.scm
deleted file mode 100644
index 0ea28bc9cb..0000000000
--- a/collects/schelog/dialects/files-to-be-ported.scm
+++ /dev/null
@@ -1,4 +0,0 @@
-#lang racket
-
-#|schelog.scm
-|#
diff --git a/collects/schelog/dialects/gambit-schelog.scm b/collects/schelog/dialects/gambit-schelog.scm
deleted file mode 100644
index a01f8298aa..0000000000
--- a/collects/schelog/dialects/gambit-schelog.scm
+++ /dev/null
@@ -1,6 +0,0 @@
-(declare (standard-bindings) (extended-bindings) (block) (not safe))
-
-;if all your arithmetic is going to be fixnum-only,
-;you might want to
-
-;(declare (fixnum))

From b5d2496544bd7fa1679e76906555b0acebfb9bd7 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 22 Apr 2010 11:42:02 -0600
Subject: [PATCH 13/16] Unifying tmp files

---
 collects/meta/drdr/metadata.ss   | 2 +-
 collects/meta/drdr/path-utils.ss | 4 ++++
 collects/meta/drdr/plt-build.ss  | 3 ++-
 3 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/collects/meta/drdr/metadata.ss b/collects/meta/drdr/metadata.ss
index f9d1428eac..51d29fb333 100644
--- a/collects/meta/drdr/metadata.ss
+++ b/collects/meta/drdr/metadata.ss
@@ -50,7 +50,7 @@
   (define props:get-prop
     (hash-ref! props-cache rev
                (lambda ()
-                 (define tmp-file (make-temporary-file "props~a.ss"))
+                 (define tmp-file (make-temporary-file "props~a.ss" #f (current-temporary-directory)))
                  (and
                   ; Checkout the props file
                   (scm-export
diff --git a/collects/meta/drdr/path-utils.ss b/collects/meta/drdr/path-utils.ss
index 2b508d99ab..7259f59eab 100644
--- a/collects/meta/drdr/path-utils.ss
+++ b/collects/meta/drdr/path-utils.ss
@@ -1,6 +1,9 @@
 #lang scheme
 (require scheme/file)
 
+(define current-temporary-directory
+  (make-parameter #f))
+
 (define (directory-list->directory-list* l)
   (sort (filter-not (compose 
                      (lambda (s)
@@ -41,6 +44,7 @@
       (path->string pth-string)))
 
 (provide/contract
+ [current-temporary-directory (parameter/c (or/c false/c path-string?))]
  [safely-delete-directory (path-string? . -> . void)]
  [directory-list->directory-list* ((listof path?) . -> . (listof path?))]
  [directory-list* (path-string? . -> . (listof path?))]
diff --git a/collects/meta/drdr/plt-build.ss b/collects/meta/drdr/plt-build.ss
index 10ecd143d9..7477ccb24f 100644
--- a/collects/meta/drdr/plt-build.ss
+++ b/collects/meta/drdr/plt-build.ss
@@ -230,7 +230,7 @@
   (stop-job-queue! test-workers))
 
 (define (make-fresh-home-dir)
-  (define new-dir (make-temporary-file "home~a" 'directory))
+  (define new-dir (make-temporary-file "home~a" 'directory (current-temporary-directory)))
   (with-handlers ([exn:fail? void])
     (copy-directory/files (hash-ref (current-env) "HOME") new-dir))
   (path->string new-dir))
@@ -263,6 +263,7 @@
      (make-directory* tmp-dir)
      ; We are running inside of a test directory so that random files are stored there
      (parameterize ([current-directory test-dir]
+                    [current-temporary-directory tmp-dir]
                     [current-rev rev])
        (with-env (["PLTSTDERR" "error"]
                   ["TMPDIR" (path->string tmp-dir)]

From 09164a2027107b21ee463ba4343013073d1f9d82 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 22 Apr 2010 13:06:40 -0600
Subject: [PATCH 14/16] Finalizing git transition

---
 collects/meta/drdr/analyze.ss     |   4 +-
 collects/meta/drdr/monitor-scm.ss |   2 +-
 collects/meta/drdr/plt-build.ss   |  36 +++++---
 collects/meta/drdr/render.ss      | 149 ++++++++++++++++++++----------
 collects/meta/drdr/scm.ss         |  28 ++++--
 5 files changed, 147 insertions(+), 72 deletions(-)

diff --git a/collects/meta/drdr/analyze.ss b/collects/meta/drdr/analyze.ss
index fa79f0e7f5..f29cf3ba6c 100644
--- a/collects/meta/drdr/analyze.ss
+++ b/collects/meta/drdr/analyze.ss
@@ -129,7 +129,7 @@
       responsible))
   (define committer
     (with-handlers ([exn:fail? (lambda (x) #f)])
-      (svn-rev-log-author 
+      (scm-commit-author 
        (read-cache*
         (revision-commit-msg cur-rev)))))
   (define diff
@@ -317,7 +317,7 @@
                  (or
                   (and committer? 
                        (with-handlers ([exn:fail? (lambda (x) #f)])
-                         (svn-rev-log-author (read-cache (revision-commit-msg (current-rev))))))
+                         (scm-commit-author (read-cache (revision-commit-msg (current-rev))))))
                   (or (path-responsible (trunk-path dir-pth))
                       "unknown"))
                  
diff --git a/collects/meta/drdr/monitor-scm.ss b/collects/meta/drdr/monitor-scm.ss
index 267cc7b4e8..da1875b893 100644
--- a/collects/meta/drdr/monitor-scm.ss
+++ b/collects/meta/drdr/monitor-scm.ss
@@ -31,7 +31,7 @@
  [current-monitoring-interval-seconds 
   (parameter/c exact-nonnegative-integer?)]
  [monitor-scm
-  (string? exact-nonnegative-integer? 
+  (path-string? exact-nonnegative-integer? 
            ((listof exact-nonnegative-integer?) . -> . void)
            (exact-nonnegative-integer? exact-nonnegative-integer? . -> . void)
            . -> . any)])
\ No newline at end of file
diff --git a/collects/meta/drdr/plt-build.ss b/collects/meta/drdr/plt-build.ss
index 7477ccb24f..f9749c8af9 100644
--- a/collects/meta/drdr/plt-build.ss
+++ b/collects/meta/drdr/plt-build.ss
@@ -80,6 +80,20 @@
 (define-syntax-rule (with-temporary-directory e)
   (call-with-temporary-directory (lambda () e)))
 
+(define (call-with-temporary-home-directory thunk)
+  (define new-dir (make-temporary-file "home~a" 'directory (current-temporary-directory)))
+  (dynamic-wind
+   (lambda ()
+     (with-handlers ([exn:fail? void])
+       (copy-directory/files (hash-ref (current-env) "HOME") new-dir)))
+   (lambda ()
+     (with-env (["HOME" (path->string new-dir)])
+       (thunk)))
+   (lambda ()
+     (delete-directory/files new-dir))))
+(define-syntax-rule (with-temporary-home-directory e)
+  (call-with-temporary-home-directory (lambda () e)))
+
 (define (with-running-program command args thunk)
   (define-values (new-command new-args)
     (command+args+env->command+args
@@ -185,14 +199,14 @@
                                          test-workers
                                          (lambda ()
                                            (define l (pth-cmd))
-                                           (with-env (["DISPLAY" (format ":~a" (+ XSERVER-OFFSET (current-worker)))]
-                                                      ["HOME" (make-fresh-home-dir)])
-                                             (with-temporary-directory
-                                                 (run/collect/wait/log log-pth 
-                                                                       #:timeout pth-timeout
-                                                                       #:env (current-env)
-                                                                       (first l)
-                                                                       (rest l))))
+                                           (with-env (["DISPLAY" (format ":~a" (+ XSERVER-OFFSET (current-worker)))])
+                                             (with-temporary-home-directory
+                                                 (with-temporary-directory
+                                                     (run/collect/wait/log log-pth 
+                                                                           #:timeout pth-timeout
+                                                                           #:env (current-env)
+                                                                           (first l)
+                                                                           (rest l)))))
                                            (semaphore-post dir-sema)))
                                         (semaphore-post dir-sema)))))))
                       files)
@@ -229,12 +243,6 @@
   (notify! "Stopping testing")
   (stop-job-queue! test-workers))
 
-(define (make-fresh-home-dir)
-  (define new-dir (make-temporary-file "home~a" 'directory (current-temporary-directory)))
-  (with-handlers ([exn:fail? void])
-    (copy-directory/files (hash-ref (current-env) "HOME") new-dir))
-  (path->string new-dir))
-
 (define (recur-many i r f)
   (if (zero? i)
       (f)
diff --git a/collects/meta/drdr/render.ss b/collects/meta/drdr/render.ss
index 65683b1bf6..6e521f7674 100644
--- a/collects/meta/drdr/render.ss
+++ b/collects/meta/drdr/render.ss
@@ -99,55 +99,101 @@
 
 (define (svn-date->nice-date date)
   (regexp-replace "^(....-..-..)T(..:..:..).*Z$" date "\\1 \\2"))
+(define (git-date->nice-date date)
+  (regexp-replace "^(....-..-..) (..:..:..).*$" date "\\1 \\2"))
 
 (define (format-commit-msg)
   (define pth (revision-commit-msg (current-rev)))
-  (define msg-v (read-cache* pth))
-  (match msg-v
-    ; XXX git push
+  (define (timestamp pth)
+    (with-handlers ([exn:fail? (lambda (x) "")])
+      (date->string (seconds->date (read-cache (build-path (revision-dir (current-rev)) pth))) #t)))
+  (define bdate/s (timestamp "checkout-done"))
+  (define bdate/e (timestamp "integrated"))
+  (match (read-cache* pth)
+    [(struct git-push (num author commits))
+     `(table ([class "data"])
+             (tr ([class "author"]) (td "Author:") (td ,author))
+             (tr ([class "date"]) (td "Build Start:") (td ,bdate/s))
+             (tr ([class "date"]) (td "Build End:") (td ,bdate/e))
+             ,@(append-map
+                (match-lambda
+                  [(struct git-merge (hash author date msg from to))
+                   `((tr ([class "hash"]) (td "Commit:") (td (a ([href ,(format "http://github.com/plt/racket/commit/~a" hash)]) ,hash)))
+                     (tr ([class "date"]) (td "Date:") (td ,(git-date->nice-date date)))
+                     (tr ([class "author"]) (td "Author:") (td ,author))
+                     (tr ([class "msg"]) (td "Log:") (td (pre ,@msg)))
+                     (tr ([class "merge"]) (td "Merge:") (td "From " ,from " to " ,to)))]
+                  [(struct git-diff (hash author date msg mfiles))
+                   (define cg-id (symbol->string (gensym 'changes)))
+                   (define ccss-id (symbol->string (gensym 'changes)))
+                   `((tr ([class "hash"]) (td "Commit:") (td (a ([href ,(format "http://github.com/plt/racket/commit/~a" hash)]) ,hash)))
+                     (tr ([class "date"]) (td "Date:") (td ,(git-date->nice-date date)))
+                     (tr ([class "author"]) (td "Author:") (td ,author))
+                     (tr ([class "msg"]) (td "Log:") (td (pre ,@msg)))
+                     (tr ([class "changes"]) 
+                         (td 
+                          (a ([href ,(format "javascript:TocviewToggle(\"~a\",\"~a\");" cg-id ccss-id)])
+                             (span ([id ,cg-id]) 9658) "Changes:"))
+                         (td
+                          (div ([id ,ccss-id]
+                                [style "display: none;"])
+                               ,@(for/list ([path (in-list mfiles)])
+                                         `(p ([class "output"])
+                                             ,(if (regexp-match #rx"^collects" path)
+                                                  (local [(define path-w/o-trunk
+                                                            (apply build-path (explode-path path)))
+                                                          (define html-path
+                                                            (if (looks-like-directory? path)
+                                                                (format "~a/" path-w/o-trunk)
+                                                                path-w/o-trunk))
+                                                          (define path-url
+                                                            (path->string* html-path))
+                                                          (define path-tested?
+                                                            #t)]
+                                                    (if path-tested?
+                                                        `(a ([href ,path-url]) ,path)
+                                                        path))
+                                                  path)))))))])
+                commits))]
+     
     [(struct svn-rev-log (num author date msg changes))
      (define url (format "http://svn.plt-scheme.org/view?view=rev&revision=~a" num))
-     (define (timestamp pth)
-       (with-handlers ([exn:fail? (lambda (x) "")])
-         (date->string (seconds->date (read-cache (build-path (revision-dir (current-rev)) pth))) #t)))
-     (define bdate/s (timestamp "checkout-done"))
-     (define bdate/e (timestamp "integrated"))
      (define cg-id (symbol->string (gensym 'changes)))
      (define ccss-id (symbol->string (gensym 'changes)))
      `(table ([class "data"])
-             (tr ([class "author"]) (td "Author:") (td ,author))
-             (tr ([class "date"]) (td "Commit Date:") (td ,(svn-date->nice-date date)))
-             (tr ([class "date"]) (td "Build Start:") (td ,bdate/s))
-             (tr ([class "date"]) (td "Build End:") (td ,bdate/e))
-             (tr ([class "msg"]) (td "Log:") (td (pre ,msg)))
-             (tr ([class "changes"]) 
-                 (td 
-                  (a ([href ,(format "javascript:TocviewToggle(\"~a\",\"~a\");" cg-id ccss-id)])
-                     (span ([id ,cg-id]) 9658) "Changes:"))
-                 (td
-                  (div ([id ,ccss-id]
-                        [style "display: none;"])
-                       ,@(map (match-lambda
-                                [(struct svn-change (action path))
-                                 `(p ([class "output"])
-                                     ,(symbol->string action) " " 
-                                     ,(if (regexp-match #rx"^/trunk/collects" path)
-                                          (local [(define path-w/o-trunk
-                                                    (apply build-path (list-tail (explode-path path) 2)))
-                                                  (define html-path
-                                                    (if (looks-like-directory? path)
-                                                        (format "~a/" path-w/o-trunk)
-                                                        path-w/o-trunk))
-                                                  (define path-url
-                                                    (path->string* html-path))
-                                                  (define path-tested?
-                                                    #t)]
-                                            (if path-tested?
-                                                `(a ([href ,path-url]) ,path)
-                                                path))
-                                          path))])
-                              changes))))
-             (tr (td nbsp) (td (a ([href ,url]) "View Commit"))))]
+              (tr ([class "author"]) (td "Author:") (td ,author))
+              (tr ([class "date"]) (td "Build Start:") (td ,bdate/s))
+              (tr ([class "date"]) (td "Build End:") (td ,bdate/e))
+              (tr ([class "rev"]) (td "Commit:") (td (a ([href ,url]) ,(number->string num))))
+              (tr ([class "date"]) (td "Date:") (td ,(svn-date->nice-date date)))
+              (tr ([class "msg"]) (td "Log:") (td (pre ,msg)))
+              (tr ([class "changes"]) 
+                  (td 
+                   (a ([href ,(format "javascript:TocviewToggle(\"~a\",\"~a\");" cg-id ccss-id)])
+                      (span ([id ,cg-id]) 9658) "Changes:"))
+                  (td
+                   (div ([id ,ccss-id]
+                         [style "display: none;"])
+                        ,@(map (match-lambda
+                                 [(struct svn-change (action path))
+                                  `(p ([class "output"])
+                                      ,(symbol->string action) " " 
+                                      ,(if (regexp-match #rx"^/trunk/collects" path)
+                                           (local [(define path-w/o-trunk
+                                                     (apply build-path (list-tail (explode-path path) 2)))
+                                                   (define html-path
+                                                     (if (looks-like-directory? path)
+                                                         (format "~a/" path-w/o-trunk)
+                                                         path-w/o-trunk))
+                                                   (define path-url
+                                                     (path->string* html-path))
+                                                   (define path-tested?
+                                                     #t)]
+                                             (if path-tested?
+                                                 `(a ([href ,path-url]) ,path)
+                                                 path))
+                                           path))])
+                               changes)))))]
     [else
      'nbsp]))
 
@@ -184,11 +230,16 @@
         (define-values (title breadcrumb) (path->breadcrumb log-pth #f))
         (define the-base-path
           (base-path log-pth))
-        ; XXX git url
-        (define svn-url
-          (format "http://svn.plt-scheme.org/view/trunk/~a?view=markup&pathrev=~a"
-                  the-base-path
-                  (current-rev)))
+        (define scm-url
+          (if ((current-rev) . < . 20000)
+              (format "http://svn.plt-scheme.org/view/trunk/~a?view=markup&pathrev=~a"
+                      the-base-path
+                      (current-rev))
+              (local [(define msg (read-cache* (revision-commit-msg (current-rev))))]
+                (if msg
+                    (format "http://github.com/plt/racket/blob/~a~a"
+                            (git-push-end-commit msg) the-base-path)
+                    "#"))))
         (define prev-rev-url (format "/~a~a" (previous-rev) the-base-path))
         (define cur-rev-url (format "/~a~a" "current" the-base-path))
         (define output (map render-event output-log))
@@ -209,7 +260,7 @@
                             (tr (td "Duration:") (td ,(format-duration-ms dur)))
                             (tr (td "Timeout:") (td ,(if (timeout? log) checkmark-entity "")))
                             (tr (td "Exit Code:") (td ,(if (exit? log) (number->string (exit-code log)) "")))
-                            (tr (td nbsp) (td (a ([href ,svn-url]) "View File"))))
+                            (tr (td nbsp) (td (a ([href ,scm-url]) "View File"))))
                      ,(if (lc-zero? changed)
                           ""
                           `(div ([class "error"])
@@ -270,8 +321,8 @@
              (div ([class "dirlog, content"])
                   ,breadcrumb
                   ,(if show-commit-msg?
-                       (format-commit-msg)
-                       "")
+                        (format-commit-msg)
+                        "")
                   ,(local [(define (path->url pth)
                              (format "http://drdr.plt-scheme.org/~a~a" (current-rev) pth))
                            
diff --git a/collects/meta/drdr/scm.ss b/collects/meta/drdr/scm.ss
index 9932289f4b..ec47204cb3 100644
--- a/collects/meta/drdr/scm.ss
+++ b/collects/meta/drdr/scm.ss
@@ -135,14 +135,30 @@
           [to string?])]
  [get-scm-commit-msg (exact-nonnegative-integer? path-string? . -> . git-push?)])
 
+(define (git-push-end-commit gp)
+  (git-commit-hash (first (git-push-commits gp))))
+(provide/contract
+ [git-push-end-commit (git-push? . -> . string?)])
+
+(define scm-commit-author
+  (match-lambda
+    [(? git-push? gp) (git-push-author gp)]
+    [(? svn-rev-log? srl) (svn-rev-log-author srl)]))
+(provide/contract
+ [scm-commit-author ((or/c git-push? svn-rev-log?) . -> . string?)])
+
 (define (scm-export rev repo file dest)
   (define commit
     (push-data-end-commit (push-info rev)))
-  (define cmd
-    (format "~S archive --format=tar ~S ~S | tar -O -xf - ~S > ~S"
-            (git-path) commit file file dest))
-  (parameterize ([current-directory repo])
-    (system cmd))
+  (call-with-output-file*
+   dest
+   #:exists 'truncate/replace
+   (lambda (file-port)
+     (parameterize ([current-directory repo])
+       (system/output-port
+        #:k void
+        #:stdout file-port
+        (git-path) "--no-pager" "show" (format "~a:~a" commit file)))))
   (void))
 
 (define (scm-checkout rev repo dest)
@@ -168,6 +184,6 @@
 
 (provide/contract
  [scm-update (path? . -> . void?)]
- [scm-revisions-after (exact-nonnegative-integer? . -> . void?)]
+ [scm-revisions-after (exact-nonnegative-integer? . -> . (listof exact-nonnegative-integer?))]
  [scm-export (exact-nonnegative-integer? path-string? string? path-string? . -> . void?)]
  [scm-checkout (exact-nonnegative-integer? path-string? path-string? . -> . void?)])
\ No newline at end of file

From 3df194f523eab6550209e7008713572925d8e316 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 22 Apr 2010 13:18:21 -0600
Subject: [PATCH 15/16] Fixing future rev link

---
 collects/meta/drdr/render.ss | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/collects/meta/drdr/render.ss b/collects/meta/drdr/render.ss
index 6e521f7674..033a9f229a 100644
--- a/collects/meta/drdr/render.ss
+++ b/collects/meta/drdr/render.ss
@@ -206,10 +206,6 @@
         (br)
         "Current time: " ,(date->string (seconds->date (current-seconds)) #t)))
 
-(define (revision-svn-url rev)
-  (format "http://svn.plt-scheme.org/view?view=rev&revision=~a"
-          rev))
-
 (define (render-event e)
   (with-handlers ([exn:fail?
                    (lambda (x)
@@ -611,10 +607,13 @@
                             (define rev (string->number name))
                             (define log (read-cache (future-record-path rev)))
                             (define-values (committer title)
-                              (log->committer+title log))                            
+                              (log->committer+title log))
+                            (define url
+                              (format "http://github.com/plt/racket/commit/~a"
+                                      (git-push-end-commit log)))
                             `(tr ([class "dir"]
                                   [title ,title])
-                                 (td (a ([href ,(revision-svn-url name)]) ,name))
+                                 (td (a ([href ,url]) ,name))
                                  (td ([class "building"] [colspan "6"])
                                      "")
                                  (td ([class "author"]) ,committer))]

From 2436c638fa26172a0f1975864499a30d13a688f3 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 22 Apr 2010 13:53:44 -0600
Subject: [PATCH 16/16] Updating FAQ

---
 collects/web-server/scribblings/faq.scrbl | 47 ++++++++++++++++++++---
 1 file changed, 41 insertions(+), 6 deletions(-)

diff --git a/collects/web-server/scribblings/faq.scrbl b/collects/web-server/scribblings/faq.scrbl
index a0f44f9ed6..9e44038125 100644
--- a/collects/web-server/scribblings/faq.scrbl
+++ b/collects/web-server/scribblings/faq.scrbl
@@ -3,18 +3,53 @@
 
 @title[#:tag "faq"]{Troubleshooting and Tips}
 
-@section{Why are my servlets not updating on the server when I change the code on disk?}
+@section{Why are my templates not updating on the server when I change the file on disk?}
 
-@(require (for-label web-server/dispatchers/dispatch-servlets))
+Templates are compiled into your application, so when you change them there is no connection between that change in the filesystem and the compiled bytecode that is already loaded in a running Web server process. For more discussion, see @secref["update-servlets"].
 
-By default, the server uses @scheme[make-cached-url->servlet] to load servlets
+@section{Why are templates compiled into programs?}
+
+@(require (for-label web-server/templates))
+
+Since templates can include arbitrary Scheme code, macros, etc and refer to
+arbitrary identifiers, @scheme[include-template] is really just an obscured
+@scheme[require].
+
+@section[#:tag "update-servlets"]{Why are my stateful servlets not updating on the server when I change the file on disk?}
+
+@(require (for-label web-server/dispatchers/dispatch-servlets
+                     web-server/servlet-env))
+
+If you are using @scheme[serve/servlet], it starts a Web server that directly references a closure that has no connection
+to some file on the disk.
+
+If you are using the command-line tool, or configuration file, then by default,
+the server uses @scheme[make-cached-url->servlet] to load servlets
 from the disk. As it loads them, they are cached and the disk is not referred to for future
 requests. This ensures that there is a single namespace for each servlet, so that different instances
 can share resources, such as database connections, and communicate through the store. The default
 configuration of the server (meaning the dispatcher sequence used when you load a configuration file)
-provides a special URL to localhost that will reset the cache: @filepath{/conf/refresh-servlets}. If
-you want the server to reload your changed servlet code, then GET this URL and the server will reload the
-servlet on the next request.
+provides a special URL to localhost that will reset the cache: @filepath{/conf/refresh-servlets}.
+
+If you want the server to reload your changed servlet code, then GET this URL and the server will reload the
+servlet on the next request. However, you may be surprised by what happens on the next request. For more discussion, see @secref["refresh-servlets"].
+
+@section[#:tag "refresh-servlets"]{After refreshing my stateful servlet, old captured continuations don't change or old global effects are gone. Why?}
+
+Every load of your servlet is in a fresh namespace. When you refresh, a new namespace without the old effects is created. Old captured continuations
+refer to the original namespace and will never update. It is impossible, in general, to port a continuation from one namespace to another, because the
+code could be arbitrarily different.
+
+@section{How are stateless servlets different from stateful servlets vis a vis refreshing?}
+
+Continuations are serialized with a hash that ensures that any source
+code modifications makes all the old continuations incompatible for
+the same reason native continuations naturally are.
+
+However, this hash only protects against changes in a single source file. Therefore if you modularize
+your application, then only continuations that refer to changed source files will be incompatible.
+For example, if you put all your templates in a single module, then it can change without
+invalidating old continuations.
 
 @section{What special considerations are there for security with the Web Server?}