Merge branch 'jb/quote'

src/alloc.c

@@ -96,6 +96,7 @@ jl_sym_t *boundscheck_sym; jl_sym_t *copyast_sym;
 jl_sym_t *fastmath_sym;
 jl_sym_t *simdloop_sym; jl_sym_t *meta_sym;
 jl_sym_t *arrow_sym; jl_sym_t *ldots_sym;
+jl_sym_t *inert_sym;
 
 typedef struct {
     int64_t a;

src/ast.c

@@ -345,7 +345,8 @@ static jl_value_t *scm_to_julia_(value_t e, int eo)
                     return jl_new_struct(jl_gotonode_type,
                                          scm_to_julia_(car_(e),0));
                 }
-                if (sym == quote_sym) {
+                if (sym == inert_sym || (sym == quote_sym && (!iscons(car_(e)) ||
+                                                              !iscons(cdr_(car_(e)))))) {
                     return jl_new_struct(jl_quotenode_type,
                                          scm_to_julia_(car_(e),0));
                 }
@@ -477,7 +478,7 @@ static value_t julia_to_scm_(jl_value_t *v)
         return julia_to_list2((jl_value_t*)goto_sym, jl_fieldref(v,0));
     }
     if (jl_typeis(v, jl_quotenode_type)) {
-        return julia_to_list2((jl_value_t*)quote_sym, jl_fieldref(v,0));
+        return julia_to_list2((jl_value_t*)inert_sym, jl_fieldref(v,0));
     }
     if (jl_typeis(v, jl_newvarnode_type)) {
         return julia_to_list2((jl_value_t*)newvar_sym, jl_fieldref(v,0));

src/jltypes.c

@@ -3287,6 +3287,7 @@ void jl_init_types(void)
     call_sym = jl_symbol("call");
     call1_sym = jl_symbol("call1");
     quote_sym = jl_symbol("quote");
+    inert_sym = jl_symbol("inert");
     top_sym = jl_symbol("top");
     dots_sym = jl_symbol("Vararg");
     line_sym = jl_symbol("line");

src/julia-parser.scm

@@ -900,7 +900,7 @@
         (begin (take-token s)
                (cond ((closing-token? (peek-token s))  op)
                      ((memq op '(& |::|))  (list op (parse-call s)))
-                     (else                 (list op (parse-atom s)))))
+                     (else                 (list op (parse-unary-prefix s)))))
         (parse-atom s))))
 
 ;; parse function call, indexing, dot, and transpose expressions

src/julia-syntax.scm

@@ -34,7 +34,7 @@
         ((atom? e) (string e))
         ((eq? (car e) '|.|)
          (string (deparse (cadr e)) '|.|
-                 (if (and (pair? (caddr e)) (eq? (caaddr e) 'quote))
+                 (if (and (pair? (caddr e)) (memq (caaddr e) '(quote inert)))
                      (deparse (cadr (caddr e)))
                      (string #\( (deparse (caddr e)) #\)))))
         ((memq (car e) '(... |'| |.'|))
@@ -447,7 +447,7 @@
   (or (symbol? e)
       (and (length= e 3) (eq? (car e) '|.|)
            (or (atom? (cadr e)) (sym-ref? (cadr e)))
-           (pair? (caddr e)) (eq? (car (caddr e)) 'quote)
+           (pair? (caddr e)) (memq (car (caddr e)) '(quote inert))
            (symbol? (cadr (caddr e))))))
 
 (define (method-def-expr- name sparams argl body isstaged)
@@ -480,7 +480,7 @@
 (define (ctrans? x) (and (pair? x) (eq? (car x) '|'|)))
 
 (define (const-default? x)
-  (or (number? x) (string? x) (char? x) (and (pair? x) (eq? (car x) 'quote))))
+  (or (number? x) (string? x) (char? x) (and (pair? x) (memq (car x) '(quote inert)))))
 
 (define (keywords-method-def-expr name sparams argl body isstaged)
   (let* ((kargl (cdar argl))  ;; keyword expressions (= k v)
@@ -1624,6 +1624,7 @@
 (define expand-table
   (table
    'quote identity
+   'inert identity
    'top   identity
    'line  identity
 
@@ -3272,53 +3273,54 @@ So far only the second case can actually occur.
        (length= (cadr e) 2)   (eq? (caadr e) 'tuple)
        (vararg? (cadadr e))))
 
-(define (expand-backquote e)
-  (cond ((or (eq? e 'true) (eq? e 'false))  e)
-        ((symbol? e)          `(quote ,e))
-        ((jlgensym? e)        `(quote ,e))
-        ((not (pair? e))      e)
-        ((eq? (car e) '$)     (cadr e))
-        ((eq? (car e) 'inert) e)
-        ((and (eq? (car e) 'quote) (pair? (cadr e)))
-         (expand-backquote (expand-backquote (cadr e))))
-        ((not (contains (lambda (e) (and (pair? e) (eq? (car e) '$))) e))
-         `(copyast (inert ,e)))
-        ((not (any splice-expr? e))
-         `(call (top _expr) ,.(map expand-backquote e)))
-        (else
-         (let loop ((p (cdr e)) (q '()))
-           (if (null? p)
-               (let ((forms (reverse q)))
-                 `(call (top splicedexpr) ,(expand-backquote (car e))
-                        (call (top append_any) ,@forms)))
-               ;; look for splice inside backquote, e.g. (a,$(x...),b)
-               (if (splice-expr? (car p))
-                   (loop (cdr p)
-                         (cons (cadr (cadadr (car p))) q))
-                   (loop (cdr p)
-                         (cons `(cell1d ,(expand-backquote (car p)))
-                               q))))))))
-
-(define (inert->quote e)
-  (cond ((atom? e)  e)
-        ((eq? (car e) 'inert)
-         (cons 'quote (map inert->quote (cdr e))))
-        (else  (map inert->quote e))))
+(define (julia-bq-bracket x d)
+  (cond ((splice-expr? x)
+	 (if (= d 0)
+	     (cadr (cadr (cadr x)))
+	     (list 'cell1d
+		   `(call (top _expr) (inert $)
+			  (call (top _expr) (inert tuple)
+				(call (top _expr) (inert |...|)
+				      ,(julia-bq-expand (cadr (cadr (cadr x))) (- d 1))))))))
+	((and (pair? x) (eq? (car x) '$))
+	 (if (= d 0)
+	     (list 'cell1d (cadr x))
+	     (list 'cell1d `(call (top _expr) (inert $) ,(julia-bq-expand (cadr x) (- d 1))))))
+	(else  (list 'cell1d (julia-bq-expand x d)))))
+
+(define (julia-bq-expand x d)
+  (cond ((or (eq? x 'true) (eq? x 'false))  x)
+	((or (symbol? x) (jlgensym? x))     (list 'inert x))
+        ((atom? x)  x)
+        ((eq? (car x) 'quote)
+	 `(call (top _expr) (inert quote) ,(julia-bq-expand (cadr x) (+ d 1))))
+        ((eq? (car x) '$)
+	 (if (and (= d 0) (length= x 2))
+	     (cadr x)
+	     `(call (top _expr) (inert $) ,(julia-bq-expand (cadr x) (- d 1)))))
+        ((not (contains (lambda (e) (and (pair? e) (eq? (car e) '$))) x))
+         `(copyast (inert ,x)))
+	((or (> d 0) (not (any splice-expr? x)))
+	 `(call (top _expr) ,.(map (lambda (ex) (julia-bq-expand ex d)) x)))
+	(else
+	 (let loop ((p (cdr x)) (q '()))
+	   (if (null? p)
+	       (let ((forms (reverse q)))
+		 `(call (top splicedexpr) ,(julia-bq-expand (car x) d)
+			(call (top append_any) ,@forms)))
+	       (loop (cdr p) (cons (julia-bq-bracket (car p) d) q)))))))
 
 (define (julia-expand-macros e)
-  (inert->quote (julia-expand-macros- e)))
-
-(define (julia-expand-macros- e)
   (cond ((not (pair? e))     e)
-        ((and (eq? (car e) 'quote) (pair? (cadr e)))
+        ((eq? (car e) 'quote)
          ;; backquote is essentially a built-in macro at the moment
-         (julia-expand-macros- (expand-backquote (cadr e))))
+         (julia-expand-macros (julia-bq-expand (cadr e) 0)))
         ((eq? (car e) 'inert)
          e)
         ((eq? (car e) 'macrocall)
          ;; expand macro
          (let ((form
-               (apply invoke-julia-macro (cadr e) (cddr e))))
+                (apply invoke-julia-macro (cadr e) (cddr e))))
            (if (not form)
                (error (string "macro \"" (cadr e) "\" not defined")))
            (if (and (pair? form) (eq? (car form) 'error))
@@ -3327,10 +3329,10 @@ So far only the second case can actually occur.
                  (m    (cdr form)))
              ;; m is the macro's def module, or #f if def env === use env
              (rename-symbolic-labels
-           (julia-expand-macros-
-             (resolve-expansion-vars form m))))))
+              (julia-expand-macros
+               (resolve-expansion-vars form m))))))
         (else
-         (map julia-expand-macros- e))))
+         (map julia-expand-macros e))))
 
 (define (pair-with-gensyms v)
   (map (lambda (s)

src/julia.h

@@ -421,6 +421,7 @@ extern jl_sym_t *boundscheck_sym; extern jl_sym_t *copyast_sym;
 extern jl_sym_t *fastmath_sym;
 extern jl_sym_t *simdloop_sym; extern jl_sym_t *meta_sym;
 extern jl_sym_t *arrow_sym; extern jl_sym_t *ldots_sym;
+extern jl_sym_t *inert_sym;
 
 
 // GC write barrier

src/match.scm

@@ -157,7 +157,7 @@
 ; for example
 ; (pattern-lambda (/ 2 3) '(/ 3 2)), (pattern-lambda (/ 3 2) '(/ 2 3))
 (define (pattern-expand plist expr)
-  (if (or (not (pair? expr)) (eq? (car expr) 'quote) (eq? (car expr) 'varlist))
+  (if (or (not (pair? expr)) (memq (car expr) '(quote varlist inert)))
       expr
       (let ((enew (apply-patterns plist expr)))
         (if (eq? enew expr)
@@ -176,7 +176,7 @@
 
 ;; expand only outermost
 (define (pattern-expand1 plist expr)
-  (if (or (not (pair? expr)) (eq? (car expr) 'quote))
+  (if (or (not (pair? expr)) (memq (car expr) '(quote inert)))
       expr
       (let ((enew (apply-patterns plist expr)))
         (if (eq? enew expr)
@@ -187,7 +187,7 @@
 ;; finds and replaces pattern matches with their expansions
 ;; one pass, does not expand recursively
 (define (pattern-replace plist expr)
-  (if (or (not (pair? expr)) (eq? (car expr) 'quote))
+  (if (or (not (pair? expr)) (memq (car expr) '(quote inert)))
       expr
       (let ((enew (apply-patterns plist expr)))
         (if (eq? enew expr)

test/show.jl

@@ -204,11 +204,11 @@ immutable TParametricPrint{a}; end
 # issue #9797
 let q1 = parse(repr(:("$(a)b"))),
     q2 = parse(repr(:("$ab")))
-    @test isa(q1, QuoteNode)
-    @test q1.value.head === :string
-    @test q1.value.args == [:a, "b"]
+    @test isa(q1, Expr)
+    @test q1.args[1].head === :string
+    @test q1.args[1].args == [:a, "b"]
 
-    @test isa(q2, QuoteNode)
-    @test q2.value.head == :string
-    @test q2.value.args == [:ab,]
+    @test isa(q2, Expr)
+    @test q2.args[1].head == :string
+    @test q2.args[1].args == [:ab,]
 end