Skip to content

Add exact and inexact to cptypes #991

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 3 commits into
base: main
Choose a base branch
from
+260 −66
Open

Add exact and inexact to cptypes #991

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
360c1bf
Add exact and inexact to cptypes
gus-massa Aug 21, 2025
af96156
Reverse arguments of $real->flonum
gus-massa Nov 3, 2025
af71359
Add exact and inexact to cpprim
gus-massa Sep 22, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 5 additions & 5 deletions boot/pb/equates.h
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
/* equates.h for Chez Scheme Version 10.4.0-pre-release.1 */
/* equates.h for Chez Scheme Version 10.4.0-pre-release.2 */

/* Do not edit this file. It is automatically generated and */
/* specifically tailored to the version of Chez Scheme named */
Expand Down Expand Up @@ -335,7 +335,7 @@ typedef uint64_t U64;
#define int_bits 0x20
#define integer_divide_instruction 1
#define keyboard_interrupt_index 0x3
#define library_entry_vector_size 0x27A
#define library_entry_vector_size 0x282
#define libspec_closure_index 0xD
#define libspec_does_not_expect_headroom_index 0x0
#define libspec_error_index 0xE
Expand Down Expand Up @@ -1015,7 +1015,7 @@ typedef uint64_t U64;
#define rtd_sealed 0x4
#define sbwp (ptr)0x4E
#define scaled_shot_1_shot_flag -0x8
#define scheme_version 0xA040001
#define scheme_version 0xA040002
#define seginfo_generation_disp 0x1
#define seginfo_list_bits_disp 0x8
#define seginfo_space_disp 0x0
Expand Down Expand Up @@ -1649,5 +1649,5 @@ typedef uint64_t U64;
/* library entries we access from C code */
#define library_nonprocedure_code 162
#define library_dounderflow 164
#define library_popcount_slow 630
#define library_cpu_features 632
#define library_popcount_slow 638
#define library_cpu_features 640
Binary file modified boot/pb/petite.boot
View file
Open in desktop
Binary file not shown.
Binary file modified boot/pb/scheme.boot
View file
Open in desktop
Binary file not shown.
4 changes: 2 additions & 2 deletions boot/pb/scheme.h
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
/* scheme.h for Chez Scheme Version 10.4.0-pre-release.1 (pb) */
/* scheme.h for Chez Scheme Version 10.4.0-pre-release.2 (pb) */

/* Do not edit this file. It is automatically generated and */
/* specifically tailored to the version of Chez Scheme named */
Expand Down Expand Up @@ -40,7 +40,7 @@
#endif

/* Chez Scheme Version and machine type */
#define VERSION "10.4.0-pre-release.1"
#define VERSION "10.4.0-pre-release.2"
#define MACHINE_TYPE "pb"

/* Integer typedefs */
Expand Down
49 changes: 49 additions & 0 deletions mats/cptypes.ms
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1080,6 +1080,55 @@
'(flonum? real? (lambda (x) (and (integer? x) (exact? x)))))
)

(mat cptypes-in/exact
(test-closed1 '(inexact exact)
'(real?))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(inexact x)))
'(lambda (x) (when (fixnum? x)
(#3%fixnum->flonum x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(inexact x)))
'(lambda (x) (when (flonum? x)
(#3%fl+ x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (real? x)
(inexact x)))
'(lambda (x) (when (real? x)
(#3%real->flonum x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (inexact? x)
(inexact x)))
'(lambda (x) (when (inexact? x)
x)))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(real->flonum x)))
'(lambda (x) (when (fixnum? x)
(#3%fixnum->flonum x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (integer? x) ; a subset of rational? that is representable
(exact x)))
'(lambda (x) (when (integer? x)
(#3%exact x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (exact? x)
(exact x)))
'(lambda (x) (when (exact? x)
x)))
(cptypes-equivalent-expansion?
'(lambda (x) (when (zero? x)
(exact x)))
'(lambda (x) (when (zero? x)
0)))
(cptypes/first-equivalent-expansion?
; try to change $value to fl+, to allow flonum unboxing
'(lambda (t x) (when (flonum? x) (#3%$value (if t x 1.0))))
'(lambda (t x) (when (flonum? x) (#3%fl+ (if t x 1.0)))))
)

(mat cptypes-plus
(test-closed1 '(+ (lambda (x) (+ x 1)) (lambda (x) (+ x x)))
'(flonum? real? (lambda (x) (and (integer? x) (exact? x))) (lambda (x) (and (number? x) (exact? x)))))
Expand Down
5 changes: 5 additions & 0 deletions release_notes/release_notes.stex
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -116,6 +116,11 @@ Online versions of both books can be found at
%-----------------------------------------------------------------------------
\section{Functionality Changes}\label{section:functionality}

\subsection{Type recovery improvements (10.4.0)}

The type recovery pass has improved support for \scheme{exact}, \scheme{inexact},
and similar functions.

\subsection{In-place vector copying (10.3.0)}

The \scheme{vector-copy!} procedure copies a subsequence
Expand Down
22 changes: 16 additions & 6 deletions s/5_3.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1445,13 +1445,21 @@
(set-who! inexact (lambda (z) (convert-to-inexact z who)))
(set-who! exact->inexact (lambda (z) (convert-to-inexact z who))))

(set! $real->flonum
(lambda (who z)
(type-case z
[(fixnum?) (fixnum->flonum z)]
[(bignum? ratnum?) (float z)]
[(flonum?) z]
[else (nonreal-error who z)])))

(let ()
(define convert-to-exact
(lambda (z who)
(lambda (who z)
(type-case z
[(flonum?)
(when (exceptional-flonum? z)
($oops 'exact "no exact representation for ~s" z))
($oops who "no exact representation for ~s" z))
(let ([dx (decode-float z)])
(let ([mantissa (* (vector-ref dx 0) (vector-ref dx 2))]
[exponent (vector-ref dx 1)])
Expand All @@ -1460,12 +1468,14 @@
(* mantissa (ash 1 exponent)))))]
[($inexactnum?)
(make-rectangular
(exact ($inexactnum-real-part z))
(exact ($inexactnum-imag-part z)))]
(convert-to-exact who ($inexactnum-real-part z))
(convert-to-exact who ($inexactnum-imag-part z)))]
[(fixnum? bignum? ratnum? $exactnum?) z]
[else (nonnumber-error who z)])))
(set-who! exact (lambda (z) (convert-to-exact z who)))
(set-who! inexact->exact (lambda (z) (convert-to-exact z who))))
(set-who! exact (lambda (z) (convert-to-exact who z)))
(set-who! inexact->exact (lambda (z) (convert-to-exact who z)))
(set-who! $exact (lambda (who z) (convert-to-exact who z)))
)

(set! rationalize
; Alan Bawden's algorithm
Expand Down
4 changes: 2 additions & 2 deletions s/bytevector.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1039,7 +1039,7 @@
(bytevector-u8-set! v (fx+ i 3) (bytevector-u8-ref v2 3))))
(unless (mutable-bytevector? v) (not-a-mutable-bytevector who v))
(unaligned-ref-check who 4 v i)
(let ([x ($real->flonum x who)])
(let ([x ($real->flonum who x)])
(if (or (constant unaligned-floats) (fx= (fxlogand i 3) 0))
(if (eq? eness (native-endianness))
(#3%bytevector-ieee-single-native-set! v i x)
Expand Down Expand Up @@ -1084,7 +1084,7 @@
(bytevector-u8-set! v (fx+ i 7) (bytevector-u8-ref v2 7))))
(unless (mutable-bytevector? v) (not-a-mutable-bytevector who v))
(unaligned-ref-check who 8 v i)
(let ([x ($real->flonum x who)])
(let ([x ($real->flonum who x)])
(if (or (constant unaligned-floats) (fx= (fxlogand i 7) 0))
(if (eq? eness (native-endianness))
(#3%bytevector-ieee-double-native-set! v i x)
Expand Down
8 changes: 6 additions & 2 deletions s/cmacros.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -357,7 +357,7 @@
;; ---------------------------------------------------------------------
;; Version and machine types:

(define-constant scheme-version #x0a040001)
(define-constant scheme-version #x0a040002)

(define-syntax define-machine-types
(lambda (x)
Expand Down Expand Up @@ -2984,7 +2984,11 @@
(bytevector=? #f 2 #f #f)
(bytevector-ieee-double-native-ref #f 2 #t #t)
(bytevector-ieee-double-native-set! #f 2 #t #t)
(real->flonum #f 2 #f #t)
($real->flonum #f 2 #f #t)
(inexact #f 1 #f #t)
(exact->inexact #f 1 #f #t)
(exact #f 1 #f #t)
(inexact->exact #f 1 #f #t)
(exact? #f 1 #t #t)
(inexact? #f 1 #t #t)
(unsafe-port-eof? #f 1 #f #t)
Expand Down
56 changes: 46 additions & 10 deletions s/cpprim.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -742,14 +742,14 @@
(set! ,(%mref ,t ,offset) ,(car args))
,(f (cdr args) (fx+ offset (constant ptr-bytes)))))))))))))
(define build-$real->flonum
(lambda (src sexpr x who)
(lambda (src sexpr who x)
(if (known-flonum-result? x)
x
(bind #t (x)
(bind #f (who)
(bind #f (who)
(bind #t (x)
`(if ,(%type-check mask-flonum type-flonum ,x)
,x
,(build-libcall #t src sexpr real->flonum x who)))))))
,(build-libcall #t src sexpr $real->flonum who x)))))))
(define build-$inexactnum-real-part
(lambda (e)
(%lea ,e (fx+ (constant inexactnum-real-disp)
Expand Down Expand Up @@ -5408,9 +5408,46 @@
,(build-fixnum->flonum e-x values)
(if ,(%type-check mask-flonum type-flonum ,e-x)
,e-x
,(build-libcall #t src sexpr real->flonum e-x `(quote real->flonum))))))]))
(define-inline 3 $real->flonum
[(x who) (build-$real->flonum src sexpr x who)])
,(build-libcall #t src sexpr $real->flonum `(quote real->flonum) e-x)))))])
(define-inline 3 $real->flonum
[(who x) (build-$real->flonum src sexpr who x)])
(define-inline 2 inexact
[(e-x)
(if (known-flonum-result? e-x)
e-x
(bind #t (e-x)
`(if ,(%type-check mask-fixnum type-fixnum ,e-x)
,(build-fixnum->flonum e-x values)
(if ,(build-simple-or
(%type-check mask-flonum type-flonum ,e-x)
(%typed-object-check mask-inexactnum type-inexactnum ,e-x))
,e-x
,(build-libcall #t src sexpr inexact e-x)))))])
(define-inline 2 exact->inexact
Copy link
Contributor

@mflatt mflatt Nov 13, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This seems like too much code duplication. Add a build-exact->inexact parameterized over the library entry to call?

Copy link
Contributor Author

@gus-massa gus-massa Nov 13, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The (small) problem is that build-libcall is a macro that expect an not-quoted version of the name of the library call. So build-exact->inexact must be a macro too.

Copy link
Contributor

@mflatt mflatt Nov 14, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Or pass in a function like(lambda (e-x) (build-libcall #t src sexpr inexact e-x)). I'd say the goal isn't to avoid every bit of duplication, but to get most of it.

[(e-x)
(if (known-flonum-result? e-x)
e-x
(bind #t (e-x)
`(if ,(%type-check mask-fixnum type-fixnum ,e-x)
,(build-fixnum->flonum e-x values)
(if ,(build-simple-or
(%type-check mask-flonum type-flonum ,e-x)
(%typed-object-check mask-inexactnum type-inexactnum ,e-x))
,e-x
,(build-libcall #t src sexpr exact->inexact e-x)))))])
)
(define-inline 2 exact
Copy link
Contributor

@mflatt mflatt Nov 13, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I share your reluctance about these. Maybe if they included conversion from integer flonums that are small enough to fit into a fixnum? Otherwise, I'd be inclined to leave them out until motivated by a use.

Copy link
Contributor Author

@gus-massa gus-massa Nov 13, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Something like (copiying from #2%flonum->fixnum)

,(build-and
                            (build-fl< e-x `(quote ,(constant too-positive-flonum-for-fixnum)))
                            (build-fl< `(quote ,(constant too-negative-flonum-for-fixnum)) e-x))

I'll try tomorrow, because I prefer to see the code to think about it, but I'm still not sure.

Copy link
Contributor Author

@gus-massa gus-massa Nov 15, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The code should check that it's an integer flonum. flonum->fixnum just truncates the value. To check that one possibility is to look if the exponent is big enough, but that will detect only very big flonums, bigger than ~2^54 that are not very interesting (and I'm missing 0.0 and inf.0). It looks too hard to do something interesting with fast code.

I'll try to add the most interesting cases to cptypes instead.

[(e-x)
(bind #t (e-x)
`(if ,(%type-check mask-fixnum type-fixnum ,e-x)
,e-x
,(build-libcall #t src sexpr exact e-x)))])
(define-inline 2 inexact->exact
[(e-x)
(bind #t (e-x)
`(if ,(%type-check mask-fixnum type-fixnum ,e-x)
,e-x
,(build-libcall #t src sexpr inexact->exact e-x)))])
(define-inline 2 $record
[(tag . args) (build-$record tag args)])
(define-inline 3 $object-address
Expand Down Expand Up @@ -7136,7 +7173,7 @@
(let-values ([(e-index imm-offset) (bv-index-offset e-offset)])
(bind #f (e-bv e-index)
(build-object-set! 'type e-bv e-index imm-offset
(build-$real->flonum src sexpr e-val `(quote name)))))])])))
(build-$real->flonum src sexpr `(quote name) e-val))))])])))

(define-bv-native-ieee-set!-inline bytevector-ieee-single-native-set! single-float)
(define-bv-native-ieee-set!-inline bytevector-ieee-double-native-set! double-float)
Expand Down Expand Up @@ -7264,8 +7301,7 @@
(let-values ([(e-index imm-offset) (bv-index-offset e-offset)])
(bind #f (e-bv e-index)
(build-object-set! 'type e-bv e-index imm-offset
(build-$real->flonum src sexpr e-value
`(quote name))))))])])))
(build-$real->flonum src sexpr `(quote name) e-value)))))])])))

(define-bv-ieee-set!-inline bytevector-ieee-single-set! single-float 3)
(define-bv-ieee-set!-inline bytevector-ieee-double-set! double-float 7))
Expand Down
8 changes: 6 additions & 2 deletions s/cptypes-lattice.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -68,12 +68,15 @@
flonum-pred
real-pred
number-pred
zero-pred
flzero-pred
flinteger-pred
exact-real-pred
exact-pred
inexact-pred
integer-pred
subset-of-rational-pred
subset-of-complex-rational-pred
$fixmediate-pred
$list-pred ; immutable lists
list-pair-pred
Expand Down Expand Up @@ -579,8 +582,7 @@
[maybe-flonum maybe-flonum-pred]
[real real-pred]
[sub-real (cons 'bottom real-pred)]
[rational (cons (predicate-union exact-real-pred flinteger-pred)
real-pred)]
[rational (cons subset-of-rational-pred real-pred)]
[flrational (cons flinteger-pred flonum-pred)]
[(infinite nan) (cons 'bottom flonum**-pred)]
[integer integer-pred]
Expand Down Expand Up @@ -1493,6 +1495,8 @@
(define maybe-number-pred (maybe number-pred))
(define zero-pred (predicate-union (predicate-union flzero-pred inexact-complex-zero-pred)
fxzero-rec))
(define subset-of-rational-pred (predicate-union exact-real-pred flinteger-pred))
(define subset-of-complex-rational-pred (predicate-union subset-of-rational-pred inexact-complex-zero-pred))
(define maybe-symbol-pred (maybe symbol-pred))
(define maybe-procedure-pred (maybe 'procedure))
(define vector-pred (predicate-union null-vector-pred vector*-pred))
Expand Down
Loading