diff options
author | Andy Wingo <wingo@pobox.com> | 2020-08-03 21:49:50 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2020-08-03 22:19:18 +0200 |
commit | d238566d0e6b36706c33d22c19b5c86d2e60640f (patch) | |
tree | a2f84e3721ae724d4ebd3ec20b62e2385abc542d /module/system/base | |
parent | 1ee99d97db342ab6c8e3f81f697ebe6caf38478b (diff) | |
download | guile-d238566d0e6b36706c33d22c19b5c86d2e60640f.tar.gz |
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.
Diffstat (limited to 'module/system/base')
-rw-r--r-- | module/system/base/types/internal.scm | 35 |
1 files changed, 19 insertions, 16 deletions
diff --git a/module/system/base/types/internal.scm b/module/system/base/types/internal.scm index 768deae92..c75ca3bf6 100644 --- a/module/system/base/types/internal.scm +++ b/module/system/base/types/internal.scm @@ -103,13 +103,16 @@ (fixnum fixnum? #b11 #b10) (heap-object heap-object? #b111 #b000) (char char? #b11111111 #b00001100) - (false eq-false? #b111111111111 #b000000000100) - (nil eq-nil? #b111111111111 #b000100000100) - (null eq-null? #b111111111111 #b001100000100) - (true eq-true? #b111111111111 #b010000000100) - (unspecified unspecified? #b111111111111 #b100000000100) (undefined undefined? #b111111111111 #b100100000100) - (eof eof-object? #b111111111111 #b101000000100) + + ;; To check for these values from Scheme, use eq?. From assembler, + ;; use eq-immediate?. + (false #f #b111111111111 #b000000000100) + (nil #f #b111111111111 #b000100000100) + (null #f #b111111111111 #b001100000100) + (true #f #b111111111111 #b010000000100) + (unspecified #f #b111111111111 #b100000000100) + (eof #f #b111111111111 #b101000000100) ;;(nil eq-nil? #b111111111111 #b000100000100) ;;(eol eq-null? #b111111111111 #b001100000100) @@ -200,24 +203,24 @@ may not fit into a word on the target platform." ((eq? x #t) %tc16-true) ((unspecified? x) %tc16-unspecified) ;; FIXME: %tc16-undefined. - ((eof-object? x) %tc16-eof) + ((eof-object? x) %tc16-eof) (else #f))) (define (immediate-bits->scm imm) "Return the SCM object corresponding to the immediate encoding @code{imm}. Note that this value should be sign-extended already." (define-syntax-rule (define-predicate name pred mask tag) - (define (pred) (eqv? (logand imm mask) tag))) + (define (name) (eqv? (logand imm mask) tag))) (visit-immediate-tags define-predicate) (cond - ((fixnum?) (ash imm -2)) - ((char?) (integer->char (ash imm -8))) - ((eq-false?) #f) - ((eq-nil?) #nil) - ((eq-null?) '()) - ((eq-true?) #t) - ((unspecified?) (if #f #f)) - ((eof-object?) the-eof-object) + ((fixnum) (ash imm -2)) + ((char) (integer->char (ash imm -8))) + ((false) #f) + ((nil) #nil) + ((null) '()) + ((true) #t) + ((unspecified) (if #f #f)) + ((eof) the-eof-object) (else (error "invalid immediate" imm))) ) (define (sign-extend x bits) |