qq.wart

# Quasiquote (ported from an Arc port of GNU clisp 2.47's backquote.lisp).

# Like join, except it can create dotted lists if the last arg is an atom

def append args
  if no.args
      nil
    ~cdr.args
      car.args
    let a car.args
      if no.a
        append @cdr.args
        cons car.a (append cdr.a @cdr.args)

# Reproduced from arc.arc

def rreduce(f xs)
  if cddr.xs
    f car.xs (rreduce f cdr.xs)
    f @xs

# Like list, except that the last cons of the constructed list is dotted

def dotted_list xs
  if ~cdr.xs
    car.xs
    rreduce cons xs

atom? <- ~cons?

def dotted?(x)
  if atom?.x
    nil
    and cdr.x (or (atom? cdr.x) (dotted? cdr.x))

def proper?(xs)
  and list?.xs ~dotted?.xs

def qq_non_list_splice_error(expr)
  err:str "The syntax `,@" expr " is invalid"

def qq_dotted_splice_error(expr)
  err:str "The syntax `([exprs] ... ,@" expr ") is invalid"

# Quasiquotation

mac qq(expr)
  qq_expand expr

# Since qq handles 'unq and 'unqs, we can define those as macros down to
# errors, as they're automatically outside of a qq.

mac unq(expr)
  list 'err:str "unq not allowed outside of a qq: " expr

mac unqs(expr)
  list 'err:str "unqs not allowed outside of a qq: " expr

# Recursive Expansion Engine

# The behaviour is more-or-less dictated by the Common Lisp HyperSpec's general
# description of backquote:
#
#   `atom/nil  -->  'atom/nil
#   `,expr     -->  expr
#   `,@expr    -->  error
#   ``expr     -->  `expr-expanded
#   `list-expr -->  expand each element & handle dotted tails:
#       `(x1 x2 ... xn)     -->  (append y1 y2 ... yn)
#       `(x1 x2 ... . xn)   -->  (append y1 y2 ... 'xn)
#       `(x1 x2 ... . ,xn)  -->  (append y1 y2 ... xn)
#       `(x1 x2 ... . ,@xn) -->  error
#     where each yi is the output of (qq-transform xi).
#
#  [NOTE] Mind that the above uses traditional CL syntax of "."s for dotted
#  tails; the "..."s represent 0 or more expressions.

carif <- (cons? & car)

def qq_expand(expr)
  qq_appends:qq_expand_list expr

def qq_expand(expr) :case atom?.expr
  list 'quote expr

def qq_expand(expr) :case (carif.expr = 'unq)
  cadr expr

def qq_expand(expr) :case (carif.expr = 'unqs)
  qq_non_list_splice_error cadr.expr

def qq_expand(expr) :case (carif.expr = 'qq)
  list 'qq (qq_expand cadr.expr)

# Produce a list of forms suitable for append.
# Note: if we see 'unq or 'unqs in the middle of a list, we
# assume it's from dotting, since (a ... (unq b)) == (a unq b).  This
# is a "problem" if the user does something like `(a unq b c d), which we
# interpret as `(a ... ,b).

def qq_expand_list(expr)
  cons (qq_transform car.expr) (qq_expand_list cdr.expr)

def qq_expand_list(expr) :case no.expr
  nil

def qq_expand_list(expr) :case (car.expr = 'unq)
  list cadr.expr

def qq_expand_list(expr) :case (car.expr = 'unqs)
  qq_dotted_splice_error cadr.expr

def qq_expand_list(expr) :case atom?.expr
  list (list 'quote expr)

# Do the transformations for elements in qq_expand_list that aren't the dotted
# tail.  Also, handle nested quasiquotes.

def qq_transform(expr)
  qq_list qq_expand.expr

def qq_transform(expr) :case (carif.expr = 'unq)
  qq_list cadr.expr

def qq_transform(expr) :case (carif.expr = 'unqs)
  cadr.expr

def qq_transform(expr) :case (carif.expr = 'qq)
  qq_list (list 'qq (qq_expand cadr.expr))

# Expansion Optimizer

# This is mainly woven through qq_cons and qq_append.  It can run in a
# non-optimized mode (where lists are always consed at run-time), or
# optimizations can be done that reduce run-time consing / simplify the
# macroexpansion.  For example,
#   `(,(foo) ,(bar))
#      non-optimized --> (append (cons (foo) nil) (cons (bar) nil))
#      optimized     --> (list (foo) (bar))

# Optimization is disabled by default, but can be turned on when bugs get
# sorted out, like:
#
# wart> (eval '(quote x))
# 013object.cc:53 can't coerce symbol ' to function
# 021eval.cc:59 Not a call: (quote x)
# Perhaps you need to split the line in two.
# dying
#
# wart> (quote 1)
# 013object.cc:53 can't coerce symbol ' to function
# 021eval.cc:59 Not a call: (quote 1)
# Perhaps you need to split the line in two.
# dying

Optimize_cons   <- nil
Optimize_append <- nil

def toggle_optimize()
  Optimize_cons   <- no.Optimize_cons
  Optimize_append <- no.Optimize_append

# Test whether the given expr may yield multiple list elements.
# Note: not only does ,@x splice, but so does ,,@x (unlike in vanilla Arc)

def splicing?(expr)
  or (carif.expr = 'unqs)
     and (carif.expr = 'unq) (splicing? cadr.expr)

def splicing_to_non(expr)
  if splicing?.expr
    list 'append expr
    expr

def quoted_non_splice?(expr)
  and (carif.expr = 'quote)
      single? cdr.expr
      ~splicing? cadr.expr

def literal?(expr)
  if (isa expr symbol)
      no expr
     (isa expr list)
      car.expr = 'quote

def qq_cons(expr1 expr2)
  # assume expr2 is non-splicing
  let operator (if splicing?.expr1 'dotted_list 'cons)
    if no.Optimize_cons
        list operator expr1 expr2
       (and literal?.expr1 no.expr2)
        list 'quote (list eval.expr1)
       no.expr2
        list 'list expr1
       atom?.expr2
        list operator expr1 expr2
       (carif.expr2 = 'list)
        dotted_list 'list expr1 cdr.expr2
       (and quoted_non_splice?.expr1 quoted_non_splice?.expr2)
        list 'quote (cons cadr.expr1) cadr.expr2
       :else
        list operator expr1 expr2

def qq_list(expr)
  qq_cons expr nil

def qq_append(expr1 expr2)
  default expr2 to: nil
  if no.Optimize_append
      list 'append expr1 expr2
     no.expr1
      expr2
     no.expr2
      expr1
     (carif.expr1 = 'list)
      qq_append_list expr1 expr2
     (and quoted_non_splice?.expr1
          proper?:cadr.expr1
          (carif:cadr.expr1 ~= 'unq)) # since unq expects only 1 arg
      (rreduce (fn (x xs) (qq_cons (list 'quote x) xs))
               (join cadr.expr1 list:splicing_to_non.expr2))
     (carif.expr2 = 'append)
      dotted_list 'append expr1 cdr.expr2
     :else
      list 'append expr1 expr2

def qq_append_list(expr1 expr2)
  if single?.expr1
      expr2
     single? cdr.expr1
      qq_cons cadr.expr1 expr2
     :else
      cons 'dotted_list (append cdr.expr1 list.expr2)

def qq_appends(exprs)
  splicing_to_non (rreduce qq_append exprs)