[compilation cleanup
atsmyles@earthlink.net**20091111184134] hunk ./compile-r6rs 8
-;prefix is just the directory it's under. 
-(define gambit-libraries-prefix "gambit")
-(define srfi-libraries-prefix "srfi")
-(define standard-libraries-prefix "rnrs")
-(define misc-libraries-prefix "")
-(define core-library-name "r6rs")
-(define standard-library-name "r6rs-stdlib")
hunk ./compile-r6rs 10
-(define (display* . args)
-  (for-each (lambda (x) (display x)) args)
-  (newline))
+(define stage-files (list "err5rs-records-inspection.scm" "err5rs-records-procedural.scm" "error.scm" "catalog.scm" "srfi-69.scm" "compat-gambit.scm" "runtime.scm"))
+(define scenary-files (list "srfi-66.scm"))
+(define play-files (list "core.exp" "expander.exp"))
+(define encore-files (list "primitives.scm"))
+(define r6rs-result "~/.gambit/lib/r6rs")
hunk ./compile-r6rs 21
-(define (compile-files-to-c . files)
+
+
+
+(define (display* . args)
+  (for-each (lambda (x) (display x)) args)
+  (newline))
+
+(define (string-join delim args)
+  (cond 
+	((null? args) "")
+	((null? (cdr args)) (car args))
+	(else (string-append (car args) delim (string-join delim (cdr args))))))
+
+
+
+
+
+(define (compile-files-to-c tmp-dir files . options)
hunk ./compile-r6rs 40
-	     (compile-file-to-c file options: '(debug) output: tmp-dir)) files))
+	     (display* "compiling " file) 
+	     (compile-file-to-c file options: options output: tmp-dir)) files))
hunk ./compile-r6rs 66
-(display* "generating r6rs. This may take a while. Coffee break!")
-(display* "creating stage")
+(display* "generating r6rs.")
hunk ./compile-r6rs 68
-(define stage-files (list 
-   (path-expand "err5rs-records-inspection.scm")
-   (path-expand "err5rs-records-procedural.scm")
-   (path-expand "error.scm")
-   (path-expand "catalog.scm") 
-   (path-expand "srfi-69.scm")
-   (path-expand "compat-gambit.scm")
-   (path-expand "runtime.scm")))
+(display* "creating stage" )
+(compile-files-to-c tmp-dir (apply path-expand* (current-directory) (append stage-files scenary-files)) 'debug)
hunk ./compile-r6rs 71
-(define scenary-files (list (path-expand "srfi-66.scm")))
+(display* "loading stage...")
+(for-each (lambda (file) (load file)) (apply path-expand* (current-directory) stage-files))
hunk ./compile-r6rs 74
-(define play-files (list (path-expand "core.exp" tmp-dir) (path-expand "expander.scm" tmp-dir) (path-expand "primitives.scm")))
-
-(apply compile-files-to-c (append stage-files scenary-files))
-
-(display* "creating expander")
-(for-each (lambda (file) (load file)) stage-files)
hunk ./compile-r6rs 78
- (apply ex:expand-file* (car play-files) core-libraries)
- (ex:expand-r5rs-file "expander.scm" (cadr play-files) (ex:environment '(except (r5rs) eval)))
- (apply compile-files-to-c play-files)
+(display* "create play")
+ (apply ex:expand-file* (path-expand (car play-files) tmp-dir) core-libraries)
+ (ex:expand-r5rs-file "expander.scm" (path-expand (cadr play-files) tmp-dir) (ex:environment '(except (r5rs) eval)))
+ (compile-files-to-c tmp-dir (append (apply path-expand* tmp-dir play-files) (apply path-expand* (current-directory) encore-files)) 'debug)
+
+ (let ((modules (map (lambda (f) (string-append (path-strip-extension (path-expand f tmp-dir)))) (append stage-files scenary-files play-files encore-files)))
+	
+       (link-file  (string-append (path-expand (path-strip-directory r6rs-result) tmp-dir) ".o1.c")))
+
+ (link-flat modules output: link-file  warnings?: #f)
+ (gambc-cc "dyn" output: (path-expand (string-append r6rs-result ".o1")) verbose: "true" input-files: (append (map (lambda (f) (string-append f ".c")) modules) (list link-file)))    
+)
hunk ./compile-r6rs 91
-(apply compile-r6rs-base (append stage-files scenary-files play-files))
+;(apply compile-r6rs-base (append stage-files scenary-files play-files))
hunk ./primitives.scm 8
-
-(define CC #.CC)
-
hunk ./primitives.scm 10
+(define (gambc-cc type . options )
+ (define (join strings)
+  (cond
+   ((null? strings) "")
+   ((null? (cdr strings)) (car strings))
+   (else (string-append (car strings) " " (join (cdr strings))))))
+ (define (value->string value)
+  (cond
+   ((list? value) (join value))
+   ((symbol? value) (symbol->string value))
+   ((string? value) value)
+   ((boolean? value) (if value "true" ""))
+   (else value)))
+  	
+  (define (option key default)
+   (let get-key ((options options))
+    (if (null? options) default
+     (if (eq? (car options) key) (cadr options) (get-key (cddr options))))))
+ 
+ (define (envar name key default)
+  (string-append (value->string name) "=" (value->string (option key default)) ))
+   
+	(let ((env (list 
+		    (envar 'GAMBCDIR_INCLUDE include: (path-expand "~~include"))
+		    (envar 'BUILD_DYN_OUTPUT_FILENAME output: "")
+		    (envar 'BUILD_DYN_CC_OPTIONS cc-options: "")
+		    (envar 'BUILD_DYN_LD_OPTIONS_PRELUDE ld-options-prelude: "")
+		    (envar 'BUILD_DYN_LD_OPTIONS ld-options: "")
+		    (envar 'BUILD_DYN_INPUT_FILENAMES input-files: '())
+		    (envar 'GAMBC_CC_VERBOSE verbose: ""))))
+	 (process-status
+	  (open-process `(path: ,(path-expand "~~bin/gambc-cc.bat")
+			  arguments: ,(list (value->string type))
+			  environment: ,env
+			  stdout-redirection: #f
+			  directory: ,(option directory: #f))))))
+	
hunk ./primitives.scm 103
-#;(define (ex:compile-library form . options)
- (if (and (pair? form) (eq? (car form) 'library))
-  (let* ((library-name (cadr form))
-	 (to-file (library->filename library-name))
-	 (expanded-file (path-expand (path-strip-directory to-file) "/tmp"))
-         (c-file (string-append (path-strip-extension expanded-file) ".c"))
-         (l-file (string-append expanded-file ".c"))
-	 (gcc (string-append CC " "
-		(if (memq 'apple (system-type)) "-bundle" "-shared")
-		" -D___DYNAMIC -I" 
-		(path-expand "~~/include") 
-		" " c-file 
-		" " l-file 
-		" -o " to-file )))
-   (display expanded-file)
-   (newline)
-   (display c-file)
-   (newline)
-   (display l-file)
-   (newline)
-   (display to-file)
-   (newline)
-   (display gcc)
-   (newline)
-   (write-file (ex:expand-r6rs-sequence (list form)) expanded-file)
-   (apply compile-file-to-c expanded-file output: c-file options)
-   (link-flat expanded-file output: l-file)
-   (apply compile-file expanded-file output: to-file options)
-   (delete-file expanded-file)
-   (delete-file c-file)
-   (delete-file l-file)
-   (make-r6rs-library (cdr forms) options))))	
hunk ./primitives.scm 138
- (define (get-compiler-option key compiler-options default)
+ (define (get-compiler-option compiler-options key default)
hunk ./primitives.scm 142
-	(else (get-compiler-option key (cddr compiler-options) default))))
+	(else (get-compiler-option (cddr compiler-options) key default))))
hunk ./primitives.scm 158
+
hunk ./primitives.scm 162
-      (let ((c-files (append (map path-file native-files) (list (compile-library-to-c library-form))))
+      (let ((c-files (append (map path-expand native-files) (list (compile-library-to-c library-form))))
hunk ./primitives.scm 165
-
-      (process-status (open-process `(path: ,(path-expand "~/gsc-cc-o.bat")
+	(gambc-cc 'dyn 
+		input-files:  (map (lambda (file) (string-append file ".c")) 
+					   (append c-files (list link-file))
+					   )
+		output: (path-expand output-file)
+		cc-options: (get-compiler-option compiler-options cc-options: "")
+		ld-options: (get-compiler-option compiler-options ld-options: "")
+		ld-options-prelude: (get-compiler-option compiler-options ld-options-prelude: "")
+		verbose: #t)
+      #;(process-status (open-process `(path: ,(path-expand "~/gsc-cc-o.bat")
hunk ./primitives.scm 180
-			      (string-append "GSC_CC_O_OBJ_FILENAME=" (path-expand output-file))
+			      (string-append "GSC_CC_O_OBJ_FILENAME=" )
hunk ./primitives.scm 183
-				(apply string-append 
-					(map (lambda (file) (string-append " " file ".c")) 
-					   (append c-files (list link-file))
-					   )))
+				)
hunk ./primitives.scm 185
-			      (string-append "GSC_CC_O_CC_OPTIONS=" (get-compiler-option cc-options: compiler-options ""))
-			      (string-append "GSC_CC_O_LD_OPTIONS_PRELUDE=" (get-compiler-option ld-options-prelude: compiler-options ""))
-			      (string-append "GSC_CC_O_LD_OPTIONS=" (get-compiler-option ld-options: compiler-options "")))
+			      (string-append "GSC_CC_O_CC_OPTIONS=" )
+			      (string-append "GSC_CC_O_LD_OPTIONS_PRELUDE=" )
+			      (string-append "GSC_CC_O_LD_OPTIONS=" ))
hunk ./primitives.scm 190
-	(if (not (get-option keep-files: #f options)) (for-each delete-file (directory-files tmp-dir)))))
-      
-      (if (not (get-option keep-files: #f options)) (delete-directory tmp-dir))
-       )
+	(if (get-compiler-option compiler-options keep-files: #f)
+		(void) 
+		(begin 
+			(for-each delete-file (directory-files tmp-dir))
+			(delete-directory tmp-dir))))))