[Guile-commits] 01/01: Better char<? compilation

[Andy Wingo]

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