123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243 |
- #| -*-Scheme-*-
- Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Massachusetts
- Institute of Technology
- This file is part of MIT/GNU Scheme.
- MIT/GNU Scheme 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 2 of the License, or (at
- your option) any later version.
- MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
- USA.
- |#
- (define (generic-environment-maker)
- ;; FBE
- (let ((e (extend-top-level-environment scmutils-base-environment)
- ;;(extend-top-level-environment scmutils-base-environment '(generic)) ; guile
- ))
- (let ((d (lambda (name value)
- (environment-define e name value))))
- (d '*environment* 'generic-environment)
- ;; Unary operators from generic.scm
- (d 'type g:type)
- (d 'type-predicate g:type-predicate)
- (d 'arity g:arity)
- (d 'inexact? g:inexact?)
- (d 'zero-like g:zero-like)
- (d 'one-like g:one-like)
- (d 'identity-like g:identity-like)
-
- (d 'zero? g:zero?)
- (d 'one? g:one?)
- (d 'identity? g:identity?)
- (d 'negate g:negate)
- (d 'invert g:invert)
- (d 'square g:square)
- (d 'cube g:cube)
- (d 'sqrt g:sqrt)
- (d 'exp g:exp)
- (d 'log g:log)
- (d 'exp2 g:exp2)
- (d 'exp10 g:exp10)
- (d 'log2 g:log2)
- (d 'log10 g:log10)
- (d 'sin g:sin)
- (d 'cos g:cos)
- (d 'tan g:tan)
- (d 'cot g:cot)
- (d 'sec g:sec)
- (d 'csc g:csc)
- (d 'asin g:asin)
- (d 'acos g:acos)
- (d 'sinh g:sinh)
- (d 'cosh g:cosh)
- (d 'tanh g:tanh)
- (d 'sech g:sech)
- (d 'csch g:csch)
- (d 'asinh g:asinh)
- (d 'acosh g:acosh)
- (d 'atanh g:atanh)
- (d 'abs g:abs)
- (d 'determinant g:determinant)
- (d 'trace g:trace)
- (d 'transpose g:transpose)
- (d 'dimension g:dimension)
- (d 'solve-linear g:solve-linear)
- (d 'derivative g:derivative)
- ;; Binary (and nary) operators from generic.scm
- (d '= g:=)
- (d '< g:<)
- (d '<= g:<=)
- (d '> g:>)
- (d '>= g:>=)
- (d '+ g:+)
- (d '- g:-)
- (d '* g:*)
- (d '/ g:/)
- (d 'dot-product g:dot-product)
- (d 'cross-product g:cross-product)
- (d 'outer-product g:outer-product)
- (d 'expt g:expt)
- (d 'gcd g:gcd)
- ;; Complex operators from generic.scm
- (d 'make-rectangular g:make-rectangular)
- (d 'make-polar g:make-polar)
- (d 'real-part g:real-part)
- (d 'imag-part g:imag-part)
- (d 'magnitude g:magnitude)
- (d 'angle g:angle)
- (d 'conjugate g:conjugate)
- ;; Wierd operators from generic.scm
- (d 'atan g:atan)
- (d 'partial-derivative g:partial-derivative)
- (d 'partial g:partial)
- (d 'apply g:apply)
- ;; Compound operators from mathutil.scm
- (d 'arg-scale g:arg-scale)
- (d 'arg-shift g:arg-shift)
- (d 'sigma g:sigma)
- (d 'ref g:ref)
- (d 'size g:size)
- (d 'compose g:compose)
- )
- e))
- ;; (define generic-environment
- ;; (generic-environment-maker))
- (define generic-numerical-operators
- '(
- zero-like
- one-like
- identity-like
- negate
- invert
- square
- cube
- sqrt
- exp
- log
- exp2
- exp10
- log2
- log10
- sin
- cos
- tan
- sec
- csc
- asin
- acos
- sinh
- cosh
- tanh
- sech
- csch
- abs
- +
- -
- *
- /
- expt
- gcd
- make-rectangular
- make-polar
- real-part
- imag-part
- magnitude
- angle
- conjugate
- atan))
- #|
- (let ((numerical-environment
- (extend-top-level-environment generic-environment)))
- (environment-define scmutils-base-environment
- 'numerical-environment
- numerical-environment)
- (environment-define numerical-environment
- '*environment*
- 'numerical-environment))
- |#
- ;; FBE
- ;; (let ((numerical-environment
- ;; (extend-top-level-environment scmutils-base-environment)
- ;; ;;(extend-top-level-environment scmutils-base-environment '(numerical)) ; guile
- ;; ))
- ;; (environment-define scmutils-base-environment
- ;; 'numerical-environment
- ;; numerical-environment)
- ;; (environment-define numerical-environment
- ;; '*environment*
- ;; 'numerical-environment))
|