[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: Better char<? compilation
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/01: Better char<? compilation |
Date: |
Fri, 2 Sep 2016 08:05:24 +0000 (UTC) |
wingo pushed a commit to branch master
in repository guile.
commit 3b2cd09fe277ce3dc02f32962cfc82b0c201691c
Author: Andy Wingo <address@hidden>
Date: Fri Sep 2 10:02:54 2016 +0200
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.
---
module/language/cps/effects-analysis.scm | 4 ----
module/language/cps/types.scm | 4 ----
module/language/tree-il/primitives.scm | 18 ++++++++++++++++++
3 files changed, 18 insertions(+), 8 deletions(-)
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index aed47d4..9c40839 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 266cb74..e8f53bb 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 0a88f14..4f960e5 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