diff options
Diffstat (limited to 'compile.scm')
| -rwxr-xr-x | compile.scm | 60 |
1 files changed, 38 insertions, 22 deletions
diff --git a/compile.scm b/compile.scm index ce96822..1242231 100755 --- a/compile.scm +++ b/compile.scm @@ -44,13 +44,18 @@ ;;;; "compile.scm", Compile C ==> Scheme ==> object-file. ;;; Author: Aubrey Jaffer. -(define (go-script) - (cond ((not *script*)) - ((and (<= 1 (- (length *argv*) *optind*)) - (not (eqv? #\- (string-ref (car (list-tail *argv* *optind*)) 0)))) - (apply compile-file (list-tail *argv* *optind*))) - (else - (display "\ +(require-if 'compiling 'hobbit) +(require-if 'compiling 'glob) +(require-if 'compiling 'build) + +(define (compile.scm args) + (cond ((and (<= 1 (length args)) + (not (eqv? #\- (string-ref (car args) 0)))) + (apply compile-file args)) + (else (compile.usage)))) + +(define (compile.usage) + (display "\ \ Usage: compile.scm FILE1.scm FILE2.scm ... \ @@ -58,9 +63,11 @@ Usage: compile.scm FILE1.scm FILE2.scm ... FILE1<object-suffix>, where <object-suffix> is the object file suffix for your computer (for instance, `.o'). FILE1.scm must be in the current directory; FILE2.scm ... can be in other directories. + +http://swissnet.ai.mit.edu/~jaffer/SCM " - (current-error-port)) - (exit #f)))) + (current-error-port)) + #f) ;;; This unusual autoload loads either the ;;; source or compiled version if present. @@ -69,44 +76,53 @@ Usage: compile.scm FILE1.scm FILE2.scm ... (require 'hobbit) (apply hobbit args))) +(define (find-option-file file) + (let ((opt file)) + (if (file-exists? opt) + (list "-f" opt) + '()))) +;@ (define (compile-file file . args) + (define sfs (scheme-file-suffix)) (require 'glob) (apply hobbit file args) (let ((command - (list "build" - "-hsystem" - "-tdll" - (string-append "--compiler-options=-I" (implementation-vicinity)) - "-c" (replace-suffix file (scheme-file-suffix) ".c")))) + (apply list + "build" + "-hsystem" + "-tdll" + (string-append "--compiler-options=-I" (implementation-vicinity)) + "-c" (replace-suffix file sfs ".c") + (find-option-file (replace-suffix file sfs ".opt"))))) (require 'build) (cond ((>= (verbose) 3) (write command) (newline))) (build-from-whole-argv command))) - -(define (compile->executable name . args) +;@ +(define (compile->executable exename . files) (define sfs (scheme-file-suffix)) (require 'glob) - (for-each hobbit args) + (for-each hobbit files) (let ((inits (map (lambda (file) (string-append "-iinit_" (replace-suffix file sfs ""))) - args)) + files)) (files (map (lambda (file) (string-append "-c" (replace-suffix file sfs ".c"))) - args))) + files))) (define command (append (list "build" "-hsystem" "--type=exe" - "-o" name + "-o" exename "-F" "compiled-closure" "inexact" (string-append "--linker-options=-L" (implementation-vicinity))) + (find-option-file (string-append exename ".opt")) files inits)) (require 'build) (cond ((>= (verbose) 3) (write command) (newline))) (build-from-whole-argv command))) -(go-script) - ;;; Local Variables: ;;; mode:scheme ;;; End: +(and *script* (exit (compile.scm (list-tail *argv* *optind*)))) |