diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
commit | 8466d8cfa486fb30d1755c4261b781135083787b (patch) | |
tree | c8c12c67246f543c3cc4f64d1c07e003cb1d45ae /cring.scm | |
parent | 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff) | |
download | slib-8466d8cfa486fb30d1755c4261b781135083787b.tar.gz slib-8466d8cfa486fb30d1755c4261b781135083787b.zip |
Import Upstream version 3a1upstream/3a1
Diffstat (limited to 'cring.scm')
-rw-r--r-- | cring.scm | 30 |
1 files changed, 18 insertions, 12 deletions
@@ -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 |