#!/usr/bin/gsc-script -i
; vim: syntax=scheme

(current-readtable (readtable-eval-allowed?-set (current-readtable) #t))
(define CC "gcc")
;directories
(define tmp-dir (string-append "/tmp/r6rs-expand-" (number->string (inexact->exact (floor (time->seconds (current-time)))))))


(define stage-files (list "srfi-1-min.scm" "srfi-99.scm" "error.scm" "srfi-69.scm" "uri.scm" "catalog.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 (or R6RS-CORE "~/.gambit/r6rs"))

(define (path-expand* dir . files)
   (map (lambda (x) (path-expand x dir)) files))

(define core-libraries (path-expand* "libs/core" "lists.scm" "core.scm" "r5rs.scm" "records.scm" "hashtables.scm" "bytevectors.scm" "uri.scm"))




(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)
  (for-each (lambda (file)
	     (display* "compiling " file) 
	     (compile-file-to-c file options: options output: tmp-dir)) files))

(define (expand-all files from-dir prefix to-dir)
    (let ((to-files (map (lambda (x) (path-expand (string-append prefix "-" x) to-dir)) files))
	  (from-files (map (lambda (x) (path-expand x from-dir)) files)))
    (for-each ex:expand-file from-files to-files)
    to-files))


(create-directory tmp-dir)
(display* "generating r6rs.")

(display* "creating stage" )
(compile-files-to-c tmp-dir (apply path-expand* (current-directory) (append stage-files scenary-files)) 'debug)

(display* "loading stage...")
(for-each (lambda (file) (load file)) (apply path-expand* (current-directory) stage-files))

(load "~~lib/syntax-case")
(load "expander.scm")
(load "primitives.scm")

(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) ".c")))

(display* "linking " modules)
 (link-flat modules output: link-file  warnings?: #f)
(display* "generating-library ...")
 (gambc-cc "dyn" output: (path-expand r6rs-result) input-files: (append (map (lambda (f) (string-append f ".c")) modules) (list link-file)))    
)


(display* "done")