From: Chris Hanson Date: Mon, 15 Jan 1990 21:27:55 +0000 (+0000) Subject: Add new variable `flonum-unparser-cutoff', which controls the flonum X-Git-Tag: 20090517-FFI~11595 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2100c1deabd262b6958f607a96ac8f7e1b13cf0b;p=mit-scheme.git Add new variable `flonum-unparser-cutoff', which controls the flonum printer's precision. Acceptable values of this variable are: NORMAL use all available precision (RELATIVE ) digits of precision (ABSOLUTE ) digits of precision after the decimal point --- diff --git a/v7/src/runtime/dragon4.scm b/v7/src/runtime/dragon4.scm index b694cce8e..d1bf8b200 100644 --- a/v7/src/runtime/dragon4.scm +++ b/v7/src/runtime/dragon4.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dragon4.scm,v 1.2 1989/10/30 22:36:38 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dragon4.scm,v 1.3 1990/01/15 21:27:25 cph Exp $ -Copyright (c) 1989 Massachusetts Institute of Technology +Copyright (c) 1989, 1990 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -43,49 +43,71 @@ MIT in each case. |# (let ((p flo:significand-digits-base-2)) (with-values (lambda () (dragon4-normalize x p)) (lambda (f e) - (dragon4 f e p radix 'NORMAL 0 - (lambda (u k generate) - (let ((digits - (list->string - (let loop ((u u) (k k) (generate generate)) - k ;ignore - (if (negative? u) - '() - (cons (digit->char u radix) - (generate loop))))))) - (let ((k+1 (1+ k))) - (let ((k+1-l (- k+1 (string-length digits))) - (n (flo:significand-digits radix)) - (scientific - (lambda () - (string-append (string-head digits 1) - "." - (string-tail digits 1) - "e" - (int:->string k radix))))) - (cond ((< k+1-l (- n)) - (scientific)) - ((negative? k) - (string-append "." - (make-string (- k+1) #\0) - digits)) - ((negative? k+1-l) - (string-append (string-head digits k+1) - "." - (string-tail digits k+1))) - ((<= k n) - (string-append digits - (make-string k+1-l #\0) - ".")) - (else - (scientific)))))))))))))) + (with-values flonum-unparser-cutoff-args + (lambda (cutoff-mode cutoff) + (dragon4 f e p radix cutoff-mode cutoff + (lambda (u k generate) + (let ((digits + (list->string + (let loop ((u u) (k k) (generate generate)) + k ;ignore + (if (negative? u) + '() + (cons (digit->char u radix) + (generate loop))))))) + (let ((k+1 (1+ k))) + (let ((k+1-l (- k+1 (string-length digits))) + (n (flo:significand-digits radix)) + (scientific + (lambda () + (string-append (string-head digits 1) + "." + (string-tail digits 1) + "e" + (int:->string k radix))))) + (cond ((< k+1-l (- n)) + (scientific)) + ((negative? k) + (string-append "." + (make-string (- k+1) #\0) + digits)) + ((negative? k+1-l) + (string-append (string-head digits k+1) + "." + (string-tail digits k+1))) + ((<= k n) + (string-append digits + (make-string k+1-l #\0) + ".")) + (else + (scientific)))))))))))))))) (or (and flonum-unparser-hook (flonum-unparser-hook x radix)) (cond ((flo:positive? x) (x>0 x)) ((flo:negative? x) (string-append "-" (x>0 (flo:negate x)))) (else (string-copy "0.")))))) +(define (flonum-unparser-cutoff-args) + (cond ((eq? 'NORMAL flonum-unparser-cutoff) + (values 'NORMAL 0)) + ((and (pair? flonum-unparser-cutoff) + (pair? (cdr flonum-unparser-cutoff)) + (null? (cddr flonum-unparser-cutoff)) + (let ((mode (car flonum-unparser-cutoff)) + (place (cadr flonum-unparser-cutoff))) + (and (memq mode '(ABSOLUTE RELATIVE NORMAL)) + (exact-integer? place) + (or (not (eq? 'RELATIVE mode)) + (positive? place))))) + (values (car flonum-unparser-cutoff) + (- (cadr flonum-unparser-cutoff)))) + (else + (warn "illegal flonum unparser cutoff parameter" + flonum-unparser-cutoff) + (values 'NORMAL 0)))) + (define flonum-unparser-hook #f) +(define flonum-unparser-cutoff 'NORMAL) (define (dragon4-normalize x precision) (with-values (lambda () (flo:normalize x)) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 026697374..f4f8cd0e5 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.56 1989/12/07 05:32:23 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.57 1990/01/15 21:27:38 cph Exp $ -Copyright (c) 1988, 1989 Massachusetts Institute of Technology +Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -977,6 +977,7 @@ MIT in each case. |# exact? exp expt + flonum-unparser-cutoff floor floor->exact gcd diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index 185c9e0c2..475b714b4 100644 --- a/v7/src/runtime/version.scm +++ b/v7/src/runtime/version.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.70 1990/01/10 12:39:17 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.71 1990/01/15 21:27:55 cph Exp $ -Copyright (c) 1988, 1989 Massachusetts Institute of Technology +Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -45,7 +45,7 @@ MIT in each case. |# '())) (add-system! microcode-system) (add-event-receiver! event:after-restore snarf-microcode-version!) - (add-identification! "Runtime" 14 70)) + (add-identification! "Runtime" 14 71)) (define microcode-system) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index bf638d138..3b76b2919 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.56 1989/12/07 05:32:23 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.57 1990/01/15 21:27:38 cph Exp $ -Copyright (c) 1988, 1989 Massachusetts Institute of Technology +Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -977,6 +977,7 @@ MIT in each case. |# exact? exp expt + flonum-unparser-cutoff floor floor->exact gcd