cs: fix checking and arity of unsupported extfl functions

pkgs/racket-doc/scribblings/reference/extflonums.scrbl

@@ -140,7 +140,7 @@ and if the values in corresponding slots of the @tech{extflvectors} are
 @defproc[(extflvector? [v any/c]) boolean?]
 @defproc[(extflvector [x extflonum?] ...) extflvector?]
 @defproc[(make-extflvector [size exact-nonnegative-integer?]
-                           [x extflonum? 0.0l0])
+                           [x extflonum? 0.0t0])
          extflvector?]
 @defproc[(extflvector-length [vec extflvector?]) exact-nonnegative-integer?]
 @defproc[(extflvector-ref [vec extflvector?] [pos exact-nonnegative-integer?])
@@ -176,11 +176,15 @@ and @racket[flvector-copy], but for @tech{extflvectors}.}
 Like @racket[in-flvector], @racket[for/flvector], and @racket[for*/flvector],
 but for @tech{extflvectors}.}
 
+@deftogether[(
+@defproc[(shared-extflvector [x extflonum?] ...) extflvector?]
 @defproc[(make-shared-extflvector [size exact-nonnegative-integer?]
-                                  [x extflonum? 0.0l0]) 
+                                  [x extflonum? 0.0t0])
-         extflvector?]{
+         extflvector?]
+)]{
 
-Like @racket[make-shared-flvector], but for @tech{extflvectors}.}
+Like @racket[shared-flvector] and @racket[make-shared-flvector],
+but for @tech{extflvectors}.}
 
 @; ------------------------------------------------------------
 

racket/src/cs/rumble/extfl.ss

@@ -23,71 +23,138 @@
 
 (define-syntax (define-extfl-ids stx)
   (syntax-case stx ()
-    [(_ id ...)
+    [(_ (id arg ...) ...)
      #'(begin
-         (define (id v)
+         (define/who (id arg ...)
-           (raise-unsupported-error 'id))
+           (check who extflonum? arg) ...
+           (raise-unsupported-error who))
          ...)]))
 
 (define-extfl-ids
-  extfl*
+  (extfl* a b)
-  extfl+
+  (extfl+ a b)
-  extfl-
+  (extfl- a b)
-  ->extfl
+  (extfl->exact a)
-  extfl->exact
+  (extfl->exact-integer a)
-  extfl->exact-integer
+  (extfl->floating-point-bytes a)
-  extfl->floating-point-bytes
+  (extfl->fx a)
-  extfl->fx
+  (extfl->inexact a)
-  extfl->inexact
+  (extfl/ a b)
-  extfl/
+  (extfl< a b)
-  extfl<
+  (extfl<= a b)
-  extfl<=
+  (extfl= a b)
-  extfl=
+  (extfl> a b)
-  extfl>
+  (extfl>= a b)
-  extfl>=
+  (extflabs a)
-  extflabs
+  (extflacos a)
-  extflacos
+  (extflasin a)
-  extflasin
+  (extflatan a)
-  extflatan
+  (extflceiling a)
-  extflceiling
+  (extflcos a)
-  extflcos
+  (extflexp a)
-  extflexp
+  (extflexpt a b)
-  extflexpt
+  (extflfloor a)
-  floating-point-bytes->extfl
+  (extfllog a)
-  extflfloor
+  (extflmax a b)
-  fx->extfl
+  (extflmin a b)
-  extfllog
+  (extflround a)
-  make-shared-extflvector
+  (extflsin a)
-  make-extflvector
+  (extflsqrt a)
-  extflmax
+  (extfltan a)
-  extflmin
+  (extfltruncate a)
-  real->extfl
-  extflround
-  shared-extflvector
-  extflsin
-  extflsqrt
-  extfltan
-  extfltruncate
-  extflvector
-  extflvector-length
-  extflvector-ref
-  extflvector-set!
 
-  unsafe-extfl*
+  (unsafe-extfl* a b)
-  unsafe-extfl+
+  (unsafe-extfl+ a b)
-  unsafe-extfl-
+  (unsafe-extfl- a b)
-  unsafe-extfl/
+  (unsafe-extfl/ a b)
-  unsafe-extfl<
+  (unsafe-extfl< a b)
-  unsafe-extfl<=
+  (unsafe-extfl<= a b)
-  unsafe-extfl=
+  (unsafe-extfl= a b)
-  unsafe-extfl>
+  (unsafe-extfl> a b)
-  unsafe-extfl>=
+  (unsafe-extfl>= a b)
-  unsafe-extflabs
+  (unsafe-extflabs a b)
-  unsafe-extflmax
+  (unsafe-extflmax a b)
-  unsafe-extflmin
+  (unsafe-extflmin a b)
-  unsafe-extflsqrt
+  (unsafe-extflsqrt a)
-  unsafe-extfl->fx
+  (unsafe-extfl->fx a)
-  unsafe-fx->extfl
+  (unsafe-fx->extfl a))
-  unsafe-extflvector-length
+
-  unsafe-extflvector-ref
+(define/who (->extfl a)
-  unsafe-extflvector-set!)
+  (check who exact-integer? a)
+  (raise-unsupported-error who))
+
+(define/who (fx->extfl a)
+  (check who fixnum? a)
+  (raise-unsupported-error who))
+
+(define/who (real->extfl a)
+  (check who real? a)
+  (raise-unsupported-error who))
+
+(define/who floating-point-bytes->extfl
+  (case-lambda
+   [(bstr big-endian? start end)
+    (check who bytes? bstr)
+    (check who exact-nonnegative-integer? start)
+    (check who exact-nonnegative-integer? end)
+    (case (- end start)
+      [(10) (raise-unsupported-error who)]
+      [else
+       (raise-arguments-error who
+                              "length is not 10 bytes"
+                              "length" (- end start))])]
+   [(bstr)
+    (floating-point-bytes->extfl bstr (system-big-endian?) 0 (and (bytes? bstr) (bytes-length bstr)))]
+   [(bstr big-endian?)
+    (floating-point-bytes->extfl bstr big-endian? 0 (and (bytes? bstr) (bytes-length bstr)))]
+   [(bstr big-endian? start)
+    (floating-point-bytes->extfl bstr big-endian? start (and (bytes? bstr) (bytes-length bstr)))]))
+
+(define/who make-extflvector
+  (case-lambda
+   [(len)
+    (check who exact-nonnegative-integer? len)
+    (raise-unsupported-error who)]
+   [(len v)
+    (check who exact-nonnegative-integer? len)
+    (check who extflonum? v)
+    (raise-unsupported-error who)]))
+
+(define/who make-shared-extflvector
+  (case-lambda
+   [(len)
+    (check who exact-nonnegative-integer? len)
+    (raise-unsupported-error who)]
+   [(len v)
+    (check who exact-nonnegative-integer? len)
+    (check who extflonum? v)
+    (raise-unsupported-error who)]))
+
+(define/who (extflvector . args)
+  (for-each (lambda (a) (check who extflonum? a))
+            args)
+  (raise-unsupported-error who))
+
+(define/who (shared-extflvector . args)
+  (for-each (lambda (a) (check who extflonum? a))
+            args)
+  (raise-unsupported-error who))
+
+(define/who (extflvector-length a)
+  (check who extflvector? a)
+  ;; won't get here
+  (raise-unsupported-error who))
+
+(define/who (extflvector-ref a i)
+  (check who extflvector? a)
+  ;; won't get here
+  (raise-unsupported-error who))
+
+(define/who (extflvector-set! a i v)
+  (check who extflvector? a)
+  ;; won't get here
+  (raise-unsupported-error who))
+
+(define/who (unsafe-extflvector-length a) (extflvector-length a))
+(define/who (unsafe-extflvector-ref a i) (extflvector-ref a i))
+(define/who (unsafe-extflvector-set! a i v) (extflvector-set! a i v))

racket/src/cs/rumble/number.ss

@@ -248,7 +248,7 @@
                                                   (endianness big)
                                                   (endianness little)))]
       [else
-       (raise-arguments-error 'floating-point-bytes->real
+       (raise-arguments-error who
                               "length is not 4 or 8 bytes"
                               "length" (- end start))])]
    [(bstr)