anchor.diff:  ;;; License: MIT License
   (in-package :papply)
   
  -(eval-when (:compile-toplevel :load-toplevel :execute)
  -  #+sbcl (require :sb-cltl2))
   
   (eval-when (:load-toplevel :compile-toplevel :execute)
     (defun underscore-included-p (tree)
  
positive.code:         `(apply #',op ,@body ,not-applied-args))
        `(apply ,op ,@body ,not-applied-args))))
  
  (defmacro papply-enumerate-format (op &rest args &environment env)
    (let* ((gensym-lst)
           (body (with-tree-leaves args (eq leaf '_)
                   (car (push (gensym "PARG") gensym-lst)))))
      (with-gensyms (not-applied-args)
        `(lambda (,@(nreverse gensym-lst) &rest ,not-applied-args)
           (declare (ignorable ,not-applied-args))
           ,(construct-body op not-applied-args body env)))))
  
  (defmacro papply-form-format ((op &rest args))
    `(papply-enumerate-format ,op ,@args))
  
  (defmacro papply (op &rest args)
    " papply (op &rest args) => function
      papply op &rest args => function
      op : a symbol or a function object.
      args : objects.
      function : a function object.
  
      PAPPLY macro generates a function object by applying the first m
      arguments of `op` to `args` where m is the number of elemetns in
      `args` except a form that includes symbol `_`. The special symbol
      `_` works as the place holder for not-yet-fixed arguments. The nth
      `_` is replaced by the nth argument of the result function object.
      The order is from left to right; depth-first-order.
       For example,
  
          (papply (list _ (1+ _) 'a))
  
      is converted into a lambda expression behaves same as following lambda
      expression.
  
      (lambda (x y &rest restparams)
        (apply #'list x (1+ y) 'a restparams))
    "
    (cond ((or (atom op) (eq (car op) 'function))
           `(papply-enumerate-format ,op ,@args))
          (t `(papply-form-format ,op ,@args))))
  
  ;;; APAPPLY
  (eval-when (:load-toplevel :compile-toplevel :execute)
  
negative.code:           ((atom tree) nil)
            (t (some #'underscore-included-p tree))))
  
    (defun embody-template (template)
      (let* (concrete-symbols
             (embodied (with-tree-leaves template (eq leaf '_)
                         (push (gensym "PARG") concrete-symbols)
                         (car concrete-symbols))))
        (values embodied (nreverse concrete-symbols)))))
  
  (eval-when (:load-toplevel :compile-toplevel :execute)
    (defun construct-body (op not-applied-args body env)
  