[Guile-commits] GNU Guile branch, wip-cps-bis, updated. v2.1.0-160-g242ba83

[Mark H Weaver]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=242ba83c88699c72b1ac5455140d3385b404b596

The branch, wip-cps-bis has been updated
       via  242ba83c88699c72b1ac5455140d3385b404b596 (commit)
      from  2091b4ae2256f41edb2c51f2facecad10be45b57 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 242ba83c88699c72b1ac5455140d3385b404b596
Author: Mark H Weaver <address@hidden>
Date:   Tue Aug 13 09:03:23 2013 -0400

    Convert branchable primitives into binary operations only.
    
    * module/language/tree-il/primitives.scm (maybe-simplify-to-eq): Wrap
      within another lambda, binding the primitive name.  If there are less
      than two arguments, expand to constant #t.  If there are more than two
      arguments, convert into a conjunction of binary applications.
      (expand-chained-comparisons): New procedure.
      (*primitive-expand-table*): Add entries for (< <= = >= > eq?).

-----------------------------------------------------------------------

Summary of changes:
 module/language/tree-il/primitives.scm |   28 +++++++++++++++++++++++++---
 1 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index db001f9..e62d137 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -519,8 +519,10 @@
   (bytevector-ieee-double-native-set! vec (* i 8) x))
 
 ;; Appropriate for use with either 'eqv?' or 'equal?'.
-(define maybe-simplify-to-eq
+(define (maybe-simplify-to-eq prim)
   (case-lambda
+    ((src) (make-const src #t))
+    ((src a) (make-const src #t))
     ((src a b)
      ;; Simplify cases where either A or B is constant.
      (define (maybe-simplify a b)
@@ -534,10 +536,30 @@
                             (>= v most-negative-fixnum)))
                    (make-primcall src 'eq? (list a b))))))
      (or (maybe-simplify a b) (maybe-simplify b a)))
+    ((src a b . rest)
+     (make-conditional src (make-primcall src prim (list a b))
+                       (make-primcall src prim (cons b rest))
+                       (make-const src #f)))
     (else #f)))
 
-(hashq-set! *primitive-expand-table* 'eqv?   maybe-simplify-to-eq)
-(hashq-set! *primitive-expand-table* 'equal? maybe-simplify-to-eq)
+(hashq-set! *primitive-expand-table* 'eqv?   (maybe-simplify-to-eq 'eqv?))
+(hashq-set! *primitive-expand-table* 'equal? (maybe-simplify-to-eq 'equal?))
+
+(define (expand-chained-comparisons prim)
+  (case-lambda
+    ((src) (make-const src #t))
+    ((src a) (make-const src #t))
+    ((src a b) #f)
+    ((src a b . rest)
+     (make-conditional src (make-primcall src prim (list a b))
+                       (make-primcall src prim (cons b rest))
+                       (make-const src #f)))
+    (else #f)))
+
+(for-each (lambda (prim)
+            (hashq-set! *primitive-expand-table* prim
+                        (expand-chained-comparisons prim)))
+ '(< <= = >= > eq?))
 
 (hashq-set! *primitive-expand-table*
             'call-with-prompt


hooks/post-receive
-- 
GNU Guile