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-41-gce30


From: Daniel Kraft
Subject: [Guile-commits] GNU Guile branch, elisp, updated. release_1-9-1-41-gce30538
Date: Thu, 30 Jul 2009 11:54:09 +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=ce305387df9c111d9b2e0b330c1eb87fd1bee5cb

The branch, elisp has been updated
       via  ce305387df9c111d9b2e0b330c1eb87fd1bee5cb (commit)
       via  f3df67e203d7679f90db2a3d806651c7aa4c0fdc (commit)
       via  e96a9591cedc0d7dff6b3e64003542ad2d10cd9d (commit)
       via  c61ec8e29e0454cfd4a69daf54f100ec0f438b39 (commit)
       via  c2c7c277552e6f980175eaf65624910608f25a51 (commit)
      from  a6a5cf03d4689d9d5c9c50631e33562640439224 (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 ce305387df9c111d9b2e0b330c1eb87fd1bee5cb
Author: Daniel Kraft <address@hidden>
Date:   Thu Jul 30 13:54:07 2009 +0200

    Switch use of guile-primitive to now available funcall in test.

commit f3df67e203d7679f90db2a3d806651c7aa4c0fdc
Author: Daniel Kraft <address@hidden>
Date:   Thu Jul 30 13:51:45 2009 +0200

    without-void-checks as new extension for fine-control
    
    * module/language/elisp/README: Document it.
    * module/language/elisp/compile-tree-il.scm: Handle without-void-checks.
    * test-suite/tests/elisp-compiler.test: Test it.

commit e96a9591cedc0d7dff6b3e64003542ad2d10cd9d
Author: Daniel Kraft <address@hidden>
Date:   Wed Jul 29 16:27:45 2009 +0200

    funcall, apply and eval built-ins.
    
    * module/language/elisp/README: Document new features.
    * module/language/elisp/runtime/function-slot.scm: Implement funcall, apply 
and
      eval by using the existing compiler code.
    * test-suite/tests/elisp-compiler.test: Test those.

commit c61ec8e29e0454cfd4a69daf54f100ec0f438b39
Author: Daniel Kraft <address@hidden>
Date:   Wed Jul 29 14:25:33 2009 +0200

    Added guile-primitive construct for references to primitives from Elisp.
    
    * module/language/elisp/README: Document it.
    * module/language/elisp/compile-tree-il.scm: Implement guile-primitive.
    * test-suite/tests/elisp-compiler.test: Switched a usage of guile-ref to
      the now available guile-primitive.

commit c2c7c277552e6f980175eaf65624910608f25a51
Author: Daniel Kraft <address@hidden>
Date:   Wed Jul 29 13:45:40 2009 +0200

    Added length built-in.
    
    * module/language/elisp/runtime/function-slot.scm: Add length built-in.
    * test-suite/tests/elisp-compiler.test: Test length.

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

Summary of changes:
 module/language/elisp/README                    |   28 ++++++---
 module/language/elisp/compile-tree-il.scm       |   34 +++++++++--
 module/language/elisp/runtime/function-slot.scm |   37 +++++++++++-
 test-suite/tests/elisp-compiler.test            |   71 ++++++++++++++++++++---
 4 files changed, 145 insertions(+), 25 deletions(-)

diff --git a/module/language/elisp/README b/module/language/elisp/README
index 931de7f..004fd97 100644
--- a/module/language/elisp/README
+++ b/module/language/elisp/README
@@ -11,6 +11,8 @@ Already implemented:
   * referencing and setting (setq) variables
   * set, symbol-value, makunbound, boundp functions
   * fset, symbol-function, fmakunbound, fboundp
+  * funcall, apply (also with raw lists as arguments and the like!)
+  * eval
   * while, dotimes, dolist
   * catch, throw, unwind-protect
   * let, let*
@@ -23,7 +25,6 @@ Already implemented:
 Especially still missing:
   * real elisp reader instead of Scheme's
   * more general built-ins
-  * funcall and apply functions
   * advice?
   * defsubst and inlining
   * recursive macros
@@ -38,23 +39,25 @@ Compiler options implemented:
     for void value on access either completely or for some symbols
 
 Extensions over original elisp:
-  * guile-ref
+  * guile-ref, guile-primitive
   * flet and flet*
   * lexical-let and lexical-let*
+  * without-void-checks
 
 
 Details to the implemented extensions
 =====================================
 
-guile-ref:
-----------
+guile-ref and guile-primitive:
+------------------------------
 
 (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).
+Guile-world.  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.
 
-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.
+(guile-primitive sym) does the same to access a Guile primitive directly, which
+is slightly faster where applicable.
 
 flet and flet*:
 ---------------
@@ -93,3 +96,12 @@ for compatibility:
   * 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...
+
+without-void-checks:
+--------------------
+
+Disable void checks in addition to the compiler option for all or some symbols
+in the lexical scope of this construct:
+
+(without-void-checks all body...) or
+(without-void-checks (sym1 sym2 ...) body...
diff --git a/module/language/elisp/compile-tree-il.scm 
b/module/language/elisp/compile-tree-il.scm
index 30ca24d..269037d 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -111,11 +111,13 @@
 
 ; See if we should do a void-check for a given variable.  That means, check
 ; that this check is not disabled via the compiler options for this symbol.
+; Disabling of void check is only done for the value-slot module!
 
-(define (want-void-check? sym)
+(define (want-void-check? sym module)
   (let ((disabled (fluid-ref disable-void-check)))
-    (and (not (eq? disabled 'all))
-         (not (memq sym disabled)))))
+    (or (not (equal? module value-slot))
+        (and (not (eq? disabled 'all))
+             (not (memq sym disabled))))))
 
 
 ; Handle access to a variable (reference/setting) correctly depending on
@@ -146,7 +148,7 @@
 ; Reference a variable and error if the value is void.
 
 (define (reference-with-check loc sym module)
-  (if (want-void-check? sym)
+  (if (want-void-check? sym module)
     (let ((var (gensym)))
       (make-let loc '(value) `(,var) `(,(reference-variable loc sym module))
         (make-conditional loc
@@ -700,13 +702,35 @@
                                            (not (null? body))))
      (generate-let* loc function-slot bindings body))
 
+    ; Temporarily disable void checks for certain symbols within the lexical
+    ; scope of without-void-checks.
+    ((without-void-checks ,syms . ,body)
+     (guard (and (list? body) (not (null? body))
+                 (or (eq? syms 'all)
+                     (and (list? syms) (and-map symbol? syms)))))
+     (let ((disabled (fluid-ref disable-void-check))
+           (make-body (lambda ()
+                        (make-sequence loc (map compile-expr body)))))
+       (if (eq? disabled 'all)
+         (make-body)
+         (let ((new-disabled (if (eq? syms 'all)
+                               'all
+                               (append syms disabled))))
+           (with-fluid* disable-void-check new-disabled make-body)))))
+
+
     ; guile-ref allows building TreeIL's module references from within
-    ; elisp as a way to access data (and primitives, for instance) within
+    ; elisp as a way to access data within
     ; the Guile universe.  The module and symbol referenced are static values,
     ; just like (@ module symbol) does!
     ((guile-ref ,module ,sym) (guard (and (list? module) (symbol? sym)))
      (make-module-ref loc module sym #t))
 
+    ; guile-primitive allows to create primitive references, which are still
+    ; a little faster.
+    ((guile-primitive ,sym) (guard (symbol? sym))
+     (make-primitive-ref loc sym))
+
     ; A while construct is transformed into a tail-recursive loop like this:
     ; (letrec ((iterate (lambda ()
     ;                     (if condition
diff --git a/module/language/elisp/runtime/function-slot.scm 
b/module/language/elisp/runtime/function-slot.scm
index 805f22a..79eaeaf 100644
--- a/module/language/elisp/runtime/function-slot.scm
+++ b/module/language/elisp/runtime/function-slot.scm
@@ -20,7 +20,8 @@
 ;;; Code:
 
 (define-module (language elisp runtime function-slot)
-  #:use-module (language elisp runtime))
+  #:use-module (language elisp runtime)
+  #:use-module (system base compile))
 
 ; This module contains the function-slots of elisp symbols.  Elisp built-in
 ; functions are implemented as predefined function bindings here.
@@ -179,6 +180,8 @@
           ((zero? i) tail)
           (else (iterate (prim 1- i) (prim cdr tail))))))))
 
+(built-in-func length (@ (guile) length))
+
 
 ; Building lists.
 
@@ -270,6 +273,29 @@
                   (eq? void (reference-variable function-slot-module sym))))))
 
 
+; Function calls.  These must take care of special cases, like using symbols
+; or raw lambda-lists as functions!
+
+(built-in-func apply
+  (lambda (func . args)
+    (let ((real-func (cond
+                       ((symbol? func)
+                        (reference-variable-with-check function-slot-module
+                                                       func))
+                       ((list? func)
+                        (if (and (prim not (null? func))
+                                 (eq? (prim car func) 'lambda))
+                          (compile func #:from 'elisp #:to 'value)
+                          (runtime-error "list is not a function" func)))
+                       (else func))))
+      (prim apply (@ (guile) apply) real-func args))))
+
+(built-in-func funcall
+  (let ((myapply (fluid-ref apply)))
+    (lambda (func . args)
+      (myapply func args))))
+
+
 ; Throw can be implemented as built-in function.
 
 (built-in-func throw
@@ -279,5 +305,10 @@
 
 ; Miscellaneous.
 
-(built-in-func not (lambda (x)
-                     (if x nil-value t-value)))
+(built-in-func not
+  (lambda (x)
+    (if x nil-value t-value)))
+
+(built-in-func eval
+  (lambda (form)
+    (compile form #:from 'elisp #:to 'value)))
diff --git a/test-suite/tests/elisp-compiler.test 
b/test-suite/tests/elisp-compiler.test
index e8bb46c..7e013b8 100644
--- a/test-suite/tests/elisp-compiler.test
+++ b/test-suite/tests/elisp-compiler.test
@@ -182,6 +182,32 @@
            (and (= a 0) (= b 0) (= c 0)
                 (= (unwind-protect 42 1 2 3) 42)))))
 
+(with-test-prefix/compile "Eval"
+
+  (pass-if-equal "basic eval" 3
+    (progn (setq code '(+ 1 2))
+           (eval code)))
+
+  (pass-if "real dynamic code"
+    (and (setq a 1 b 1 c 1)
+         (defun set-code (var val)
+           (list 'setq var val))
+         (= a 1) (= b 1) (= c 1)
+         (eval (set-code 'a '(+ 2 3)))
+         (eval (set-code 'c 42))
+         (= a 5) (= b 1) (= c 42)))
+
+  ; Build code that recursively again and again calls eval.  What we want is
+  ; something like:
+  ; (eval '(1+ (eval '(1+ (eval 1)))))
+  (pass-if "recursive eval"
+    (progn (setq depth 10 i depth)
+           (setq code '(eval 0))
+           (while (not (zerop i))
+             (setq code (\` (eval (quote (1+ (\, code))))))
+             (setq i (1- i)))
+           (= (eval code) depth))))
+
 
 ; Test handling of variables.
 ; ===========================
@@ -193,6 +219,9 @@
   (pass-if-equal "setq and reference" 6
     (progn (setq a 1 b 2 c 3)
            (+ a b c)))
+  (pass-if-equal "setq evaluation order" 1
+    (progn (setq a 0 b 0)
+           (setq a 1 b a)))
   (pass-if-equal "setq value" 2
     (progn (setq a 1 b 2)))
 
@@ -212,7 +241,10 @@
     #:opts '(#:disable-void-check all))
   (pass-if "disabled void check (symbol list)"
     (progn (makunbound 'a) a t)
-    #:opts '(#:disable-void-check (x y a b))))
+    #:opts '(#:disable-void-check (x y a b)))
+  (pass-if "without-void-checks"
+    (progn (makunbound 'a)
+           (= (without-void-checks (a) a 5) 5))))
 
 (with-test-prefix/compile "Let and Let*"
 
@@ -304,13 +336,13 @@
              (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))))
+         (= (funcall c1) 1)
+         (= (funcall c1) 2)
+         (= (funcall c1) 3)
+         (= (funcall c2) 1)
+         (= (funcall c2) 2)
+         (= (funcall c1) 4)
+         (= (funcall c2) 3))))
 
 (with-test-prefix/compile "defconst and defvar"
 
@@ -410,7 +442,23 @@
            (defun bar (a)
              (foo))
            (and (= 43 (bar 42))
-                (zerop a)))))
+                (zerop a))))
+
+  (pass-if "funcall and apply argument handling"
+    (and (defun allid (&rest args) args)
+         (setq allid-var (symbol-function 'allid))
+         (equal (funcall allid-var 1 2 3) '(1 2 3))
+         (equal (funcall allid-var) nil)
+         (equal (funcall allid-var 1 2 '(3 4)) '(1 2 (3 4)))
+         (equal (funcall allid-var '()) '(()))
+         (equal (apply allid-var 1 2 '(3 4)) '(1 2 3 4))
+         (equal (apply allid-var '(1 2)) '(1 2))
+         (equal (apply allid-var '()) nil)))
+
+  (pass-if "raw functions with funcall"
+    (and (= (funcall '+ 1 2) 3)
+         (= (funcall (lambda (a b) (+ a b)) 1 2) 3)
+         (= (funcall '(lambda (a b) (+ a b)) 1 2) 3))))
 
 
 ; Quoting and Backquotation.
@@ -553,6 +601,11 @@
          (equal (nthcdr 1 '(1 2 3)) '(2 3))
          (equal (nthcdr 2 '(1 2 3)) '(3))))
 
+  (pass-if "length"
+    (and (= (length '()) 0)
+         (= (length '(1 2 3 4 5)) 5)
+         (= (length '(1 2 (3 4 (5)) 6)) 4)))
+
   (pass-if "cons, list and make-list"
     (and (equal (cons 1 2) '(1 . 2)) (equal (cons 1 '(2 3)) '(1 2 3))
          (equal (cons 1 '()) '(1))


hooks/post-receive
-- 
GNU Guile




reply via email to

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