;;;; Lisp procedures for c:\qrg\FIRE\V1\evalfns.lsp
;;;; Automatically generated 6/1/2004, 0:7:50.
;;;; PLEASE DO NOT MANUALLY EDIT.

(in-package :data)


;;; Lisp procedure for implementing LengthOfListFn
(defun LengthOfListFn-3295055270 (?list)
  (if (and (listp ?list) (eql (car ?list) 'TheList)
           (listp (cdr ?list)))
      (1- (length ?list))
    :eval-error))

;;; Lisp procedure for implementing CardinalityFn
(defun CardinalityFn-3295055270 (?list)
  (if (and (listp ?list) (eql (car ?list) 'TheSet))
      (1- (length ?list))
    :eval-error))

;;; Lisp procedure for implementing ListFn
(defun ListFn-3295055270 (&rest ?arglist) `(TheList ,@?arglist))

;;; Lisp procedure for implementing MemberFn
(defun MemberFn-3295055270 (?elt ?lst)
  (if (and (or (eql (car ?lst) 'TheList) (eql (car ?lst) 'TheSet))
           (listp ?lst) (listp (cdr ?lst)))
      (if (member ?elt (cdr ?lst)) t nil)
    :eval-error))

;;; Lisp procedure for implementing SublistFromToFn
(defun SublistFromToFn-3295055270 (?list ?from ?to)
  (if (or (not (integerp ?from)) (not (integerp ?to))
          (not (listp ?list)) (> ?from ?to)
          (> ?from (- (length ?list) 1))
          (not (eql (car ?list) 'TheList)))
      :eval-error
    `(TheList ,@(subseq (cdr ?list) (- ?from 1) ?to))))

;;; Lisp procedure for implementing NthInListFn
(defun NthInListFn-3295055270 (?n ?list)
  (if (eql (car ?list) 'TheList)
      (nth (- ?n 1) (cdr ?list))
    :eval-error))

;;; Lisp procedure for implementing TheList
(defun TheList-3295055270 (&rest ?arglist)
  (values `(TheList ,@?arglist)))

;;; Lisp procedure for implementing TheSet
(defun TheSet-3295055270 (&rest ?arglist)
  (values `(TheSet ,@(remove-duplicates ?arglist :test 'equal))))

;;; Lisp procedure for implementing PlusFn
(defun PlusFn-3295055270 (&rest ?arglist)
  (if (and (listp ?arglist) (every #'numberp ?arglist))
      (apply #'+ ?arglist)
    :eval-error))

;;; Lisp procedure for implementing TimesFn
(defun TimesFn-3295055270 (&rest ?arglist)
  (if (and (listp ?arglist) (every #'numberp ?arglist))
      (apply #'* ?arglist)
    :eval-error))

;;; Lisp procedure for implementing DifferenceFn
(defun DifferenceFn-3295055270 (?minuend ?subtrahend)
  (if (and (numberp ?minuend) (numberp ?subtrahend))
      (- ?minuend ?subtrahend)
    :eval-error))

;;; Lisp procedure for implementing QuotientFn
(defun QuotientFn-3295055270 (?dividend ?divisor)
  (if (and (numberp ?dividend) (numberp ?divisor))
      (/ ?dividend ?divisor)
    :eval-error))

;;; Lisp procedure for implementing AbsoluteValueFn
(defun AbsoluteValueFn-3295055270 (?num)
  (if (numberp ?num) (abs ?num) :eval-error))

;;; Lisp procedure for implementing ExponentFn
(defun ExponentFn-3295055270 (?base ?exp)
  (if (and (numberp ?base) (numberp ?exp))
      (expt ?base ?exp)
    :eval-error))

;;; Lisp procedure for implementing ExpFn
(defun ExpFn-3295055270 (?exp)
  (if (numberp ?exp) (exp ?exp) :eval-error))

;;; Lisp procedure for implementing LogFn
(defun LogFn-3295055270 (?num)
  (if (numberp ?num) (log ?num) :eval-error))

;;; Lisp procedure for implementing MaximumFn
(defun MaximumFn-3295055270 (?set ?function)
  (multiple-value-bind (numbers units)
      (convert-list-to-same-units (mapcar ?function (cdr ?set)))
    (cond ((eq numbers :eval-error) :eval-error)
          (t
           (let ((the-max (apply 'max numbers)))
             (if units (list units the-max) the-max))))))

;;; Lisp procedure for implementing PlusAll
(defun PlusAll-3295055270 (?set ?function)
  (multiple-value-bind (numbers units)
      (convert-list-to-same-units (mapcar ?function (cdr ?set)))
    (cond ((eq numbers :eval-error) :eval-error)
          (t
           (let ((the-sum (apply '+ numbers)))
             (if units (list units the-sum) the-sum))))))

;;; Lisp procedure for implementing utilities
(defun convert-list-to-same-units (maybe-units-and-numbers)
  (let ((units nil))
    (values (delete nil
                    (mapcar #'(lambda (elt)
                                (cond
                                 ((numberp elt)
                                  (cond
                                   (units
                                    (return-from
                                     convert-list-to-same-units
                                     (values :eval-error)))
                                   (t elt)))
                                 ((or
                                   (not (listp elt))
                                   (cddr elt)
                                   (not (numberp (cadr elt)))
                                   (not (symbolp (car elt)))
                                   (not
                                    (fire:instance-of?
                                     (car elt)
                                     'UnitOfMeasure
                                     fire:*reasoner*)))
                                  nil)
                                 ((null units)
                                  (setq units (car elt))
                                  (cadr elt))
                                 ((equal units (car elt)) (cadr elt))
                                 (t
                                  (let
                                   ((converted-value
                                     (convert-to-units
                                      units
                                      (car elt)
                                      (cadr elt))))
                                   (cond
                                    ((not (numberp converted-value))
                                     (return-from
                                      convert-list-to-same-units
                                      (values :eval-error)))
                                    (t converted-value))))))
                            maybe-units-and-numbers))
            units)))

;;; Lisp procedure for implementing utilities
(defun convert-to-units (desired-units given-units value)
  (case desired-units
    (SquareMile
     (case given-units
       (SquareKilometer (* 0.386102 value))
       (Acre (/ value 640.0))
       (t :eval-error)))
    (SquareKilometer
     (case given-units
       (SquareMile (* 2.589988 value))
       (Acre (/ value 247.10538))
       (t :eval-error)))
    (Acre
     (case given-units
       (SquareKilometer (* value 247.10538))
       (SquareMile (* value 640))
       (t :eval-error)))
    (t :eval-error)))

;;; Lisp procedure for implementing FunctionToArg
(defun FunctionToArg-3295055270 (?nth ?predicate)
  (let ((arity (fire:arity ?predicate)))
    (cond ((or (not (integerp arity)) (not (integerp ?nth)) (< ?nth 0)
               (> ?nth arity))
           :eval-error)
          (t (make-lambda-for-FunctionToArg arity ?nth ?predicate)))))

;;; Lisp procedure for implementing utilities
(defun make-lambda-for-FunctionToArg (arity ?nth ?predicate)
  (multiple-value-bind (inputs output args)
      (create-extractor-function-arg-lists arity ?nth)
    (let* ((form
            (append (list ?predicate)
                    (mapcar #'(lambda (var)
                                (if (eq var output) `',var var))
                            args)))
           (body (car (fire:ask-it form :response output :number 1)))
           (ante (car (fire:ask-it form :number 1))))
      (cond ((null ante)
             (return-from make-lambda-for-FunctionToArg
               (values :eval-error nil)))
            (t (values (eval `(lambda ,inputs ,body)) (list ante)))))))

;;; Lisp procedure for implementing utilities
(defun create-extractor-function-arg-lists (arity nth)
  (let ((all-vars nil) (input-vars nil) (output-var nil))
    (dotimes (i arity
              (values (nreverse input-vars) output-var
                      (nreverse all-vars)))
      (let* ((this (1+ i))
             (this-var (intern (format nil "?v~D" this))))
        (cond ((= this nth) (setq output-var this-var))
              (t (push this-var input-vars)))
        (push this-var all-vars)))))

;;; Lisp procedure for implementing TheClosedRetrievalSetOf
(defun TheClosedRetrievalSetOf-3295055270 (?var ?statement)
  (let ((time-cwa
         (fire::make-closed-retrieval-set-cwa ?var ?statement))
        (antes (fire:ask-it ?statement))
        (members
         (remove-duplicates (fire:ask-it ?statement :response ?var))))
    (fire:tell time-cwa fire:*reasoner* :closed-set-retrieval-cwa :WM)
    (values `(TheSet ,@members) (cons time-cwa antes))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; End of file