A Replace Function in Lisp That Duplicates Mathematica Functionality

Question

What is the easiest way to accomplish the following in a Mathematica clone or in any version of Lisp(any language is probably okay actually even Haskell)? It doesn't appear any lisps have a similar replace function.

Replace[{
  f[{x, "[", y, "]"}],
  f@f[{x, "[", y, y2, "]"}]
  }
 , f[{x_, "[", y__, "]"}] :> x[y],
 Infinity]

and a return value of {x[y], f[x[y, y2]]}

It replaces all instances of f[{x_, "[", y__, "]"}] in args where x_ represents a single variable and y__ represents one or more variables.

In lisp the function and replacement would probably be the equivalent(forgive me I am not the best with Lisp). I'm looking for a function of the form (replace list search replace).

(replace
  '(
   (f (x "[" y "]"))
   (f (f '(x "[" y y2 "]")))
  )
  '(f (x_ "[" y__ "]"))
  '(x y)
)

and get a return value of ((x y) (f (x y y2))).

Answer 1

Let's give it another try.

First, install quicklisp and use it to fetch, install and load optima and alexandria.

(ql:quickload :optima)
(ql:quickload :alexandria)
(use-package :alexandria)

The functions from alexandria referenced below are ensure-list and last-elt. If you don't have them installed, you can use the following definitions:

(defun ensure-list (list) (if (listp list) list (list list)))
(defun last-elt (list) (car (last list)))

We define rules as functions from one form to another. Below, the function tries to destructure the input as (f (<X> "[" <ARGS> "]"), where <ARGS> is zero or more form. If destructuring fails, we return NIL (we expect non-matching filters to return NIL hereafter).

(defun match-ugly-funcall (form)
  (optima:match form
    ((list 'f (cons x args))
     (unless (and (string= "[" (first args))
                  (string= "]" (last-elt args)))
       (optima:fail))
     `(,x ,@(cdr (butlast args))))))

(match-ugly-funcall '(f (g "[" 1 3 5 4 8 "]")))
; => (G 1 3 5 4 8)

Then, we mimic Mathematica's Replace with this function, which takes a form and a list of rules to be tried. It is possible to pass a single rule (thanks to ensure-list). If a list of list of rules is given, a list of matches should be returned (to be done).

(defun match-replace (form rules &optional (levelspec '(0)))
  (setf rules (ensure-list rules))
  (multiple-value-bind (match-levelspec-p recurse-levelspec-p)
      (optima:ematch levelspec
        ((list n1 n2) (if (some #'minusp (list  n1 n2))
                          (optima:fail)
                          (values (lambda (d) (<= n1 d n2))
                                  (lambda (d) (< d n2)))))
        ((list n) (if (minusp n)
                      (optima:fail)
                      (values (lambda (d) (= d n))
                              (lambda (d) (< d n)))))
        (:infinity (values (constantly t) (constantly t))))
    (labels
        ((do-replace (form depth)
           (let ((result
                   (and (funcall match-levelspec-p depth)
                        (some (lambda (r) (funcall r form)) rules))))
             (cond
               (result (values result t))
               ((and (listp form)
                     (funcall recurse-levelspec-p depth))
                (incf depth)
                (do (newlist
                     (e (pop form) (pop form)))
                    ((endp form) (values form nil))
                  (multiple-value-bind (result matchedp) (do-replace e depth)
                    (if matchedp
                        (return (values (nconc (nreverse newlist) 
                                               (list* result form)) t))
                        (push e newlist)))))
               (t (values form nil))))))
      (do-replace form 0))))

And a test:

(match-replace '(a b (f (x "[" 1 2 3 "]")) c d)
               #'match-ugly-funcall
               :infinity)
; => (A B (X 1 2 3) C D)
;    T

In order to replace all expressions instead of the first matching one, use this instead:

  (defun match-replace-all (form rules &optional (levelspec '(0)))
      (setf rules (ensure-list rules))
      (multiple-value-bind (match-levelspec-p recurse-levelspec-p)
          (optima:ematch levelspec
            ((list n1 n2) (if (some #'minusp (list  n1 n2))
                              (optima:fail)
                              (values (lambda (d) (<= n1 d n2))
                                      (lambda (d) (< d n2)))))
            ((list n) (if (minusp n)
                          (optima:fail)
                          (values (lambda (d) (= d n))
                                  (lambda (d) (< d n)))))
            (:infinity (values (constantly t) (constantly t))))
        (labels
            ((do-replace (form depth)
               (let ((result
                       (and (funcall match-levelspec-p depth)
                            (some (lambda (r) (funcall r form)) rules))))
                 (cond
                   (result result)
                   ((and (listp form)
                         (funcall recurse-levelspec-p depth))
                    (incf depth)
                    (mapcar (lambda (e) (do-replace e depth)) form))
                   (t form)))))
          (do-replace form 0))))