Skip to content

Add reductions for + in cptypes #959

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

Merged
merged 4 commits into from
Aug 15, 2025
Merged

Add reductions for + in cptypes #959

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
2af3b91
add reductions for + in cptypes
gus-massa Aug 8, 2025
f38e102
Add $fxx- primitive
gus-massa Aug 11, 2025
163e60e
add reductions for - in cptypes
gus-massa Aug 11, 2025
8c1d401
re.boot
gus-massa Aug 13, 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
4 changes: 2 additions & 2 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.3.0-pre-release.2 */
/* equates.h for Chez Scheme Version 10.3.0-pre-release.3 */

/* Do not edit this file. It is automatically generated and */
/* specifically tailored to the version of Chez Scheme named */
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 0xA030002
#define scheme_version 0xA030003
#define seginfo_generation_disp 0x1
#define seginfo_list_bits_disp 0x8
#define seginfo_space_disp 0x0
Expand Down
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.3.0-pre-release.2 (pb) */
/* scheme.h for Chez Scheme Version 10.3.0-pre-release.3 (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.3.0-pre-release.2"
#define VERSION "10.3.0-pre-release.3"
#define MACHINE_TYPE "pb"

/* Integer typedefs */
Expand Down
303 changes: 297 additions & 6 deletions mats/cptypes.ms
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,23 @@
#;[optimize-level (max (optimize-level) 2)])
(expand/optimize y)))]))

(define-syntax cptypes/first-equivalent-expansion?
; When run-cp0 is call, use first #3%$cptypes and
; then twice the cp0 function provided.
; This checks that cptypes.ss doesn't mess up unusual combinations
; that are reduced by cp0.
(syntax-rules ()
[(_ x y)
(equivalent-expansion?
(parameterize ([run-cp0 (lambda (cp0 c) (cp0 (cp0 (#3%$cptypes c))))]
[#%$suppress-primitive-inlining #f]
#;[optimize-level (max (optimize-level) 2)])
(expand/optimize x))
(parameterize ([run-cp0 (lambda (cp0 c) (cp0 (cp0 (#3%$cptypes c))))]
[#%$suppress-primitive-inlining #f]
#;[optimize-level (max (optimize-level) 2)])
(expand/optimize y)))]))

(mat cptypes-handcoded
(cptypes-equivalent-expansion?
'(vector? (vector)) ;actually reduced by folding, not cptypes
Expand Down Expand Up @@ -664,6 +681,7 @@
(test-chain* '(fixnum? integer? real?))
(test-chain* '(fixnum? exact? number?)) ; exact? may raise an error
(test-chain* '(bignum? exact? number?)) ; exact? may raise an error
(test-chain '(fixnum? (lambda (x) (and (integer? x) (exact? x))) (lambda (x) (and (number? x) (exact? x))) number?))
(test-chain '((lambda (x) (eqv? x (expt 256 100))) bignum? integer? real? number?))
(test-chain '((lambda (x) (eqv? 0.0 x)) flonum? real? number?))
(test-chain '((lambda (x) (eqv? 0.0 x)) flonum? cflonum? number?))
Expand Down Expand Up @@ -980,7 +998,7 @@
'(lambda (x) (when (fixnum? x)
(sub1 x)))
'(lambda (x) (when (fixnum? x)
(#3%$fxx+ x -1))))
(#3%$fxx- x 1))))
(not (cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(fixnum? (sub1 x))))
Expand All @@ -1000,7 +1018,7 @@
'(lambda (x) (when (fixnum? x)
(1- x)))
'(lambda (x) (when (fixnum? x)
(#3%$fxx+ x -1))))
(#3%$fxx- x 1))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(1- x)))
Expand All @@ -1010,7 +1028,7 @@
'(lambda (x) (when (fixnum? x)
(-1+ x)))
'(lambda (x) (when (fixnum? x)
(#3%$fxx+ x -1))))
(#3%$fxx- x 1))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(-1+ x)))
Expand All @@ -1026,9 +1044,9 @@
(abs x)))
'(lambda (x) (when (fixnum? x)
(let ([t x])
(if (#3%fx= t (most-negative-fixnum))
(pariah (- (most-negative-fixnum)))
(#3%fxabs t))))))
(if (#3%fx>= t 0)
t
(#3%$fxx- t))))))
(cptypes-equivalent-expansion? ; unexpected, but correct
'(lambda (x) (when (bignum? x)
(bignum? (abs x))))
Expand All @@ -1043,6 +1061,279 @@
'(flonum? real? (lambda (x) (and (integer? x) (exact? x)))))
)

(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)))))
(not (cptypes-equivalent-expansion? ; integer? is not closed
'(lambda (x) (when (integer? x) (integer? (+ x x))))
'(lambda (x) (when (integer? x) (+ x x) #t))))
(cptypes-equivalent-expansion?
'(lambda (x y) (when (and (fixnum? x) (fixnum? y))
(+ x y)))
'(lambda (x y) (when (and (fixnum? x) (fixnum? y))
(#3%$fxx+ x y))))
(cptypes-equivalent-expansion?
'(lambda (x y) (when (and (flonum? x) (flonum? y))
(+ x y)))
'(lambda (x y) (when (and (flonum? x) (flonum? y))
(#3%fl+ x y))))
(cptypes-equivalent-expansion?
'(lambda (x y) (when (and (number? x) (number? y))
(+ x y)))
'(lambda (x y) (when (and (number? x) (number? y))
(#3%+ x y))))
; in cp0, partial-folder reverses (+ x 1) to (+ 1 x)
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(+ 1 x)))
'(lambda (x) (when (fixnum? x)
(#3%$fxx+ 1 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(+ 1 x)))
'(lambda (x) (when (flonum? x)
(#3%fl+ 1.0 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (number? x)
(+ 1 x)))
'(lambda (x) (when (number? x)
(#3%+ 1 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(+ 1.0 x)))
'(lambda (x) (when (fixnum? x)
(#3%fl+ 1.0 (fixnum->flonum x)))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(+ -0.0 x)))
'(lambda (x) (when (fixnum? x)
(#3%fl+ -0.0 (if (#3%eqv? x 0) -0.0 (fixnum->flonum x))))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (bignum? x)
(+ -0.0 x)))
'(lambda (x) (when (bignum? x)
(#3%fl+ -0.0 (real->flonum x)))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(+ 1.0 x)))
'(lambda (x) (when (flonum? x)
(#3%fl+ 1.0 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (number? x)
(+ 1.0 x)))
'(lambda (x) (when (number? x)
(#3%+ 1.0 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(+ 1 x x)))
'(lambda (x) (when (fixnum? x)
(#3%$fxx+ 1 x x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(+ 1 x x)))
'(lambda (x) (when (flonum? x)
(#3%fl+ 1.0 x x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (number? x)
(+ 1 x x)))
'(lambda (x) (when (number? x)
(#3%+ 1 x x))))
(cptypes/first-equivalent-expansion?
'(lambda (x) (+))
'(lambda (x) 0))
(cptypes/first-equivalent-expansion?
'(lambda (x) (+ 0))
'(lambda (x) 0))
(cptypes/first-equivalent-expansion?
'(lambda (x) (+ 0 0))
'(lambda (x) 0))
(cptypes/first-equivalent-expansion?
'(lambda (x) (+ 0 0.0))
'(lambda (x) 0.0))
(cptypes/first-equivalent-expansion?
'(lambda (x) (+ 0 -0.0))
'(lambda (x) -0.0))
(cptypes/first-equivalent-expansion?
'(lambda (x) (+ 0.0 -0.0))
'(lambda (x) 0.0))
)

(mat cptypes-minus
(test-closed1 '(- (lambda (x) (- x 1)) (lambda (x) (- 1 x)) (lambda (x) (- x x)))
'(flonum? real? (lambda (x) (and (integer? x) (exact? x))) (lambda (x) (and (number? x) (exact? x)))))
(not (cptypes-equivalent-expansion? ; integer? is not closed
'(lambda (x y) (when (and (integer? x) (integer? y)) (integer? (- x y))))
'(lambda (x y) (when (and (integer? x) (integer? y)) (- x y) #t))))
(cptypes-equivalent-expansion?
'(lambda (x y) (when (and (fixnum? x) (fixnum? y))
(- x y)))
'(lambda (x y) (when (and (fixnum? x) (fixnum? y))
(#3%$fxx- x y))))
(cptypes-equivalent-expansion?
'(lambda (x y) (when (and (flonum? x) (flonum? y))
(- x y)))
'(lambda (x y) (when (and (flonum? x) (flonum? y))
(#3%fl- x y))))
(cptypes-equivalent-expansion?
'(lambda (x y) (when (and (number? x) (number? y))
(- x y)))
'(lambda (x y) (when (and (number? x) (number? y))
(#3%- x y))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(- 1 x)))
'(lambda (x) (when (fixnum? x)
(#3%$fxx- 1 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(- 1 x)))
'(lambda (x) (when (flonum? x)
(#3%fl- 1.0 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (number? x)
(- 1 x)))
'(lambda (x) (when (number? x)
(#3%- 1 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(- x 1)))
'(lambda (x) (when (fixnum? x)
(#3%$fxx- x 1))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(- x 1)))
'(lambda (x) (when (flonum? x)
(#3%fl- x 1.0))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (number? x)
(- x 1)))
'(lambda (x) (when (number? x)
(#3%- x 1))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(- 1.0 x)))
'(lambda (x) (when (fixnum? x)
(#3%fl- 1.0 (fixnum->flonum x)))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(- x 1.0)))
'(lambda (x) (when (fixnum? x)
(#3%fl- (fixnum->flonum x) 1.0))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(- -0.0 x)))
'(lambda (x) (when (fixnum? x)
(#3%fl- -0.0 (fixnum->flonum x)))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (bignum? x)
(- -0.0 x)))
'(lambda (x) (when (bignum? x)
(#3%fl- -0.0 (real->flonum x)))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(- x -0.0)))
'(lambda (x) (when (fixnum? x)
(#3%fl- (fixnum->flonum x) -0.0))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (bignum? x)
(- x -0.0)))
'(lambda (x) (when (bignum? x)
(#3%fl- (real->flonum x) -0.0))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(- 0.0 x)))
'(lambda (x) (when (fixnum? x)
(#3%fl- 0.0 (fixnum->flonum x)))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (bignum? x)
(- 0.0 x)))
'(lambda (x) (when (bignum? x)
(#3%fl- 0.0 (real->flonum x)))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(- x 0.0)))
'(lambda (x) (when (fixnum? x)
(#3%fl- (if (#3%eqv? x 0) -0.0 (fixnum->flonum x)) 0.0))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (bignum? x)
(- x 0.0)))
'(lambda (x) (when (bignum? x)
(#3%fl- (real->flonum x) 0.0))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(- 1.0 x)))
'(lambda (x) (when (flonum? x)
(#3%fl- 1.0 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (number? x)
(- 1.0 x)))
'(lambda (x) (when (number? x)
(#3%- 1.0 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(- x 1.0)))
'(lambda (x) (when (flonum? x)
(#3%fl- x 1.0))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (number? x)
(- x 1.0)))
'(lambda (x) (when (number? x)
(#3%- x 1.0))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (number? x)
(- x 1.0)))
'(lambda (x) (when (number? x)
(#3%- x 1.0))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(- 1 x x)))
'(lambda (x) (when (fixnum? x)
(#3%$fxx- 1 x x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(- 1 x x)))
'(lambda (x) (when (flonum? x)
(#3%fl- 1.0 x x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (number? x)
(- 1 x x)))
'(lambda (x) (when (number? x)
(#3%- 1 x x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x)
(- x 1 x)))
'(lambda (x) (when (fixnum? x)
(#3%$fxx- x 1 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (flonum? x)
(- x 1 x)))
'(lambda (x) (when (flonum? x)
(#3%fl- x 1.0 x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (number? x)
(- x 1 x)))
'(lambda (x) (when (number? x)
(#3%- x 1 x))))
(cptypes/first-equivalent-expansion?
'(lambda (x) (- 0))
'(lambda (x) 0))
(cptypes/first-equivalent-expansion?
'(lambda (x) (- 0 0))
'(lambda (x) 0))
(cptypes/first-equivalent-expansion?
'(lambda (x) (- 0 0.0))
'(lambda (x) -0.0))
(cptypes/first-equivalent-expansion?
'(lambda (x) (- 0 -0.0))
'(lambda (x) 0.0))
(cptypes/first-equivalent-expansion?
'(lambda (x) (- 0.0 -0.0))
'(lambda (x) 0.0))
(cptypes/first-equivalent-expansion?
'(lambda (x) (- -0.0 0.0))
'(lambda (x) -0.0))
)

(mat cptypes-rest-argument
(cptypes/nocp0-equivalent-expansion?
'((lambda (x . r) (pair? r)) 1)
Expand Down
1 change: 1 addition & 0 deletions release_notes/release_notes.stex
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -139,6 +139,7 @@ and \scheme{inexact?}, .
The type recovery pass has improved support for \scheme{cfl+} and
similar functions. Also improve the support of predicates, in
particular integer?, zero? and similar predicates.
Also, add suport for \scheme{+} abd \scheme{-}.

\subsection{Unicode 16.0.0 support (10.3.0)}

Expand Down
2 changes: 1 addition & 1 deletion 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 #x0a030002)
(define-constant scheme-version #x0a030003)

(define-syntax define-machine-types
(lambda (x)
Expand Down
Loading