;;; print-flic.scm -- printers for FLIC structures
 ;;;
 ;;; author :  Sandra Loosemore
 ;;; date   :  30 Mar 1992
 ;;;
 ;;;
 
 
 ;;; For now, printing of FLIC structures is controlled by the same
 ;;; *print-ast-syntax* variable as for AST structures.
 ;;; Maybe eventually this should use its own variable.
 
 (define-syntax (define-flic-printer type lambda-list . body)
   `(define-ast-printer ,type ,lambda-list ,@body))
 
 (define-flic-printer flic-lambda (object xp)
   (with-ast-block (xp)
     (write-string "\\ " xp)
     (write-ordinary-list (flic-lambda-vars object) xp)
     (write-string " ->" xp)
     (write-whitespace xp)
     (write (flic-lambda-body object) xp)))
 
 (define-flic-printer flic-let (object xp)
   (pprint-logical-block (xp '() "" "")  ; no extra indentation
     (write-string "let " xp)
     (write-layout-rule (flic-let-bindings object) xp
 		       (lambda (v xp)
 		         (with-ast-block (xp)
 		           (write v xp)
 			   (write-string " =" xp)
 			   (write-whitespace xp)
 			   (write (var-value v) xp))))
     (write-whitespace xp)
     (write-string "in " xp)
     (write (flic-let-body object) xp)))
 
 (define-flic-printer flic-app (object xp)
   (with-ast-block (xp)
     (maybe-paren-flic-object (flic-app-fn object) xp)
     (write-whitespace xp)
     (write-flic-list (flic-app-args object) xp)))
 
 (define (maybe-paren-flic-object object xp)
   (cond ((or (flic-ref? object)
 	     (flic-const? object)
 	     (flic-pack? object))
 	 (write object xp))
 	(else
 	 (write-char #\( xp)
 	 (write object xp)
 	 (write-char #\) xp))))
 
 (define (write-flic-list objects xp)
   (write-delimited-list objects xp (function maybe-paren-flic-object) "" "" ""))
 
 (define-flic-printer flic-ref (object xp)
   (write (flic-ref-var object) xp))
 
 (define-flic-printer flic-const (object xp)
   (write (flic-const-value object) xp))
 
 (define-flic-printer flic-pack (object xp)
   (write-string "pack/" xp)
   (write (flic-pack-con object) xp))
 
 (define-flic-printer flic-case-block (object xp)
   (with-ast-block (xp)
     (write-string "case-block " xp)
     (write (flic-case-block-block-name object) xp)
     (write-whitespace xp)
     (write-layout-rule (flic-case-block-exps object) xp (function write))))
 
 (define-flic-printer flic-return-from (object xp)
   (with-ast-block (xp)
     (write-string "return-from " xp)
     (write (flic-return-from-block-name object) xp)
     (write-whitespace xp)
     (write (flic-return-from-exp object) xp)))
 
 (define-flic-printer flic-and (object xp)
   (with-ast-block (xp)
     (write-string "and " xp)
     (write-layout-rule (flic-and-exps object) xp (function write))))
 
 (define-flic-printer flic-if (object xp)
   (with-ast-block (xp)
     (write-string "if " xp)
     (write (flic-if-test-exp object) xp)
     (write-whitespace xp)
     (with-ast-block (xp)
       (write-string "then" xp)
       (write-whitespace xp)
       (write (flic-if-then-exp object) xp))
     (write-whitespace xp)
     (with-ast-block (xp)
       (write-string "else" xp)
       (write-whitespace xp)
       (write (flic-if-else-exp object) xp))
     ))
 
 
 (define-flic-printer flic-sel (object xp)
   (with-ast-block (xp)
     (write-string "sel/" xp)
     (write (flic-sel-con object) xp)
     (write-char #\/ xp)
     (write (flic-sel-i object) xp)
     (write-whitespace xp)
     (write (flic-sel-exp object) xp)))
 
 (define-flic-printer flic-is-constructor (object xp)
   (with-ast-block (xp)
     (write-string "is-constructor/" xp)
     (write (flic-is-constructor-con object) xp)
     (write-whitespace xp)
     (write (flic-is-constructor-exp object) xp)))
 
 (define-flic-printer flic-con-number (object xp)
   (with-ast-block (xp)
     (write-string "con/" xp)
     (write (flic-con-number-type object) xp)
     (write-whitespace xp)
     (write (flic-con-number-exp object) xp)))
 
 (define-flic-printer flic-void (object xp)
   (declare (ignore object))
   (write-string "Void" xp))