Commit 95f5e98f authored by Marco Antoniotti's avatar Marco Antoniotti

Initial checkin.

parents
*.*fasl
docs/
Copyright (c) 2018 Marco Antoniotti
All rights reserved.
Permission is hereby granted, without written agreement and without
license or royalty fees, to use, copy, modify, and distribute this
software and its documentation for any purpose, provided that the
above copyright notice and the following two paragraphs appear in all
copies of this software.
IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE TO ANY PARTY FOR DIRECT,
INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF
THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR(S),
HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
THE AUTHOR(S) UNIVERSITY, COMPANY AND/OR AFFILIATION SPECIFICALLY
DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND
THE AUTHOR(S) HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT,
UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
Common Lisp Extension: Math
===========================
Copyright (c) 2018 Marco Antoniotti
See file COPYING for licensing information
DESCRIPTION
-----------
This library provides a layer of generic functions and some numerical
hooks that can be used to further "extend" Common Lisp mathematical
capabilities.
;;;; -*- Mode: Lisp -*-
;;;; common-math-package.lisp
;;;;
;;;; See file COPYING in the main folder for licensing information.
(defpackage "IT.UNIMIB.DISCO.MA.CL.EXT.MATH" (:use "CL")
(:nicknames
"COMMON-MATH"
"MATH"
"CL.MATH"
"CL.EXTENSIONS.MATH"
"CL.EXT.MATH")
;; IEEE names.
(:export
"NAN")
(:export
"LONG-FLOAT-POSITIVE-INFINITY"
"LONG-FLOAT-NEGATIVE-INFINITY"
"DOUBLE-FLOAT-POSITIVE-INFINITY"
"DOUBLE-FLOAT-NEGATIVE-INFINITY"
"SINGLE-FLOAT-POSITIVE-INFINITY"
"SINGLE-FLOAT-NEGATIVE-INFINITY"
"SHORT-FLOAT-POSITIVE-INFINITY"
"SHORT-FLOAT-NEGATIVE-INFINITY"
)
(:export "+POSITIVE-INFINITY+" "+NEGATIVE-INFINITY+")
(:export
"IS-NAN"
"NAN-P"
"IS-INFINITY"
"INFINITY-P"
)
(:export
"ROUNDING-MODES"
)
(:export
"UNIT-ROUNDOFF"
"+UNIT-ROUNDOFF-RATIONAL+"
"+UNIT-ROUNDOFF-SHORT-RATIONAL+"
"+UNIT-ROUNDOFF-SINGLE-RATIONAL+"
"+UNIT-ROUNDOFF-DOUBLE-RATIONAL+"
"+UNIT-ROUNDOFF-LONG-RATIONAL+"
"+UNIT-ROUNDOFF-FLOAT+"
"+UNIT-ROUNDOFF-SHORT-FLOAT+"
"+UNIT-ROUNDOFF-SINGLE-FLOAT+"
"+UNIT-ROUNDOFF-DOUBLE-FLOAT+"
"+UNIT-ROUNDOFF-LONG-FLOAT+"
)
;; Generic names (shadowing CL symbols).
(:shadow "=" "+" "-" "*" "/" ">" "<" ">=" "<=" "/=")
(:shadow "PLUSP" "MINUSP" "ZEROP")
(:shadow "EXPT" "GCD" "LCM")
(:export "=" "+" "-" "*" "/" ">" "<" ">=" "<=" "/=")
(:export "PLUSP" "MINUSP" "ZEROP")
(:export "EXPT" "GCD" "LCM")
(:export "INCREASING" "DECREASING")
(:export "MINIMUM" "MAXIMUM" "MINMAX")
(:export "OUTER-PRODUCT")
(:export "INNER-PRODUCT" "DOT")
(:export "SUM")
(:export "PRODUCT")
(:export ; Fixed arity operators.
"+." ".+."
"*." ".*."
"-." ".-."
"/." "./."
"=." ".=."
".<."
".>."
".<=."
".>=."
"/=."
"./=."
)
(:export "GCD." ".GCD." "LCM." ".LCM.")
(:export "/*" "./*.") ; Inner product.
(:export "*/" ".*/.") ; Outer product.
(:export "/+" "./+.") ; Inner sum.
(:export "+/" ".+/.") ; Outer sum.
;; Conditions.
(:export "UNDEFINED-OPERATION")
)
;;;; end of file -- common-math-package.lisp
;;;; -*- Mode: Lisp -*-
;;;; common-math.asd
;;;;
;;;; See file COPYING in the main folder for licensing information.
(asdf:defsystem "COMMON-MATH"
:author "Marco Antoniotti"
:license "BSD"
:components ((:file "common-math-package")
(:file "prologue"
:depends-on ("common-math-package"))
(:module "impl-dependent"
:depends-on ("prologue" "common-math-package")
:components (
#+lispworks
(:module "lispworks"
:components ((:file "lispworks")))
#+cmucl
(:module "cmucl"
:components ((:file "cmucl")))
#+sbcl
(:module "sbcl"
:components ((:file "sbcl")))
#+ccl
(:module "ccl"
:components ((:file "ccl")))
#+allegro
(:module "acl"
:components ((:file "acl")))
#-(or lispworks cmucl sbcl ccl allegro)
(:file "no-impl-dependent-code")
))
(:file "ieee-base"
:depends-on ("common-math-package" "impl-dependent"))
(:file "numerics-base"
:depends-on ("common-math-package"))
(:file "common-math"
:depends-on ("common-math-package"
"ieee-base"
"numerics-base"))
)
)
;;;; end of file -- common-math.asd
This diff is collapsed.
;;;; -*- Mode: Lisp -*-
;;;; common-math.system
;;;;
;;;; See file COPYING in the main folder for licensing information.
(mk:defsystem "COMMON-MATH"
:author "Marco Antoniotti"
:licence "BSD"
:source-extension "lisp"
:binary-pathname ".cmbin"
:components ((:file "common-math-package")
(:file "prologue"
:depends-on ("common-math-package"))
(:module "impl-dependent"
:depends-on ("prologue" "common-math-package")
:components (
#+lispworks
(:module "lispworks"
:components ((:file "lispworks")))
#+cmucl
(:module "cmucl"
:components ((:file "cmucl")))
#+sbcl
(:module "sbcl"
:components ((:file "sbcl")))
#+ccl
(:module "ccl"
:components ((:file "ccl")))
#+allegro
(:module "acl"
:components ((:file "acl")))
#-(or lispworks cmucl sbcl ccl allegro)
(:file "no-impl-dependent-code")
))
(:file "ieee-base"
:depends-on ("common-math-package" "impl-dependent"))
(:file "numerics-base"
:depends-on ("common-math-package"))
(:file "common-math"
:depends-on ("common-math-package"
"ieee-base"
"numerics-base"))
)
)
;;;; end of file -- common-math.system
;;;; -*- Mode: Lisp -*-
;;;; ieee-base.lisp
;;;;
;;;; See file COPYING in the main folder for licensing information.
(in-package "CL.EXT.MATH")
(deftype rounding-modes ()
'(member :positive ; C99 FE_UPWARD
:negative ; C99 FE_DOWNWARD
:zero ; C99 FE_TOWARDZERO
:nearest ; C99 FE_TONEAREST
))
(defparameter *error-on-nan-returning-operations* nil)
;;;; end of file -- ieee-base.lisp
;;;; -*- Mode: Lisp -*-
;;;; acl.lisp
;;;; Implementation dependent code.
;;;;
;;;; See file COPYING in the main folder for licensing information.
(in-package "CL.EXT.MATH")
(defparameter nan excl::*nan-double*)
(defconstant long-float-positive-infinity excl:*infinity-double*)
(defconstant long-float-negative-infinity excl:*negative-infinity-double*)
(defconstant double-float-positive-infinity excl:*infinity-double*)
(defconstant double-float-negative-infinity excl:*negative-infinity-double*)
(defconstant single-float-positive-infinity excl:*infinity-single*)
(defconstant single-float-negative-infinity excl:*negative-infinity-single*)
(defconstant short-float-positive-infinity excl:*infinity-single*)
(defconstant short-float-negative-infinity excl:*negative-infinity-single*)
;;;; end of file -- acl.lisp
;;;; -*- Mode: Lisp -*-
;;;; ccl.lisp
;;;; Implementation dependent code.
;;;;
;;;; See file COPYING in the main folder for licensing information.
(in-package "CL.EXT.MATH")
(defconstant nan 1D+-0)
(defconstant long-float-positive-infinity 1L++0)
(defconstant long-float-negative-infinity -1L++0)
(defconstant double-float-positive-infinity 1D++0)
(defconstant double-float-negative-infinity -1D++0)
(defconstant single-float-positive-infinity 1F++0)
(defconstant single-float-negative-infinity -1F++0)
(defconstant short-float-positive-infinity 1S++0)
(defconstant short-float-negative-infinity -1S++0)
;;;; end of file -- ccl.lisp
;;;; -*- Mode: Lisp -*-
;;;; cmucl.lisp
;;;; Implementation dependent code.
;;;;
;;;; See file COPYING in the main folder for licensing information.
(in-package "CL.EXT.MATH")
(defparameter nan (kernel:make-double-float -524288 0))
(defconstant long-float-positive-infinity ext:long-float-positive-infinity)
(defconstant long-float-negative-infinity ext:long-float-negative-infinity)
(defconstant double-float-positive-infinity ext:double-float-positive-infinity)
(defconstant double-float-negative-infinity ext:double-float-negative-infinity)
(defconstant single-float-positive-infinity ext:single-float-positive-infinity)
(defconstant single-float-negative-infinity ext:single-float-negative-infinity)
(defconstant short-float-positive-infinity ext:short-float-positive-infinity)
(defconstant short-float-negative-infinity ext:short-float-negative-infinity)
;;;; end of file -- cmucl.lisp
;;;; -*- Mode: Lisp -*-
;;;; lispworks.lisp
;;;; Implementation dependent code.
(in-package "CL.EXT.MATH")
(defconstant nan 1D+-0)
(defconstant long-float-positive-infinity 1L++0)
(defconstant long-float-negative-infinity -1L++0)
(defconstant double-float-positive-infinity 1D++0)
(defconstant double-float-negative-infinity -1D++0)
(defconstant single-float-positive-infinity 1F++0)
(defconstant single-float-negative-infinity -1F++0)
(defconstant short-float-positive-infinity 1S++0)
(defconstant short-float-negative-infinity -1S++0)
(defun nan-p (x) (sys::nan-p x))
(defun is-nan (x) (nan-p x))
(defun infinity-p (x)
(or (cl:= x double-float-positive-infinity)
(cl:= x double-float-negative-infinity)))
(defun is-infinity (x)
(infinity-p x))
;;;; Rounding Modes
(defun current-rounding-mode ()
(unimplemented current-rounding-mode))
;;;; end of file -- lispworks.lisp
;;;; -*- Mode: Lisp -*-
;;;; no-impl-dependent-code.lisp
;;;;
;;;; See file COPYING in the main folder for licensing information.
(in-package "CL.EXT.MATH")
(eval-when (:load-toplevel :compile-toplevel :execute)
(warn "CL.EXT.MATH: either no implementation dependente code has ~@
been written for your Common Lisp implementation, ~A, ~@
or your implementations does not support a number of numerical features ~@
necessary for the Mathematical extensions to work.~@
In this last case, most likely, IEEE NaNs and infinities are not accessible ~@
in the implementation.~@
~@
Many features will not work and many functions, variables and constants ~@
will be undefined."))
;;;; end of file -- no-impl-dependent-code.lisp
;;;; -*- Mode: Lisp -*-
;;;; sbcl.lisp
;;;; Implementation dependent code.
;;;;
;;;; See file COPYING in the main folder for licensing information.
(in-package "CL.EXT.MATH")
(defparameter nan (sb-kernel:make-double-float -524288 0)) ; Nice trick, courtesy of Raymond Toy.
(defconstant long-float-positive-infinity sb-ext:long-float-positive-infinity)
(defconstant long-float-negative-infinity sb-ext:long-float-negative-infinity)
(defconstant double-float-positive-infinity sb-ext:double-float-positive-infinity)
(defconstant double-float-negative-infinity sb-ext:double-float-negative-infinity)
(defconstant single-float-positive-infinity sb-ext:single-float-positive-infinity)
(defconstant single-float-negative-infinity sb-ext:single-float-negative-infinity)
(defconstant short-float-positive-infinity sb-ext:short-float-positive-infinity)
(defconstant short-float-negative-infinity sb-ext:short-float-negative-infinity)
;;;; end of file -- sbcl.lisp
;;;; -*- Mode: Lisp -*-
;;;; numerics-base.lisp
;;;;
;;;; See file COPYING in the main folder for licensing information.
(in-package "CL.EXT.MATH")
(declaim (ftype (function (fixnum fixnum) ratio) unit-roundoff))
(eval-when (:load-toplevel :compile-toplevel :execute)
(defun unit-roundoff (base precision)
;; BASE is "beta" and PRECISION is "p" in the standard Numerical
;; Analisys terminology.
(declare (type fixnum base precision)) ; This should do it.
(cl:* 1/2 (cl:expt base (cl:- 1 precision))))
)
#-sbc
(progn
(defconstant +unit-roundoff-short-rational+
(unit-roundoff 2 (float-precision 1.0s0)))
(defconstant +unit-roundoff-single-rational+
(unit-roundoff 2 (float-precision 1.0f0)))
(defconstant +unit-roundoff-double-rational+
(unit-roundoff 2 (float-precision 1.0d0)))
(defconstant +unit-roundoff-long-rational+
(unit-roundoff 2 (float-precision 1.0l0)))
(defconstant +unit-roundoff-rational+ +unit-roundoff-double-rational+)
(defconstant +unit-roundoff-short-float+
(cl:float +unit-roundoff-short-rational+ 1.0S0))
(defconstant +unit-roundoff-single-float+
(cl:float +unit-roundoff-single-rational+ 1.0F0))
(defconstant +unit-roundoff-double-float+
(cl:float +unit-roundoff-double-rational+ 1.0D0))
(defconstant +unit-roundoff-long-float+
(cl:float +unit-roundoff-long-rational+ 1.0L0))
(defconstant +unit-roundoff-float+ +unit-roundoff-double-float+)
)
#+sbcl ; Fascist SBCL!!!!
(progn
(defparameter +unit-roundoff-short-rational+
(unit-roundoff 2 (float-precision 1.0s0)))
(defparameter +unit-roundoff-single-rational+
(unit-roundoff 2 (float-precision 1.0f0)))
(defparameter +unit-roundoff-double-rational+
(unit-roundoff 2 (float-precision 1.0d0)))
(defparameter +unit-roundoff-long-rational+
(unit-roundoff 2 (float-precision 1.0l0)))
(defparameter +unit-roundoff-rational+ +unit-roundoff-double-rational+)
(defparameter +unit-roundoff-short-float+
(cl:float +unit-roundoff-short-rational+ 1.0S0))
(defparameter +unit-roundoff-single-float+
(cl:float +unit-roundoff-single-rational+ 1.0F0))
(defparameter +unit-roundoff-double-float+
(cl:float +unit-roundoff-double-rational+ 1.0D0))
(defparameter +unit-roundoff-long-float+
(cl:float +unit-roundoff-long-rational+ 1.0L0))
(defparameter +unit-roundoff-float+ +unit-roundoff-double-float+)
)
;;;; end of file -- numerics-base.lisp
;;;; -*- Mode: Lisp -*-
;;;; prologue.lisp
;;;;
;;;; See file COPYING in the main folder for licensing information.
(in-package "CL.EXT.MATH")
(define-condition unimplemented-function (undefined-function)
()
(:report (lambda (uf stream)
(format stream "Function ~A in not (yet) implemented in CL.EXT.MATH."
(cell-error-name uf)))))
(defmacro unimplemented (name)
`(error 'unimplemented-function :name ',name))
;;;; end of file -- prologue.lisp
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