;;; Alef Lazily Evaluates Functions
;;; (C) 2008-2009 Dr. Gergo ERDI <http://gergo.erdi.hu/>

(in-package :alef)

(defun native-strict (fun)
  (lambda (&rest args)
    (dolist (arg args)
      (reduce-expr* arg))
    (apply fun args)))

(defmacro define-native/strict (fun-name (&rest args) ((&rest param-types) return-type &key reqs) &body body)
  (declare (ignore reqs)) ; TODO: requirements
  `(progn
     (push (cons ',fun-name (native-strict
                             (lambda (,@args)
                               ,@(if (eql return-type 'bool)                                                  
                                     `((if (progn ,@body) 'true 'false))
                                     body))))
           *native-functions*)
     (setf (gethash ',fun-name *declarations/native*)
           (make-signature '(fun ,@(loop for param-type in param-types collect param-type) ,return-type) ()))))

(defmacro define-native/tunnel (fun-name lisp-name (&rest param-types) return-type &key reqs)
  `(define-native/strict ,fun-name (&rest args) (,param-types ,return-type :reqs ,reqs)
     (apply #',lisp-name (mapcar #'gnode-symbol args))))

(push 'int *types/native*)
(push 'string *types/native*)

(define-native/tunnel +/int + (int int) int)
(define-native/tunnel -/int - (int int) int)
(define-native/tunnel */int * (int int) int)
(define-native/tunnel //int / (int int) int)
(define-native/tunnel mod mod (int int) int)

(define-native/tunnel =/int = (int int) bool)

(define-native/tunnel </int  <  (int int) bool)
(define-native/tunnel <=/int <= (int int) bool)
(define-native/tunnel >=/int >= (int int) bool)
(define-native/tunnel >/int  >  (int int) bool)

(define-native/strict +/string (x y) ((string string) string)
  (with-output-to-string (s)
    (princ (the string (gnode-symbol x)) s)
    (princ (the string (gnode-symbol y)) s)))

(define-native/strict show/int (x) ((int) string)
  (with-output-to-string (s)
    (princ (gnode-symbol x) s)))