From f24b9140d6f74804d5599ec225717d38ca443813 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:26 -0800 Subject: Import Upstream version 2c0 --- wttree.scm | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) (limited to 'wttree.scm') diff --git a/wttree.scm b/wttree.scm index 467aa86..7cfa85e 100644 --- a/wttree.scm +++ b/wttree.scm @@ -56,14 +56,6 @@ ;; ;; It has been tested on MIT-Scheme, scheme48 and scm4e1 ;; -;; Non-standard procedures: -;; error -;; error:wrong-type-argument -;; error:band-range-argument -;; These are only called when there is an error so it is not critical to -;; have them defined :-) -;; -;; ;; If your system has a compiler and you want this code to run fast, you ;; should do whatever is necessary to inline all of the structure accessors. ;; @@ -71,6 +63,20 @@ ;; ;;(declare (usual-integrations)) +(define error + (case (scheme-implementation-type) + ((MITScheme) error) + (else slib:error))) +(define error:wrong-type-argument + (case (scheme-implementation-type) + ((MITScheme) error:wrong-type-argument) + (else (lambda (arg1 arg2 arg3) + (slib:error 'wrong-type-argument arg1 arg2 arg3))))) +(define error:bad-range-argument + (case (scheme-implementation-type) + ((MITScheme) error:bad-range-argument) + (else (lambda (arg1 arg2) + (slib:error 'bad-range-argument arg1 arg2))))) ;;; ;;; Interface to this package. @@ -127,7 +133,7 @@ (define fix:+ +) (define fix:- -) (define fix:< <) - (define fix:<= <) + (define fix:<= <=) (define fix:> >) (define fix:* *) -- cgit v1.2.3