;;; dump-flic.scm -- general dump functions for flic structures
 ;;;
 ;;; author :  Sandra Loosemore
 ;;; date   :  24 Feb 1993
 ;;;
 ;;;
 ;;; This stuff is used to write inline expansions to the interface file.
 ;;; 
 
 
 (define-flic-walker dump-flic (object var-renamings))
 
 (define (dump-flic-list objects var-renamings)
   (let ((result  '()))
     (dolist (o objects)
       (push (dump-flic o var-renamings) result))
     `(list ,@(nreverse result))))
 
 (define (dump-flic-top object)
   (dump-flic object '()))
 
 
 (define (make-temp-bindings-for-dump oldvars var-renamings)
   (let ((vars      '())
 	(bindings  '()))
     (dolist (v oldvars)
       (let ((var  (def-name v))
 	    (temp (gensym)))
 	(push temp vars)
 	(push `(,temp (create-temp-var ',var)) bindings)
 	(push (cons v temp) var-renamings)))
     (setf bindings (nreverse bindings))
     (setf vars (nreverse vars))
     (values vars bindings var-renamings)))
 
 (define-dump-flic flic-lambda (object var-renamings)
   (multiple-value-bind (vars bindings var-renamings)
       (make-temp-bindings-for-dump (flic-lambda-vars object) var-renamings)
     `(let ,bindings
        (make-flic-lambda
 	 (list ,@vars)
 	 ,(dump-flic (flic-lambda-body object) var-renamings)))
     ))
 
 (define-dump-flic flic-let (object var-renamings)
   (multiple-value-bind (vars bindings var-renamings)
       (make-temp-bindings-for-dump (flic-let-bindings object) var-renamings)
     `(let ,bindings
        ,@(map (lambda (temp v)
 		`(setf (var-value ,temp)
 		       ,(dump-flic (var-value v) var-renamings)))
 	      vars
 	      (flic-let-bindings object))
        (make-flic-let
 	 (list ,@vars)
 	 ,(dump-flic (flic-let-body object) var-renamings)
 	 ',(flic-let-recursive? object)))
     ))
 
 (define-dump-flic flic-app (object var-renamings)
   `(make-flic-app
      ,(dump-flic (flic-app-fn object) var-renamings)
      ,(dump-flic-list (flic-app-args object) var-renamings)
      ',(flic-app-saturated? object)))
 
 (define-dump-flic flic-ref (object var-renamings)
   (let* ((var    (flic-ref-var object))
 	 (entry  (assq var var-renamings)))
     (if entry
 	`(make-flic-ref ,(cdr entry))
 	`(make-flic-ref ,(dump-object var)))))
 
 (define-dump-flic flic-const (object var-renamings)
   (declare (ignore var-renamings))
   `(make-flic-const ',(flic-const-value object)))
 
 (define-dump-flic flic-pack (object var-renamings)
   (declare (ignore var-renamings))
   `(make-flic-pack ,(dump-object (flic-pack-con object))))
 
 (define-dump-flic flic-case-block (object var-renamings)
   `(make-flic-case-block
      ',(flic-case-block-block-name object)
      ,(dump-flic-list (flic-case-block-exps object) var-renamings)))
 
 (define-dump-flic flic-return-from (object var-renamings)
   `(make-flic-return-from
      ',(flic-return-from-block-name object)
      ,(dump-flic (flic-return-from-exp object) var-renamings)))
 
 (define-dump-flic flic-and (object var-renamings)
   `(make-flic-and
      ,(dump-flic-list (flic-and-exps object) var-renamings)))
 
 (define-dump-flic flic-if (object var-renamings)
   `(make-flic-if
      ,(dump-flic (flic-if-test-exp object) var-renamings)
      ,(dump-flic (flic-if-then-exp object) var-renamings)
      ,(dump-flic (flic-if-else-exp object) var-renamings)))
 
 (define-dump-flic flic-sel (object var-renamings)
   `(make-flic-sel
      ,(dump-object (flic-sel-con object))
      ,(flic-sel-i object)
      ,(dump-flic (flic-sel-exp object) var-renamings)))
 
 (define-dump-flic flic-is-constructor (object var-renamings)
   `(make-flic-is-constructor
      ,(dump-object (flic-is-constructor-con object))
      ,(dump-flic (flic-is-constructor-exp object) var-renamings)))
 
 (define-dump-flic flic-con-number (object var-renamings)
   `(make-flic-con-number
      ,(dump-object (flic-con-number-type object))
      ,(dump-flic (flic-con-number-exp object) var-renamings)))
 
 (define-dump-flic flic-void (object var-renamings)
   (declare (ignore object var-renamings))
   `(make-flic-void))