summaryrefslogtreecommitdiffstats
path: root/cring.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
commit8466d8cfa486fb30d1755c4261b781135083787b (patch)
treec8c12c67246f543c3cc4f64d1c07e003cb1d45ae /cring.scm
parent87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff)
downloadslib-8466d8cfa486fb30d1755c4261b781135083787b.tar.gz
slib-8466d8cfa486fb30d1755c4261b781135083787b.zip
Import Upstream version 3a1upstream/3a1
Diffstat (limited to 'cring.scm')
-rw-r--r--cring.scm30
1 files changed, 18 insertions, 12 deletions
diff --git a/cring.scm b/cring.scm
index dfbb027..97a637d 100644
--- a/cring.scm
+++ b/cring.scm
@@ -1,5 +1,5 @@
;;;"cring.scm" Extend Scheme numerics to any commutative ring.
-;Copyright (C) 1997, 1998 Aubrey Jaffer
+;Copyright (C) 1997, 1998, 2001 Aubrey Jaffer
;
;Permission to copy this software, to modify it, to redistribute it,
;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
;1. Any copy made of this software must include this copyright notice
;in full.
;
-;2. I have made no warrantee or representation that the operation of
+;2. I have made no warranty or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
@@ -19,10 +19,21 @@
(require 'common-list-functions)
(require 'relational-database)
-(require 'database-utilities)
+(require 'databases)
(require 'sort)
+(require-if '(not inexact) 'logical) ;for integer-expt
+(define number^ (if (provided? 'inexact) expt integer-expt))
+
+(define number* *)
+(define number+ +)
+(define number- -)
+(define number/ /)
+(define number0? zero?)
+(define (zero? x) (and (number? x) (number0? x)))
+;;(define (sign x) (if (positive? x) 1 (if (negative? x) -1 0)))
(define cring:db (create-database #f 'alist-table))
+;@
(define (make-ruleset . rules)
(define name #f)
(cond ((and (not (null? rules)) (symbol? (car rules)))
@@ -41,12 +52,13 @@
(list (table 'get 'reduction)
(table 'row:update)
table))))
+;@
(define *ruleset* (make-ruleset 'default))
(define (cring:define-rule . args)
(if *ruleset*
((cadr *ruleset*) args)
(slib:warn "No ruleset in *ruleset*")))
-
+;@
(define (combined-rulesets . rulesets)
(define name #f)
(cond ((symbol? (car rulesets))
@@ -59,6 +71,7 @@
rulesets))))
;;; Distribute * over + (and -)
+;@
(define distribute*
(make-ruleset
'distribute*
@@ -72,6 +85,7 @@
(apply - (map (lambda (trm) (* trm exp2)) (cdr exp1)))))))
;;; Distribute / over + (and -)
+;@
(define distribute/
(make-ruleset
'distribute/
@@ -103,15 +117,7 @@
(else (expression-< (cdr x) (cdr y)))))
(define (expression-sort seq) (sort! seq expression-<))
-(define number* *)
-(define number+ +)
-(define number- -)
-(define number/ /)
-(define number^ integer-expt)
(define is-term-op? (lambda (term op) (and (pair? term) (eq? op (car term)))))
-;;(define (sign x) (if (positive? x) 1 (if (negative? x) -1 0)))
-(define number0? zero?)
-(define (zero? x) (and (number? x) (number0? x)))
;; To convert to CR internal form, NUMBER-op all the `numbers' in the
;; argument list and remove them from the argument list. Collect the