mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +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.
|
||||
(define-primitive-effects
|
||||
((char<? . _) &type-check)
|
||||
((char<=? . _) &type-check)
|
||||
((char>=? . _) &type-check)
|
||||
((char>? . _) &type-check)
|
||||
((integer->char _) &type-check)
|
||||
((char->integer _) &type-check))
|
||||
|
||||
|
|
|
@ -1423,10 +1423,6 @@ minimum, and maximum."
|
|||
;;; 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-type-inferrer (integer->char i result)
|
||||
(restrict! i &u64 0 *max-codepoint*)
|
||||
|
|
|
@ -549,6 +549,24 @@
|
|||
(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?'.
|
||||
(define (maybe-simplify-to-eq prim)
|
||||
(case-lambda
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue