include ChezScheme sources in a source distribution

Note that the source-distribution client must have a "build/ChezScheme" checkout created, maybe by building as a 'cs variant. A pruned version of that checkout is then included with other sources. The resulting source distributon then works for building either Racket variant. Adapt the configure scripts and makefiles to use a "ChezScheme" directory that is bundled with sources.
2019-04-22 13:52:31 -06:00 · 2019-04-22 13:52:31 -06:00 · e001f3b3cb
commit e001f3b3cb
parent 21ad81b4fc
9 changed files with 141 additions and 31 deletions
--- a/8
+++ b/8
@ -263,7 +263,7 @@ RACKET_BUILT_FOR_CS = racket/src/build/racket/racket3m
 # Chez Scheme from `CHEZ_SCHEME_REPO`
 SCHEME_SRC = 
 DEFAULT_SCHEME_SRC = racket/src/build/ChezScheme
-MAKE_BUILD_SCHEME = y
+MAKE_BUILD_SCHEME = checkout

 CHEZ_SCHEME_REPO = https://github.com/racket/ChezScheme
 GIT_CLONE_ARGS_qq = -q --depth 1
@ -336,7 +336,7 @@ ABS_SCHEME_SRC = `$(RACKET) $(ABS_BOOT) racket/src/cs/absify.rkt $(SCHEME_SRC)`
 cs-after-racket-with-racket:
 	if [ "$(SCHEME_SRC)" = "" ] ; \
 	  then $(MAKE) cs-after-racket-with-racket-and-scheme-src RACKET="$(RACKET)" SCHEME_SRC="$(DEFAULT_SCHEME_SRC)" ; \
-	  else $(MAKE) cs-after-racket-with-racket-and-scheme-src RACKET="$(RACKET)" SCHEME_SRC="$(SCHEME_SRC)" MAKE_BUILD_SCHEME=n ; fi
+	  else $(MAKE) cs-after-racket-with-racket-and-scheme-src RACKET="$(RACKET)" SCHEME_SRC="$(SCHEME_SRC)" MAKE_BUILD_SCHEME=none ; fi

 cs-after-racket-with-racket-and-scheme-src:
 	$(RACKET) -O "info@compiler/cm" $(ABS_BOOT) racket/src/cs/absify.rkt just-to-compile-absify
@ -448,9 +448,9 @@ win32-just-cs:
 native-cs-for-cross:
 	if [ "$(SCHEME_SRC)" = "" ] ; \
         then $(MAKE) scheme-src-then-cross ; \
-         else $(MAKE) native-cs-for-cross-after-scheme-src MAKE_BUILD_SCHEME=n ; fi
+         else $(MAKE) native-cs-for-cross-after-scheme-src MAKE_BUILD_SCHEME=none ; fi

-CS_CROSS_SCHEME_CONFIG = SCHEME_SRC="`pwd`/racket/src/build/cross/ChezScheme" MAKE_BUILD_SCHEME=y
+CS_CROSS_SCHEME_CONFIG = SCHEME_SRC="`pwd`/racket/src/build/cross/ChezScheme" MAKE_BUILD_SCHEME=checkout

 scheme-src-then-cross:
 	$(MAKE) scheme-src BUILD_FOR_FOR_SCHEME_DIR="racket/src/build/cross/"
--- a/racket/collects/setup/unixstyle-install.rkt
+++ b/racket/collects/setup/unixstyle-install.rkt
@ -29,7 +29,8 @@

 #lang racket/base
 (require setup/cross-system
-         racket/file)
+         racket/file
+         racket/list)

 (module test racket/base)

@ -90,6 +91,7 @@
      [(man)      #f]
      [(applications) #f]
      [(src)      1]
+      [(ChezScheme) 1]
      [(README)   #f] ; moved last
      [else (error 'level-of "internal-error -- unknown dir: ~e" dir)])))

@ -149,7 +151,7 @@

 ;; copy a file or a directory (recursively), preserving time stamps
 ;; (racket's copy-file preservs permission bits)
-(define (cp src dst)
+(define (cp src dst #:build-path? [build-path? #f])
  (define skip-filter (current-skip-filter))
  (let loop ([src src] [dst dst])
    (let ([time! (lambda ()
@ -160,8 +162,12 @@
             (make-file-or-directory-link (resolve-path src) dst)]
            [(directory-exists? src)
             (make-directory dst)
-             (parameterize ([current-directory src])
-               (for-each (lambda (p) (loop p (make-path dst p))) (ls)))]
+             (if build-path?
+                 (for-each (lambda (p) (loop (make-path src p) (make-path dst p)))
+                           (parameterize ([current-directory src])
+                             (ls)))
+                 (parameterize ([current-directory src])
+                   (for-each (lambda (p) (loop p (make-path dst p))) (ls))))]
            [(file-exists? src) (copy-file src dst) (time!)]
            [else (error 'cp "internal error: ~e" src)]))))

@ -198,6 +204,10 @@
  (cp src dst)
  (register-change! 'cp src dst))

+(define (cp*/build src dst)
+  (cp src dst #:build-path? #t)
+  (register-change! 'cp src dst))
+
 (define (fix-executable file)
  (define (fix-binary file)
    (define (fix-one tag dir)
@ -414,7 +424,9 @@
                 [(n) (error "Abort!")]
                 [else (loop)]))))))

-(define ((move/copy-tree move?) src dst* #:missing [missing 'error])
+(define ((move/copy-tree move?) src dst*
+                                #:missing [missing 'error]
+                                #:build-path? [build-path? #f])
  (define skip-filter (current-skip-filter))
  (define dst (if (symbol? dst*) (dir: dst*) dst*))
  (define src-exists?
@ -426,7 +438,7 @@
     (let loop ([src (path->string (simplify-path src #f))]
                [dst (path->string (simplify-path dst #f))]
                [lvl (level-of src)]) ; see above
-       (let ([doit (let ([doit (if move? mv* cp*)]) (lambda () (doit src dst)))]
+       (let ([doit (let ([doit (if move? mv* (if build-path? cp*/build cp*))]) (lambda () (doit src dst)))]
             [src-d? (directory-exists? src)]
             [dst-l? (link-exists? dst)]
             [dst-d? (directory-exists? dst)]
@ -504,10 +516,12 @@
    (current-directory (dirname rktdir))
    (delete-directory rktdir)))

+(define dot-file?
+  ;; skip all dot-names, except ".LOCK..."
+  (lambda (p) (regexp-match? #rx"^[.](?!LOCK)" (basename p))))
+
 (define (skip-dot-files!)
-  (current-skip-filter
-   ;; skip all dot-names, except ".LOCK..."
-   (lambda (p) (regexp-match? #rx"^[.](?!LOCK)" (basename p)))))
+  (current-skip-filter dot-file?))

 (define (make-install-copytree)
  (define copytree (move/copy-tree #f))
@ -556,6 +570,11 @@
    (current-skip-filter ; skip src/build
     (lambda (p) (regexp-match? #rx"^build$" p)))
    (do-tree "src" (build-path base-destdir "src"))
+    ;; Copy Chez Scheme source, if present
+    (let ([src-cs "src/build/ChezScheme"])
+      (when (directory-exists? src-cs)
+        (current-skip-filter (make-chez-source-skip src-cs))
+        (do-tree src-cs (build-path base-destdir "src/ChezScheme") #:build-path? #t)))
    ;; Remove directories that get re-created:
    (define (remove! dst*) (rm (dir: dst*)))
    (remove! 'bin)
@ -570,6 +589,66 @@

 ;; --------------------------------------------------------------------------

+(define (make-chez-source-skip src-cs)
+  (define orig-skip? (current-skip-filter))
+  (define git-skip? (read-git-ignore-paths src-cs))
+  ;; Keep only the part of LZ4 that we need, since it has a more liberal license
+  (define src-cs-ex (explode-path src-cs))
+  (define (lz4-skip? p)
+    (define-values (base name dir?) (split-path p))
+    (and (not (equal? (path->string name) "lib"))
+         (path? base)
+         (let-values ([(base name dir?) (split-path base)])
+           (and (equal? (explode-path base) src-cs-ex)
+                (equal? (path->string name) "lz4")))))
+  (lambda (p)
+    (or (dot-file? p)
+        (orig-skip? p)
+        (git-skip? p)
+        (lz4-skip? p))))
+
+(define (read-git-ignore-paths subdir)
+  (define subdir-len (length (explode-path subdir)))
+  (define pred-on-exploded
+    (call-with-input-file*
+     (build-path subdir ".gitignore")
+     (lambda (i)
+       (let loop ([pred (lambda (elems) #f)])
+         (define l (read-line i 'any))
+         (cond
+           [(eof-object? l) pred]
+           [(or (string=? l "")
+                (eqv? #\# (string-ref l 0)))
+            (loop pred)]
+           [(eqv? #\/ (string-ref l 0))
+            (define match-elems? (map elem->matcher (explode-path (substring l 1))))
+            (loop (lambda (elems)
+                    (or (pred elems)
+                        (and (equal? (length elems) (+ subdir-len (length match-elems?)))
+                             (andmap (lambda (m? e) (m? e)) match-elems? (list-tail elems subdir-len))))))]
+           [else
+            (define match-elems? (map elem->matcher (explode-path (substring l 1))))
+            (loop (lambda (elems)
+                    (or (pred elems)
+                        (and ((length elems) . >= . (+ subdir-len (length match-elems?)))
+                             (andmap (lambda (m? e) (m? e)) match-elems? (take-right elems (length match-elems?)))))))])))))
+  (lambda (p)
+    (pred-on-exploded (explode-path p))))
+
+(define (elem->matcher elem)
+  (define s (path->string elem))
+  (cond
+    [(regexp-match? #rx"[*?.]" s)
+     (let* ([rx (regexp-replace* #rx"[.]" s "[.]")]
+            [rx (regexp-replace* #rx"[?]" s ".")]
+            [rx (regexp-replace* #rx"[*]" rx ".*")]
+            [rx (regexp rx)])
+       (lambda (p) (regexp-match? rx (path->string p))))]
+    [else
+     (lambda (p) (equal? (path->string p) s))]))
+
+;; --------------------------------------------------------------------------
+
 (module+ main
  (case op
    [(move) (move/copy-distribution #t #f)]
--- a/racket/src/README.txt
+++ b/racket/src/README.txt
@ -58,12 +58,16 @@ To build Racket-on-Chez on Unix variants or Mac OS:
   The generated Racket-on-Chez executables will *not* have a "cs"
   suffix.

-Chez Scheme is not included with Racket sources, but building
-Racket-on-Chez requires either a "ChezScheme" build checkout within
-the build directory or at at an alternate location specified by the
-`--enable-scheme=...` argument to `configure`.
+Chez Scheme is included in a Racket source distribution, but not in
+the main Racket source repository. Building Racket-on-Chez requires
+either a "ChezScheme" build checkout within the build directory or at
+at an alternate location specified by the `--enable-scheme=...`
+argument to `configure`. If "--enable-scheme=...` is not specified,
+then a "ChezScheme" directory is copied if it exists to the build
+subdirectory, otherwise if must be checked out before configuring into
+the build directory.

-For now, use the patched version of Chez Scheme at
+Use the patched version of Chez Scheme at

    https://github.com/racket/ChezScheme

--- a/racket/src/configure
+++ b/racket/src/configure
@ -50,9 +50,11 @@ done
 if test "$use_cs" = "yes" ; then
  if test "$supplied_scheme" = "no" ; then
    if ! test -d ChezScheme ; then
-      echo $0: supply --enable-scheme=... or check out a Chez Scheme
-      echo build directory as '"ChezScheme"' in the current directory
-      exit 1
+      if ! test -d "$dir/ChezScheme" ; then
+        echo $0: supply --enable-scheme=... or check out a Chez Scheme
+        echo build directory as '"ChezScheme"' in the current directory
+        exit 1
+      fi
    fi
  fi

--- a/racket/src/cs/c/Makefile.in
+++ b/racket/src/cs/c/Makefile.in
@ -128,15 +128,24 @@ bounce:
 	cd $(srcdir)/../../schemify && $(MAKE) known-src-generate RACKET="$(BOOTSTRAP_RACKET)" BUILDDIR="$(builddir)/"

 scheme:
-	if [ "$(MAKE_BUILD_SCHEME)" = "y" ] ; \
-         then $(MAKE) scheme-make ; fi
+	$(MAKE) scheme-make-$(MAKE_BUILD_SCHEME)
+
+scheme-make-none:
+	echo Using Chez Scheme build as-is
+
+scheme-make-checkout:
+	cd $(SCHEME_SRC) && git submodule -q init && git submodule -q update
+	$(MAKE) scheme-make-finish
+
+scheme-make-copy:
+	if [ ! -d "$(SCHEME_SRC)" ] ; then cp -r $(srcdir)/../../ChezScheme "$(SCHEME_SRC)" ; fi
+	$(MAKE) scheme-make-finish

 SCHEME_CONFIG_VARS = CC="$(CC)" CFLAGS="$(BASE_CFLAGS)" LD="$(LD)" LDFLAGS="$(LDFLAGS)" \
                     AR="$(AR)" ARFLAGS="$(ARFLAGS)" RANLIB="$(RANLIB)" \
                     WINDRES="$(WINDRES)"

-scheme-make:
-	cd $(SCHEME_SRC) && git submodule -q init && git submodule -q update
+scheme-make-finish:
 	env SCHEME_SRC="$(SCHEME_SRC)" MACH="$(MACH)" $(BOOTSTRAP_RACKET) $(srcdir)/../bootstrap/make-boot.rkt
 	cd $(SCHEME_SRC) && ./configure @SCHEME_CONFIG_ARGS@ $(SCHEME_CONFIG_VARS)
 	mkdir -p $(SCHEME_SRC)/$(MACH)/boot/$(MACH)
--- a/racket/src/cs/c/configure
+++ b/racket/src/cs/c/configure
@ -4121,11 +4121,16 @@ fi
 # is different in cross-build mode).

 SCHEME_SRC=../../ChezScheme
-MAKE_BUILD_SCHEME=y
+MAKE_BUILD_SCHEME=checkout

 if test "${enable_scheme}" != "" ; then
  SCHEME_SRC="${enable_scheme}"
-  MAKE_BUILD_SCHEME=n
+  MAKE_BUILD_SCHEME=none
+else
+  # Check for a directory packaged with a source distribution
+  if test -d "${srcdir}/../../ChezScheme" ; then
+    MAKE_BUILD_SCHEME=copy
+  fi
 fi

 if test "${enable_racket}" != "" ; then
--- a/racket/src/cs/c/configure.ac
+++ b/racket/src/cs/c/configure.ac
@ -373,11 +373,16 @@ fi
 # is different in cross-build mode).

 SCHEME_SRC=../../ChezScheme
-MAKE_BUILD_SCHEME=y
+MAKE_BUILD_SCHEME=checkout

 if test "${enable_scheme}" != "" ; then
  SCHEME_SRC="${enable_scheme}"
-  MAKE_BUILD_SCHEME=n
+  MAKE_BUILD_SCHEME=none
+else
+  # Check for a directory packaged with a source distribution
+  if test -d "${srcdir}/../../ChezScheme" ; then
+    MAKE_BUILD_SCHEME=copy
+  fi
 fi

 if test "${enable_racket}" != "" ; then
--- a/racket/src/worksp/README.txt
+++ b/racket/src/worksp/README.txt
@ -57,8 +57,10 @@ The result is "..\..\Racket.exe", DLLs and "GRacket.exe" in
 "..\..\lib", and other files in "..\..\lib", "..\..\etc", etc.

 Many intermediate files will be put in "../build", including a Chez
-Scheme checkout if it's not already present (in which case `git` must
-be available).
+Scheme checkout if it's not already present there; if a "ChezScheme"
+directory exists in the Racket suorce directory, it is copied to the
+build directory, otherwise it is cloned from a Git repository (in
+which case `git` must be available).

 See also "Completing the Build" below.

--- a/racket/src/worksp/csbuild.rkt
+++ b/racket/src/worksp/csbuild.rkt
@ -77,7 +77,11 @@
                           "clone")
                     git-clone-args
                     (list from to))))
+  (define bundled-src-dir (build-path here 'up "ChezScheme"))
  (cond
+    [(directory-exists? bundled-src-dir)
+     (unless (directory-exists? scheme-dir)
+       (copy-directory/files bundled-src-dir scheme-dir))]
    [extra-repos-base
     ;; Intentionally not using `git-clone-args`, because dumb transport
     ;; (likely for `extra-repos-base`) does not support shallow copies