guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, elisp, updated. release_1-9-1-36-ga6a5


From: Daniel Kraft
Subject: [Guile-commits] GNU Guile branch, elisp, updated. release_1-9-1-36-ga6a5cf0
Date: Wed, 29 Jul 2009 10:11:15 +0000

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=a6a5cf03d4689d9d5c9c50631e33562640439224

The branch, elisp has been updated
       via  a6a5cf03d4689d9d5c9c50631e33562640439224 (commit)
       via  fd40f371a6f0e8e5e719dd93ded5b2b53e3ec178 (commit)
      from  a0899974414ce35f91fa66c240947a5710481665 (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 a6a5cf03d4689d9d5c9c50631e33562640439224
Author: Daniel Kraft <address@hidden>
Date:   Wed Jul 29 12:09:43 2009 +0200

    Implemented lexical-let and lexical-let* for elisp.
    
    * module/language/elisp/README: Document it.
    * module/language/elisp/bindings.scm: New fields in bindings data structure
      to keep track of lexical bindings for symbols.
    * module/language/elisp/compile-tree-il.scm: Implement lexical-let(*).
    * test-suite/tests/elisp-compiler.test: Test lexical scoping with 
lexical-let.

commit fd40f371a6f0e8e5e719dd93ded5b2b53e3ec178
Author: Daniel Kraft <address@hidden>
Date:   Mon Jul 27 10:55:23 2009 +0200

    In elisp-compiler.test, check that let* works without values given, too.

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

Summary of changes:
 module/language/elisp/README              |   56 ++++++-
 module/language/elisp/bindings.scm        |   62 +++++++-
 module/language/elisp/compile-tree-il.scm |  263 ++++++++++++++++++++---------
 test-suite/tests/elisp-compiler.test      |   83 +++++++++-
 4 files changed, 373 insertions(+), 91 deletions(-)

diff --git a/module/language/elisp/README b/module/language/elisp/README
index 7fc51be..931de7f 100644
--- a/module/language/elisp/README
+++ b/module/language/elisp/README
@@ -31,7 +31,6 @@ Especially still missing:
 
 Other ideas and things to think about:
   * %nil vs. #f/'() handling in Guile
-  * lexical-let and/or optional lexical binding as extensions
   * compiler options for all lexical binding
 
 Compiler options implemented:
@@ -39,5 +38,58 @@ Compiler options implemented:
     for void value on access either completely or for some symbols
 
 Extensions over original elisp:
-  * (guile-ref module symbol) construct to build a (@ module symbol) from elisp
+  * guile-ref
   * flet and flet*
+  * lexical-let and lexical-let*
+
+
+Details to the implemented extensions
+=====================================
+
+guile-ref:
+----------
+
+(guile-ref module sym) is a new special construct to access symbols from the
+Guile-world (for instance, Guile primitives directly but it also allows to
+set some variables in other modules than the elisp runtime ones).
+
+Actually, (guile-ref module sym) is the same as (@ module sym) would be in
+Scheme.  Both module and sym must be statically given and are not evaluated.
+
+flet and flet*:
+---------------
+
+These constructs behave exactly like let and let*, except that they bind the
+function slots rather than the value slots, and so make dynamic scoping
+available for functions, too.
+
+The distinction between flet and flet* is probably less useful than the one
+between let and let*, but it was easy to implement both flet and flet*
+based on the existing let and let* code, so not having both of them seemed
+a little inconsistent.
+
+lexical-let and lexical-let*:
+-----------------------------
+
+lexical-let and lexical-let* are constructs provided by the elisp package
+'cl originally, but in Guile they are natively implemented because using
+lexical instead of dynamic binding gives better performance in this case.
+
+They work just like let and let*, but bind their target symbols lexically.
+Some oberservations with the Emacs 'cl implementation that we mimic in Guile
+for compatibility:
+
+  * Ordinary let's within the lexical scope of a lexical-let still establish 
new
+    *lexical* bindings for symbols already lexically bound.  So once lexical,
+    always lexical (on a per-symbol basis).
+
+  * However, lambda constructs within the lexical scope of a lexical-let where
+    one of their arguments is already lexically bound still bind it dynamically
+    for their scope.
+
+  * On the other hand, symbols lexically bound that are not rebound via the
+    argument-list build lexical closures just well.
+
+  * If symbols are accessed where they are not known at compile-time (like
+    symbol-value or set primitives), this always refers to the dynamic binding
+    and never the lexical one.  That's very nice to the implementor...
diff --git a/module/language/elisp/bindings.scm 
b/module/language/elisp/bindings.scm
index e38ad95..228a746 100644
--- a/module/language/elisp/bindings.scm
+++ b/module/language/elisp/bindings.scm
@@ -20,23 +20,36 @@
 ;;; Code:
 
 (define-module (language elisp bindings)
-  #:export (make-bindings mark-fluid-needed! map-fluids-needed))
+  #:export (make-bindings
+            mark-fluid-needed! map-fluids-needed
+            with-lexical-bindings with-dynamic-bindings
+            get-lexical-binding))
 
 ; This module defines routines to handle analysis of symbol bindings used
 ; during elisp compilation.  This data allows to collect the symbols, for
 ; which fluids need to be created, or mark certain symbols as lexically bound.
 
+; Needed fluids are stored in an association-list that stores a list of fluids
+; for each module they are needed in.
+
+; The lexical bindings of symbols are stored in a hash-table that associates
+; symbols to fluids; those fluids are used in the with-lexical-binding and
+; with-dynamic-binding routines to associate symbols to different bindings
+; over a dynamic extent.
+
 
 ; Record type used to hold the data necessary.
 
-(define bindings-type (make-record-type 'bindings '(needed-fluids)))
+(define bindings-type
+  (make-record-type 'bindings
+                    '(needed-fluids lexical-bindings)))
 
 
 ; Construct an 'empty' instance of the bindings data structure to be used
 ; at the start of a fresh compilation.
 
 (define (make-bindings)
-  ((record-constructor bindings-type) '()))
+  ((record-constructor bindings-type) '() (make-hash-table)))
 
 
 ; Mark that a given symbol is needed as fluid in the specified slot-module.
@@ -55,7 +68,7 @@
 ; creation or some other analysis.
 
 (define (map-fluids-needed bindings proc)
-  (let* ((needed ((record-accessor bindings-type 'needed-fluids) bindings)))
+  (let ((needed ((record-accessor bindings-type 'needed-fluids) bindings)))
     (let iterate-modules ((mod-tail needed)
                           (mod-result '()))
       (if (null? mod-tail)
@@ -72,3 +85,44 @@
                 (iterate-symbols (cdr sym-tail)
                                  (cons (proc module (car sym-tail))
                                        sym-result))))))))))
+
+
+; Get the current lexical binding (gensym it should refer to in the current
+; scope) for a symbol or #f if it is dynamically bound.
+
+(define (get-lexical-binding bindings sym)
+  (let* ((lex ((record-accessor bindings-type 'lexical-bindings) bindings))
+         (slot (hash-ref lex sym #f)))
+    (if slot
+      (fluid-ref slot)
+      #f)))
+
+
+; Establish a binding or mark a symbol as dynamically bound for the extent of
+; calling proc.
+
+(define (with-symbol-bindings bindings syms targets proc)
+  (if (or (not (list? syms))
+          (not (and-map symbol? syms)))
+    (error "can't bind non-symbols" syms))
+  (let ((lex ((record-accessor bindings-type 'lexical-bindings) bindings)))
+    (for-each (lambda (sym)
+                (if (not (hash-ref lex sym))
+                  (hash-set! lex sym (make-fluid))))
+              syms)
+    (with-fluids* (map (lambda (sym)
+                         (hash-ref lex sym))
+                       syms)
+                  targets
+                  proc)))
+
+(define (with-lexical-bindings bindings syms targets proc)
+  (if (or (not (list? targets))
+          (not (and-map symbol? targets)))
+    (error "invalid targets for lexical binding" targets)
+    (with-symbol-bindings bindings syms targets proc)))
+
+(define (with-dynamic-bindings bindings syms proc)
+  (with-symbol-bindings bindings
+                        syms (map (lambda (el) #f) syms)
+                        proc))
diff --git a/module/language/elisp/compile-tree-il.scm 
b/module/language/elisp/compile-tree-il.scm
index a7374c6..30ca24d 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -118,12 +118,29 @@
          (not (memq sym disabled)))))
 
 
-; Generate code to reference a fluid saved variable.
+; Handle access to a variable (reference/setting) correctly depending on
+; whether it is currently lexically or dynamically bound.
+; lexical access is done only for references to the value-slot module!
+
+(define (access-variable loc sym module handle-lexical handle-dynamic)
+  (let ((lexical (get-lexical-binding (fluid-ref bindings-data) sym)))
+    (if (and lexical (equal? module value-slot))
+      (handle-lexical lexical)
+      (handle-dynamic))))
+
+
+; Generate code to reference a variable.
+; For references in the value-slot module, we may want to generate a lexical
+; reference instead if the variable has a lexical binding.
 
 (define (reference-variable loc sym module)
-  (mark-fluid-needed! (fluid-ref bindings-data) sym module)
-  (call-primitive loc 'fluid-ref
-                  (make-module-ref loc module sym #t)))
+  (access-variable loc sym module
+                   (lambda (lexical)
+                     (make-lexical-ref loc lexical lexical))
+                   (lambda ()
+                     (mark-fluid-needed! (fluid-ref bindings-data) sym module)
+                     (call-primitive loc 'fluid-ref
+                                     (make-module-ref loc module sym #t)))))
 
 
 ; Reference a variable and error if the value is void.
@@ -141,12 +158,19 @@
     (reference-variable loc sym module)))
 
 
-; Generate code to set a fluid saved variable.
+; Generate code to set a variable.
+; Just as with reference-variable, in case of a reference to value-slot,
+; we want to generate a lexical set when the variable has a lexical binding.
 
 (define (set-variable! loc sym module value)
-  (mark-fluid-needed! (fluid-ref bindings-data) sym module)
-  (call-primitive loc 'fluid-set!
-                  (make-module-ref loc module sym #t) value))
+  (access-variable loc sym module
+                   (lambda (lexical)
+                     (make-lexical-set loc lexical lexical value))
+                   (lambda ()
+                     (mark-fluid-needed! (fluid-ref bindings-data) sym module)
+                     (call-primitive loc 'fluid-set!
+                                     (make-module-ref loc module sym #t)
+                                     value))))
 
 
 ; Process the bindings part of a let or let* expression; that is, check for
@@ -165,6 +189,109 @@
        bindings))
 
 
+; Split the let bindings into a list to be done lexically and one dynamically.
+; A symbol will be bound lexically if and only if:
+; We're processing a lexical-let (i.e. module is 'lexical), OR
+; we're processing a value-slot binding AND
+;   the symbol is already lexically bound.
+
+(define (bind-lexically? sym module)
+  (or (eq? module 'lexical)
+      (and (equal? module value-slot)
+           (get-lexical-binding (fluid-ref bindings-data) sym))))
+
+(define (split-let-bindings bindings module)
+  (let iterate ((tail bindings)
+                (lexical '())
+                (dynamic '()))
+    (if (null? tail)
+      (values (reverse lexical) (reverse dynamic))
+      (if (bind-lexically? (caar tail) module)
+        (iterate (cdr tail) (cons (car tail) lexical) dynamic)
+        (iterate (cdr tail) lexical (cons (car tail) dynamic))))))
+
+
+; Compile let and let* expressions.  The code here is used both for let/let*
+; and flet/flet*, just with a different bindings module.
+;
+; A special module value 'lexical means that we're doing a lexical-let instead
+; and the bindings should not be safed to fluids at all but be done with the
+; lexical framework instead.
+
+; Let is done with a single call to with-fluids* binding them locally to new
+; values all "at once".  If there is at least one variable to bind lexically
+; among the bindings, we first do a let for all of them to evaluate all
+; values before any bindings take place, and then call with-fluids* for the
+; variables to bind dynamically.
+(define (generate-let loc module bindings body)
+  (let ((bind (process-let-bindings loc bindings)))
+    (call-with-values
+      (lambda ()
+        (split-let-bindings bind module))
+      (lambda (lexical dynamic)
+        (for-each (lambda (sym)
+                    (mark-fluid-needed! (fluid-ref bindings-data) sym module))
+                  (map car dynamic))
+        (let ((fluids (make-application loc (make-primitive-ref loc 'list)
+                        (map (lambda (el)
+                               (make-module-ref loc module (car el) #t))
+                             dynamic)))
+              (make-values (lambda (for)
+                             (map (lambda (el)
+                                    (compile-expr (cdr el)))
+                                  for)))
+              (make-body (lambda ()
+                           (make-sequence loc (map compile-expr body)))))
+          (if (null? lexical)
+            (call-primitive loc 'with-fluids*
+              fluids
+              (make-application loc (make-primitive-ref loc 'list)
+                (make-values dynamic))
+              (make-lambda loc '() '() '() (make-body)))
+            (let* ((lexical-syms (map (lambda (el) (gensym)) lexical))
+                   (dynamic-syms (map (lambda (el) (gensym)) dynamic))
+                   (all-syms (append lexical-syms dynamic-syms))
+                   (vals (append (make-values lexical) (make-values dynamic))))
+              (make-let loc all-syms all-syms vals
+                (with-lexical-bindings (fluid-ref bindings-data)
+                                       (map car lexical) lexical-syms
+                  (lambda ()
+                    (if (null? dynamic)
+                      (make-body)
+                      (call-primitive loc 'with-fluids*
+                        fluids
+                        (make-application loc (make-primitive-ref loc 'list)
+                          (map (lambda (sym) (make-lexical-ref loc sym sym))
+                               dynamic-syms))
+                        (make-lambda loc '() '() '() (make-body))))))))))))))
+
+
+; Let* is compiled to a cascaded set of "small lets" for each binding in turn
+; so that each one already sees the preceding bindings.
+(define (generate-let* loc module bindings body)
+  (let ((bind (process-let-bindings loc bindings)))
+    (begin
+      (for-each (lambda (sym)
+                  (if (not (bind-lexically? sym module))
+                    (mark-fluid-needed! (fluid-ref bindings-data) sym module)))
+                (map car bind))
+      (let iterate ((tail bind))
+        (if (null? tail)
+          (make-sequence loc (map compile-expr body))
+          (let ((sym (caar tail))
+                (value (compile-expr (cdar tail))))
+            (if (bind-lexically? sym module)
+              (let ((target (gensym)))
+                (make-let loc `(,target) `(,target) `(,value)
+                  (with-lexical-bindings (fluid-ref bindings-data)
+                                         `(,sym) `(,target)
+                    (lambda ()
+                      (iterate (cdr tail))))))
+              (call-primitive loc 'with-fluid*
+                (make-module-ref loc module (caar tail) #t) value
+                (make-lambda loc '() '() '() (iterate (cdr tail)))))))))))
+
+
 ; Split the argument list of a lambda expression into required, optional and
 ; rest arguments and also check it is actually valid.
 
@@ -217,45 +344,51 @@
 ;             (fluid-set! c rest_))))
 ;       body)))
 ;
-; This is formulated quite imperatively, but I think in this case that is quite
+; This is formulated very imperatively, but I think in this case that is quite
 ; clear and better than creating a lot of nested let's.
+;
+; Another thing we have to be aware of is that lambda arguments are always
+; dynamically bound, even when a lexical binding is in tact for a symbol.
 
 (define (compile-lambda loc args body)
   (if (not (list? args))
     (error "expected list for argument-list" args))
   (if (null? body)
     (error "function body might not be empty"))
-  (call-with-values
+  (with-dynamic-bindings (fluid-ref bindings-data) args
     (lambda ()
-      (split-lambda-arguments loc args))
-    (lambda (required optional rest)
-      (let ((required-sym (map (lambda (sym) (gensym)) required))
-            (rest-sym (if (or rest (not (null? optional))) (gensym) '())))
-        (let ((real-args (append required-sym rest-sym))
-              (locals `(,@required ,@optional ,@(if rest (list rest) '()))))
-          (make-lambda loc
-            real-args real-args '()
-            (begin
-              (for-each (lambda (sym)
-                          (mark-fluid-needed! (fluid-ref bindings-data)
-                                              sym value-slot))
-                        locals)
-              (call-primitive loc 'with-fluids*
-                (make-application loc (make-primitive-ref loc 'list)
-                  (map (lambda (sym) (make-module-ref loc value-slot sym #t))
-                       locals))
-                (make-application loc (make-primitive-ref loc 'list)
-                  (append (map (lambda (sym) (make-lexical-ref loc sym sym))
-                               required-sym)
-                          (map (lambda (sym) (nil-value loc))
-                               (if rest
-                                 `(,@optional ,rest-sym)
-                                 optional))))
-                (make-lambda loc '() '() '()
-                  (make-sequence loc
-                    `(,(process-optionals loc optional rest-sym)
-                      ,(process-rest loc rest rest-sym)
-                      ,@(map compile-expr body))))))))))))
+      (call-with-values
+        (lambda ()
+          (split-lambda-arguments loc args))
+        (lambda (required optional rest)
+          (let ((required-sym (map (lambda (sym) (gensym)) required))
+                (rest-sym (if (or rest (not (null? optional))) (gensym) '())))
+            (let ((real-args (append required-sym rest-sym))
+                  (locals `(,@required ,@optional ,@(if rest (list rest) 
'()))))
+              (make-lambda loc
+                real-args real-args '()
+                (begin
+                  (for-each (lambda (sym)
+                              (mark-fluid-needed! (fluid-ref bindings-data)
+                                                  sym value-slot))
+                            locals)
+                  (call-primitive loc 'with-fluids*
+                    (make-application loc (make-primitive-ref loc 'list)
+                      (map (lambda (sym)
+                             (make-module-ref loc value-slot sym #t))
+                           locals))
+                    (make-application loc (make-primitive-ref loc 'list)
+                      (append (map (lambda (sym) (make-lexical-ref loc sym 
sym))
+                                   required-sym)
+                              (map (lambda (sym) (nil-value loc))
+                                   (if rest
+                                     `(,@optional ,rest-sym)
+                                     optional))))
+                    (make-lambda loc '() '() '()
+                      (make-sequence loc
+                        `(,(process-optionals loc optional rest-sym)
+                          ,(process-rest loc rest rest-sym)
+                          ,@(map compile-expr body))))))))))))))
 
 ; Build the code to handle setting of optional arguments that are present
 ; and updating the rest list.
@@ -408,46 +541,6 @@
             (list (compile-expr iter-list))))))))
 
 
-; Compile let and let* expressions.  The code here is used both for let/let*
-; and flet/flet*, just with a different bindings module.
-
-; Let is done with a single call to with-fluids* binding them locally to new
-; values all "at once".
-(define (generate-let loc module bindings body)
- (let ((bind (process-let-bindings loc bindings)))
-   (begin
-     (for-each (lambda (sym)
-                 (mark-fluid-needed! (fluid-ref bindings-data) sym module))
-               (map car bind))
-     (call-primitive loc 'with-fluids*
-       (make-application loc (make-primitive-ref loc 'list)
-         (map (lambda (el)
-                (make-module-ref loc module (car el) #t))
-              bind))
-       (make-application loc (make-primitive-ref loc 'list)
-         (map (lambda (el)
-                (compile-expr (cdr el)))
-              bind))
-       (make-lambda loc '() '() '() 
-         (make-sequence loc (map compile-expr body)))))))
-
-; Let* is compiled to a cascaded set of with-fluid* for each binding in turn
-; so that each one already sees the preceding bindings.
-(define (generate-let* loc module bindings body)
- (let ((bind (process-let-bindings loc bindings)))
-   (begin
-     (for-each (lambda (sym)
-                 (mark-fluid-needed! (fluid-ref bindings-data) sym module))
-               (map car bind))
-     (let iterate ((tail bind))
-       (if (null? tail)
-         (make-sequence loc (map compile-expr body))
-         (call-primitive loc 'with-fluid*
-           (make-module-ref loc module (caar tail) #t)
-           (compile-expr (cdar tail))
-           (make-lambda loc '() '() '() (iterate (cdr tail)))))))))
-
-
 ; Compile a symbol expression.  This is a variable reference or maybe some
 ; special value like nil.
 
@@ -578,13 +671,17 @@
                    (cons (set-variable! loc sym value-slot val)
                          (iterate (cdr tailtail)))))))))))
 
-    ; let/let* and flet/flet* are done using the generate-let/generate-let*
-    ; methods.
+    ; All lets (let, flet, lexical-let and let* forms) are done using the
+    ; generate-let/generate-let* methods.
 
     ((let ,bindings . ,body) (guard (and (list? bindings)
                                          (not (null? bindings))
                                          (not (null? body))))
      (generate-let loc value-slot bindings body))
+    ((lexical-let ,bindings . ,body) (guard (and (list? bindings)
+                                                 (not (null? bindings))
+                                                 (not (null? body))))
+     (generate-let loc 'lexical bindings body))
     ((flet ,bindings . ,body) (guard (and (list? bindings)
                                           (not (null? bindings))
                                           (not (null? body))))
@@ -594,6 +691,10 @@
                                           (not (null? bindings))
                                           (not (null? body))))
      (generate-let* loc value-slot bindings body))
+    ((lexical-let* ,bindings . ,body) (guard (and (list? bindings)
+                                                  (not (null? bindings))
+                                                  (not (null? body))))
+     (generate-let* loc 'lexical bindings body))
     ((flet* ,bindings . ,body) (guard (and (list? bindings)
                                            (not (null? bindings))
                                            (not (null? body))))
diff --git a/test-suite/tests/elisp-compiler.test 
b/test-suite/tests/elisp-compiler.test
index 584cfd4..e8bb46c 100644
--- a/test-suite/tests/elisp-compiler.test
+++ b/test-suite/tests/elisp-compiler.test
@@ -223,11 +223,17 @@
            (let ((a 1)
                  (b a))
              b)))
-  (pass-if-equal "let*" 1
+
+  (pass-if "let*"
     (progn (setq a 0)
-           (let* ((a 1)
-                  (b a))
-             b)))
+           (and (let* ((a 1)
+                       (b a))
+                  (= b 1))
+                (let* (a b)
+                  (setq a 1 b 2)
+                  (and (= a 1) (= b 2)))
+                (= a 0)
+                (not (boundp 'b)))))
 
   (pass-if "local scope"
     (progn (setq a 0)
@@ -237,6 +243,75 @@
            (and (= a 0)
                 (= b 1)))))
 
+(with-test-prefix/compile "Lexical Scoping"
+
+  (pass-if "basic let semantics"
+    (and (setq a 1)
+         (lexical-let ((a 2) (b a))
+           (and (= a 2) (= b 1)))
+         (lexical-let* ((a 2) (b a))
+           (and (= a 2) (= b 2) (setq a 42) (= a 42)))
+         (= a 1)))
+
+  (pass-if "lexical scope with lexical-let's"
+    (and (setq a 1)
+         (defun dyna () a)
+         (lexical-let (a)
+           (setq a 2)
+           (and (= a 2) (= (dyna) 1)))
+         (= a 1)
+         (lexical-let* (a)
+           (setq a 2)
+           (and (= a 2) (= (dyna) 1)))
+         (= a 1)))
+
+  (pass-if "lexical scoping vs. symbol-value / set"
+    (and (setq a 1)
+         (lexical-let ((a 2))
+           (and (= a 2)
+                (= (symbol-value 'a) 1)
+                (set 'a 3)
+                (= a 2)
+                (= (symbol-value 'a) 3)))
+         (= a 3)))
+
+  (pass-if "let inside lexical-let"
+    (and (setq a 1 b 1)
+         (defun dynvals () (cons a b))
+         (lexical-let ((a 2))
+           (and (= a 2) (equal (dynvals) '(1 . 1))
+                (let ((a 3) (b a))
+                  (and (= a 3) (= b 2)
+                       (equal (dynvals) '(1 . 2))))
+                (let* ((a 4) (b a))
+                  (and (= a 4) (= b 4)
+                       (equal (dynvals) '(1 . 4))))
+                (= a 2)))
+         (= a 1)))
+
+  (pass-if "lambda args inside lexical-let"
+    (and (setq a 1)
+         (defun dyna () a)
+         (lexical-let ((a 2) (b 42))
+           (and (= a 2) (= (dyna) 1)
+                ((lambda (a) (and (= a 3) (= b 42) (= (dyna) 3))) 3)
+                (= a 2) (= (dyna) 1)))
+         (= a 1)))
+
+  (pass-if "closures"
+    (and (defun make-counter ()
+           (lexical-let ((cnt 0))
+             (lambda ()
+               (setq cnt (1+ cnt)))))
+         (setq c1 (make-counter) c2 (make-counter))
+         (= ((guile-ref (guile) apply) c1 '()) 1)
+         (= ((guile-ref (guile) apply) c1 '()) 2)
+         (= ((guile-ref (guile) apply) c1 '()) 3)
+         (= ((guile-ref (guile) apply) c2 '()) 1)
+         (= ((guile-ref (guile) apply) c2 '()) 2)
+         (= ((guile-ref (guile) apply) c1 '()) 4)
+         (= ((guile-ref (guile) apply) c2 '()) 3))))
+
 (with-test-prefix/compile "defconst and defvar"
 
   (pass-if-equal "defconst without docstring" 3.141


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]