diff --git a/module/language/elisp/README b/module/language/elisp/README index 5f0b7c81e..684677bf4 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 cd0cc7458..d09bbbcb5 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/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test index af928c5df..b77cbd344 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. ; =======