mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-17 09:10:22 +02:00
CPS compiler reduces eq? on constant to eq-constant?
* module/language/cps/compile-bytecode.scm (compile-function): Expect eq-constant? instead of eq-null?, etc. * module/language/cps/effects-analysis.scm: Likewise. * module/language/cps/reify-primitives.scm (reify-primitives): For eq-constant?, reify a $const unless the constant is an immediate whose encoding fits in 16 bits. * module/language/cps/type-fold.scm (materialize-constant): Helper to make a constant from a type, min, and max. (fold-eq-constant?): New helper. (eq-constant?): New folder. (undefined?): Define specifically. (define-nullish-predicate-folder): Renamd from define-special-immediate-predicate-folder. Use only for null?, false, and nil?. (*branch-reducers*): New mechanism. Reduce eq? to eq-constant? if possible. (local-type-fold): Refactor to use materialize-constant, and to allow reducing branches. * module/language/cps/types.scm (constant-type): Return three values instead of a type entry. (constant-type-entry): New function that returns a type entry. Adapt callers. (infer-constant-comparison): New helper. (eq-constant?): New inferrer. (undefined?): New inferrer. * module/language/tree-il/compile-bytecode.scm (eq-constant?): Fix truncate-bits signed arg. (define-immediate-type-predicate): Adapt to visit-immediate-tags change. * module/language/tree-il/compile-cps.scm (convert): Convert eq? to constant to eq-constant?. Advantaged is that it gets fixnums and chars in addition to special immediates. * module/language/tree-il/cps-primitives.scm (define-immediate-type-predicate): Adapt to allow #f as pred. * module/system/base/types/internal.scm (immediate-tags): Use #f as pred for false, nil, etc. (immediate-bits->scm): Adapt. * module/system/vm/assembler.scm (emit-eq-null?, emit-eq-nil?) (emit-eq-false?, emit-eq-true?, emit-unspecified?, emit-eof-object?): Remove specialized emitters. * module/system/vm/assembler.scm (define-immediate-tag=?-macro-assembler): Allow for pred to be #f. * module/system/vm/disassembler.scm (define-immediate-tag-annotation): Adapt to pred being #f.
This commit is contained in:
parent
1ee99d97db
commit
d238566d0e
11 changed files with 227 additions and 146 deletions
|
@ -300,7 +300,7 @@
|
|||
(and=>
|
||||
(scm->immediate-bits x)
|
||||
(lambda (bits)
|
||||
(truncate-bits bits 16 x))))
|
||||
(truncate-bits bits 16 #t))))
|
||||
#:emit/immediate (lambda (asm a b kf)
|
||||
(emit-eq-immediate? asm a b)
|
||||
(emit-jne asm kf)))
|
||||
|
@ -326,9 +326,12 @@
|
|||
#`(lambda (asm a kf)
|
||||
(#,(id-prepend 'emit- #'pred) asm a)
|
||||
(emit-jne asm kf))))))
|
||||
(define-syntax-rule (define-immediate-type-predicate name pred mask tag)
|
||||
(define-primitive pred #:nargs 1 #:predicate? #t
|
||||
#:emit (predicate-emitter pred)))
|
||||
(define-syntax define-immediate-type-predicate
|
||||
(syntax-rules ()
|
||||
((_ name #f mask tag) #f)
|
||||
((_ name pred mask tag)
|
||||
(define-primitive pred #:nargs 1 #:predicate? #t
|
||||
#:emit (predicate-emitter pred)))))
|
||||
(define-syntax-rule (define-heap-type-predicate name pred mask tag)
|
||||
(define-primitive pred #:nargs 1 #:predicate? #t
|
||||
#:emit (lambda (asm a kf)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue