(module dotnet_lisp
   (import type_type ast_var ast_node)
   (export (generic compile-lisp e::node)) )

(define-generic (compile-lisp e::node))

(define-method (compile-lisp e::atom)
   (atom-value e) )

(define-method (compile-lisp e::var)
   (let ( (v (var-variable e)) )
      (if (local? v)
	  (variable-name v)
	  (variable-id v) )))

(define-method (compile-lisp e::let-var)
   (with-access::let-var e (bindings body)
      `(let ,(map (lambda (b) (list (local-name (car b))
				    (compile-lisp (cdr b)) ))
		  bindings )
	  ,(compile-lisp body) )))

(define-method (compile-lisp e::setq)
   (with-access::setq e (var value)
      `(setq ,(compile-lisp var) ,(compile-lisp value)) ))

(define-method (compile-lisp e::sequence)
   (with-access::sequence e (nodes)
      `(progn ,@(map compile-lisp nodes)) ))

(define-method (compile-lisp e::conditional)
   (with-access::conditional e (test true false)
      `(if ,(compile-lisp test) ,(compile-lisp true) ,(compile-lisp false)) ))

(define-method (compile-lisp e::select)
   (with-access::select e (test clauses)
      `(selectq
	,@(map (lambda (b) (list (car b) (compile-lisp (cdr b)))) clauses) )))

(define-method (compile-lisp e::let-fun)
   (with-access::let-fun e (locals body)
      `(flet ,(map (lambda (b) (cons (local-name b) (compile-sfun b)))
		  locals )
	  ,(compile-lisp body) )))

(define (compile-sfun v)
   (with-access::local v (value)
      (with-access::sfun value (args body)
	 `(,(map local-name args)
	   ,(compile-lisp body) ))))

(define-method (compile-lisp e::app)
   (with-access::app e (fun args)
      `(,(compile-lisp fun) ,@(map compile-lisp args)) ))

(define-method (compile-lisp e::app-ly)
   (with-access::app-ly e (fun arg)
      `(apply ,(compile-lisp fun) ,(compile-lisp arg)) ))
	  
(define-method (compile-lisp e::funcall)
   (with-access::funcall e (fun args)
      `(funcall ,(compile-lisp fun) ,@(map compile-lisp args)) ))

(define-method (compile-lisp e::getfield)
   `(getfield ,@(map compile-lisp (extern-expr* e))) )

(define-method (compile-lisp e::setfield)
   `(setfield ,@(map compile-lisp (extern-expr* e))) )

(define-method (compile-lisp e::new)
   `(new ,@(map compile-lisp (extern-expr* e))) )

(define-method (compile-lisp e::valloc)
   `(makevector ,@(map compile-lisp (extern-expr* e))) )

(define-method (compile-lisp e::vref)
   `(vref ,@(map compile-lisp (extern-expr* e))) )

(define-method (compile-lisp e::vset!)
   `(vset ,@(map compile-lisp (extern-expr* e))) )

(define-method (compile-lisp e::vlength)
   `(vlength ,@(map compile-lisp (extern-expr* e))) )

(define-method (compile-lisp e::isa)
   `(is? ,(isa-class e) ,@(map compile-lisp (extern-expr* e))) )

(define-method (compile-lisp e::cast)
   (with-access::cast e (arg)
      `(cast ,type ,(compile-lisp arg)) ))

(define-method (compile-lisp e::set-ex-it)
   (with-access::set-ex-it e (var body)
      `(setexit ,(compile-lisp var) ,(compile-lisp body)) ))

(define-method (compile-lisp e::jump-ex-it)
   (with-access::jump-ex-it e (exit value)
      `(throw ,(compile-lisp exit) ,(compile-lisp value)) ))

(define-method (compile-lisp e::fail)
   (with-access::fail e (proc msg obj)
      `(fail ,(compile-lisp proc) ,(compile-lisp msg) ,(compile-lisp obj)) ))

(define-method (compile-lisp e::make-box)
   (with-access::make-box e (value)
      `(make-box ,(compile-lisp value)) ))

(define-method (compile-lisp e::box-ref)
   (with-access::box-ref e (var)
      `(box-ref ,(compile-lisp var)) ))

(define-method (compile-lisp e::box-set!)
   (with-access::box-set! e (var value)
      `(box-set ,(compile-lisp var) ,(compile-lisp value)) ))

      

