[Guile-commits] GNU Guile branch, elisp, updated. release_1-9-1-42-ge6042c0

[Daniel Kraft]

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

The branch, elisp has been updated
       via  e6042c08b76fd9145c023b9507565b0caf5baebe (commit)
      from  ce305387df9c111d9b2e0b330c1eb87fd1bee5cb (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 e6042c08b76fd9145c023b9507565b0caf5baebe
Author: Daniel Kraft <address@hidden>
Date:   Thu Jul 30 21:43:24 2009 +0200

    Implement some elisp constructs in macros instead of hard-coded compiler 
code.
    
    * module/language/elisp/compile-tree-il.scm: Remove implementation of prog1,
      and, or, cond, dolist.
    * module/language/elisp/runtime/macro-slot.scm: Implement them here instead.

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

Summary of changes:
 module/language/elisp/compile-tree-il.scm    |  111 +++-----------------------
 module/language/elisp/runtime/macro-slot.scm |  103 +++++++++++++++++++++---
 2 files changed, 99 insertions(+), 115 deletions(-)

diff --git a/module/language/elisp/compile-tree-il.scm 
b/module/language/elisp/compile-tree-il.scm
index 269037d..42daaf1 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -504,45 +504,6 @@
     (make-const loc expr)))
 
 
-; Compile a dolist construct.
-; This is compiled to something along:
-; (with-fluid* iter-var %nil
-;   (lambda ()
-;     (let iterate ((tail list))
-;       (if (null? tail)
-;         result
-;         (begin
-;           (fluid-set! iter-var (car tail))
-;           body
-;           (iterate (cdr tail)))))))
-
-(define (compile-dolist loc var iter-list result body)
-  (let* ((tailvar (gensym))
-         (iterate (gensym))
-         (tailref (make-lexical-ref loc tailvar tailvar))
-         (iterate-func (make-lambda loc `(,tailvar) `(,tailvar) '()
-                         (make-conditional loc
-                           (call-primitive loc 'null? tailref)
-                           (compile-expr result)
-                           (make-sequence loc
-                             `(,(set-variable! loc var value-slot
-                                  (call-primitive loc 'car tailref))
-                               ,@(map compile-expr body)
-                               ,(make-application loc
-                                  (make-lexical-ref loc iterate iterate)
-                                  (list (call-primitive loc 'cdr
-                                          tailref)))))))))
-    (mark-fluid-needed! (fluid-ref bindings-data) var value-slot)
-    (call-primitive loc 'with-fluid*
-      (make-module-ref loc value-slot var #t)
-      (nil-value loc)
-      (make-lambda loc '() '() '()
-        (make-letrec loc `(,iterate) `(,iterate) `(,iterate-func)
-          (make-application loc
-            (make-lexical-ref loc iterate iterate)
-            (list (compile-expr iter-list))))))))
-
-
 ; Compile a symbol expression.  This is a variable reference or maybe some
 ; special value like nil.
 
@@ -561,16 +522,6 @@
     ((progn . ,forms)
      (make-sequence loc (map compile-expr forms)))
 
-    ; I chose to implement prog1 directly (not with macros) so that the
-    ; temporary variable used can be a lexical one that is not backed by a 
fluid
-    ; for better performance.
-    ((prog1 ,form1 . ,forms)
-     (let ((temp (gensym)))
-       (make-let loc `(,temp) `(,temp) `(,(compile-expr form1))
-         (make-sequence loc
-           (append (map compile-expr forms)
-                   (list (make-lexical-ref loc temp temp)))))))
-
     ((if ,condition ,ifclause)
      (make-conditional loc (compile-expr condition)
                            (compile-expr ifclause)
@@ -584,51 +535,8 @@
                            (compile-expr ifclause)
                            (make-sequence loc (map compile-expr elses))))
 
-    ; For (cond ...) forms, a special case is a (condition) clause without
-    ; body.  In this case, the value of condition itself should be returned,
-    ; and thus is saved in a local variable for testing and returning, if it
-    ; is found true.
-    ((cond . ,clauses) (guard (and-map (lambda (el)
-                                         (and (list? el) (not (null? el))))
-                                       clauses))
-     (let iterate ((tail clauses))
-       (if (null? tail)
-         (nil-value loc)
-         (let ((cur (car tail)))
-           (if (null? (cdr cur))
-             (let ((var (gensym)))
-               (make-let loc
-                 '(condition) `(,var) `(,(compile-expr (car cur)))
-                 (make-conditional loc
-                   (make-lexical-ref loc 'condition var)
-                   (make-lexical-ref loc 'condition var)
-                   (iterate (cdr tail)))))
-             (make-conditional loc
-               (compile-expr (car cur))
-               (make-sequence loc (map compile-expr (cdr cur)))
-               (iterate (cdr tail))))))))
-
-    ((and) (t-value loc))
-    ((and . ,expressions)
-     (let iterate ((tail expressions))
-       (if (null? (cdr tail))
-         (compile-expr (car tail))
-         (make-conditional loc
-           (compile-expr (car tail))
-           (iterate (cdr tail))
-           (nil-value loc)))))
-
-    ((or . ,expressions)
-     (let iterate ((tail expressions))
-       (if (null? tail)
-         (nil-value loc)
-         (let ((var (gensym)))
-           (make-let loc
-             '(condition) `(,var) `(,(compile-expr (car tail)))
-             (make-conditional loc
-               (make-lexical-ref loc 'condition var)
-               (make-lexical-ref loc 'condition var)
-               (iterate (cdr tail))))))))
+    ; defconst and defvar are kept here in the compiler (rather than doing them
+    ; as macros) for if we may want to handle the docstring somehow.
 
     ((defconst ,sym ,value . ,doc)
      (if (handle-var-def loc sym doc)
@@ -754,13 +662,6 @@
        (make-letrec loc '(iterate) (list itersym) (list iter-thunk)
          iter-call)))
 
-    ; dolist is treated here rather than as macro because it can take advantage
-    ; of a non-fluid-based variable.
-    ((dolist (,var ,iter-list) . ,body) (guard (symbol? var))
-     (compile-dolist loc var iter-list 'nil body))
-    ((dolist (,var ,iter-list ,result) . ,body) (guard (symbol? var))
-     (compile-dolist loc var iter-list result body))
-
     ; catch and throw can mainly be implemented directly using Guile's
     ; primitives for exceptions, the only difficulty is that the keys used
     ; within Guile must be symbols, while elisp allows any value and checks
@@ -768,6 +669,9 @@
     ; for the Guile primitives and check for matches inside the handler; if
     ; the elisp keys are not eq?, we rethrow the exception.
     ;
+    ; TODO: Implement catch with a macro once we can build the lambda with
+    ; lexical arguments.
+    ;
     ; throw is implemented as built-in function.
 
     ((catch ,tag . ,body) (guard (not (null? body)))
@@ -794,6 +698,8 @@
 
     ; unwind-protect is just some weaker construct as dynamic-wind, so 
     ; straight-forward to implement.
+    ; TODO: This might be implemented as a macro, once lambda's without
+    ; arguments do not call with-fluids* anymore.
     ((unwind-protect ,body . ,clean-ups) (guard (not (null? clean-ups)))
      (call-primitive loc 'dynamic-wind
                      (make-lambda loc '() '() '() (make-void loc))
@@ -811,6 +717,8 @@
      (compile-lambda loc args body))
 
     ; Build a lambda and also assign it to the function cell of some symbol.
+    ; This is no macro as we might want to honour the docstring at some time;
+    ; just as with defvar/defconst.
     ((defun ,name ,args . ,body)
      (if (not (symbol? name))
        (error "expected symbol as function name" name)
@@ -831,6 +739,7 @@
          (define-macro! loc name object)
          (make-const loc name))))
 
+    ; XXX: Maybe we could implement backquotes in macros, too.
     ((,backq ,val) (guard (backquote? backq))
      (process-backquote loc val))
 
diff --git a/module/language/elisp/runtime/macro-slot.scm 
b/module/language/elisp/runtime/macro-slot.scm
index a9381eb..e74d749 100644
--- a/module/language/elisp/runtime/macro-slot.scm
+++ b/module/language/elisp/runtime/macro-slot.scm
@@ -28,8 +28,16 @@
 ; here.
 
 
-; The prog2 construct can be directly defined in terms of prog1 and progn,
-; so this is done using a macro.
+; The prog1 and prog2 constructs can easily be defined as macros using progn
+; and some lexical-let's to save the intermediate value to return at the end.
+
+(built-in-macro prog1
+  (lambda (form1 . rest)
+    (let ((temp (gensym)))
+      `(without-void-checks (,temp)
+         (lexical-let ((,temp ,form1))
+           ,@rest
+           ,temp)))))
 
 (built-in-macro prog2
   (lambda (form1 form2 . rest)
@@ -47,21 +55,66 @@
     `(if ,condition nil (progn ,@elses))))
 
 
-; Define the dotimes iteration macro.
-; As the variable has to be bound locally for elisp, this needs to go through
-; the dynamic scoping fluid system.  So we can't speed these forms up by
-; implementing them directly in the compiler with just a lexical variable
-; anyways.
-; For dolist, on the other hand, we have to bind the elisp variable to the
-; list elements but keep track of the list-tails in another one.  Therefore,
-; this can take advantage of real compilation because of circumventing the
-; fluid-system for this variable.
+; Impement the cond form as nested if's.  A special case is a (condition)
+; subform, in which case we need to return the condition itself if it is true
+; and thus save it in a local variable before testing it.
+
+(built-in-macro cond
+  (lambda (. clauses)
+    (let iterate ((tail clauses))
+      (if (null? tail)
+        'nil
+        (let ((cur (car tail))
+              (rest (iterate (cdr tail))))
+          (prim cond
+            ((prim or (not (list? cur)) (null? cur))
+             (macro-error "invalid clause in cond" cur))
+            ((null? (cdr cur))
+             (let ((var (gensym)))
+               `(without-void-checks (,var)
+                  (lexical-let ((,var ,(car cur)))
+                    (if ,var
+                      ,var
+                      ,rest)))))
+            (else
+              `(if ,(car cur)
+                 (progn ,@(cdr cur))
+                 ,rest))))))))
+
+
+; The and and or forms can also be easily defined with macros.
+
+(built-in-macro and
+  (lambda (. args)
+    (if (null? args)
+      't
+      (let iterate ((tail args))
+        (if (null? (cdr tail))
+          (car tail)
+          `(if ,(car tail)
+             ,(iterate (cdr tail))
+             nil))))))
+
+(built-in-macro or
+  (lambda (. args)
+    (let iterate ((tail args))
+      (if (null? tail)
+        'nil
+        (let ((var (gensym)))
+          `(without-void-checks (,var)
+             (lexical-let ((,var ,(car tail)))
+               (if ,var
+                 ,var
+                 ,(iterate (cdr tail))))))))))
+
+
+; Define the dotimes and dolist iteration macros.
 
 (built-in-macro dotimes
   (lambda (args . body)
-    (if (or (not (list? args))
-            (< (length args) 2)
-            (> (length args) 3))
+    (if (prim or (not (list? args))
+                 (< (length args) 2)
+                 (> (length args) 3))
       (macro-error "invalid dotimes arguments" args)
       (let ((var (car args))
             (count (cadr args)))
@@ -75,6 +128,28 @@
                (list (caddr args))
                '()))))))
 
+(built-in-macro dolist
+  (lambda (args . body)
+    (if (prim or (not (list? args))
+                 (< (length args) 2)
+                 (> (length args) 3))
+      (macro-error "invalid dolist arguments" args)
+      (let ((var (car args))
+            (iter-list (cadr args))
+            (tailvar (gensym)))
+        (if (not (symbol? var))
+          (macro-error "expected symbol as dolist variable")
+          `(let (,var)
+             (without-void-checks (,tailvar)
+               (lexical-let ((,tailvar ,iter-list))
+                 (while (not (null ,tailvar))
+                   (setq ,var (car ,tailvar))
+                   ,@body
+                   (setq ,tailvar (cdr ,tailvar)))
+                 ,@(if (= (length args) 3)
+                     (list (caddr args))
+                     '())))))))))
+
 
 ; Pop off the first element from a list or push one to it.
 


hooks/post-receive
-- 
GNU Guile