;;       
;; 
;; Utility procedures for manipulating arithmetic expressions. 
;;
;; Copyright 2008-2013 Ivan Raikov and the Okinawa Institute of Science and Technology
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; A full copy of the GPL license can be found at
;; <http://www.gnu.org/licenses/>.
;;


(define symbolic-constants `(false true random.normal random.exponential random.uniform random.poisson))


(define (sexp->value sexp)
  (cond
	((and (pair? sexp) (eq? 'if (car sexp)))
	 (V:Ifv (sexp->value (cadr sexp)) 
		(sexp->value (caddr sexp))
		(sexp->value (cadddr sexp))))
	((and (pair? sexp) (symbol? (car sexp)))
	 (V:Op (car sexp) (map sexp->value (cdr sexp))))
	((number? sexp)
	 (V:C (exact->inexact sexp)))
	((symbol? sexp)
	 (V:Var sexp))
	((null? sexp)
	 (V:Var 'null))
	(else 
	 (error 'sexp->value "invalid value s-expression" sexp)))
  )


(define (function->expr name fd)
  (let ((r (sexp->value (function-body fd))))
    (if (pair? (function-formals fd))
	(B:Val name (V:Fn (function-formals fd) (E:Ret r)))
	(B:Val name r))
    ))

(define (function->expr* name fd)
  (let ((r (sexp->value (function-body fd))))
    (B:Val name (V:Fn (function-formals fd) (E:Ret r)))
    ))


(define (prim->expr name fd)
  (let ((r (sexp->value (prim-body fd))))
    (if (null? (prim-formals fd))
        (B:Val name r)
	(B:Val name (V:Fn (append (prim-formals fd) (lset-difference eq? (prim-states fd) (prim-formals fd))) (E:Ret r)))
	)
    ))

(define (prim->init name fd)
  (let ((r (sexp->value (prim-init fd))))
    (B:Val name r)
    ))


(define (enum-freevars expr bnds ax)
  (cond ((pair? expr)
	 (case (car expr)
	   ((if) (let ((es (cdr expr))) 
		   (fold (lambda (x ax) (enum-freevars x bnds ax)) ax es)))
	   ((let)
	    (let ((lbnds (cadr expr))
		  (body (caddr expr)))
	      (let ((bnds1 (append (map first lbnds) bnds)))
		(enum-freevars body bnds1 
			       (fold (lambda (x ax) (enum-freevars x bnds ax)) ax
				     (map second lbnds))))))
	   (else
	    (let ((s (car expr)) (es (cdr expr)))
	      (if (symbol? s)  (fold (lambda (x ax) (enum-freevars x bnds ax)) ax es) ax)))
	   ))
	(else
	 (let ((id expr))
	   (if (and (symbol? id) (not (member id bnds)))  (cons id ax) ax)))))