suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Major cleanup

Browse Source 
svn: r11237
This commit is contained in:
Eli Barzilay 2008-08-14 10:07:14 +00:00
parent 2d3dfd9d9e
commit 2ef6a23b4e
8 changed files with 534 additions and 579 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/make/collection-sig.ss
View File

@ -1,9 +1,8 @@
#lang mzscheme
(module collection-sig mzscheme
(require mzlib/unit) (require mzlib/unit)
(provide make:collection^) (provide make:collection^)
(define-signature make:collection^ (define-signature make:collection^
(make-collection))) (make-collection))

36
collects/make/collection-unit.ss
View File

@ -1,13 +1,11 @@
#lang mzscheme
(module collection-unit mzscheme
(require mzlib/unit (require mzlib/unit
mzlib/list mzlib/list
mzlib/file) mzlib/file
"collection-sig.ss"
(require "collection-sig.ss") "make-sig.ss"
(require "make-sig.ss") compiler/sig
(require compiler/sig
dynext/file-sig) dynext/file-sig)
(provide make:collection@) (provide make:collection@)
@ -18,23 +16,19 @@
compiler^) compiler^)
(export make:collection^) (export make:collection^)
(define (make-collection (define (make-collection collection-name collection-files argv)
collection-name
collection-files
argv)
(printf "building collection ~a: ~a~n" collection-name collection-files) (printf "building collection ~a: ~a~n" collection-name collection-files)
(let* ([zo-compiler #f] (let* ([zo-compiler #f]
[src-dir (current-directory)] [src-dir (current-directory)]
[sses (sort collection-files [sses (sort collection-files
(lambda (a b) (string-ci<? (path->string a) (path->string b))))] (lambda (a b)
(string-ci<? (path->string a) (path->string b))))]
[bases (map (lambda (src) [bases (map (lambda (src)
(extract-base-filename/ss src 'make-collection-extension)) (extract-base-filename/ss src
'make-collection-extension))
sses)] sses)]
[zos (map [zos (map (lambda (base)
(lambda (base) (build-path "compiled" (append-zo-suffix base)))
(build-path
"compiled"
(append-zo-suffix base)))
bases)] bases)]
[ss->zo-list [ss->zo-list
(map (lambda (ss zo) (map (lambda (ss zo)
@ -45,8 +39,4 @@
(zo-compiler (list ss) "compiled")))) (zo-compiler (list ss) "compiled"))))
sses zos)]) sses zos)])
(unless (directory-exists? "compiled") (make-directory "compiled")) (unless (directory-exists? "compiled") (make-directory "compiled"))
(make/proc (make/proc (append `(("zo" ,zos)) ss->zo-list) argv))))
(append
`(("zo" ,zos))
ss->zo-list)
argv)))))

9
collects/make/collection.ss
View File

@ -1,8 +1,7 @@
#lang mzscheme
(module collection mzscheme (require mzlib/unit
(require mzlib/unit) dynext/file-sig
(require dynext/file-sig
dynext/file dynext/file
compiler/sig compiler/sig
compiler/compiler compiler/compiler
@ -15,4 +14,4 @@
(define-values/invoke-unit/infer make:collection@) (define-values/invoke-unit/infer make:collection@)
(provide-signature-elements make:collection^)) (provide-signature-elements make:collection^)

1
collects/make/make-sig.ss
View File

@ -1,4 +1,3 @@
#lang scheme/signature #lang scheme/signature
make/proc make/proc

232
collects/make/make-unit.ss
View File

@ -1,4 +1,3 @@
#lang scheme/unit #lang scheme/unit
(require "make-sig.ss") (require "make-sig.ss")
@ -6,162 +5,113 @@
(import) (import)
(export make^) (export make^)
(define-struct (exn:fail:make exn:fail) (target orig-exn))
(define make-print-checking (make-parameter #t)) (define make-print-checking (make-parameter #t))
(define make-print-dep-no-line (make-parameter #t)) (define make-print-dep-no-line (make-parameter #t))
(define make-print-reasons (make-parameter #t)) (define make-print-reasons (make-parameter #t))
(define make-notify-handler (make-parameter void)) (define make-notify-handler (make-parameter void))
;(define-type line (list (union path-string (list-of path-string)) (list-of path-string) thunk)) (define-struct line (targets ; (list-of string)
;(define-type spec (list-of line)) dependencies ; (list-of string)
command)) ; (union thunk #f)
(define-struct (exn:fail:make exn:fail) (target orig-exn))
(define (path-string=? a b) ;; check-spec : TST -> (non-empty-list-of line)
(equal? (if (string? a) (string->path a) a) ;; throws an error on bad input
(if (string? b) (string->path b) b))) (define (spec->lines spec)
(define (path-string->string s) (define (->strings xs)
(if (string? s) (map (lambda (x) (if (path? x) (path->string x) x)) xs))
s (define (err s p) (error 'make/proc "~a: ~e" s p))
(path->string s))) (unless (and (list? spec) (pair? spec))
(err "specification is not a non-empty list" spec))
(for/list ([line spec])
(unless (and (list? line) (<= 2 (length line) 3))
(err "line is not a list with 2 or 3 parts" line))
(let* ([name (car line)]
[tgts (if (list? name) name (list name))]
[deps (cadr line)]
[thunk (and (pair? (cddr line)) (caddr line))])
(define (err s p) (error 'make/proc "~a: ~e for line: ~a" s p name))
(unless (andmap path-string? tgts)
(err "line does not start with a path/string or list of paths/strings"
line))
(unless (list? deps) (err "second part of line is not a list" deps))
(for ([dep deps])
(unless (path-string? dep)
(err "dependency item is not a path/string" dep)))
(unless (or (not thunk)
(and (procedure? thunk) (procedure-arity-includes? thunk 0)))
(err "command part of line is not a thunk" thunk))
(make-line (->strings tgts) (->strings deps) thunk))))
; find-matching-line : path-string spec -> (union line #f) ;; (union path-string (vector-of path-string) (list-of path-string))
(define (find-matching-line str spec) ;; -> (list-of string)
(let ([match? (lambda (s) (path-string=? s str))]) ;; throws an error on bad input
(let loop ([lines spec]) (define (argv->args x)
(cond (let ([args (cond [(list? x) x]
[(null? lines) #f] [(vector? x) (vector->list x)]
[else (let* ([line (car lines)] [else (list x)])])
[names (if (path-string? (car line)) (map (lambda (a)
(list (car line)) (cond [(string? a) a]
(car line))]) [(path? a) (path->string a)]
(if (ormap match? names) [else (raise-type-error
line 'make/proc "path/string or path/string vector or list"
(loop (cdr lines))))])))) x)]))
args)))
; form-error : TST TST -> a ;; path-date : path-string -> (union integer #f)
(define (form-error s p) (error 'make/proc "~a: ~s" s p)) (define (path-date p)
(and (or (directory-exists? p) (file-exists? p))
(file-or-directory-modify-seconds p)))
; line-error : TST TST TST -> a ;; make/proc :
(define (line-error s p n) (error 'make/proc "~a: ~s for line: ~a" s p n)) ;; spec (union path-string (vector-of path-string) (list-of path-string))
;; -> void
; check-spec : TST -> #t ;; effect : make, according to spec and argv. See docs for details
; effect : calls error if input is not a spec (define (make/proc spec [argv '()])
(define (check-spec spec) (define made null)
(and (or (list? spec) (form-error "specification is not a list" spec)) (define lines (spec->lines spec))
(or (pair? spec) (form-error "specification is an empty list" spec)) (define args (argv->args argv))
(andmap (define (make-file s indent)
(lambda (line) (define line
(and (or (and (list? line) (<= 2 (length line) 3)) (findf (lambda (line)
(form-error "list is not a list with 2 or 3 parts" line)) (ormap (lambda (s1) (string=? s s1)) (line-targets line)))
(or (or (path-string? (car line)) lines))
(and (list? (car line)) (define date (path-date s))
(andmap path-string? (car line)))) (when (and (make-print-checking) (or line (make-print-dep-no-line)))
(form-error "line does not start with a path/string or list of paths/strings" line)) (printf "make: ~achecking ~a\n" indent s)
(let ([name (car line)])
(or (list? (cadr line))
(line-error "second part of line is not a list" (cadr line) name)
(andmap (lambda (dep)
(or (path-string? dep)
(form-error "dependency item is not a path/string" dep name)))
(cadr line)))
(or (null? (cddr line))
(and (procedure? (caddr line))
(procedure-arity-includes? (caddr line) 0))
(line-error "command part of line is not a thunk" (caddr line) name)))))
spec)))
; check-spec : TST -> #t
; effect : calls error if input is not a (union path-string (vector-of path-string))
(define (check-argv argv)
(or (path-string? argv)
(and (vector? argv)
(andmap path-string? (vector->list argv)))
(raise-type-error 'make/proc "path/string or path/string vector" argv)))
; make/proc/helper : spec (union path-string (vector-of path-string)) -> void
; effect : make, according to spec and argv. See docs for details
(define (make/proc/helper spec argv)
(check-spec spec)
(check-argv argv)
(letrec ([made null]
[make-file
(lambda (s indent)
(let ([line (find-matching-line s spec)]
[date (and (or (directory-exists? s)
(file-exists? s))
(file-or-directory-modify-seconds s))])
(when (and (make-print-checking)
(or line (make-print-dep-no-line)))
(printf "make: ~achecking ~a~n" indent s)
(flush-output)) (flush-output))
(if (not line)
(if line (unless date (error 'make "don't know how to make ~a" s))
(let ([deps (cadr line)]) (let* ([deps (line-dependencies line)]
(for-each (let ([new-indent (string-append " " indent)]) [command (line-command line)]
(lambda (d) (make-file d new-indent))) [indent+ (string-append indent " ")]
deps) [dep-dates (for/list ([d deps])
(let ([reason (make-file d indent+)
(or (not date) (or (path-date d)
(ormap (lambda (dep) (error 'make "dependancy ~a was not made\n" d)))]
(unless (or (file-exists? dep) [reason (or (not date)
(directory-exists? dep)) (ormap (lambda (dep ddate) (and (> ddate date) dep))
(error 'make "dependancy ~a was not made~n" dep)) deps dep-dates))])
(and (> (file-or-directory-modify-seconds dep) date) (when (and reason command)
dep))
deps))])
(when reason
(let ([l (cddr line)])
(unless (null? l)
(set! made (cons s made)) (set! made (cons s made))
((make-notify-handler) s) ((make-notify-handler) s)
(printf "make: ~amaking ~a~a~n" (printf "make: ~amaking ~a~a\n"
(if (make-print-checking) indent "") (if (make-print-checking) indent "")
(path-string->string s) s
(if (make-print-reasons) (cond [(not (make-print-reasons)) ""]
(cond [(not date) (format " because ~a does not exist" s)]
[(not date) [else (format " because ~a changed" reason)]))
(string-append " because " (path-string->string s) " does not exist")]
[(path-string? reason)
(string-append " because " (path-string->string reason) " changed")]
[else
(string-append
(format " because (reason: ~a date: ~a)"
reason date))])
""))
(flush-output) (flush-output)
(with-handlers ([exn:fail? (with-handlers ([exn:fail?
(lambda (exn) (lambda (exn)
(raise (make-exn:fail:make (raise (make-exn:fail:make
(format "make: Failed to make ~a; ~a" (format "make: failed to make ~a; ~a"
(let ([fst (car line)]) s (exn-message exn))
(if (pair? fst)
(map path-string->string fst)
(path-string->string fst)))
(if (exn? exn)
(exn-message exn)
exn))
(if (exn? exn)
(exn-continuation-marks exn) (exn-continuation-marks exn)
(current-continuation-marks)) (line-targets line)
(car line)
exn)))]) exn)))])
((car l)))))))) (command))))))
(unless date (for ([f (if (null? args) (list (car (line-targets (car lines)))) args)])
(error 'make "don't know how to make ~a" (make-file f ""))
(path-string->string s))))))]) (for ([item (reverse made)]) (printf "make: made ~a\n" item))
(cond (flush-output))
[(path-string? argv) (make-file argv "")]
[(equal? argv #()) (make-file (caar spec) "")]
[else (for-each (lambda (f) (make-file f "")) (vector->list argv))])
(for-each (lambda (item)
(printf "make: made ~a~n" (path-string->string item)))
(reverse made))
(flush-output)))
(define make/proc
(case-lambda
[(spec) (make/proc/helper spec #())]
[(spec argv) (make/proc/helper spec argv)]))

117
collects/make/make.scrbl
View File

@ -17,8 +17,8 @@
@title{@bold{Make}: Dependency Manager} @title{@bold{Make}: Dependency Manager}
The @schememodname[make] library provides a Scheme version of the The @schememodname[make] library provides a Scheme version of the
standard Unix @exec{make} utility. Its syntax is intended to imitate popular @exec{make} utility. Its syntax is intended to imitate the
regular Unix make, but in Scheme. syntax of @exec{make}, only in Scheme.
@table-of-contents[] @table-of-contents[]
@ -33,18 +33,19 @@ dependency tracking, just use @exec{mzc} as described in
If you are already familiar with @exec{make}, skip to the precise If you are already familiar with @exec{make}, skip to the precise
details of the @schememodname[make] library in @secref["make"]. This details of the @schememodname[make] library in @secref["make"]. This
section contains a brief overview of @exec{make} for everyone section contains a brief overview of @exec{make} for everyone
else. The idea is to explain how to generate some project you have else.
from a collection of source files that go through several stages of
processing.
For example, let's say that you are writing some project that has When you use @exec{make}, the idea is that you explain how to generate
three input files (that you create and maintain) called files in a project from a collection of source files that go through
@filepath{a.input}, @filepath{b.input}, and several stages of processing.
@filepath{c.input}. Further, there are two stages of processing: first
you run a particular tool @exec{make-output} that takes an input file For example, say that you are writing a project that has three input
and produces and output file, and second you combine the input files files (which you create and maintain) called @filepath{a.input},
into a single file using @filepath{output}. Using @exec{make}, you @filepath{b.input}, and @filepath{c.input}. Further, there are two
might write this: stages of processing: first you run a particular tool
@exec{make-output} that takes an input file and produces an output
file, and then you combine the input files into a single file using
@exec{combine-files}. Using @exec{make}, you might describe this as:
@verbatim[#:indent 2]{ @verbatim[#:indent 2]{
a.output: a.input a.output: a.input
@ -54,30 +55,32 @@ b.output: b.input
c.output: c.input c.output: c.input
make-output c.input c.output make-output c.input c.output
total: a.output b.output c.output total: a.output b.output c.output
combine a.output b.output c.output combine-files a.output b.output c.output
} }
Once you've put those above lines in a file called Once you've put this description in a file called @filepath{Makefile}
@filepath{Makefile} you can issue the command: you can issue the command:
@commandline{make total} @commandline{make total}
that builds your entire project. The @filepath{Makefile} consists of to build your entire project. The @filepath{Makefile} consists of
several lines that tell @exec{make} how to create each piece. The several rules that tell @exec{make} how to create each piece of your
first two lines say that @filepath{a.output} depends on project. For example, the rule that is specified in the first two
@filepath{a.input} and the command for making @filepath{a.output} from lines say that @filepath{a.output} depends on @filepath{a.input} and
@filepath{a.input} is the command for making @filepath{a.output} from @filepath{a.input} is
@commandline{make-output a.input a.output} @commandline{make-output a.input a.output}
The point of using @exec{make} is that it looks at the file creation The main feature of @exec{make} is that it uses the time stamps of
dates of the various files and only re-builds what is necessary. files to determine when a certain step is necessary. The @exec{make}
utility uses existing programs to build your project --- each rule has
a shell command line.
The @exec{make} utility builds things with shell programs. If, on the The @schememodname[make] library provides similar functionality,
other hand, you want to build similar things with various Scheme except that the description is in Scheme, and the steps that are
programs, you can use the @schememodname[make] library. needed to build target files are implemented as Scheme functions.
Here's the equivalent Scheme program: Here's a Scheme program that is equivalent to the above:
@schemeblock[ @schemeblock[
(require make) (require make)
@ -85,24 +88,49 @@ Here's the equivalent Scheme program:
(define (make-output in out) (define (make-output in out)
....) ....)
(define (combine-total . args) (define (combine-files . args)
....) ....)
(make (make
(("a.output" ("a.input") (make-output "a.output" "a.input")) (("a.output" ("a.input") (make-output "a.input" "a.output"))
("b.output" ("b.input") (make-output "b.output" "b.input")) ("b.output" ("b.input") (make-output "b.input" "b.output"))
("c.output" ("c.input") (make-output "c.output" "c.input")) ("c.output" ("c.input") (make-output "c.input" "c.output"))
("total" ("a.output" "b.output" "c.output") ("total" ("a.output" "b.output" "c.output")
(combine-total "a.output" "b.output" "c.output")))) (combine-files "a.output" "b.output" "c.output"))))
] ]
If you were to fill in the ellipses above with calls to If you were to fill in the ellipses above with calls to
@scheme[system], you'd have the exact same thing as the original @scheme[system], you'd have the exact same functionality as the
@filepath{Makefile}. In addition, if you use @scheme[make/proc]], you original @filepath{Makefile}. In addition, you can use
can abstract over the various make lines (for example, the @scheme[make/proc] to abstract over the various lines. For example,
@filepath{a.output}, @filepath{b.output}, and @filepath{c.output} the @filepath{a.output}, @filepath{b.output}, and @filepath{c.output}
lines are similar, and it would be good to write a program to generate lines are very similar so you can write the code that generates those
those lines). lines:
@schemeblock[
(require make)
(define (make-output in out)
....)
(define (combine-files . args)
....)
(define files '("a" "b" "c"))
(define inputs (map (lambda (f) (string-append f ".input"))))
(define outputs (map (lambda (f) (string-append f ".output"))))
(define (line file)
(let ([i (string-append file ".input")]
[o (string-append file ".output")])
`(,o (,i) )
(list o (list i) (lambda () (make-output o i)))))
(make/proc
`(,@(map (lambda (i o) `(o (,i) ,(lambda () (make-output i o))))
inputs outputs)
("total" ,outputs ,(lambda () (apply combine-files outputs)))))
]
@; ---------------------------------------------------------------------- @; ----------------------------------------------------------------------
@ -120,7 +148,8 @@ Expands to
@schemeblock[ @schemeblock[
(make/proc (make/proc
(list (list target-expr (list depend-expr ...) (list (list target-expr (list depend-expr ...)
(lambda () command-expr ...)) ...) (lambda () command-expr ...))
...)
argv-expr) argv-expr)
]} ]}
@ -129,7 +158,8 @@ Expands to
(cons/c (listof path-string?) (cons/c (listof path-string?)
(or/c null? (or/c null?
(list/c (-> any))))))] (list/c (-> any))))))]
[argv (or/c string? (vectorof string?))]) void?] [argv (or/c string? (vectorof string?) (listof string?))])
void?]
Performs a make according to @scheme[spec] and using @scheme[argv] as Performs a make according to @scheme[spec] and using @scheme[argv] as
command-line arguments selecting one or more targets. command-line arguments selecting one or more targets.
@ -153,10 +183,11 @@ While running a command thunk, @scheme[make/proc] catches exceptions
and wraps them in an @scheme[exn:fail:make] structure, the raises the and wraps them in an @scheme[exn:fail:make] structure, the raises the
resulting structure.} resulting structure.}
@defstruct[(exn:fail:make exn:fail) ([target (or/c path-string? (listof path-string?))] @defstruct[(exn:fail:make exn:fail)
([targets (listof path-string?)]
[orig-exn any/c])]{ [orig-exn any/c])]{
The @scheme[target] field is a list of list of strings naming the The @scheme[targets] field is a list of strings naming the
target(s), and the @scheme[orig-exn] field is the original raised target(s), and the @scheme[orig-exn] field is the original raised
value.} value.}
@ -254,7 +285,7 @@ options (see @schememodname[dynext/compile] and
[unix-libs (listof string?)] [unix-libs (listof string?)]
[windows-libs (listof string?)] [windows-libs (listof string?)]
[extra-depends (listof path-string?)] [extra-depends (listof path-string?)]
[last-chance-k ((-> any) . > . any)] [last-chance-k ((-> any) . -> . any)]
[3m-too? any/c #f]) [3m-too? any/c #f])
void?]{ void?]{

24
collects/make/make.ss
View File

@ -1,14 +1,15 @@
#lang mzscheme
(module make mzscheme (require mzlib/unit
(require mzlib/unit) "make-sig.ss"
(require "make-sig.ss"
"make-unit.ss") "make-unit.ss")
(define-values/invoke-unit/infer make@) (define-values/invoke-unit/infer make@)
(provide-signature-elements make^) (provide-signature-elements make^)
(provide make)
(define-syntax make (define-syntax make
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
@ -29,17 +30,16 @@
(form-error "clause does not have at least 2 parts" line)) (form-error "clause does not have at least 2 parts" line))
(let ([name (car ll)]) (let ([name (car ll)])
(unless (syntax->list (cadr ll)) (unless (syntax->list (cadr ll))
(form-error "second part of clause is not a sequence" (cadr ll)))))) (form-error "second part of clause is not a sequence"
(cadr ll))))))
sl) sl)
(with-syntax ([(line ...) (with-syntax ([(line ...)
(map (lambda (line) (map (lambda (line)
(syntax-case line () (syntax-case line ()
[(target deps) (syntax (list target (list . deps)))] [(target deps)
[(target deps . c) (syntax (list target (list . deps) (syntax (list target (list . deps)))]
[(target deps . c)
(syntax (list target (list . deps)
(lambda () . c)))])) (lambda () . c)))]))
sl)]) sl)])
(syntax (make/proc (syntax (make/proc (list line ...) argv)))))])))
(list line ...)
argv)))))])))
(provide make))

85
collects/make/setup-extension.ss
View File

@ -1,5 +1,5 @@
#lang mzscheme
(module setup-extension mzscheme
(require make (require make
dynext/link dynext/link
dynext/compile dynext/compile
@ -11,20 +11,18 @@
compiler/xform compiler/xform
setup/dirs) setup/dirs)
(provide pre-install (provide pre-install)
with-new-flags)
;; Syntax used to add a command-line flag: ;; Syntax used to add a command-line flag:
(define-syntax with-new-flags (define-syntax with-new-flags
(syntax-rules () (syntax-rules ()
[(_ param flags body0 body ...) [(_ ([param flags] ...) body0 body ...)
(parameterize ([param (append (parameterize* ([param (append (param) flags)] ...)
(param)
flags)])
body0 body ...)])) body0 body ...)]))
(define (extract-base-filename file.c) (define (extract-base-filename file.c)
(let-values ([(base name dir?) (split-path (extract-base-filename/c file.c 'pre-install))]) (let-values ([(base name dir?)
(split-path (extract-base-filename/c file.c 'pre-install))])
name)) name))
(define (string-path->string s) (define (string-path->string s)
@ -80,19 +78,16 @@
name)) name))
file.c)))))) file.c))))))
(define (pre-install/check-precompiled main-collects-parent-dir collection-dir file.c . rest) (define (pre-install/check-precompiled
(let* ([pre-dir (build-path collection-dir main-collects-parent-dir collection-dir file.c . rest)
"precompiled" (let* ([pre-dir (build-path collection-dir "precompiled" "native")]
"native")]
[variant-dir (system-library-subpath (link-variant))] [variant-dir (system-library-subpath (link-variant))]
[base-file (string-append (path-element->string (extract-base-filename file.c)) [base-file (string-append (path-element->string (extract-base-filename file.c))
"_ss")] "_ss")]
[file.so (build-path pre-dir variant-dir (append-extension-suffix base-file))]) [file.so (build-path pre-dir variant-dir (append-extension-suffix base-file))])
(if (file-exists? file.so) (if (file-exists? file.so)
;; Just copy pre-compiled file: ;; Just copy pre-compiled file:
(let* ([dest-dir (build-path collection-dir (let* ([dest-dir (build-path collection-dir "compiled" "native"
"compiled"
"native"
variant-dir)] variant-dir)]
[dest-file.so (build-path dest-dir (append-extension-suffix base-file))]) [dest-file.so (build-path dest-dir (append-extension-suffix base-file))])
(make-directory* dest-dir) (make-directory* dest-dir)
@ -181,45 +176,32 @@
(define file.so (build-path dir (append-extension-suffix base-file))) (define file.so (build-path dir (append-extension-suffix base-file)))
(define file.o (build-path dir (append-object-suffix base-file))) (define file.o (build-path dir (append-object-suffix base-file)))
(with-new-flags (with-new-flags ([current-extension-compiler-flags
current-extension-compiler-flags ((current-make-compile-include-strings)
((current-make-compile-include-strings) (build-path sys-path "include")) (build-path sys-path "include"))]
[current-extension-preprocess-flags
(with-new-flags ((current-make-compile-include-strings)
current-extension-preprocess-flags (build-path sys-path "include"))]
((current-make-compile-include-strings) (build-path sys-path "include"))
;; Add -L and -l for Unix: ;; Add -L and -l for Unix:
(with-new-flags [current-extension-linker-flags
current-extension-linker-flags
(if is-win? (if is-win?
null null
(list (format "-L~a/lib" (path->string sys-path)))) (list (format "-L~a/lib" (path->string sys-path))))]
;; Add libs for Windows: ;; Add libs for Windows:
(with-new-flags [current-standard-link-libraries
current-standard-link-libraries
(if is-win? (if is-win?
(append (map (append (map
(lambda (l) (lambda (l)
(build-path sys-path "lib" (format "~a.lib" l))) (build-path sys-path "lib"
(format "~a.lib" l)))
find-windows-libs) find-windows-libs)
windows-libs) windows-libs)
null) null)]
;; Extra stuff: ;; Extra stuff:
(with-new-flags [current-extension-linker-flags
current-extension-linker-flags (case mach-id [(rs6k-aix) (list "-lc")] [else null])]
(case mach-id [current-standard-link-libraries
[(rs6k-aix) (list "-lc")] (case mach-id [(i386-cygwin) (list "-lc")] [else null])])
[else null])
(with-new-flags
current-standard-link-libraries
(case mach-id
[(i386-cygwin) (list "-lc")]
[else null])
(define (delete/continue x) (define (delete/continue x)
(with-handlers ([(lambda (x) #t) void]) (with-handlers ([(lambda (x) #t) void])
(delete-file x))) (delete-file x)))
@ -233,22 +215,27 @@
(list (list file.so (list (list file.so
(list file.o) (list file.o)
(lambda () (lambda ()
(link-extension #f (append (list file.o) (link-extension
#f (append
(list file.o)
(if is-win? (if is-win?
null null
(map (lambda (l) (map (lambda (l)
(string-append "-l" (string-path->string l))) (string-append
"-l" (string-path->string l)))
(append find-unix-libs unix-libs)))) (append find-unix-libs unix-libs))))
file.so))) file.so)))
(list file.o (list file.o
(append (list file.c) (append (list file.c)
(filter (lambda (x) (filter (lambda (x)
(regexp-match #rx#"mzdyn[a-z0-9]*[.]o" (regexp-match
#rx#"mzdyn[a-z0-9]*[.]o"
(if (string? x) (if (string? x)
x x
(path->string x)))) (path->string x))))
(expand-for-link-variant (current-standard-link-libraries))) (expand-for-link-variant
(current-standard-link-libraries)))
headers headers
extra-depends) extra-depends)
(lambda () (lambda ()
@ -271,4 +258,4 @@
(current-directory))) (current-directory)))
mz-inc-dir))))) mz-inc-dir)))))
null)) null))
#()))))))))))))) #())))))))