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.

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

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))
 

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.
 ; =======