mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 04:10:18 +02:00
Better char<? compilation
* module/language/tree-il/primitives.scm (character-comparison-expander): Expand out char<? and friends to <, unboxing the char arguments. * module/language/cps/types.scm: * module/language/cps/effects-analysis.scm: Remove mention of char<? and friends as we won't see them any more. Also fixes #24318.
This commit is contained in:
parent
2dbb0e212d
commit
3b2cd09fe2
3 changed files with 18 additions and 8 deletions
|
@ -488,10 +488,6 @@ is or might be a read or a write to the same location as A."
|
||||||
|
|
||||||
;; Characters.
|
;; Characters.
|
||||||
(define-primitive-effects
|
(define-primitive-effects
|
||||||
((char<? . _) &type-check)
|
|
||||||
((char<=? . _) &type-check)
|
|
||||||
((char>=? . _) &type-check)
|
|
||||||
((char>? . _) &type-check)
|
|
||||||
((integer->char _) &type-check)
|
((integer->char _) &type-check)
|
||||||
((char->integer _) &type-check))
|
((char->integer _) &type-check))
|
||||||
|
|
||||||
|
|
|
@ -1423,10 +1423,6 @@ minimum, and maximum."
|
||||||
;;; Characters.
|
;;; Characters.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define-simple-type (char<? &char &char)
|
|
||||||
((logior &true &false) 0 0))
|
|
||||||
(define-type-aliases char<? char<=? char>=? char>?)
|
|
||||||
|
|
||||||
(define-simple-type-checker (integer->char (&u64 0 *max-codepoint*)))
|
(define-simple-type-checker (integer->char (&u64 0 *max-codepoint*)))
|
||||||
(define-type-inferrer (integer->char i result)
|
(define-type-inferrer (integer->char i result)
|
||||||
(restrict! i &u64 0 *max-codepoint*)
|
(restrict! i &u64 0 *max-codepoint*)
|
||||||
|
|
|
@ -549,6 +549,24 @@
|
||||||
(chained-comparison-expander prim-name)))
|
(chained-comparison-expander prim-name)))
|
||||||
'(< > <= >= =))
|
'(< > <= >= =))
|
||||||
|
|
||||||
|
(define (character-comparison-expander char< <)
|
||||||
|
(lambda (src . args)
|
||||||
|
(expand-primcall
|
||||||
|
(make-primcall src <
|
||||||
|
(map (lambda (arg)
|
||||||
|
(make-primcall src 'char->integer (list arg)))
|
||||||
|
args)))))
|
||||||
|
|
||||||
|
(for-each (match-lambda
|
||||||
|
((char< . <)
|
||||||
|
(hashq-set! *primitive-expand-table* char<
|
||||||
|
(character-comparison-expander char< <))))
|
||||||
|
'((char<? . <)
|
||||||
|
(char>? . >)
|
||||||
|
(char<=? . <=)
|
||||||
|
(char>=? . >=)
|
||||||
|
(char=? . =)))
|
||||||
|
|
||||||
;; Appropriate for use with either 'eqv?' or 'equal?'.
|
;; Appropriate for use with either 'eqv?' or 'equal?'.
|
||||||
(define (maybe-simplify-to-eq prim)
|
(define (maybe-simplify-to-eq prim)
|
||||||
(case-lambda
|
(case-lambda
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue