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 <d...@domob.eu> 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 <d...@domob.eu> 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
