;;; main.scm -- main entry point for CFN pass
 ;;;
 ;;; author :  Sandra Loosemore
 ;;; date   :  27 Feb 1992
 ;;;
 
 
 ;;;===================================================================
 ;;; Basic support
 ;;;===================================================================
 
 
 ;;; Define the basic walker and some helper functions.
 
 (define-walker cfn ast-td-cfn-walker)
 
 (define (cfn-ast-1 x)
   (call-walker cfn x))
 
 (define (cfn-ast/list l)
   (map (lambda (x) (cfn-ast-1 x)) l))
 
 
 ;;; This is the main entry point.  It is called by the driver on
 ;;; each top-level decl in the module.
 
 (define (cfn-ast x)
   (let ((result  (cfn-ast-1 x)))
 ;    (pprint result)  ;*** debug
     result))
 
 
 
 ;;;===================================================================
 ;;; Default traversal methods
 ;;;===================================================================
 
 
 (define-local-syntax (make-cfn-code slot type)
   (let ((stype  (sd-type slot))
         (sname  (sd-name slot)))
     (cond ((and (symbol? stype)
                 (or (eq? stype 'exp)
                     (subtype? stype 'exp)))
            `(setf (struct-slot ',type ',sname object)
                   (cfn-ast-1 (struct-slot ',type ',sname object))))
           ((and (pair? stype)
                 (eq? (car stype) 'list)
                 (symbol? (cadr stype))
                 (or (eq? (cadr stype) 'exp)
                     (subtype? (cadr stype) 'exp)))
            `(setf (struct-slot ',type ',sname object)
                   (cfn-ast/list (struct-slot ',type ',sname object))))
           ((and (pair? stype)
                 (eq? (car stype) 'list)
                 (eq? (cadr stype) 'decl))
            `(setf (struct-slot ',type ',sname object)
                   (cfn-valdef-list (struct-slot ',type ',sname object))))
           (else
 ;          (format '#t "Cfn: skipping slot ~A in ~A~%"
 ;                  (sd-name slot)
 ;                  type)
            '#f))))
 
 (define-modify-walker-methods cfn
   (let if
    exp-sign
    app
    var-ref con-ref
    integer-const float-const char-const string-const
    con-number sel is-constructor
    void
    case-block return-from and-exp
    )
   (object)
   make-cfn-code)
 
 
 ;;; These have specialized walkers:
 ;;; lambda, case, valdef, list-comp  (pattern.scm)
 ;;; list-exp, list-comp, section-l, section-r, dict-placeholder,
 ;;; recursive-placeholder, save-old-exp (misc.scm)