; Copyright (c) 1993-2008 by Richard Kelsey and Jonathan Rees. See file COPYING.


; This file contains things that tie together the compiler and the
; run-time system.

; EVAL

(define (eval form package)
  (compile-and-run (list form) package #f #f))

; LOAD-INTO - load file into package.

(define (load-into filename package)
  (really-load-into filename package #f #f))

(define (load-script-into filename package)
  (really-load-into filename package #f #t))

; Evaluate forms as if they came from the given file.

(define (eval-from-file forms package filename)
  (if filename
      ((fluid-cell-ref $note-file-package)
        filename package))
  (compile-and-run forms package filename #t))

; for macro expansion
; returns unlinked template, thunk that runs the node
(define (compile-syntax-node name node env) ; env can be package or compile-time environment
  (let* ((package (if (compiler-env? env)
		      (comp-env-package env)
		      env))
	 (uid (package-uid package))
	 (template (compile-rhs name node uid))
	 (linked (link template env 0 #t)))
    (values template
	    (lambda ()
	      (invoke-closure
	       (make-closure linked uid))))))

; LOAD

(define (load filename . package-option)
  (let ((package (if (null? package-option)
		     (interaction-environment)
		     (car package-option))))
    (really-load-into filename package #t #f)))

;----------------

(define (really-load-into filename package note-undefined? script?)
  (force-output (current-output-port))	; just to make the output nice
  (let ((forms (read-forms filename package script?)))
    (newline (current-noise-port))	; READ-FORMS prints the filename
    (compile-and-run forms
		     package
		     filename
		     note-undefined?)))

(define (compile-and-run forms package maybe-filename note-undefined?)
  (let ((env (package->environment package)))
    (call-with-values
	(lambda ()
	  (expand-forms env (list (cons maybe-filename forms))))
      (lambda (nodes for-syntax)
	(let* ((uid (package-uid package))
	       (template (compile-forms nodes maybe-filename uid)))
	  (link! template env 0 note-undefined?)
	  (with-load-filename maybe-filename
			      (lambda ()
				(invoke-closure
				 (make-closure template uid)))))))))

(define $load-filename (make-fluid (make-cell #f)))

(define (with-load-filename filename thunk)
  (let-fluid $load-filename (make-cell filename)
	     thunk))

(define (current-load-filename)
  (fluid-cell-ref $load-filename))
