From 553c72ab2897316b1808cc646843d3773e445e39 Mon Sep 17 00:00:00 2001 From: Neil Toronto Date: Fri, 25 Nov 2011 18:37:18 -0700 Subject: [PATCH] Moved some flonum stuff (e.g. flatan2, flnext, +max.0, +min.0, etc.) to unstable/flonum (will document in another commit) Moved Racket-language, doc-generating "defthing" defines to unstable/latent-contract/defthing (will document in another commit) --- collects/plot/common/axis-transform.rkt | 5 +- collects/plot/common/contract.rkt | 4 +- collects/plot/common/date-time.rkt | 3 +- collects/plot/common/draw.rkt | 2 +- collects/plot/common/format.rkt | 2 +- collects/plot/common/legend.rkt | 2 +- collects/plot/common/marching-cubes.rkt | 4 +- collects/plot/common/marching-squares.rkt | 4 +- collects/plot/common/math.rkt | 69 +++-------------- collects/plot/common/nonrenderer.rkt | 3 +- collects/plot/common/parameters.rkt | 3 +- collects/plot/common/plot-element.rkt | 24 +++--- collects/plot/common/sample.rkt | 2 +- collects/plot/common/samplers.rkt | 6 +- collects/plot/common/ticks.rkt | 2 +- collects/plot/common/worker-thread.rkt | 3 +- collects/plot/compat.rkt | 3 +- collects/plot/contracted/math.rkt | 6 +- collects/plot/deprecated/deprecated.rkt | 3 +- collects/plot/doc.rkt | 2 +- collects/plot/plot2d/contour.rkt | 2 +- collects/plot/plot2d/decoration.rkt | 2 +- collects/plot/plot2d/interval.rkt | 4 +- collects/plot/plot2d/kde.rkt | 2 +- collects/plot/plot2d/line.rkt | 4 +- collects/plot/plot2d/plot.rkt | 2 +- collects/plot/plot2d/point.rkt | 4 +- collects/plot/plot2d/rectangle.rkt | 2 +- collects/plot/plot3d/contour.rkt | 2 +- collects/plot/plot3d/isosurface.rkt | 5 +- collects/plot/plot3d/line.rkt | 5 +- collects/plot/plot3d/plot.rkt | 2 +- collects/plot/plot3d/point.rkt | 5 +- collects/plot/plot3d/rectangle.rkt | 3 +- collects/plot/plot3d/surface.rkt | 4 +- collects/plot/scribblings/common.rkt | 2 +- collects/plot/scribblings/compat.scrbl | 2 +- collects/plot/tests/isosurface-tests.rkt | 2 +- collects/plot/tests/plot3d-tests.rkt | 2 +- collects/unstable/flonum.rkt | 74 +++++++++++++++++++ .../latent-contract/defthing.rkt} | 0 .../latent-contract}/serialize-syntax.rkt | 0 42 files changed, 148 insertions(+), 134 deletions(-) create mode 100644 collects/unstable/flonum.rkt rename collects/{plot/common/contract-doc.rkt => unstable/latent-contract/defthing.rkt} (100%) rename collects/{plot/common => unstable/latent-contract}/serialize-syntax.rkt (100%) diff --git a/collects/plot/common/axis-transform.rkt b/collects/plot/common/axis-transform.rkt index b48b424fd8..b096f64085 100644 --- a/collects/plot/common/axis-transform.rkt +++ b/collects/plot/common/axis-transform.rkt @@ -1,9 +1,8 @@ #lang racket/base -(require racket/math racket/flonum racket/contract racket/match +(require racket/math racket/flonum racket/contract racket/match unstable/latent-contract/defthing "math.rkt" - "contract.rkt" - "contract-doc.rkt") + "contract.rkt") (provide (all-defined-out)) diff --git a/collects/plot/common/contract.rkt b/collects/plot/common/contract.rkt index 16fc964022..0f60bb6370 100644 --- a/collects/plot/common/contract.rkt +++ b/collects/plot/common/contract.rkt @@ -1,7 +1,7 @@ #lang racket/base -(require racket/contract racket/draw racket/class unstable/latent-contract unstable/contract - "contract-doc.rkt") +(require racket/contract racket/draw racket/class unstable/contract unstable/latent-contract + unstable/latent-contract/defthing) (provide (except-out (all-defined-out) treeof diff --git a/collects/plot/common/date-time.rkt b/collects/plot/common/date-time.rkt index a06f40273f..d5d7c93b67 100644 --- a/collects/plot/common/date-time.rkt +++ b/collects/plot/common/date-time.rkt @@ -1,10 +1,9 @@ #lang racket/base -(require racket/date racket/contract racket/match +(require racket/date racket/contract racket/match unstable/latent-contract/defthing (prefix-in srfi-date: srfi/19) db "contract.rkt" - "contract-doc.rkt" "math.rkt" "format.rkt") diff --git a/collects/plot/common/draw.rkt b/collects/plot/common/draw.rkt index 3432d9b679..d528225543 100644 --- a/collects/plot/common/draw.rkt +++ b/collects/plot/common/draw.rkt @@ -3,10 +3,10 @@ ;; Extra drawing, font, color and style functions. (require racket/draw racket/class racket/match racket/list racket/contract racket/math racket/flonum + unstable/latent-contract/defthing "math.rkt" "utils.rkt" "contract.rkt" - "contract-doc.rkt" "sample.rkt") (provide (all-defined-out)) diff --git a/collects/plot/common/format.rkt b/collects/plot/common/format.rkt index 797e9b6b47..a5b76e35e4 100644 --- a/collects/plot/common/format.rkt +++ b/collects/plot/common/format.rkt @@ -3,8 +3,8 @@ ;; Functions to format numbers, and data structures containing numbers. (require racket/string racket/list racket/pretty racket/contract racket/match + unstable/latent-contract/defthing "contract.rkt" - "contract-doc.rkt" "math.rkt") (provide (all-defined-out)) diff --git a/collects/plot/common/legend.rkt b/collects/plot/common/legend.rkt index 2e43757c9b..03ea13832c 100644 --- a/collects/plot/common/legend.rkt +++ b/collects/plot/common/legend.rkt @@ -3,9 +3,9 @@ ;; Functions that create legend entries and lists of legend entries. (require racket/class racket/match racket/list racket/string racket/sequence racket/contract + unstable/latent-contract/defthing "math.rkt" "contract.rkt" - "contract-doc.rkt" "format.rkt" "draw.rkt" "utils.rkt") diff --git a/collects/plot/common/marching-cubes.rkt b/collects/plot/common/marching-cubes.rkt index 9aefe43e6d..15ab082e62 100644 --- a/collects/plot/common/marching-cubes.rkt +++ b/collects/plot/common/marching-cubes.rkt @@ -1,11 +1,11 @@ #lang racket/base (require racket/contract racket/flonum racket/fixnum racket/list racket/match racket/unsafe/ops + unstable/latent-contract/defthing (for-syntax racket/base racket/syntax racket/match racket/list) "math.rkt" "utils.rkt" - "marching-utils.rkt" - "contract-doc.rkt") + "marching-utils.rkt") (provide heights->cube-polys heights->cube-polys:doc) diff --git a/collects/plot/common/marching-squares.rkt b/collects/plot/common/marching-squares.rkt index 31ab72d188..657bc2fa24 100644 --- a/collects/plot/common/marching-squares.rkt +++ b/collects/plot/common/marching-squares.rkt @@ -1,11 +1,11 @@ #lang racket/base (require racket/flonum racket/fixnum racket/list racket/match racket/unsafe/ops racket/contract + unstable/latent-contract/defthing (for-syntax racket/base) "math.rkt" "utils.rkt" - "marching-utils.rkt" - "contract-doc.rkt") + "marching-utils.rkt") (provide heights->lines heights->polys heights->lines:doc heights->polys:doc) diff --git a/collects/plot/common/math.rkt b/collects/plot/common/math.rkt index 0b25858d62..2886040458 100644 --- a/collects/plot/common/math.rkt +++ b/collects/plot/common/math.rkt @@ -1,7 +1,6 @@ #lang racket -(require racket/contract racket/unsafe/ops - "contract-doc.rkt") +(require racket/contract racket/unsafe/ops unstable/flonum unstable/latent-contract/defthing) (provide (all-defined-out)) @@ -20,22 +19,12 @@ [(not (flonum? α)) (raise-type-error 'flblend "flonum" 2 x y α)] [else (unsafe-fl+ (unsafe-fl* α x) (unsafe-fl* (unsafe-fl- 1.0 α) y))])) -(defproc (flatan2 [y flonum?] [x flonum?]) flonum? - (cond [(not (flonum? y)) (raise-type-error 'flatan2 "flonum" 0 x y)] - [(not (flonum? x)) (raise-type-error 'flatan2 "flonum" 1 x y)] - [else (exact->inexact (atan2 y x))])) - (defproc (flsum [f (any/c . -> . flonum?)] [xs (listof any/c)]) flonum? (define ys (map f xs)) (cond [(not (andmap flonum? ys)) (raise-type-error 'sum "any -> flonum" f)] [else (for/fold ([sum 0.0]) ([y (in-list ys)]) (unsafe-fl+ sum y))])) -(defproc (flmodulo [x flonum?] [y flonum?]) flonum? - (cond [(not (flonum? x)) (raise-type-error 'flmodulo "flonum" 0 x y)] - [(not (flonum? y)) (raise-type-error 'flmodulo "flonum" 1 x y)] - [else (unsafe-fl- x (unsafe-fl* y (unsafe-flfloor (unsafe-fl/ x y))))])) - (define fldistance (case-lambda [() 0.0] @@ -51,53 +40,6 @@ [xs (cond [(not (andmap flonum? xs)) (raise-type-error 'fldistance "flonums" xs)] [else (unsafe-flsqrt (flsum (λ (x) (unsafe-fl* x x)) xs))])])) -(define (flonum->bit-field x) - (integer-bytes->integer (real->floating-point-bytes x 8) #f)) - -(define (bit-field->flonum i) - (floating-point-bytes->real (integer->integer-bytes i 8 #f))) - -(defproc (flonum->ordinal [x flonum?]) integer? - (cond [(x . < . 0) (- (flonum->bit-field (- x)))] - [else (flonum->bit-field (abs x))])) - -(defproc (ordinal->flonum [i (integer-in #x-7FFFFFFFFFFFFFFF #x7FFFFFFFFFFFFFFF)]) flonum? - (cond [(i . < . 0) (- (bit-field->flonum (- i)))] - [else (bit-field->flonum i)])) - -(define +inf-ordinal (flonum->ordinal +inf.0)) -(define -inf-ordinal (flonum->ordinal -inf.0)) - -(defproc (flstep [x flonum?] [n exact-integer?]) flonum? - (cond [(eqv? x +nan.0) +nan.0] - [(and (eqv? x +inf.0) (n . >= . 0)) +inf.0] - [(and (eqv? x -inf.0) (n . <= . 0)) -inf.0] - [else - (define i (+ n (flonum->ordinal x))) - (cond [(i . < . -inf-ordinal) -inf.0] - [(i . > . +inf-ordinal) +inf.0] - [else (ordinal->flonum i)])])) - -(defproc (flnext [x flonum?]) flonum? #:document-body - (flstep x 1)) - -(defproc (flprev [x flonum?]) flonum? #:document-body - (flstep x -1)) - -(defthing +min.0 flonum? #:document-value (flnext 0.0)) -(defthing -min.0 flonum? #:document-value (flprev 0.0)) -(defthing +max.0 flonum? #:document-value (flprev +inf.0)) -(defthing -max.0 flonum? #:document-value (flnext -inf.0)) - -;; =================================================================================================== -;; Reals - -(defproc (maybe-inexact->exact [x (or/c rational? #f)]) (or/c rational? #f) - (cond [x (unless (rational? x) - (raise-type-error 'maybe-inexact->exact "rational or #f" x)) - (inexact->exact x)] - [else #f])) - (defproc (flonum-ok-for-range? [x-min rational?] [x-max rational?] [size exact-positive-integer?]) boolean? (let/ec return @@ -121,6 +63,15 @@ (define min-diff (- (inexact->exact inexact-x-min-next) x-min)) (and (max-diff . < . step-size) (min-diff . < . step-size))))) +;; =================================================================================================== +;; Reals + +(defproc (maybe-inexact->exact [x (or/c rational? #f)]) (or/c rational? #f) + (cond [x (unless (rational? x) + (raise-type-error 'maybe-inexact->exact "rational or #f" x)) + (inexact->exact x)] + [else #f])) + (define equal?* (case-lambda [() #t] diff --git a/collects/plot/common/nonrenderer.rkt b/collects/plot/common/nonrenderer.rkt index 7539c3c4e6..5b44d35b7f 100644 --- a/collects/plot/common/nonrenderer.rkt +++ b/collects/plot/common/nonrenderer.rkt @@ -1,9 +1,8 @@ #lang racket/base -(require racket/list racket/contract +(require racket/list racket/contract unstable/latent-contract/defthing "math.rkt" "contract.rkt" - "contract-doc.rkt" "ticks.rkt" "plot-element.rkt") diff --git a/collects/plot/common/parameters.rkt b/collects/plot/common/parameters.rkt index 6559c10553..1736d598d7 100644 --- a/collects/plot/common/parameters.rkt +++ b/collects/plot/common/parameters.rkt @@ -2,9 +2,8 @@ ;; Parameters that control the look and behavior of plots. -(require racket/contract unstable/parameter-group unstable/latent-contract +(require racket/contract unstable/parameter-group unstable/latent-contract/defthing "contract.rkt" - "contract-doc.rkt" "draw.rkt" "axis-transform.rkt" "ticks.rkt" diff --git a/collects/plot/common/plot-element.rkt b/collects/plot/common/plot-element.rkt index 30c70f0611..6687f84aea 100644 --- a/collects/plot/common/plot-element.rkt +++ b/collects/plot/common/plot-element.rkt @@ -1,10 +1,9 @@ #lang racket/base -(require racket/list racket/contract racket/match +(require racket/list racket/contract racket/match unstable/latent-contract/defthing "math.rkt" "ticks.rkt" "contract.rkt" - "contract-doc.rkt" "parameters.rkt" "sample.rkt") @@ -117,17 +116,22 @@ ;; bounds containing all the new bounds. This function is monotone and increasing regardless of ;; whether any element's bounds function is. If iterating it is bounded, a fixpoint exists. (define (apply-bounds* elems bounds-rect) - (apply rect-join bounds-rect (for/list ([elem (in-list elems)]) - (apply-bounds elem bounds-rect)))) + (rect-inexact->exact + (apply rect-join bounds-rect (for/list ([elem (in-list elems)]) + (apply-bounds elem bounds-rect))))) ;; Applies the plot element's bounds function. Asks this question: If these are your allowed bounds, ;; what bounds will you try to use? (define (apply-bounds elem bounds-rect) (match-define (plot-element elem-bounds-rect elem-bounds-fun _) elem) ;(printf "elem-bounds-rect = ~v~n" elem-bounds-rect) - (let ([elem-bounds-rect (if elem-bounds-rect - (rect-meet bounds-rect (rect-inexact->exact elem-bounds-rect)) - bounds-rect)]) - (if elem-bounds-fun - (rect-inexact->exact (elem-bounds-fun elem-bounds-rect)) - elem-bounds-rect))) + (let* ([new-bounds-rect (if elem-bounds-rect + (rect-meet bounds-rect elem-bounds-rect) + bounds-rect)] + [new-bounds-rect (if elem-bounds-fun + (elem-bounds-fun (rect-inexact->exact new-bounds-rect)) + new-bounds-rect)] + [new-bounds-rect (if elem-bounds-rect + (rect-join new-bounds-rect elem-bounds-rect) + new-bounds-rect)]) + new-bounds-rect)) diff --git a/collects/plot/common/sample.rkt b/collects/plot/common/sample.rkt index 33145c2e10..32c2449464 100644 --- a/collects/plot/common/sample.rkt +++ b/collects/plot/common/sample.rkt @@ -3,7 +3,7 @@ ;; Functions that sample from functions, and functions that create memoized samplers. (require racket/match racket/flonum racket/math racket/contract racket/list racket/vector - "contract-doc.rkt" + unstable/latent-contract/defthing "math.rkt" "axis-transform.rkt") diff --git a/collects/plot/common/samplers.rkt b/collects/plot/common/samplers.rkt index 0f8421beb7..e27a66105a 100644 --- a/collects/plot/common/samplers.rkt +++ b/collects/plot/common/samplers.rkt @@ -3,11 +3,9 @@ ;; Functions that sample from functions, and functions that create memoized samplers. (require racket/match racket/flonum racket/math racket/contract racket/list + unstable/latent-contract/defthing "parameters.rkt" - "sample.rkt" - "ticks.rkt" - "format.rkt" - "contract-doc.rkt") + "sample.rkt") (provide (all-defined-out)) diff --git a/collects/plot/common/ticks.rkt b/collects/plot/common/ticks.rkt index d10ef402af..3f21a145c1 100644 --- a/collects/plot/common/ticks.rkt +++ b/collects/plot/common/ticks.rkt @@ -3,9 +3,9 @@ ;; Data structure that represents a tick, and functions that produce ticks. (require racket/string racket/list racket/contract racket/pretty racket/match racket/sequence + unstable/latent-contract/defthing "math.rkt" "contract.rkt" - "contract-doc.rkt" "format.rkt" "utils.rkt" "axis-transform.rkt" diff --git a/collects/plot/common/worker-thread.rkt b/collects/plot/common/worker-thread.rkt index 6b6a27e3a4..4e7c5aa527 100644 --- a/collects/plot/common/worker-thread.rkt +++ b/collects/plot/common/worker-thread.rkt @@ -1,7 +1,6 @@ #lang racket -(require racket/async-channel - "contract-doc.rkt") +(require racket/async-channel) (provide make-worker-thread worker-thread? worker-thread-working? worker-thread-waiting? worker-thread-put worker-thread-try-put diff --git a/collects/plot/compat.rkt b/collects/plot/compat.rkt index 1f643a79a0..43df706fef 100644 --- a/collects/plot/compat.rkt +++ b/collects/plot/compat.rkt @@ -3,11 +3,10 @@ ;; A compatibility module for the old 'plot'. (require racket/contract racket/class racket/snip racket/draw racket/vector - unstable/latent-contract + unstable/latent-contract unstable/latent-contract/defthing ;; Plotting "common/math.rkt" "common/contract.rkt" - "common/contract-doc.rkt" "common/plot-element.rkt" "plot2d/plot-area.rkt" "plot3d/plot-area.rkt" diff --git a/collects/plot/contracted/math.rkt b/collects/plot/contracted/math.rkt index fe7086c011..61ff02d7fb 100644 --- a/collects/plot/contracted/math.rkt +++ b/collects/plot/contracted/math.rkt @@ -5,11 +5,7 @@ (require "../common/math.rkt") (provide equal?* ;; Flonums - nan? infinite? - flblend flatan2 flsum flmodulo fldistance - (activate-contract-out flonum->ordinal ordinal->flonum flstep flnext flprev - flonum-ok-for-range?) - -max.0 -min.0 +min.0 +max.0 + nan? infinite? flblend flsum fldistance (activate-contract-out flonum-ok-for-range?) ;; Reals maybe-inexact->exact min* max* degrees->radians radians->degrees blend atan2 sum real-modulo distance diff --git a/collects/plot/deprecated/deprecated.rkt b/collects/plot/deprecated/deprecated.rkt index a2e1bef88c..b767e57ea7 100644 --- a/collects/plot/deprecated/deprecated.rkt +++ b/collects/plot/deprecated/deprecated.rkt @@ -1,8 +1,7 @@ #lang racket/base -(require racket/contract plot/utils +(require racket/contract plot/utils unstable/latent-contract/defthing "../common/deprecation-warning.rkt" - "../common/contract-doc.rkt" "renderers.rkt") (provide (all-defined-out)) diff --git a/collects/plot/doc.rkt b/collects/plot/doc.rkt index f708797f60..0b73b06a1a 100644 --- a/collects/plot/doc.rkt +++ b/collects/plot/doc.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require "common/contract-doc.rkt") +(require unstable/latent-contract/defthing) ;; =================================================================================================== ;; Common exports diff --git a/collects/plot/plot2d/contour.rkt b/collects/plot/plot2d/contour.rkt index c26e6a2062..a64ebdf2ca 100644 --- a/collects/plot/plot2d/contour.rkt +++ b/collects/plot/plot2d/contour.rkt @@ -3,8 +3,8 @@ ;; Renderers for contour lines and contour intervals (require racket/contract racket/class racket/match racket/list racket/flonum racket/vector racket/math + unstable/latent-contract/defthing plot/utils - "../common/contract-doc.rkt" "../common/utils.rkt") (provide (all-defined-out)) diff --git a/collects/plot/plot2d/decoration.rkt b/collects/plot/plot2d/decoration.rkt index 570c400904..32f9d55a13 100644 --- a/collects/plot/plot2d/decoration.rkt +++ b/collects/plot/plot2d/decoration.rkt @@ -3,8 +3,8 @@ ;; Renderers for plot decorations: axes, grids, labeled points, etc. (require racket/contract racket/class racket/match racket/math racket/list + unstable/latent-contract/defthing plot/utils - "../common/contract-doc.rkt" "line.rkt" "interval.rkt" "point.rkt" diff --git a/collects/plot/plot2d/interval.rkt b/collects/plot/plot2d/interval.rkt index 73cfb39333..b031871b7a 100644 --- a/collects/plot/plot2d/interval.rkt +++ b/collects/plot/plot2d/interval.rkt @@ -3,8 +3,8 @@ ;; Renderers for intervals between functions. (require racket/contract racket/class racket/match racket/math racket/list - plot/utils - "../common/contract-doc.rkt") + unstable/latent-contract/defthing + plot/utils) (provide (all-defined-out)) diff --git a/collects/plot/plot2d/kde.rkt b/collects/plot/plot2d/kde.rkt index 0fd08f0811..b0b2784f37 100644 --- a/collects/plot/plot2d/kde.rkt +++ b/collects/plot/plot2d/kde.rkt @@ -1,8 +1,8 @@ #lang racket/base (require racket/flonum racket/list racket/promise racket/math racket/contract + unstable/latent-contract/defthing plot/utils - "../common/contract-doc.rkt" "../common/utils.rkt" "line.rkt") diff --git a/collects/plot/plot2d/line.rkt b/collects/plot/plot2d/line.rkt index ffd79b6604..15e761f40c 100644 --- a/collects/plot/plot2d/line.rkt +++ b/collects/plot/plot2d/line.rkt @@ -3,8 +3,8 @@ ;; Line renderers. (require racket/contract racket/class racket/match racket/math racket/list - plot/utils - "../common/contract-doc.rkt") + unstable/latent-contract/defthing + plot/utils) (provide (all-defined-out)) diff --git a/collects/plot/plot2d/plot.rkt b/collects/plot/plot2d/plot.rkt index 132428328e..514244c333 100644 --- a/collects/plot/plot2d/plot.rkt +++ b/collects/plot/plot2d/plot.rkt @@ -6,6 +6,7 @@ slideshow/pict unstable/parameter-group unstable/lazy-require + unstable/latent-contract/defthing "../common/contract.rkt" "../common/math.rkt" "../common/draw.rkt" @@ -13,7 +14,6 @@ "../common/plot-element.rkt" "../common/file-type.rkt" "../common/deprecation-warning.rkt" - "../common/contract-doc.rkt" "../common/format.rkt" "plot-area.rkt") diff --git a/collects/plot/plot2d/point.rkt b/collects/plot/plot2d/point.rkt index 746401981e..e582937738 100644 --- a/collects/plot/plot2d/point.rkt +++ b/collects/plot/plot2d/point.rkt @@ -3,8 +3,8 @@ ;; Renderers for points and other point-like things. (require racket/contract racket/class racket/match racket/math racket/list - plot/utils - "../common/contract-doc.rkt") + unstable/latent-contract/defthing + plot/utils) (provide (all-defined-out)) diff --git a/collects/plot/plot2d/rectangle.rkt b/collects/plot/plot2d/rectangle.rkt index 14740e99c3..79ca590973 100644 --- a/collects/plot/plot2d/rectangle.rkt +++ b/collects/plot/plot2d/rectangle.rkt @@ -3,8 +3,8 @@ ;; The histogram renderer. (require racket/match racket/contract racket/class racket/list + unstable/latent-contract/defthing plot/utils - "../common/contract-doc.rkt" "../common/utils.rkt") (provide (all-defined-out)) diff --git a/collects/plot/plot3d/contour.rkt b/collects/plot/plot3d/contour.rkt index 6c35c424ce..940a337d65 100644 --- a/collects/plot/plot3d/contour.rkt +++ b/collects/plot/plot3d/contour.rkt @@ -1,8 +1,8 @@ #lang racket/base (require racket/class racket/match racket/list racket/flonum racket/contract + unstable/latent-contract/defthing plot/utils - "../common/contract-doc.rkt" "../common/utils.rkt") (provide (all-defined-out)) diff --git a/collects/plot/plot3d/isosurface.rkt b/collects/plot/plot3d/isosurface.rkt index ac9369a0a5..1c4c33492f 100644 --- a/collects/plot/plot3d/isosurface.rkt +++ b/collects/plot/plot3d/isosurface.rkt @@ -1,8 +1,9 @@ #lang racket/base (require racket/class racket/match racket/list racket/flonum racket/contract racket/math - plot/utils - "../common/contract-doc.rkt") + unstable/latent-contract/defthing + unstable/flonum + plot/utils) (provide (all-defined-out)) diff --git a/collects/plot/plot3d/line.rkt b/collects/plot/plot3d/line.rkt index a4532acc7a..f711b90cbb 100644 --- a/collects/plot/plot3d/line.rkt +++ b/collects/plot/plot3d/line.rkt @@ -1,8 +1,7 @@ #lang racket/base -(require racket/class racket/match racket/list racket/contract - plot/utils - "../common/contract-doc.rkt") +(require racket/class racket/match racket/list racket/contract unstable/latent-contract/defthing + plot/utils) (provide (all-defined-out)) diff --git a/collects/plot/plot3d/plot.rkt b/collects/plot/plot3d/plot.rkt index 03d48f852d..7144a676c1 100644 --- a/collects/plot/plot3d/plot.rkt +++ b/collects/plot/plot3d/plot.rkt @@ -6,6 +6,7 @@ slideshow/pict unstable/parameter-group unstable/lazy-require + unstable/latent-contract/defthing "../common/contract.rkt" "../common/math.rkt" "../common/draw.rkt" @@ -13,7 +14,6 @@ "../common/plot-element.rkt" "../common/file-type.rkt" "../common/deprecation-warning.rkt" - "../common/contract-doc.rkt" "../common/format.rkt" "plot-area.rkt") diff --git a/collects/plot/plot3d/point.rkt b/collects/plot/plot3d/point.rkt index 29ca66c869..41b3aa4f17 100644 --- a/collects/plot/plot3d/point.rkt +++ b/collects/plot/plot3d/point.rkt @@ -1,8 +1,7 @@ #lang racket/base -(require racket/class racket/list racket/match racket/contract - plot/utils - "../common/contract-doc.rkt") +(require racket/class racket/list racket/match racket/contract unstable/latent-contract/defthing + plot/utils) (provide (all-defined-out)) diff --git a/collects/plot/plot3d/rectangle.rkt b/collects/plot/plot3d/rectangle.rkt index 500fa3fb72..a4d4c7fb65 100644 --- a/collects/plot/plot3d/rectangle.rkt +++ b/collects/plot/plot3d/rectangle.rkt @@ -2,9 +2,8 @@ ;; Functions to create renderers for 3D histograms -(require racket/match racket/list racket/contract racket/class +(require racket/match racket/list racket/contract racket/class unstable/latent-contract/defthing plot/utils - "../common/contract-doc.rkt" "../common/utils.rkt") (provide (all-defined-out)) diff --git a/collects/plot/plot3d/surface.rkt b/collects/plot/plot3d/surface.rkt index 1b058c153f..1566e7f29d 100644 --- a/collects/plot/plot3d/surface.rkt +++ b/collects/plot/plot3d/surface.rkt @@ -1,8 +1,8 @@ #lang racket/base (require racket/class racket/match racket/list racket/flonum racket/contract - plot/utils - "../common/contract-doc.rkt") + unstable/latent-contract/defthing + plot/utils) (provide (all-defined-out)) diff --git a/collects/plot/scribblings/common.rkt b/collects/plot/scribblings/common.rkt index fabe9b1b6d..3cbdb0e1c9 100644 --- a/collects/plot/scribblings/common.rkt +++ b/collects/plot/scribblings/common.rkt @@ -9,7 +9,7 @@ plot plot/utils plot/doc - plot/common/contract-doc) + unstable/latent-contract/defthing) (provide (all-defined-out) (all-from-out scribble/eval) diff --git a/collects/plot/scribblings/compat.scrbl b/collects/plot/scribblings/compat.scrbl index 8ec712b9da..62693e7df8 100644 --- a/collects/plot/scribblings/compat.scrbl +++ b/collects/plot/scribblings/compat.scrbl @@ -3,7 +3,7 @@ racket/gui/base plot/compat) plot/compat - (only-in plot/common/contract-doc + (only-in unstable/latent-contract/defthing doc-apply)) @title[#:tag "compat"]{Compatibility Module} diff --git a/collects/plot/tests/isosurface-tests.rkt b/collects/plot/tests/isosurface-tests.rkt index e403fff196..0293ba728e 100644 --- a/collects/plot/tests/isosurface-tests.rkt +++ b/collects/plot/tests/isosurface-tests.rkt @@ -1,6 +1,6 @@ #lang racket -(require plot plot/utils) +(require plot plot/utils unstable/flonum) (time (plot3d (isosurface3d (λ (x y z) (sqrt (+ (sqr x) (sqr y) (sqr z)))) 1 diff --git a/collects/plot/tests/plot3d-tests.rkt b/collects/plot/tests/plot3d-tests.rkt index e0e43c26fe..59de23cd65 100644 --- a/collects/plot/tests/plot3d-tests.rkt +++ b/collects/plot/tests/plot3d-tests.rkt @@ -1,6 +1,6 @@ #lang racket -(require plot plot/utils) +(require plot plot/utils unstable/flonum) ;(plot-new-window? #t) diff --git a/collects/unstable/flonum.rkt b/collects/unstable/flonum.rkt new file mode 100644 index 0000000000..0b325c7644 --- /dev/null +++ b/collects/unstable/flonum.rkt @@ -0,0 +1,74 @@ +#lang racket/base + +(require racket/unsafe/ops) + +(provide flatan2 flmodulo + flonum->bit-field bit-field->flonum + flonum->ordinal ordinal->flonum + flstep flnext flprev + -max.0 -min.0 +min.0 +max.0) + +(define (flatan2 y x) + (cond [(not (flonum? y)) (raise-type-error 'flatan2 "flonum" 0 y x)] + [(not (flonum? x)) (raise-type-error 'flatan2 "flonum" 1 y x)] + [else (exact->inexact (atan y x))])) + +(define (flmodulo x y) + (cond [(not (flonum? x)) (raise-type-error 'flmodulo "flonum" 0 x y)] + [(not (flonum? y)) (raise-type-error 'flmodulo "flonum" 1 x y)] + [else (unsafe-fl- x (unsafe-fl* y (unsafe-flfloor (unsafe-fl/ x y))))])) + +(define (flonum->bit-field x) + (cond [(flonum? x) (integer-bytes->integer (real->floating-point-bytes x 8) #f)] + [else (raise-type-error 'flonum->bit-field "flonum" x)])) + +(define (bit-field->flonum i) + (cond [(and (exact-integer? i) (i . >= . 0) (i . <= . #xffffffffffffffff)) + (floating-point-bytes->real (integer->integer-bytes i 8 #f))] + [else + (raise-type-error 'bit-field->flonum "exact integer in [0,#xffffffffffffffff]" i)])) + +(define (flonum->ordinal x) + (cond [(flonum? x) (cond [(x . < . 0) (- (flonum->bit-field (- x)))] + [else (flonum->bit-field (unsafe-flabs x))])] ; abs for -0.0 + [else (raise-type-error 'flonum->ordinal "flonum" x)])) + +(define (ordinal->flonum i) + (cond [(and (exact-integer? i) (i . >= . #x-7fffffffffffffff) (i . <= . #x7fffffffffffffff)) + (cond [(i . < . 0) (- (bit-field->flonum (- i)))] + [else (bit-field->flonum i)])] + [else + (raise-type-error + 'ordinal->flonum "exact integer in [#x-7fffffffffffffff,#xffffffffffffffff]" i)])) + +(define +inf-ordinal (flonum->ordinal +inf.0)) +(define -inf-ordinal (flonum->ordinal -inf.0)) + +(define (flstep x n) + (cond [(not (flonum? x)) (raise-type-error 'flstep "flonum" 0 x n)] + [(not (exact-integer? n)) (raise-type-error 'flstep "exact integer" 1 x n)] + [(eqv? x +nan.0) +nan.0] + [(and (eqv? x +inf.0) (n . >= . 0)) +inf.0] + [(and (eqv? x -inf.0) (n . <= . 0)) -inf.0] + [else (define i (+ n (flonum->ordinal x))) + (cond [(i . < . -inf-ordinal) -inf.0] + [(i . > . +inf-ordinal) +inf.0] + [else (ordinal->flonum i)])])) + +(define (flnext x) (flstep x 1)) +(define (flprev x) (flstep x -1)) + +(define -max.0 (flnext -inf.0)) +(define -min.0 (flprev 0.0)) +(define +min.0 (flnext 0.0)) +(define +max.0 (flprev +inf.0)) + +#| +(require plot) + +(parameterize ([plot-x-ticks (log-ticks #:base 2 #:number 5)] + [y-axis-ticks? #f]) + (plot (list (function (λ (x) (flonum->ordinal (exact->inexact x))) + 1/4 4) + (map y-axis '(1/2 1 2))))) +|# diff --git a/collects/plot/common/contract-doc.rkt b/collects/unstable/latent-contract/defthing.rkt similarity index 100% rename from collects/plot/common/contract-doc.rkt rename to collects/unstable/latent-contract/defthing.rkt diff --git a/collects/plot/common/serialize-syntax.rkt b/collects/unstable/latent-contract/serialize-syntax.rkt similarity index 100% rename from collects/plot/common/serialize-syntax.rkt rename to collects/unstable/latent-contract/serialize-syntax.rkt