home *** CD-ROM | disk | FTP | other *** search
/ Eagles Nest BBS 8 / Eagles_Nest_Mac_Collection_Disc_8.TOAST / Developer Tools⁄Additions / MacScheme20 / Mathlib / algcon.scm next >
Encoding:
Text File  |  1989-04-27  |  1.4 KB  |  46 lines  |  [TEXT/????]
  1. ;;; $Header: algcon.scm,v 1.2 87/08/26 13:14:07 GMT gjs Exp $
  2. ;;;;               ALGCON.SCM
  3. ;;; Algebraic constructors for symbolic experiments.
  4.  
  5. (if-mit
  6.  (declare (usual-integrations = + - * /
  7.                  zero? 1+ -1+
  8.                  ;; truncate round floor ceiling
  9.                  sqrt exp log sin cos)))
  10.  
  11. (define (make-sum a1 a2)
  12.   (cond ((and (number? a1) (number? a2)) (+ a1 a2))
  13.         ((number? a1) (if (= a1 0) a2 `(+ ,a1 ,a2)))
  14.         ((number? a2) (if (= a2 0) a1 `(+ ,a2 ,a1)))
  15.         (else `(+ ,a1 ,a2))))
  16.  
  17. (define (make-prod m1 m2)
  18.   (cond ((and (number? m1) (number? m2)) (* m1 m2))
  19.         ((number? m1)
  20.          (cond ((= m1 0) 0)
  21.                ((= m1 1) m2)
  22.                (else `(* ,m1 ,m2))))
  23.         ((number? m2)
  24.          (cond ((= m2 0) 0)
  25.                ((= m2 1) m1)
  26.                (else `(* ,m2 ,m1))))
  27.         (else `(* ,m1 ,m2))))
  28.  
  29. (define (make-diff a1 a2)
  30.   (cond ((and (number? a1) (number? a2)) (- a1 a2))
  31.         ((number? a1) (if (= a1 0) `(- ,a2) `(- ,a1 ,a2)))
  32.         ((number? a2) (if (= a2 0) a1 `(- ,a1 ,a2)))
  33.         (else `(- ,a1 ,a2))))
  34.  
  35. (define (make-quo m1 m2)
  36.   (cond ((and (number? m1) (number? m2)) (/ m1 m2))
  37.         ((number? m1)
  38.          (cond ((= m1 0) 0)
  39.                (else `(/ ,m1 ,m2))))
  40.         ((number? m2)
  41.          (cond ((= m2 0)
  42.                 (error "Divide by zero -- MAKE-QUO"))
  43.                ((= m2 1) m1)
  44.                (else `(/ ,m1 ,m2))))
  45.         (else `(/ ,m1 ,m2))))
  46.