[Guile-commits] GNU Guile branch, elisp, updated. release_1-9-0-65-g9b5ff6a

[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=9b5ff6a6e1da0d2c20b44aa12c92a68a414e8f70

The branch, elisp has been updated
       via  9b5ff6a6e1da0d2c20b44aa12c92a68a414e8f70 (commit)
       via  e905e490fae68bd87ec66b35235b02c61cdace40 (commit)
      from  74c009dadc1e8f580727d2c85bf72ec90e82d15a (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 9b5ff6a6e1da0d2c20b44aa12c92a68a414e8f70
Author: Daniel Kraft <address@hidden>
Date:   Sat Jul 18 17:32:59 2009 +0200

    Implemented real quotation (added support for backquotation).
    
    * module/language/elisp/README: Document that.
    * module/language/elisp/compile-tree-il.scm: Implement backquote.
    * test-suite/tests/elisp-compiler.test: Test quotation and backquotes.

commit e905e490fae68bd87ec66b35235b02c61cdace40
Author: Daniel Kraft <address@hidden>
Date:   Sat Jul 18 17:21:55 2009 +0200

    Implemented eq and equal built-in predicates.
    
    * module/language/elisp/runtime/function-slot.scm: Implement eq and equal.
    * test-suite/tests/elisp-compiler.test: Test them.

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

Summary of changes:
 module/language/elisp/README                    |    2 +-
 module/language/elisp/compile-tree-il.scm       |   69 +++++++++++++++++++++++
 module/language/elisp/runtime/function-slot.scm |    9 +++
 test-suite/tests/elisp-compiler.test            |   45 +++++++++++++++
 4 files changed, 124 insertions(+), 1 deletions(-)

diff --git a/module/language/elisp/README b/module/language/elisp/README
index 5f0b7c8..684677b 100644
--- a/module/language/elisp/README
+++ b/module/language/elisp/README
@@ -15,6 +15,7 @@ Already implemented:
   * some built-ins (mainly numbers/arithmetic)
   * defconst, defvar, defun
   * macros
+  * quotation and backquotation with unquote/unquote-splicing
 
 Especially still missing:
   * other progX forms, will be done in macros
@@ -28,7 +29,6 @@ Especially still missing:
   * fset & friends, defalias functions
   * advice?
   * defsubst and inlining
-  * real quoting
   * need fluids for function bindings?
   * recursive macros
   * anonymous macros
diff --git a/module/language/elisp/compile-tree-il.scm 
b/module/language/elisp/compile-tree-il.scm
index cd0cc74..d09bbbc 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -50,6 +50,26 @@
 (define macro-slot '(language elisp runtime macro-slot))
 
 
+; The backquoting works the same as quasiquotes in Scheme, but the forms are
+; named differently; to make easy adaptions, we define these predicates 
checking
+; for a symbol being the car of an unquote/unquote-splicing/backquote form.
+
+; FIXME: Remove the quasiquote/unquote/unquote-splicing symbols when real elisp
+; reader is there.
+
+(define (backquote? sym)
+  (and (symbol? sym) (or (eq? sym 'quasiquote)
+                         (eq? sym '\`))))
+
+(define (unquote? sym)
+  (and (symbol? sym) (or (eq? sym 'unquote)
+                         (eq? sym '\,))))
+
+(define (unquote-splicing? sym)
+  (and (symbol? sym) (or (eq? sym 'unquote-splicing)
+                         (eq? sym '\,@))))
+
+
 ; Build a call to a primitive procedure nicely.
 
 (define (call-primitive loc sym . args)
@@ -301,6 +321,51 @@
   (module-ref (resolve-module macro-slot) sym))
 
 
+; See if a (backquoted) expression contains any unquotes.
+
+(define (contains-unquotes? expr)
+  (if (pair? expr)
+    (if (or (unquote? (car expr)) (unquote-splicing? (car expr)))
+      #t
+      (or (contains-unquotes? (car expr))
+          (contains-unquotes? (cdr expr))))
+    #f))
+
+
+; Process a backquoted expression by building up the needed cons/append calls.
+; For splicing, it is assumed that the expression spliced in evaluates to a 
+; list.  The emacs manual does not really state either it has to or what to do
+; if it does not, but Scheme explicitly forbids it and this seems reasonable
+; also for elisp.
+
+(define (unquote-cell? expr)
+  (and (list? expr) (= (length expr) 2) (unquote? (car expr))))
+(define (unquote-splicing-cell? expr)
+  (and (list? expr) (= (length expr) 2) (unquote-splicing? (car expr))))
+
+(define (process-backquote loc expr)
+  (if (contains-unquotes? expr)
+    (if (pair? expr)
+      (if (or (unquote-cell? expr) (unquote-splicing-cell? expr))
+        (compile-expr (cadr expr))
+        (let* ((head (car expr))
+               (processed-tail (process-backquote loc (cdr expr)))
+               (head-is-list-2 (and (list? head) (= (length head) 2)))
+               (head-unquote (and head-is-list-2 (unquote? (car head))))
+               (head-unquote-splicing (and head-is-list-2
+                                           (unquote-splicing? (car head)))))
+          (if head-unquote-splicing
+            (call-primitive loc 'append
+              (compile-expr (cadr head)) processed-tail)
+            (call-primitive loc 'cons
+              (if head-unquote
+                (compile-expr (cadr head))
+                (process-backquote loc head))
+              processed-tail))))
+      (error "non-pair expression contains unquotes" expr))
+    (make-const loc expr)))
+
+
 ; Compile a symbol expression.  This is a variable reference or maybe some
 ; special value like nil.
 
@@ -499,6 +564,10 @@
          (define-macro! loc name object)
          (make-const loc name))))
 
+    ((,backq ,val) (guard (backquote? backq))
+     (process-backquote loc val))
+
+    ; XXX: Why do we need 'quote here instead of quote?
     (('quote ,val)
      (make-const loc val))
 
diff --git a/module/language/elisp/runtime/function-slot.scm 
b/module/language/elisp/runtime/function-slot.scm
index 2353419..db751d2 100644
--- a/module/language/elisp/runtime/function-slot.scm
+++ b/module/language/elisp/runtime/function-slot.scm
@@ -26,6 +26,15 @@
 ; functions are implemented as predefined function bindings here.
 
 
+; Equivalence and equalness predicates.
+
+(built-in-func eq (lambda (a b)
+                    (elisp-bool (eq? a b))))
+
+(built-in-func equal (lambda (a b)
+                       (elisp-bool (equal? a b))))
+
+
 ; Number predicates.
 
 (built-in-func floatp (lambda (num)
diff --git a/test-suite/tests/elisp-compiler.test 
b/test-suite/tests/elisp-compiler.test
index 677f14d..b77cbd3 100644
--- a/test-suite/tests/elisp-compiler.test
+++ b/test-suite/tests/elisp-compiler.test
@@ -211,6 +211,34 @@
                 (zerop a)))))
 
 
+; Quoting and Backquotation.
+; ==========================
+
+(with-test-prefix/compile "Quotation"
+
+  (pass-if "quote"
+    (and (equal '42 42) (equal '"abc" "abc")
+         (equal '(1 2 (3 (4) x)) '(1 2 (3 (4) x)))
+         (not (equal '(1 2 (3 4 (x))) '(1 2 3 4 x)))
+         (equal '(1 2 . 3) '(1 2 . 3))))
+
+  (pass-if "simple backquote"
+    (and (equal (\` 42) 42)
+         (equal (\` (1 (a))) '(1 (a)))
+         (equal (\` (1 . 2)) '(1 . 2))))
+  (pass-if "unquote"
+    (progn (setq a 42 l '(18 12))
+           (and (equal (\` (\, a)) 42)
+                (equal (\` (1 a ((\, l)) . (\, a))) '(1 a ((18 12)) . 42)))))
+  (pass-if "unquote splicing"
+    (progn (setq l '(18 12) empty '())
+           (and (equal (\` (\,@ l)) '(18 12))
+                (equal (\` (l 2 (3 (\,@ l)) ((\,@ l)) (\,@ l)))
+                       '(l 2 (3 18 12) (18 12) 18 12))
+                (equal (\` (1 2 (\,@ empty) 3)) '(1 2 3))))))
+      
+
+
 ; Macros.
 ; =======
 
@@ -227,6 +255,23 @@
 ; Test the built-ins.
 ; ===================
 
+(with-test-prefix/compile "Equivalence Predicates"
+
+  (pass-if "equal"
+    (and (equal 2 2) (not (equal 1 2))
+         (equal "abc" "abc") (not (equal "abc" "ABC"))
+         (equal 'abc 'abc) (not (equal 'abc 'def))
+         (equal '(1 2 (3 4) 5) '(1 2 (3 4) 5))
+         (not (equal '(1 2 3 4 5) '(1 2 (3 4) 5)))))
+
+  (pass-if "eq"
+    (progn (setq some-list '(1 2))
+           (setq some-string "abc")
+           (and (eq 2 2) (not (eq 1 2))
+                (eq 'abc 'abc) (not (eq 'abc 'def))
+                (eq some-string some-string) (not (eq some-string "abc"))
+                (eq some-list some-list) (not (eq some-list '(1 2)))))))
+
 (with-test-prefix/compile "Number Built-Ins"
 
   (pass-if "floatp"


hooks/post-receive
-- 
GNU Guile