;; Compile a node as a predicate
(module jvm_predicate
   (import type_type ast_var ast_node
	   object_class      ; tclass
	   jvm_env jvm_instr jvm_expr jvm_effect jvm_compiler jvm_inline )
   (export (generic compile-predicate e::node t::symbol f::symbol env::env)) )

;; When we don't know how to do the job.
(define (default e::node t::symbol f::symbol env::env)
   (compile-expr e env)
   (_if 'eq env f)
   ;; Except for (if (if ..) ..) t will follow and goto is auto removed
   (_goto env t) )

;; When we know that a node cannot respond "false"
(define (direct e::node t::symbol env::env)
   (compile-effect e env)
   ;; Except for (if (if ..) ..) t will follow and goto is auto removed
   (_goto env t) )

(define-generic (compile-predicate e::node t::symbol f::symbol env::env))

(define-method (compile-predicate e::atom t::symbol f::symbol env::env)
   (with-access::atom e (value)
      (if (or (and (fixnum? value) (=fx value 0))
	      (and (boolean? value) (eq? value #f)) )
	  (_goto env f)
	  (_goto env t) )))

(define-method (compile-predicate e::var t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::let-var t::symbol f::symbol env::env)
   (define (comp e env) (compile-predicate e t f env))
   (compiler-let e env comp) )

(define-method (compile-predicate e::setq t::symbol f::symbol env::env)
   (direct e t env) )

(define-method (compile-predicate e::sequence t::symbol f::symbol env::env)
   (define (comp e env) (compile-predicate e t f env))
   (compiler-sequence e env comp) )

(define-method (compile-predicate e::conditional t::symbol f::symbol env::env)
   (define (comp e env) (compile-predicate e t f env))
   (compiler-if e env comp) )

(define-method (compile-predicate e::select t::symbol f::symbol env::env)
   (define (comp e env) (compile-predicate e t f env))
   (compiler-select e env comp) )

(define-method (compile-predicate e::let-fun t::symbol f::symbol env::env)
   (define (comp e env) (compile-predicate e t f env))
   (compiler-labels e env comp) )

(define-method (compile-predicate e::app t::symbol f::symbol env::env)
   (with-access::app e (fun args)
      (let ( (v (var-variable fun)) )
	 (if (and (global? v) (inline-pred? v args t f env))
	     'ok
	     (default e t f env) ))))

(define-method (compile-predicate e::app-ly t::symbol f::symbol env::env)
   (default e t f env) )
	  
(define-method (compile-predicate e::funcall t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::pragma t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::getfield t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::setfield t::symbol f::symbol env::env)
   (direct e t env) )

(define-method (compile-predicate e::new t::symbol f::symbol env::env)
   (direct e t env) )

(define-method (compile-predicate e::valloc t::symbol f::symbol env::env)
   (direct e t env) )

(define-method (compile-predicate e::vref t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::vset! t::symbol f::symbol env::env)
   (direct e t env) )

(define-method (compile-predicate e::vlength t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::isa t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::cast t::symbol f::symbol env::env)
   (define (comp e env) (compile-predicate e t f env))
   (compiler-cast e env comp) )

(define-method (compile-predicate e::set-ex-it t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::jump-ex-it t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::fail t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::make-box t::symbol f::symbol env::env)
   (direct e t env) )

(define-method (compile-predicate e::box-ref t::symbol f::symbol env::env)
   (default e t f env) )

(define-method (compile-predicate e::box-set! t::symbol f::symbol env::env)
   (direct e t env) )
      
