[Guile-commits] GNU Guile branch, master, updated. release_1-9-1-30-g7382f23

[Andy Wingo]

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=7382f23e58725eef2f7a374ec101a42c0192527e

The branch, master has been updated
       via  7382f23e58725eef2f7a374ec101a42c0192527e (commit)
      from  f4863880f5ef539cb545999c19b6b5c0eec9382d (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 7382f23e58725eef2f7a374ec101a42c0192527e
Author: Andy Wingo <address@hidden>
Date:   Wed Aug 5 11:55:42 2009 +0200

    add1 and sub1 instructions
    
    * libguile/vm-i-scheme.c: Add add1 and sub1 instructions.
    * module/language/tree-il/compile-glil.scm: Compile 1+ and 1- to add1
      and sub1.
    
    * module/language/tree-il/primitives.scm (define-primitive-expander):
      Add support for `if' statements in the consequent.
      (+, -): Compile (- x 1), (+ x 1), and (+ 1 x) to 1- or 1+ as
      appropriate.
      (1-): Remove this one. Seems we forgot 1+ before, but we weren't
      compiling it nicely anyway.
    
    * test-suite/tests/tree-il.test ("void"): Fix expected compilation of (+
      (void) 1) to allow for add1.

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

Summary of changes:
 libguile/vm-i-scheme.c                   |   26 ++++++++++++++++++++++++++
 module/language/tree-il/compile-glil.scm |    2 ++
 module/language/tree-il/primitives.scm   |   28 +++++++++++++++++++++++-----
 test-suite/tests/tree-il.test            |    2 +-
 4 files changed, 52 insertions(+), 6 deletions(-)

diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index dce9b5f..675ec1a 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -215,11 +215,37 @@ VM_DEFINE_FUNCTION (120, add, "add", 2)
   FUNC2 (+, scm_sum);
 }
 
+VM_DEFINE_FUNCTION (167, add1, "add1", 1)
+{
+  ARGS1 (x);
+  if (SCM_I_INUMP (x))
+    {
+      scm_t_int64 n = SCM_I_INUM (x) + 1;
+      if (SCM_FIXABLE (n))
+       RETURN (SCM_I_MAKINUM (n));
+    }
+  SYNC_REGISTER ();
+  RETURN (scm_sum (x, SCM_I_MAKINUM (1)));
+}
+
 VM_DEFINE_FUNCTION (121, sub, "sub", 2)
 {
   FUNC2 (-, scm_difference);
 }
 
+VM_DEFINE_FUNCTION (168, sub1, "sub1", 1)
+{
+  ARGS1 (x);
+  if (SCM_I_INUMP (x))
+    {
+      scm_t_int64 n = SCM_I_INUM (x) - 1;
+      if (SCM_FIXABLE (n))
+       RETURN (SCM_I_MAKINUM (n));
+    }
+  SYNC_REGISTER ();
+  RETURN (scm_difference (x, SCM_I_MAKINUM (1)));
+}
+
 VM_DEFINE_FUNCTION (122, mul, "mul", 2)
 {
   ARGS2 (x, y);
diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index bf46997..975cbf0 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -85,6 +85,8 @@
    ((>= . 2) . ge?)
    ((+ . 2) . add)
    ((- . 2) . sub)
+   ((1+ . 1) . add1)
+   ((1- . 1) . sub1)
    ((* . 2) . mul)
    ((/ . 2) . div)
    ((quotient . 2) . quo)
diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index 9ccd272..0f58e22 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -19,6 +19,7 @@
 ;;; Code:
 
 (define-module (language tree-il primitives)
+  #:use-module (system base pmatch)
   #:use-module (rnrs bytevector)
   #:use-module (system base syntax)
   #:use-module (language tree-il)
@@ -142,8 +143,14 @@
   (define (consequent exp)
     (cond
      ((pair? exp)
-      `(make-application src (make-primitive-ref src ',(car exp))
-                         ,(inline-args (cdr exp))))
+      (pmatch exp
+        ((if ,test ,then ,else)
+         `(if ,test
+              ,(consequent then)
+              ,(consequent else)))
+        (else
+         `(make-application src (make-primitive-ref src ',(car exp))
+                            ,(inline-args (cdr exp))))))
      ((symbol? exp)
       ;; assume locally bound
       exp)
@@ -163,6 +170,15 @@
 (define-primitive-expander +
   () 0
   (x) x
+  (x y) (if (and (const? y)
+                 (let ((y (const-exp y)))
+                   (and (exact? y) (= y 1))))
+            (1+ x)
+            (if (and (const? x)
+                     (let ((x (const-exp x)))
+                       (and (exact? x) (= x 1))))
+                (1+ y)
+                (+ x y)))
   (x y z . rest) (+ x (+ y z . rest)))
   
 (define-primitive-expander *
@@ -172,11 +188,13 @@
   
 (define-primitive-expander -
   (x) (- 0 x)
+  (x y) (if (and (const? y)
+                 (let ((y (const-exp y)))
+                   (and (exact? y) (= y 1))))
+            (1- x)
+            (- x y))
   (x y z . rest) (- x (+ y z . rest)))
   
-(define-primitive-expander 1-
-  (x) (- x 1))
-
 (define-primitive-expander /
   (x) (/ 1 x)
   (x y z . rest) (/ x (* y z . rest)))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 896206b..d993e4f 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -72,7 +72,7 @@
    (program 0 0 0 () (const 1) (call return 1)))
   (assert-tree-il->glil
    (apply (primitive +) (void) (const 1))
-   (program 0 0 0 () (void) (const 1) (call add 2) (call return 1))))
+   (program 0 0 0 () (void) (call add1 1) (call return 1))))
 
 (with-test-prefix "application"
   (assert-tree-il->glil


hooks/post-receive
-- 
GNU Guile