diff --git a/mozilla/js2/semantics/Test/StandardFunction.lisp b/mozilla/js2/semantics/Test/StandardFunction.lisp index e9c9e171167..1ecfe84a450 100644 --- a/mozilla/js2/semantics/Test/StandardFunction.lisp +++ b/mozilla/js2/semantics/Test/StandardFunction.lisp @@ -6,6 +6,11 @@ (production :start () start-none) + (deftuple x-long (value (integer-range (neg (expt 2 63)) (- (expt 2 63) 1)))) + (deftuple x-u-long (value (integer-range 0 (- (expt 2 64) 1)))) + (deftype x-general-number (union long u-long float32 float64)) + (deftype x-finite-general-number (union long u-long finite-float32 finite-float64)) + (define (x-digit-value (c character)) integer (cond ((set-in c (range-set-of-ranges character #\0 #\9)) @@ -20,24 +25,34 @@ (const s (range-set integer) (range-set-of integer (neg (expt 2 1024)) 0 (expt 2 1024))) (const a integer (integer-set-min s)) (cond - ((= a (expt 2 1024)) (return +infinity)) - ((= a (neg (expt 2 1024))) (return -infinity)) - ((/= a 0) (return 78.0)) - ((< x 0 rational) (return -zero)) - (nil (return +zero)))) + ((= a (expt 2 1024)) (return +infinity64)) + ((= a (neg (expt 2 1024))) (return -infinity64)) + ((/= a 0) (return (bottom))) + ((< x 0 rational) (return -zero64)) + (nil (return +zero64)))) + + (define (x-float32-to-float64 (x float32)) float64 + (case x + (:select (tag +zero32) (return +zero64)) + (:select (tag -zero32) (return -zero64)) + (:select (tag +infinity32) (return +infinity64)) + (:select (tag -infinity32) (return -infinity64)) + (:select (tag nan32) (return nan64)) + (:narrow nonzero-finite-float32 (return (real-to-float64 (& value x)))))) (define (x-truncate-finite-float64 (x finite-float64)) integer - (rwhen (in x (tag +zero -zero) :narrow-false) + (rwhen (in x (tag +zero64 -zero64) :narrow-false) (return 0)) - (if (> x 0 rational) - (return (floor x)) - (return (ceiling x)))) + (const r rational (& value x)) + (if (> r 0 rational) + (return (floor r)) + (return (ceiling r)))) - (define (compare (x rational) (y rational)) order + #|(define (compare (x rational) (y rational)) order (cond ((< x y rational) (return less)) ((= x y rational) (return equal)) - (nil (return greater)))) + (nil (return greater))))|# ))) (defparameter *sfg* (world-grammar *sfw* 'standard-function-grammar)))