Commit a038eb56 authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Move funcall-dyadic

Move #'funcall-dyadic to a new file physical-quantities/funcall.lisp
so that it can use gird:grid and grid:gridp, which aren't defined
where it is called, in generic.lisp.
parent 77e61dbe
;; Antik system definition
;; Liam Healy 2010-12-24 09:43:28EST antik.asd
;; Time-stamp: <2011-02-11 22:31:58EST antik.asd>
;; Time-stamp: <2011-02-15 21:32:04EST antik.asd>
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -107,6 +107,7 @@
((:file "units")
(:file "scalar" :depends-on ("units"))
(:file "grid" :depends-on ("scalar"))
(:file "funcall")
(:file "unit-definitions" :depends-on ("units" "grid"))
(:file "sysunit-definitions"
:depends-on ("units" "unit-definitions"))
......
;; Generic functions for generalized numbers
;; Liam Healy Tue Feb 9 1999 - 21:38
;; Time-stamp: <2011-02-13 22:43:31EST generic.lisp>
;; Time-stamp: <2011-02-15 21:31:47EST generic.lisp>
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -67,40 +67,6 @@
;;;; Dyadic functions
;;;;****************************************************************************
(defun funcall-dyadic (op a b &optional return-other return-other-monadic)
"Call the math function on two arguments a and b, possibly
converting one argument from a number to a generic number like the
other. If return-other is a function designator, funcall
return-other-monadic on the other argument if one passes that
test."
;; This should not be used if both a and b are numbers. Check that
;; both are arguments are not non-pq grids, otherwise it will
;; recurse indefinitely.
(assert (not (and (grid:gridp a) (not (typep a 'physical-quantity))
(grid:gridp b) (not (typep b 'physical-quantity)))))
(cond
((and return-other (funcall return-other a))
(funcall (or return-other-monadic 'identity) b))
((and return-other (funcall return-other b))
(funcall (or return-other-monadic 'identity) a))
(t
(handler-case
(funcall op
;; if args are pqs, just throw away units
(etypecase a
(number (coerce a b))
(physical-quantity (pqval a))
(grid:grid a))
(etypecase b
(number (coerce b a))
(physical-quantity (pqval b))
(grid:grid b)))
(coerce-undefined ()
;; This is redundant, but I'm leaving it here so that it
;; could be replaced with something more meaningful if
;; necessary. Can't use call-next-method here.
(error "Don't know how to coerce."))))))
;;; There is a general problem with using coerce in these functions;
;;; if the second argument is T, the first argument will be returned
;;; and the function will recurse infinitely.
......
;; Generic dyadic calls
;; Liam Healy 2011-02-15 21:30:46EST funcall.lisp
;; Time-stamp: <2011-02-15 21:31:44EST funcall.lisp>
;;; This must be defined here because grid type must be loaded.
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; 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.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :antik)
(defun funcall-dyadic (op a b &optional return-other return-other-monadic)
"Call the math function on two arguments a and b, possibly
converting one argument from a number to a generic number like the
other. If return-other is a function designator, funcall
return-other-monadic on the other argument if one passes that
test."
;; This should not be used if both a and b are numbers. Check that
;; both are arguments are not non-pq grids, otherwise it will
;; recurse indefinitely.
(assert (not (and (grid:gridp a) (not (typep a 'physical-quantity))
(grid:gridp b) (not (typep b 'physical-quantity)))))
(cond
((and return-other (funcall return-other a))
(funcall (or return-other-monadic 'identity) b))
((and return-other (funcall return-other b))
(funcall (or return-other-monadic 'identity) a))
(t
(handler-case
(funcall op
;; if args are pqs, just throw away units
(etypecase a
(number (coerce a b))
(physical-quantity (pqval a))
(grid:grid a))
(etypecase b
(number (coerce b a))
(physical-quantity (pqval b))
(grid:grid b)))
(coerce-undefined ()
;; This is redundant, but I'm leaving it here so that it
;; could be replaced with something more meaningful if
;; necessary. Can't use call-next-method here.
(error "Don't know how to coerce."))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment