;*=====================================================================*/
*     serrano / prgm / project / bigloo /  / comptime / Ast / node.scm          * /
;*    -------------------------------------------------------------    */
*     Author       :                                         * /
*     Creation     :   Thu May 30 16:14:41 1996                           * /
*     Last change :   Mon Jun 27 09:57:10 2022 ( serrano )                 * /
;*    -------------------------------------------------------------    */
;*    The ast's node class definition                                  */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    The module                                                       */
;*---------------------------------------------------------------------*/
(module ast_node
   
   (import type_type
	   ast_var)

   (include "Ast/nodetype.sch")
   
   (export (class node::object
	      ;; the location 
	      (loc::obj read-only (default #f))
	      ;; the type of node, for var node this has a special meaning.
  for variables ( instances of the class VAR ) , the type field
	      ;; of the node might differ from the type of the variable
	      ;; because dataflow analysis may have found that the reference
	      ;; at a particular site may has a more precise type than the
	      ;; general variable reference type. For instance, for an
	      ;; expression such as
	      ;; (let ((x::obj EXP))
	      ;;    (if (pair? x) THEN ELSE))
	      ;; in the THEN part, the type of the var node might be ::pair
	      ;; while the type of X is ::obj
	      type::type)

	   (class node/effect::node
	      ;; a side effect field
	      (side-effect (default #unspecified))
  a key for set manipulation ( exclusively used by the cfa
	      ;; but to avoid wasting time in node-key this field
	      ;; is in the global tree)
	      (key (default -1)))

	   ;; the atom node
	   (abstract-class atom::node
	      ;; the atom value
	      value::obj)

	   ;; the literal node
	   (final-class literal::atom)
	   
	   ;; the patch node (patchable literals)
	   (final-class patch::atom
	      (ref::var read-only)
	      (index::long (default -1))
	      (patchid::obj (default #unspecified)))

	   ;; the variables node
	   (abstract-class var::node
	      ;; the variable
	      variable::variable)

	   (final-class ref::var)
	   (final-class closure::var)

	   ;; the literal node
	   (final-class kwote::node
	      ;; its value
	      (value::obj read-only))

	   ;; the sequence node
	   (final-class sequence::node/effect
	      (nodes::pair-nil read-only)
	      (unsafe::bool read-only (default #f))
	      (meta::pair-nil read-only (default '())))

	   ;; the application node
	   (final-class app::node/effect
	      ;; the called function
	      fun::var
	      ;; the actuals of the call
	      args
	      ;; can this call be replaced with an equiv. stack allocation
	      (stackable (default #f)))

	   ;; the apply construction node
	   (final-class app-ly::node
	      ;; the called function
	      fun::node
	      ;; and the argument (multiple apply are expanded)
	      arg::node)

	   ;; the computed functional application node
	   (final-class funcall::node
	      ;; the called function
	      fun::node
	      ;; the actuals
	      args
  the strength ( set by the cfa pass )
  should be ? ? ? , LIGHT or 
	      (strength::symbol (default '???))
	      ;; the list of potentially called functions
	      (functions::obj (default #unspecified)))
	   
	   ;; the extern class that describes all the primitive constructions
	   (class extern::node/effect
	      ;; the parameters of the extern form
	      (expr*::pair-nil (default '()))
	      ;; the effect of this extern expression
	      (effect (default #unspecified)))
	      
	   ;; the pragma node
	   (final-class pragma::extern
	      (format::bstring read-only))

	   ;; getpatchid node
	   (final-class genpatchid::extern
	      (index::long (default -1))
	      (rindex::long (default -1)))
	   
	   ;; private extern expression
	   (class private::extern
	      (c-format::bstring read-only))
	   
	   ;; the object field read and write
	   (final-class getfield::private
	      ;; the name of the field
	      (fname::bstring read-only)
	      ;; the type of the field
	      ftype::type
	      ;; the type the field belongs to (i.e., the class)
	      otype::type)

	   ;; the object field read and write
	   (final-class setfield::private
	      ;; the name of the field
	      (fname::bstring read-only)
	      ;; the type of the field
	      ftype::type
	      ;; the type the field belongs to (i.e., the class)
	      otype::type)

	   ;; wide chunk access
  MS CARE 16nov2011 ( not used yet )
	   (final-class widening::private
	      otype::type)

	   ;; extern object creation
	   (final-class new::private
	      (args-type::pair-nil (default '())))

	   ;; extern vector object creation
	   (final-class valloc::private
	      ;; the vector fields type
	      ftype::type
	      ;; the type of the dimension
	      otype::type)

	   ;; vector reference
	   (final-class vref::private
	      ;; the vector fields type
	      ftype::type
	      ;; the type of the offset
	      otype::type
	      ;; the type of the vector
	      vtype::type
	      ;; unsafe
	      (unsafe::bool read-only (default #f)))

	   ;; vector mutation
	   (final-class vset!::private
	      ;; the vector fields type
	      ftype::type
	      ;; the type of the offset
	      otype::type
	      ;; the type of the vector
	      vtype::type
	      ;; unsafe
	      (unsafe::bool read-only (default #f)))

	   ;; vector length
	   (final-class vlength::private
	      ;; the type of the vector
	      vtype::type
	      ;; the vector fields type
	      (ftype read-only))
	   
	   ;; extern predicate
	   (final-class instanceof::private
	      class::type)
	      
	   ;; the null node
	   (final-class cast-null::private)

	   ;; the cast node
	   (final-class cast::node
	      ;; the casted node. 
	      arg::node)

	   ;; the affections
	   (final-class setq::node
	      ;; the setted variable
	      var::var
	      ;; and the value
	      value::node)

	   ;; conditionals
	   (final-class conditional::node/effect
	      ;; the test
	      test::node
	      ;; the `then'
	      true::node
	      ;; the `else'
	      false::node)

	   ;; the failure
	   (final-class fail::node
  the 3 failures arguments
	      proc::node
	      msg::node
	      obj::node)

	   ;; the `case' constructions
	   (final-class switch::node/effect
	      ;; the test of the switch
	      test::node
	      ;; the clauses
	      (clauses::obj read-only)
	      ;; item types
	      item-type::type)

	   ;; the labels constructions
	   (final-class let-fun::node/effect
	      ;; a list of locals variables
	      locals::obj
	      ;; the body of the labels
	      body::node)

	   ;; the let-var constructions
	   (final-class let-var::node/effect
	      ;; a list of bindings
	      bindings::obj
	      ;; the body
	      body::node
	      ;; is this let removable?
	      (removable?::bool (default #t)))

	   ;; the set-exit construction
	   (final-class set-ex-it::node
	      ;; the variable of the set-exit
	      var::var
	      ;; and the body
	      body::node
	      ;; onexit
	      onexit::node)

	   ;; the jump-exit construction
	   (final-class jump-ex-it::node
	      ;; the variable of the jump-exit
	      exit::node
	      ;; the value
	      value::node)

	   ;; retblock (for breaks, continues, and explicit returns)
	   (final-class retblock::node
	      body::node)
	   
	   ;; return node
	   (final-class return::node
	      ;; the expression of the return node
	      block::retblock
	      value::node)

	   ;; the make-box construction
	   (final-class make-box::node/effect
	      value::node
	      vtype::type
	      ;; can this box allocated on the stack
	      (stackable (default #f)))

	   ;; the box-ref
	   (final-class box-ref::node/effect
	      var::var
	      vtype::type)

	   ;; the box-set!
	   (final-class box-set!::node
	      var::var
	      value::node
	      vtype::type)

	   ;; synchronization
	   (final-class sync::node
	      mutex::node
	      prelock::node
	      body::node)
	   
	   (strict-node-type::type ::type ::type)
	   (generic node-walk ::node ::procedure)))

;*---------------------------------------------------------------------*/
;*    strict-node-type ...                                             */
;*---------------------------------------------------------------------*/
(define (strict-node-type t1 t2)
   t1)

;*---------------------------------------------------------------------*/
;*    node-walk ...                                                    */
;*---------------------------------------------------------------------*/
(define-generic (node-walk node::node proc::procedure))

;*---------------------------------------------------------------------*/
;*    node-walk ::atom ...                                             */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::atom proc::procedure)
   (proc node))
 
;*---------------------------------------------------------------------*/
;*    node-walk ::var ...                                              */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::var proc::procedure)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::kwote ...                                            */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::kwote proc::procedure)
   (proc node))
       
;*---------------------------------------------------------------------*/
;*    node-walk ::sequence ...                                         */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::sequence proc::procedure)
   (node-walk* (sequence-nodes node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::sync ...                                             */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::sync proc::procedure)
   (node-walk (sync-mutex node) proc)
   (node-walk (sync-prelock node) proc)
   (node-walk (sync-body node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::app ...                                              */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::app proc::procedure)
   (node-walk (app-fun node) proc)
   (node-walk* (app-args node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::app-ly ...                                           */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::app-ly proc::procedure)
   (node-walk (app-ly-fun node) proc)
   (node-walk (app-ly-arg node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::funcall ...                                          */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::funcall proc::procedure)
   (node-walk (funcall-fun node) proc)
   (node-walk* (funcall-args node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::extern ...                                           */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::extern proc::procedure)
   (node-walk* (extern-expr* node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::cast ...                                             */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::cast proc::procedure)
   (node-walk (cast-arg node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::setq ...                                             */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::setq proc::procedure)
   (node-walk (setq-value node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::conditional ...                                      */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::conditional proc::procedure)
   (node-walk (conditional-test node) proc)
   (node-walk (conditional-true node) proc)
   (node-walk (conditional-false node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::fail ...                                             */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::fail proc::procedure)
   (node-walk (fail-proc node) proc)
   (node-walk (fail-msg node) proc)
   (node-walk (fail-obj node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::switch ...                                           */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::switch proc::procedure)
   (node-walk (switch-test node) proc)
   (for-each (lambda (clause)
		(node-walk (cdr clause) proc))
	     (switch-clauses node))
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::make-box ...                                         */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::make-box proc::procedure)
   (node-walk (make-box-value node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::box-ref ...                                          */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::box-ref proc::procedure)
   (node-walk (box-ref-var node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::box-set! ...                                         */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::box-set! proc::procedure)
   (node-walk (box-set!-var node) proc)
   (node-walk (box-set!-value node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::let-fun ...                                          */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::let-fun proc::procedure)
   (with-access::let-fun node (locals body)
      (node-walk body proc)
      (for-each (lambda (local)
		   (let ((sfun (local-value local)))
		      (node-walk (sfun-body sfun) proc)))
		locals)
      (proc node)))

;*---------------------------------------------------------------------*/
;*    node-walk ::let-var ...                                          */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::let-var proc::procedure)
   (with-access::let-var node (bindings body)
      (node-walk body proc)
      (for-each (lambda (binding)
		   (node-walk (cdr binding) proc))
		bindings)
      (proc node)))

;*---------------------------------------------------------------------*/
;*    node-walk ::set-ex-it ...                                        */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::set-ex-it proc::procedure)
   (node-walk (set-ex-it-body node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk ::jump-ex-it ...                                       */
;*---------------------------------------------------------------------*/
(define-method (node-walk node::jump-ex-it proc::procedure)
   (node-walk (jump-ex-it-exit node) proc)
   (node-walk (jump-ex-it-value node) proc)
   (proc node))

;*---------------------------------------------------------------------*/
;*    node-walk* ...                                                   */
;*---------------------------------------------------------------------*/
(define (node-walk* node* proc::procedure)
   (for-each (lambda (node) (node-walk node proc)) node*))

	      

	   
	   

*=====================================================================*/
*    -------------------------------------------------------------    */
*    -------------------------------------------------------------    */
*    The ast's node class definition                                  */
*=====================================================================*/
*---------------------------------------------------------------------*/
*    The module                                                       */
*---------------------------------------------------------------------*/
 the location 
 the type of node, for var node this has a special meaning.
 of the node might differ from the type of the variable
 because dataflow analysis may have found that the reference
 at a particular site may has a more precise type than the
 general variable reference type. For instance, for an
 expression such as
 (let ((x::obj EXP))
    (if (pair? x) THEN ELSE))
 in the THEN part, the type of the var node might be ::pair
 while the type of X is ::obj
 a side effect field
 but to avoid wasting time in node-key this field
 is in the global tree)
 the atom node
 the atom value
 the literal node
 the patch node (patchable literals)
 the variables node
 the variable
 the literal node
 its value
 the sequence node
 the application node
 the called function
 the actuals of the call
 can this call be replaced with an equiv. stack allocation
 the apply construction node
 the called function
 and the argument (multiple apply are expanded)
 the computed functional application node
 the called function
 the actuals
 the list of potentially called functions
 the extern class that describes all the primitive constructions
 the parameters of the extern form
 the effect of this extern expression
 the pragma node
 getpatchid node
 private extern expression
 the object field read and write
 the name of the field
 the type of the field
 the type the field belongs to (i.e., the class)
 the object field read and write
 the name of the field
 the type of the field
 the type the field belongs to (i.e., the class)
 wide chunk access
 extern object creation
 extern vector object creation
 the vector fields type
 the type of the dimension
 vector reference
 the vector fields type
 the type of the offset
 the type of the vector
 unsafe
 vector mutation
 the vector fields type
 the type of the offset
 the type of the vector
 unsafe
 vector length
 the type of the vector
 the vector fields type
 extern predicate
 the null node
 the cast node
 the casted node. 
 the affections
 the setted variable
 and the value
 conditionals
 the test
 the `then'
 the `else'
 the failure
 the `case' constructions
 the test of the switch
 the clauses
 item types
 the labels constructions
 a list of locals variables
 the body of the labels
 the let-var constructions
 a list of bindings
 the body
 is this let removable?
 the set-exit construction
 the variable of the set-exit
 and the body
 onexit
 the jump-exit construction
 the variable of the jump-exit
 the value
 retblock (for breaks, continues, and explicit returns)
 return node
 the expression of the return node
 the make-box construction
 can this box allocated on the stack
 the box-ref
 the box-set!
 synchronization
*---------------------------------------------------------------------*/
*    strict-node-type ...                                             */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ...                                                    */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::atom ...                                             */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::var ...                                              */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::kwote ...                                            */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::sequence ...                                         */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::sync ...                                             */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::app ...                                              */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::app-ly ...                                           */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::funcall ...                                          */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::extern ...                                           */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::cast ...                                             */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::setq ...                                             */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::conditional ...                                      */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::fail ...                                             */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::switch ...                                           */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::make-box ...                                         */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::box-ref ...                                          */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::box-set! ...                                         */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::let-fun ...                                          */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::let-var ...                                          */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::set-ex-it ...                                        */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk ::jump-ex-it ...                                       */
*---------------------------------------------------------------------*/
*---------------------------------------------------------------------*/
*    node-walk* ...                                                   */
*---------------------------------------------------------------------*/
*     serrano / prgm / project / bigloo /  / comptime / Ast / node.scm          * /
*     Author       :                                         * /
*     Creation     :   Thu May 30 16:14:41 1996                           * /
*     Last change :   Mon Jun 27 09:57:10 2022 ( serrano )                 * /

(module ast_node
   
   (import type_type
	   ast_var)

   (include "Ast/nodetype.sch")
   
   (export (class node::object
	      (loc::obj read-only (default #f))
  for variables ( instances of the class VAR ) , the type field
	      type::type)

	   (class node/effect::node
	      (side-effect (default #unspecified))
  a key for set manipulation ( exclusively used by the cfa
	      (key (default -1)))

	   (abstract-class atom::node
	      value::obj)

	   (final-class literal::atom)
	   
	   (final-class patch::atom
	      (ref::var read-only)
	      (index::long (default -1))
	      (patchid::obj (default #unspecified)))

	   (abstract-class var::node
	      variable::variable)

	   (final-class ref::var)
	   (final-class closure::var)

	   (final-class kwote::node
	      (value::obj read-only))

	   (final-class sequence::node/effect
	      (nodes::pair-nil read-only)
	      (unsafe::bool read-only (default #f))
	      (meta::pair-nil read-only (default '())))

	   (final-class app::node/effect
	      fun::var
	      args
	      (stackable (default #f)))

	   (final-class app-ly::node
	      fun::node
	      arg::node)

	   (final-class funcall::node
	      fun::node
	      args
  the strength ( set by the cfa pass )
  should be ? ? ? , LIGHT or 
	      (strength::symbol (default '???))
	      (functions::obj (default #unspecified)))
	   
	   (class extern::node/effect
	      (expr*::pair-nil (default '()))
	      (effect (default #unspecified)))
	      
	   (final-class pragma::extern
	      (format::bstring read-only))

	   (final-class genpatchid::extern
	      (index::long (default -1))
	      (rindex::long (default -1)))
	   
	   (class private::extern
	      (c-format::bstring read-only))
	   
	   (final-class getfield::private
	      (fname::bstring read-only)
	      ftype::type
	      otype::type)

	   (final-class setfield::private
	      (fname::bstring read-only)
	      ftype::type
	      otype::type)

  MS CARE 16nov2011 ( not used yet )
	   (final-class widening::private
	      otype::type)

	   (final-class new::private
	      (args-type::pair-nil (default '())))

	   (final-class valloc::private
	      ftype::type
	      otype::type)

	   (final-class vref::private
	      ftype::type
	      otype::type
	      vtype::type
	      (unsafe::bool read-only (default #f)))

	   (final-class vset!::private
	      ftype::type
	      otype::type
	      vtype::type
	      (unsafe::bool read-only (default #f)))

	   (final-class vlength::private
	      vtype::type
	      (ftype read-only))
	   
	   (final-class instanceof::private
	      class::type)
	      
	   (final-class cast-null::private)

	   (final-class cast::node
	      arg::node)

	   (final-class setq::node
	      var::var
	      value::node)

	   (final-class conditional::node/effect
	      test::node
	      true::node
	      false::node)

	   (final-class fail::node
  the 3 failures arguments
	      proc::node
	      msg::node
	      obj::node)

	   (final-class switch::node/effect
	      test::node
	      (clauses::obj read-only)
	      item-type::type)

	   (final-class let-fun::node/effect
	      locals::obj
	      body::node)

	   (final-class let-var::node/effect
	      bindings::obj
	      body::node
	      (removable?::bool (default #t)))

	   (final-class set-ex-it::node
	      var::var
	      body::node
	      onexit::node)

	   (final-class jump-ex-it::node
	      exit::node
	      value::node)

	   (final-class retblock::node
	      body::node)
	   
	   (final-class return::node
	      block::retblock
	      value::node)

	   (final-class make-box::node/effect
	      value::node
	      vtype::type
	      (stackable (default #f)))

	   (final-class box-ref::node/effect
	      var::var
	      vtype::type)

	   (final-class box-set!::node
	      var::var
	      value::node
	      vtype::type)

	   (final-class sync::node
	      mutex::node
	      prelock::node
	      body::node)
	   
	   (strict-node-type::type ::type ::type)
	   (generic node-walk ::node ::procedure)))

(define (strict-node-type t1 t2)
   t1)

(define-generic (node-walk node::node proc::procedure))

(define-method (node-walk node::atom proc::procedure)
   (proc node))
 
(define-method (node-walk node::var proc::procedure)
   (proc node))

(define-method (node-walk node::kwote proc::procedure)
   (proc node))
       
(define-method (node-walk node::sequence proc::procedure)
   (node-walk* (sequence-nodes node) proc)
   (proc node))

(define-method (node-walk node::sync proc::procedure)
   (node-walk (sync-mutex node) proc)
   (node-walk (sync-prelock node) proc)
   (node-walk (sync-body node) proc)
   (proc node))

(define-method (node-walk node::app proc::procedure)
   (node-walk (app-fun node) proc)
   (node-walk* (app-args node) proc)
   (proc node))

(define-method (node-walk node::app-ly proc::procedure)
   (node-walk (app-ly-fun node) proc)
   (node-walk (app-ly-arg node) proc)
   (proc node))

(define-method (node-walk node::funcall proc::procedure)
   (node-walk (funcall-fun node) proc)
   (node-walk* (funcall-args node) proc)
   (proc node))

(define-method (node-walk node::extern proc::procedure)
   (node-walk* (extern-expr* node) proc)
   (proc node))

(define-method (node-walk node::cast proc::procedure)
   (node-walk (cast-arg node) proc)
   (proc node))

(define-method (node-walk node::setq proc::procedure)
   (node-walk (setq-value node) proc)
   (proc node))

(define-method (node-walk node::conditional proc::procedure)
   (node-walk (conditional-test node) proc)
   (node-walk (conditional-true node) proc)
   (node-walk (conditional-false node) proc)
   (proc node))

(define-method (node-walk node::fail proc::procedure)
   (node-walk (fail-proc node) proc)
   (node-walk (fail-msg node) proc)
   (node-walk (fail-obj node) proc)
   (proc node))

(define-method (node-walk node::switch proc::procedure)
   (node-walk (switch-test node) proc)
   (for-each (lambda (clause)
		(node-walk (cdr clause) proc))
	     (switch-clauses node))
   (proc node))

(define-method (node-walk node::make-box proc::procedure)
   (node-walk (make-box-value node) proc)
   (proc node))

(define-method (node-walk node::box-ref proc::procedure)
   (node-walk (box-ref-var node) proc)
   (proc node))

(define-method (node-walk node::box-set! proc::procedure)
   (node-walk (box-set!-var node) proc)
   (node-walk (box-set!-value node) proc)
   (proc node))

(define-method (node-walk node::let-fun proc::procedure)
   (with-access::let-fun node (locals body)
      (node-walk body proc)
      (for-each (lambda (local)
		   (let ((sfun (local-value local)))
		      (node-walk (sfun-body sfun) proc)))
		locals)
      (proc node)))

(define-method (node-walk node::let-var proc::procedure)
   (with-access::let-var node (bindings body)
      (node-walk body proc)
      (for-each (lambda (binding)
		   (node-walk (cdr binding) proc))
		bindings)
      (proc node)))

(define-method (node-walk node::set-ex-it proc::procedure)
   (node-walk (set-ex-it-body node) proc)
   (proc node))

(define-method (node-walk node::jump-ex-it proc::procedure)
   (node-walk (jump-ex-it-exit node) proc)
   (node-walk (jump-ex-it-value node) proc)
   (proc node))

(define (node-walk* node* proc::procedure)
   (for-each (lambda (node) (node-walk node proc)) node*))

	      

	   
	   
