summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/language/cps/effects-analysis.scm4
-rw-r--r--module/language/cps/types.scm4
-rw-r--r--module/language/tree-il/primitives.scm18
3 files changed, 18 insertions, 8 deletions
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm
index aed47d464..9c408391c 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -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))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 266cb743d..e8f53bb3f 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -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*)
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 0a88f1476..4f960e534 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -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