some minor reformatting and improvements
svn: r9075
This commit is contained in:
Eli Barzilay
parent
473136e8b1
commit
f94acb09d5
|
|
@ -14,7 +14,7 @@
|
|||
;; See manual for information about the Scheme-level interface
|
||||
;; provided by this collection.
|
||||
|
||||
(module main scheme/base
|
||||
#lang scheme/base
|
||||
|
||||
;; On error, exit with 1 status code
|
||||
(error-escape-handler (lambda () (exit 1)))
|
||||
|
|
@ -26,7 +26,6 @@
|
|||
|
||||
;; Read argv array for arguments and input file name
|
||||
(require mzlib/cmdline
|
||||
mzlib/list
|
||||
dynext/file
|
||||
dynext/compile
|
||||
dynext/link
|
||||
|
|
@ -69,14 +68,12 @@
|
|||
|
||||
(define (extract-suffix appender)
|
||||
(bytes->string/latin-1
|
||||
(subbytes
|
||||
(path->bytes (appender (bytes->path #"x")))
|
||||
1)))
|
||||
|
||||
(subbytes (path->bytes (appender (bytes->path #"x"))) 1)))
|
||||
|
||||
;; Returns (values mode files prefixes)
|
||||
;; where mode is 'compile, 'make-zo, etc.
|
||||
(define (parse-options argv)
|
||||
(define ((add-to-param param) f v) (param (append (param) (list v))))
|
||||
(parse-command-line
|
||||
"mzc"
|
||||
argv
|
||||
|
|
@ -174,12 +171,10 @@
|
|||
(dest-dir d))
|
||||
("Output -e/-c/-z/-x file(s) to <dir>" "dir")]
|
||||
[("--auto-dir")
|
||||
,(lambda (f)
|
||||
(auto-dest-dir #t))
|
||||
,(lambda (f) (auto-dest-dir #t))
|
||||
(,(format "Output -z to \"compiled\", -e to ~s"
|
||||
(path->string
|
||||
(build-path "compiled" "native" (system-library-subpath #f)))))]]
|
||||
|
||||
(path->string (build-path "compiled" "native"
|
||||
(system-library-subpath #f)))))]]
|
||||
[help-labels
|
||||
"------------------- compiler/linker configuration flags ---------------------"]
|
||||
[once-each
|
||||
|
|
@ -190,8 +185,7 @@
|
|||
(use-standard-linker v)))
|
||||
(,(format "Use pre-defined <tool> as C compiler/linker:~a"
|
||||
(apply string-append
|
||||
(apply append
|
||||
(map (lambda (t)
|
||||
(apply append (map (lambda (t)
|
||||
(list " " (symbol->string t)))
|
||||
(get-standard-compilers)))))
|
||||
"tool")]
|
||||
|
|
@ -200,12 +194,11 @@
|
|||
("Use <compiler-path> as C compiler" "compiler-path")]]
|
||||
[multi
|
||||
[("++ccf")
|
||||
,(lambda (f v) (current-extension-compiler-flags
|
||||
(append (current-extension-compiler-flags)
|
||||
(list v))))
|
||||
,(add-to-param current-extension-compiler-flags)
|
||||
("Add C compiler flag" "flag")]
|
||||
[("--ccf")
|
||||
,(lambda (f v) (current-extension-compiler-flags
|
||||
,(lambda (f v)
|
||||
(current-extension-compiler-flags
|
||||
(remove v (current-extension-compiler-flags))))
|
||||
("Remove C compiler flag" "flag")]
|
||||
[("--ccf-clear")
|
||||
|
|
@ -213,8 +206,8 @@
|
|||
("Clear C compiler flags")]
|
||||
[("--ccf-show")
|
||||
,(lambda (f)
|
||||
(printf "C compiler flags: ~s~n" (expand-for-link-variant
|
||||
(current-extension-compiler-flags))))
|
||||
(printf "C compiler flags: ~s\n"
|
||||
(expand-for-link-variant (current-extension-compiler-flags))))
|
||||
("Show C compiler flags")]]
|
||||
[once-each
|
||||
[("--linker")
|
||||
|
|
@ -222,12 +215,11 @@
|
|||
("Use <linker-path> as C linker" "linker-path")]]
|
||||
[multi
|
||||
[("++ldf")
|
||||
,(lambda (f v) (current-extension-linker-flags
|
||||
(append (current-extension-linker-flags)
|
||||
(list v))))
|
||||
,(add-to-param current-extension-linker-flags)
|
||||
("Add C linker flag" "flag")]
|
||||
[("--ldf")
|
||||
,(lambda (f v) (current-extension-linker-flags
|
||||
,(lambda (f v)
|
||||
(current-extension-linker-flags
|
||||
(remove v (current-extension-linker-flags))))
|
||||
("Remove C linker flag" "flag")]
|
||||
[("--ldf-clear")
|
||||
|
|
@ -235,27 +227,24 @@
|
|||
("Clear C linker flags")]
|
||||
[("--ldf-show")
|
||||
,(lambda (f)
|
||||
(printf "C linker flags: ~s~n" (expand-for-link-variant
|
||||
(current-extension-linker-flags))))
|
||||
(printf "C linker flags: ~s\n"
|
||||
(expand-for-link-variant (current-extension-linker-flags))))
|
||||
("Show C linker flags")]
|
||||
[("++ldl")
|
||||
,(lambda (f v) (current-standard-link-libraries
|
||||
(append (current-standard-link-libraries)
|
||||
(list v))))
|
||||
,(add-to-param current-standard-link-libraries)
|
||||
("Add C linker library" "lib")]
|
||||
[("--ldl-show")
|
||||
,(lambda (f)
|
||||
(printf "C linker libraries: ~s~n" (expand-for-link-variant
|
||||
(current-standard-link-libraries))))
|
||||
(printf "C linker libraries: ~s\n"
|
||||
(expand-for-link-variant (current-standard-link-libraries))))
|
||||
("Show C linker libraries")]]
|
||||
[multi
|
||||
[("++cppf")
|
||||
,(lambda (f v) (current-extension-preprocess-flags
|
||||
(append (current-extension-preprocess-flags)
|
||||
(list v))))
|
||||
,(add-to-param current-extension-preprocess-flags)
|
||||
("Add C preprocess (xform) flag" "flag")]
|
||||
[("--cppf")
|
||||
,(lambda (f v) (current-extension-preprocess-flags
|
||||
,(lambda (f v)
|
||||
(current-extension-preprocess-flags
|
||||
(remove v (current-extension-preprocess-flags))))
|
||||
("Remove C preprocess (xform) flag" "flag")]
|
||||
[("--cppf-clear")
|
||||
|
|
@ -263,8 +252,8 @@
|
|||
("Clear C preprocess (xform) flags")]
|
||||
[("--cppf-show")
|
||||
,(lambda (f)
|
||||
(printf "C compiler flags: ~s~n" (expand-for-link-variant
|
||||
(current-extension-preprocess-flags))))
|
||||
(printf "C compiler flags: ~s\n"
|
||||
(expand-for-link-variant (current-extension-preprocess-flags))))
|
||||
("Show C preprocess (xform) flags")]]
|
||||
[help-labels
|
||||
"--------------------- executable configuration flags ------------------------"]
|
||||
|
|
@ -274,50 +263,37 @@
|
|||
(exe-embedded-collects-path i))
|
||||
("Set <path> main collects in --[gui-]exe/--exe-dir" "path")]
|
||||
[("--collects-dest")
|
||||
,(lambda (f i)
|
||||
(exe-embedded-collects-dest i))
|
||||
,(lambda (f i) (exe-embedded-collects-dest i))
|
||||
("Add --[gui-]exe collection code to <dir>" "dir")]
|
||||
[("--ico")
|
||||
,(lambda (f i) (exe-aux
|
||||
(cons (cons 'ico i)
|
||||
(exe-aux))))
|
||||
,(lambda (f i) (exe-aux (cons (cons 'ico i) (exe-aux))))
|
||||
("Windows icon for --[gui-]exe executable" ".ico-file")]
|
||||
[("--icns")
|
||||
,(lambda (f i) (exe-aux
|
||||
(cons (cons 'icns i)
|
||||
(exe-aux))))
|
||||
,(lambda (f i) (exe-aux (cons (cons 'icns i) (exe-aux))))
|
||||
("Mac OS X icon for --[gui-]exe executable" ".icns-file")]
|
||||
[("--orig-exe")
|
||||
,(lambda (f) (exe-aux
|
||||
(cons (cons 'original-exe? #t)
|
||||
(exe-aux))))
|
||||
,(lambda (f) (exe-aux (cons (cons 'original-exe? #t) (exe-aux))))
|
||||
("Use original executable for --[gui-]exe instead of stub")]]
|
||||
[multi
|
||||
[("++lib")
|
||||
,(lambda (f l) (exe-embedded-libraries
|
||||
(append (exe-embedded-libraries)
|
||||
(list l))))
|
||||
,(lambda (f l)
|
||||
(exe-embedded-libraries (append (exe-embedded-libraries) (list l))))
|
||||
("Embed <lib> in --[gui-]exe executable" "lib")]
|
||||
[("++collects-copy")
|
||||
,(lambda (f d) (exe-dir-add-collects-dirs
|
||||
(append (exe-dir-add-collects-dirs)
|
||||
(list d))))
|
||||
,(lambda (f d)
|
||||
(exe-dir-add-collects-dirs (append (exe-dir-add-collects-dirs) (list d))))
|
||||
("Add collects in <dir> to --exe-dir" "dir")]
|
||||
[("++exf")
|
||||
,(lambda (f v) (exe-embedded-flags
|
||||
(append (exe-embedded-flags)
|
||||
(list v))))
|
||||
,(add-to-param exe-embedded-flags)
|
||||
("Add flag to embed in --[gui-]exe executable" "flag")]
|
||||
[("--exf")
|
||||
,(lambda (f v) (exe-embedded-flags
|
||||
(remove v (exe-embedded-flags))))
|
||||
,(lambda (f v) (exe-embedded-flags (remove v (exe-embedded-flags))))
|
||||
("Remove flag to embed in --[gui-]exe executable" "flag")]
|
||||
[("--exf-clear")
|
||||
,(lambda (f) (exe-embedded-flags null))
|
||||
("Clear flags to embed in --[gui-]exe executable")]
|
||||
[("--exf-show")
|
||||
,(lambda (f)
|
||||
(printf "Flags to embed: ~s~n" (exe-embedded-flags)))
|
||||
,(lambda (f) (printf "Flags to embed: ~s\n" (exe-embedded-flags)))
|
||||
("Show flag to embed in --[gui-]exe executable")]]
|
||||
[help-labels
|
||||
"----------------------------- .plt archive flags ----------------------------"]
|
||||
|
|
@ -336,9 +312,7 @@
|
|||
,(lambda (f) (plt-files-plt-home-relative? #t))
|
||||
("Files/dirs in archive go to PLT installation if writable")]
|
||||
[("--force-all-users")
|
||||
,(lambda (f)
|
||||
(plt-files-plt-home-relative? #t)
|
||||
(plt-force-install-dir? #t))
|
||||
,(lambda (f) (plt-files-plt-home-relative? #t) (plt-force-install-dir? #t))
|
||||
("Files/dirs forced to PLT installation")]]
|
||||
[once-each
|
||||
[("--include-compiled")
|
||||
|
|
@ -346,21 +320,19 @@
|
|||
("Include \"compiled\" subdirectories in the archive")]]
|
||||
[multi
|
||||
[("++setup")
|
||||
,(lambda (f c) (plt-setup-collections
|
||||
(append (plt-setup-collections)
|
||||
(list c))))
|
||||
,(lambda (f c)
|
||||
(plt-setup-collections (append (plt-setup-collections) (list c))))
|
||||
("Setup <collect> after the archive is unpacked" "collect")]]
|
||||
[help-labels
|
||||
"----------------------- compiler optimization flags -------------------------"]
|
||||
|
||||
[once-each
|
||||
[("--no-prop")
|
||||
,(lambda (f) (compiler:option:propagate-constants #f))
|
||||
("Don't propagate constants")]
|
||||
[("--inline")
|
||||
,(lambda (f d) (compiler:option:max-inline-size
|
||||
(with-handlers ([void
|
||||
(lambda (x)
|
||||
,(lambda (f d)
|
||||
(compiler:option:max-inline-size
|
||||
(with-handlers ([void (lambda (x)
|
||||
(error 'mzc "bad size for --inline: ~a" d))])
|
||||
(let ([v (string->number d)])
|
||||
(unless (and (not (negative? v)) (exact? v) (real? v))
|
||||
|
|
@ -396,16 +368,13 @@
|
|||
("Write debugging output to dump.txt")]])
|
||||
(lambda (accum . files)
|
||||
(let ([mode (let ([l (filter symbol? accum)])
|
||||
(if (null? l)
|
||||
'make-zo
|
||||
(car l)))])
|
||||
(if (null? l) 'make-zo (car l)))])
|
||||
(values
|
||||
mode
|
||||
files
|
||||
(let ([prefixes (filter string? accum)])
|
||||
(unless (memq mode '(compile compile-c zo))
|
||||
(unless (null? prefixes)
|
||||
(error 'mzc "prefix files are not useful in ~a mode" mode)))
|
||||
(unless (or (memq mode '(compile compile-c zo)) (null? prefixes))
|
||||
(error 'mzc "prefix files are not useful in ~a mode" mode))
|
||||
(if (module-mode)
|
||||
(begin
|
||||
(when (compiler:option:assume-primitives)
|
||||
|
|
@ -423,50 +392,45 @@
|
|||
(void)))))))
|
||||
(list "file/directory/collection")))
|
||||
|
||||
(printf "mzc v~a [~a], Copyright (c) 2004-2008 PLT Scheme Inc.~n"
|
||||
(printf "mzc v~a [~a], Copyright (c) 2004-2008 PLT Scheme Inc.\n"
|
||||
(version)
|
||||
(system-type 'gc))
|
||||
|
||||
(define-values (mode source-files prefix)
|
||||
(parse-options (current-command-line-arguments)))
|
||||
|
||||
(when (auto-dest-dir)
|
||||
(unless (memq mode '(zo compile))
|
||||
(error 'mzc "--auto-dir works only with -z, --zo, -e, or --extension (or default mode)")))
|
||||
(when (and (auto-dest-dir) (not (memq mode '(zo compile))))
|
||||
(error 'mzc "--auto-dir works only with -z, --zo, -e, or --extension (or default mode)"))
|
||||
|
||||
(define (never-embedded action)
|
||||
(when (compiler:option:compile-for-embedded)
|
||||
(error 'mzc "cannot ~a an extension for an embedded MzScheme" action)))
|
||||
|
||||
(if (compiler:option:3m)
|
||||
(begin
|
||||
(link-variant '3m)
|
||||
(compile-variant '3m))
|
||||
(begin
|
||||
(link-variant 'cgc)
|
||||
(compile-variant 'cgc)))
|
||||
(begin (link-variant '3m) (compile-variant '3m))
|
||||
(begin (link-variant 'cgc) (compile-variant 'cgc)))
|
||||
|
||||
(define (compiler-warning)
|
||||
(fprintf (current-error-port)
|
||||
(string-append
|
||||
"Warning: compilation to C is usually less effective for performance\n"
|
||||
" than relying on the bytecode just-in-time compiler.\n")))
|
||||
"Warning: ~a\n ~a\n"
|
||||
"compilation to C is usually less effective for performance"
|
||||
"than relying on the bytecode just-in-time compiler."))
|
||||
|
||||
(case mode
|
||||
[(compile)
|
||||
(compiler-warning)
|
||||
(never-embedded "compile")
|
||||
((compile-extensions prefix) source-files (if (auto-dest-dir)
|
||||
'auto
|
||||
(dest-dir)))]
|
||||
((compile-extensions prefix)
|
||||
source-files
|
||||
(if (auto-dest-dir) 'auto (dest-dir)))]
|
||||
[(compile-c)
|
||||
((compile-extensions-to-c prefix) source-files (dest-dir))]
|
||||
[(zo)
|
||||
((compile-zos prefix) source-files (if (auto-dest-dir)
|
||||
'auto
|
||||
(dest-dir)))]
|
||||
((compile-zos prefix)
|
||||
source-files
|
||||
(if (auto-dest-dir) 'auto (dest-dir)))]
|
||||
[(expand)
|
||||
(for-each (lambda (src-file)
|
||||
(for ([src-file source-files])
|
||||
(let ([src-file (path->complete-path src-file)])
|
||||
(let-values ([(base name dir?) (split-path src-file)])
|
||||
(parameterize ([current-load-relative-directory base]
|
||||
|
|
@ -480,67 +444,57 @@
|
|||
(let ([e (read-syntax src-file in)])
|
||||
(unless (eof-object? e)
|
||||
(pretty-print (syntax->datum (expand e)))
|
||||
(loop))))))))))
|
||||
source-files)]
|
||||
(loop))))))))))]
|
||||
[(make-zo)
|
||||
(let ([n (make-base-empty-namespace)]
|
||||
[mc (dynamic-require 'mzlib/cm
|
||||
'managed-compile-zo)]
|
||||
[cnh (dynamic-require 'mzlib/cm
|
||||
'manager-compile-notify-handler)]
|
||||
[mc (dynamic-require 'mzlib/cm 'managed-compile-zo)]
|
||||
[cnh (dynamic-require 'mzlib/cm 'manager-compile-notify-handler)]
|
||||
[did-one? #f])
|
||||
(parameterize ([current-namespace n]
|
||||
[cnh (lambda (p)
|
||||
(set! did-one? #t)
|
||||
(printf " making ~s~n" (path->string p)))])
|
||||
(for-each (lambda (file)
|
||||
(printf " making ~s\n" (path->string p)))])
|
||||
(for ([file source-files])
|
||||
(unless (file-exists? file)
|
||||
(error 'mzc "file does not exist: ~a" file))
|
||||
(set! did-one? #f)
|
||||
(let ([name (extract-base-filename/ss file 'mzc)])
|
||||
(printf "\"~a\":~n" file)
|
||||
(printf "\"~a\":\n" file)
|
||||
(mc file)
|
||||
(let ([dest (append-zo-suffix
|
||||
(let-values ([(base name dir?) (split-path name)])
|
||||
(build-path (if (symbol? base) 'same base)
|
||||
"compiled" name)))])
|
||||
(printf " [~a \"~a\"]~n"
|
||||
(if did-one?
|
||||
"output to"
|
||||
"already up-to-date at")
|
||||
dest))))
|
||||
source-files)))]
|
||||
(printf " [~a \"~a\"]\n"
|
||||
(if did-one? "output to" "already up-to-date at")
|
||||
dest))))))]
|
||||
[(collection-zos)
|
||||
(apply compile-collection-zos source-files)]
|
||||
[(cc)
|
||||
(for-each
|
||||
(lambda (file)
|
||||
(for ([file source-files])
|
||||
(let* ([base (extract-base-filename/c file 'mzc)]
|
||||
[dest (append-object-suffix
|
||||
(let-values ([(base name dir?) (split-path base)])
|
||||
(build-path (or (dest-dir) 'same) name)))])
|
||||
(printf "\"~a\":~n" file)
|
||||
(compile-extension (not (compiler:option:verbose))
|
||||
file
|
||||
dest
|
||||
null)
|
||||
(printf " [output to \"~a\"]~n" dest)))
|
||||
source-files)]
|
||||
(printf "\"~a\":\n" file)
|
||||
(compile-extension (not (compiler:option:verbose)) file dest null)
|
||||
(printf " [output to \"~a\"]\n" dest)))]
|
||||
[(ld)
|
||||
(extract-base-filename/ext (ld-output) 'mzc)
|
||||
;; (for-each (lambda (file) (extract-base-filename/o file 'mzc)) source-files)
|
||||
;; (for ([file source-files]) (extract-base-filename/o file 'mzc))
|
||||
(let ([dest (if (dest-dir)
|
||||
(build-path (dest-dir) (ld-output))
|
||||
(ld-output))])
|
||||
(printf "~a:~n" (let ([s (apply string-append
|
||||
(map (lambda (n) (format " \"~a\"" n)) source-files))])
|
||||
(printf "~a:\n" (let ([s (apply string-append
|
||||
(map (lambda (n) (format " \"~a\"" n))
|
||||
source-files))])
|
||||
(substring s 1 (string-length s))))
|
||||
(link-extension (not (compiler:option:verbose))
|
||||
source-files
|
||||
dest)
|
||||
(printf " [output to \"~a\"]~n" dest))]
|
||||
(printf " [output to \"~a\"]\n" dest))]
|
||||
[(xform)
|
||||
(for-each (lambda (file)
|
||||
(for ([file source-files])
|
||||
(let* ([out-file (path-replace-suffix file ".3m.c")]
|
||||
[out-file (if (dest-dir)
|
||||
(build-path (dest-dir) out-file)
|
||||
|
|
@ -550,8 +504,7 @@
|
|||
file
|
||||
out-file
|
||||
(list (find-include-dir)))
|
||||
(printf " [output to \"~a\"]~n" out-file)))
|
||||
source-files)]
|
||||
(printf " [output to \"~a\"]\n" out-file)))]
|
||||
[(exe gui-exe)
|
||||
(unless (= 1 (length source-files))
|
||||
(error 'mzc "expected a single module source file to embed; given: ~e"
|
||||
|
|
@ -566,42 +519,33 @@
|
|||
#:mred? (eq? mode 'gui-exe)
|
||||
#:variant (if (compiler:option:3m) '3m 'cgc)
|
||||
#:verbose? (compiler:option:verbose)
|
||||
#:modules (cons
|
||||
`(#%mzc: (file ,(car source-files)))
|
||||
(map (lambda (l)
|
||||
`(#t (lib ,l)))
|
||||
#:modules (cons `(#%mzc: (file ,(car source-files)))
|
||||
(map (lambda (l) `(#t (lib ,l)))
|
||||
(exe-embedded-libraries)))
|
||||
#:literal-expression (parameterize ([current-namespace (make-base-namespace)])
|
||||
#:literal-expression
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(compile
|
||||
`(namespace-require
|
||||
'',(string->symbol
|
||||
(format
|
||||
"#%mzc:~a"
|
||||
(let-values ([(base name dir?) (split-path (car source-files))])
|
||||
(format "#%mzc:~a"
|
||||
(let-values ([(base name dir?)
|
||||
(split-path (car source-files))])
|
||||
(path->bytes (path-replace-suffix name #""))))))))
|
||||
#:cmdline (exe-embedded-flags)
|
||||
#:collects-path (exe-embedded-collects-path)
|
||||
#:collects-dest (exe-embedded-collects-dest)
|
||||
#:aux (exe-aux))
|
||||
(printf " [output to \"~a\"]~n" dest))]
|
||||
(printf " [output to \"~a\"]\n" dest))]
|
||||
[(c-mods)
|
||||
(let ([dest (mods-output)])
|
||||
(let-values ([(in out) (make-pipe)])
|
||||
(parameterize ([current-output-port out])
|
||||
((dynamic-require '(lib "embed.ss" "compiler")
|
||||
'write-module-bundle)
|
||||
((dynamic-require '(lib "embed.ss" "compiler") 'write-module-bundle)
|
||||
#:modules
|
||||
(append
|
||||
(map (lambda (l)
|
||||
`(#f (file ,l)))
|
||||
source-files)
|
||||
(map (lambda (l)
|
||||
`(#t (lib ,l)))
|
||||
(exe-embedded-libraries)))))
|
||||
(append (map (lambda (l) `(#f (file ,l))) source-files)
|
||||
(map (lambda (l) `(#t (lib ,l))) (exe-embedded-libraries)))))
|
||||
(close-output-port out)
|
||||
(let ([out (open-output-file
|
||||
dest
|
||||
#:exists 'truncate/replace)])
|
||||
(let ([out (open-output-file dest #:exists 'truncate/replace)])
|
||||
(fprintf out "#ifdef MZ_XFORM\n")
|
||||
(fprintf out "XFORM_START_SKIP;\n")
|
||||
(fprintf out "#endif\n")
|
||||
|
|
@ -609,11 +553,8 @@
|
|||
(fprintf out " static unsigned char data[] = {")
|
||||
(let loop ([pos 0])
|
||||
(let ([b (read-byte in)])
|
||||
(when (zero? (modulo pos 20))
|
||||
(fprintf out "\n "))
|
||||
(unless (eof-object? b)
|
||||
(fprintf out "~a," b)
|
||||
(loop (add1 pos)))))
|
||||
(when (zero? (modulo pos 20)) (fprintf out "\n "))
|
||||
(unless (eof-object? b) (fprintf out "~a," b) (loop (add1 pos)))))
|
||||
(fprintf out "0\n };\n")
|
||||
(fprintf out " Scheme_Object *eload = NULL, *a[3] = {NULL, NULL, NULL};\n")
|
||||
(fprintf out " MZ_GC_DECL_REG(4);\n")
|
||||
|
|
@ -632,63 +573,53 @@
|
|||
(fprintf out "XFORM_END_SKIP;\n")
|
||||
(fprintf out "#endif\n")
|
||||
(close-output-port out)))
|
||||
(printf " [output to \"~a\"]~n" dest))]
|
||||
(printf " [output to \"~a\"]\n" dest))]
|
||||
[(exe-dir)
|
||||
((dynamic-require 'compiler/distribute
|
||||
'assemble-distribution)
|
||||
((dynamic-require 'compiler/distribute 'assemble-distribution)
|
||||
(exe-dir-output)
|
||||
source-files
|
||||
#:collects-path (exe-embedded-collects-path)
|
||||
#:copy-collects (exe-dir-add-collects-dirs))
|
||||
(printf " [output to \"~a\"]~n" (exe-dir-output))]
|
||||
(printf " [output to \"~a\"]\n" (exe-dir-output))]
|
||||
[(plt)
|
||||
(for-each (lambda (fd)
|
||||
(for ([fd source-files])
|
||||
(unless (relative-path? fd)
|
||||
(error
|
||||
'mzc
|
||||
(error 'mzc
|
||||
"file/directory is not relative to the current directory: \"~a\""
|
||||
fd)))
|
||||
source-files)
|
||||
(pack-plt (plt-output) (plt-name)
|
||||
source-files
|
||||
#:collections (map list (plt-setup-collections))
|
||||
#:file-mode (if (plt-files-replace)
|
||||
'file-replace
|
||||
'file)
|
||||
#:file-mode (if (plt-files-replace) 'file-replace 'file)
|
||||
#:plt-relative? (or (plt-files-plt-relative?)
|
||||
(plt-files-plt-home-relative?))
|
||||
#:at-plt-home? (plt-files-plt-home-relative?)
|
||||
#:test-plt-dirs (if (or (plt-force-install-dir?)
|
||||
(not (plt-files-plt-home-relative?)))
|
||||
#f
|
||||
(list "collects" "doc" "include" "lib"))
|
||||
'("collects" "doc" "include" "lib"))
|
||||
#:requires
|
||||
;; Get current version of mzscheme for require:
|
||||
(let ([i (get-info '("mzscheme"))])
|
||||
(let ([v (and i (i 'version (lambda () #f)))])
|
||||
(list (list '("mzscheme") v)))))
|
||||
(printf " [output to \"~a\"]~n" (plt-output))]
|
||||
(let* ([i (get-info '("mzscheme"))]
|
||||
[v (and i (i 'version (lambda () #f)))])
|
||||
(list (list '("mzscheme") v))))
|
||||
(printf " [output to \"~a\"]\n" (plt-output))]
|
||||
[(plt-collect)
|
||||
(pack-collections-plt
|
||||
(plt-output)
|
||||
(if (eq? default-plt-name (plt-name))
|
||||
#f
|
||||
(plt-name))
|
||||
(if (eq? default-plt-name (plt-name)) #f (plt-name))
|
||||
(map (lambda (sf)
|
||||
(let loop ([sf sf])
|
||||
(let ([m (regexp-match "^([^/]*)/(.*)$" sf)])
|
||||
(if m
|
||||
(cons (cadr m) (loop (caddr m)))
|
||||
(list sf)))))
|
||||
(if m (cons (cadr m) (loop (caddr m))) (list sf)))))
|
||||
source-files)
|
||||
#:replace? (plt-files-replace)
|
||||
#:extra-setup-collections (map list (plt-setup-collections))
|
||||
#:file-filter (if (plt-include-compiled)
|
||||
(lambda (path)
|
||||
(or (regexp-match #rx"compiled$" path)
|
||||
(std-filter path)))
|
||||
(or (regexp-match #rx"compiled$" path) (std-filter path)))
|
||||
std-filter)
|
||||
#:at-plt-home? (plt-files-plt-home-relative?)
|
||||
#:test-plt-collects? (not (plt-force-install-dir?)))
|
||||
(printf " [output to \"~a\"]~n" (plt-output))]
|
||||
[else (printf "bad mode: ~a~n" mode)]))
|
||||
(printf " [output to \"~a\"]\n" (plt-output))]
|
||||
[else (printf "bad mode: ~a\n" mode)])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user