[Guile-commits] GNU Guile branch, master, updated. release_1-9-4-99-gd61e866

[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=d61e866c764ba94dd55c4ca5d5a73f25a8f04437

The branch, master has been updated
       via  d61e866c764ba94dd55c4ca5d5a73f25a8f04437 (commit)
       via  e581ec78746fe8ab270b54a18f0ee0c4dce61f06 (commit)
       via  4b1c3f0e06454feea7aab3f927748addd9322106 (commit)
      from  67231cef723ace0358e4ff743c0f8656eac48001 (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 d61e866c764ba94dd55c4ca5d5a73f25a8f04437
Author: Andy Wingo <address@hidden>
Date:   Sat Nov 14 13:34:40 2009 +0100

    fix bugs in ecmascript compiler
    
    * module/language/ecmascript/compile-tree-il.scm: Fix a number of bugs,
      fallen out from the ghil->tree-il conversion.
    
    * module/language/tree-il/compile-glil.scm (*primcall-ops*): Add a hack
      for "return" for javascript. Scheme shouldn't see this because it's
      not an "interesting primitive".

commit e581ec78746fe8ab270b54a18f0ee0c4dce61f06
Author: Andy Wingo <address@hidden>
Date:   Sat Nov 14 13:26:46 2009 +0100

    fix scoping in let-keywords
    
    * module/ice-9/optargs.scm (let-keywords): I thought that I had the
      scoping right here, but I didn't. Make sure that the lambda formals
      for the initializers are new, fresh identifiers, so that let scoping
      works appropriately.

commit 4b1c3f0e06454feea7aab3f927748addd9322106
Author: Andy Wingo <address@hidden>
Date:   Sat Nov 14 13:25:00 2009 +0100

    fix bug in string comparison
    
    * libguile/srfi-13.c (compare_strings): Switch the "longer" and
      "shorter" arguments. All the callers of this function assumed that
      shorter came first. Fixes (string<? "abc" "abcd").

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

Summary of changes:
 libguile/srfi-13.c                             |    8 ++--
 module/ice-9/optargs.scm                       |    3 +-
 module/language/ecmascript/compile-tree-il.scm |   50 +++++++++++++----------
 module/language/tree-il/compile-glil.scm       |    3 +
 4 files changed, 37 insertions(+), 27 deletions(-)

diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 4faa377..f760931 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -1097,13 +1097,13 @@ SCM_DEFINE (scm_string_compare_ci, "string-compare-ci", 
5, 4, 0,
 
 /* This function compares two substrings, S1 from START1 to END1 and
    S2 from START2 to END2, possibly case insensitively, and returns
-   one of the parameters LESSTHAN, GREATERTHAN, LONGER, SHORTER, or
-   EQUAL depending if S1 is less than S2, greater than S2, longer,
-   shorter, or equal. */
+   one of the parameters LESSTHAN, GREATERTHAN, SHORTER, LONGER, or
+   EQUAL depending if S1 is less than S2, greater than S2, shorter,
+   longer, or equal. */
 static SCM
 compare_strings (const char *fname, int case_insensitive,
                 SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2,
-                SCM lessthan, SCM greaterthan, SCM longer, SCM shorter, SCM 
equal)
+                SCM lessthan, SCM greaterthan, SCM shorter, SCM longer, SCM 
equal)
 {
   size_t cstart1, cend1, cstart2, cend2;
   SCM ret;
diff --git a/module/ice-9/optargs.scm b/module/ice-9/optargs.scm
index 138cf60..195bd1e 100644
--- a/module/ice-9/optargs.scm
+++ b/module/ice-9/optargs.scm
@@ -155,12 +155,13 @@
          (lambda (vars inits)
            (with-syntax ((n (length vars))
                          (vars vars)
+                         (ivars (generate-temporaries vars))
                          ((kw ...) (map symbol->keyword
                                         (map syntax->datum vars)))
                          ((idx ...) (iota (length vars)))
                          ((t ...) (generate-temporaries vars))
                          ((i ...) inits))
-             #'(let ((t (lambda vars i))
+             #'(let ((t (lambda ivars i))
                      ...)
                  (apply (lambda vars b0 b1 ...)
                         (or (parse-lambda-case '(0 0 #f n aok ((kw . idx) ...))
diff --git a/module/language/ecmascript/compile-tree-il.scm 
b/module/language/ecmascript/compile-tree-il.scm
index a820baf..a97a4c1 100644
--- a/module/language/ecmascript/compile-tree-il.scm
+++ b/module/language/ecmascript/compile-tree-il.scm
@@ -33,7 +33,7 @@
 (define-syntax @implv
   (syntax-rules ()
     ((_ sym)
-     (-> (module-ref '(language ecmascript impl) 'sym #t)))))
+     (-> (@ '(language ecmascript impl) 'sym)))))
 
 (define-syntax @impl
   (syntax-rules ()
@@ -44,7 +44,7 @@
   '())
 
 (define (econs name gensym env)
-  (acons name gensym env))
+  (acons name (-> (lexical name gensym)) env))
 
 (define (lookup name env)
   (or (assq-ref env name)
@@ -52,7 +52,9 @@
 
 (define (compile-tree-il exp env opts)
   (values
-   (parse-tree-il (comp exp (empty-lexical-environment)))
+   (parse-tree-il
+    (-> (begin (@impl js-init)
+               (comp exp (empty-lexical-environment)))))
    env
    env))
 
@@ -99,7 +101,7 @@
       ((string ,str)
        (-> (const str)))
       (this
-       (@impl get-this '()))
+       (@impl get-this))
       ((+ ,a)
        (-> (apply (-> (primitive '+))
                   (@impl ->number (comp a e))
@@ -166,7 +168,7 @@
        (-> (if (@impl ->boolean (comp test e))
                (comp then e)
                (comp else e))))
-      ((if ,test ,then ,else)
+      ((if ,test ,then)
        (-> (if (@impl ->boolean (comp test e))
                (comp then e)
                (@implv *undefined*))))
@@ -314,32 +316,36 @@
       ((ref ,id)
        (lookup id e))
       ((var . ,forms)
-       (-> (begin
-             (map (lambda (form)
-                    (pmatch form
-                      ((,x ,y)
-                       (-> (define x (comp y e))))
-                      ((,x)
-                       (-> (define x (@implv *undefined*))))
-                      (else (error "bad var form" form))))
-                  forms))))
+       `(begin
+          ,@(map (lambda (form)
+                   (pmatch form
+                     ((,x ,y)
+                      (-> (define x (comp y e))))
+                     ((,x)
+                      (-> (define x (@implv *undefined*))))
+                     (else (error "bad var form" form))))
+                 forms)))
+      ((begin)
+       (-> (void)))
+      ((begin ,form)
+       (comp form e))
       ((begin . ,forms)
        `(begin ,@(map (lambda (x) (comp x e)) forms)))
       ((lambda ,formals ,body)
        (let ((syms (map (lambda (x)
                           (gensym (string-append (symbol->string x) " ")))
                         formals)))
-         (-> (lambda '()
-               (-> (lambda-case
-                    `((() ,formals #f #f () ,syms #f)
-                      ,(comp-body e body formals syms))))))))
+         `(lambda ()
+            (lambda-case
+             ((() ,formals #f #f ,(map (lambda (x) (@implv *undefined*)) 
formals) ,syms #f)
+              ,(comp-body e body formals syms))))))
       ((call/this ,obj ,prop . ,args)
        (@impl call/this*
               obj
               (-> (lambda '() 
-                    (-> (lambda-case
-                         `((() #f #f #f () () #f)
-                           (apply ,(@impl pget obj prop) ,@args))))))))
+                    `(lambda-case
+                      ((() #f #f #f () () #f)
+                       (apply ,(@impl pget obj prop) ,@args)))))))
       ((call (pref ,obj ,prop) ,args)
        (comp `(call/this ,(comp obj e)
                          ,(-> (const prop))
@@ -551,5 +557,5 @@
                         (gensym (string-append (symbol->string x) " ")))
                       names))
            (e (fold econs (fold econs e formals formal-syms) names syms)))
-      (-> (let names syms (map (lambda (x) (->@implv *undefined*)) names)
+      (-> (let names syms (map (lambda (x) (@implv *undefined*)) names)
                (comp out e))))))
diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index dfe2907..fba0c67 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -108,6 +108,9 @@
    ((vector-ref . 2) . vector-ref)
    ((vector-set! . 3) . vector-set)
 
+   ;; hack for javascript
+   ((return . 1) return)
+
    ((bytevector-u8-ref . 2) . bv-u8-ref)
    ((bytevector-u8-set! . 3) . bv-u8-set)
    ((bytevector-s8-ref . 2) . bv-s8-ref)


hooks/post-receive
-- 
GNU Guile