;;; ndsc-top.scm
;;; Copyright Henry S. Thompson 1996
;;; Alpha version 0.7, not for onward distribution

;;; Produced at HCRC, Edinburgh with support for the UK Economic and Social
;;;  Research Council and SunSoft

;;; Driver for dsssl code walker etc. for ndsc use
;;; Last edited: Tue Nov  5 13:20:34 1996

(set! garbage-collect-notify? #f)

(map load '("dsssl-compat.scm" "dsssl-utils.scm" "dsssl.scm"
	    "dsssl-templates.scm"))

(define spec-sequence
  ;; a properly ordered list of specs for evaluation
  '())

(define dsc
  (lambda (infile lport debug? fu?)
    (set! spec-sequence '())
    (let ((res #f)
	  (out-fn (if debug? (lambda (x)
			       (set! spec-sequence
				      (tconc spec-sequence x))
			       (display ";;; ")
			       (write (cdr x))
			       (newline)
			       (write (car x))
			       (newline))
		    (lambda (x) (set! spec-sequence
				      (tconc spec-sequence x))))))
      (set! log-port lport)
      (set! res (read-spec infile (not fu?) out-fn))
      (if (pair? spec-sequence)(set! spec-sequence (car spec-sequence))))))

(define current-root
  ;; snl
  #f)

(define dodsssl
  (lambda (topnode spec-type debug?)
    (set! current-root topnode)
    (begin (load "quantity.scm")
	   (load "toplevel.scm")
	   (load "prim.scm")
	   (load "style.scm")
	   (load "transform.scm")
	   (load "redefs.scm")		; must be next-to-last
	   (load "init-dsssl.scm")	; must follow redefs
	   ;; demo version
	   (display ">>> Evaluating specification ")
	   (if debug? (begin (display "<<<")
			     (newline))
	     (display ". . ."))
	   ;; framework copied from top-level
	   (let ((te (the-environment)))
		   ;;; Allow GC to free old rep-frames when we get here on reset
	     (set! rep-frames (list top-level-control-point))
	     (if (pair? spec-sequence)
		 (call-with-current-continuation
		  (lambda (control-point)
		    (set! rep-frames (list control-point))
		    (set! top-level-control-point control-point)
		    (set! rep-level 0)
		    (map (lambda (x)
			   (if debug? (print (car x)))
			   (eval (car x) te))
			 spec-sequence)
		    ;; should now call transform or style
		    #f)))
	     (if debug? (display ">>> Finished evaluating specification <<<")
	       (display " done."))
	     (newline)
	     (set! *d!repping* #t)
	     (let loop ()
		  (if
		      (call-with-current-continuation
		       (lambda (control-point)
			 (set! rep-frames (list control-point))
			 (set! top-level-control-point control-point)
			 (set! rep-level 0)
			 (rep-loop te)
			 #f))
		      (loop)))
	     (newline)))))
