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)
2011-11-25 18:37:18 -07:00 · 2011-11-25 18:37:18 -07:00 · 553c72ab28
commit 553c72ab28
parent 59691aab83
42 changed files with 148 additions and 134 deletions
--- 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))

--- 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
--- 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")

--- 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))
--- 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))
--- 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")
--- 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)

--- 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)
--- 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]
--- 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")

--- 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"
--- 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))
--- 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")

--- 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))

--- 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"
--- 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
--- 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"
--- 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
--- 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))
--- 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
--- 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))
--- 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"
--- 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))

--- 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")

--- 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))

--- 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")

--- 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))

--- 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))
--- 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))
--- 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))

--- 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))

--- 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")

--- 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))

--- 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))
--- 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))

--- 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)
--- 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}
--- 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
--- 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)

--- a/collects/unstable/flonum.rkt
+++ 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)))))
+|#
--- a/collects/unstable/latent-contract/defthing.rkt
+++ b/collects/unstable/latent-contract/defthing.rkt
--- a/collects/unstable/latent-contract/serialize-syntax.rkt
+++ b/collects/unstable/latent-contract/serialize-syntax.rkt