Template expansion

[Jeff]

Here is a quick function to provide cl-style backtick expansion, using [*]...[/*] instead of the comma and [**]...[/**] instead of the comma-at. It uses regexes. Until parse distinguishes strings from other tokens, I have to serialize the passed in form and match against it:

Code: Select all

(constant 'exp-1 (regex-comp {\[\*\]\s*(.*)\s*\[/\*\]}))
(constant 'exp-2 (regex-comp {\[\*\*\]\s*(.*)\s*\[\/\*\*\]}))

(define (expand* src)
  (setq src (string src))
  (until (not (or (find exp-1 src 0x10000) (find exp-2 src 0x10000)))
	(replace exp-1 src (read-expr $1 (fn (s) (string (eval-string s)))) 0x10000)
	(replace exp-2 src
			 (let ((res (read-expr $1 (fn (s) (eval-string s)))))
			   (if (list? res) (slice (string res) 1 -1)
				   (throw-error (format "Expression [%s] is not a list." $1))))
			 0x10000))
  (eval-string src))

(setq form '(+ [*]x[/*] [**]y[/**]))
(setq x 10)
(setq y '(1 2 3 [**]z[/**]))
(setq z '(4 5 6))
(expand* form) ; => 31

'form is expanded to '(+ 10 1 2 3 4 5 6). The double-asterisk expands a list into the current form, eg '([**]'(1 2 3)[/**]) is (1 2 3), not ((1 2 3)).

[Jeff]

This works too - that last one was when I was working with command-event and so forth:

Code: Select all

(constant 'exp-1 '(* [*] ? [/*] *))
(constant 'exp-2 '(* [**] ? [/**] *))

(define (expand* form)
  (while (or (match exp-1 form) (match exp-2 form))
    (let ((m (match exp-1 form)))
      (if m (setq form (append (m 0) (list (eval (m 1))) (m 2)))))
    (let ((m (match exp-2 form)))
      (if m (setq form (append (m 0) (eval (m 1)) (m 2))))))
  (eval form))

...but requires spaces between [*] expr [/*].

[Jeff]

Here is a more concise version using match and commas for expansion:

Code: Select all

(constant 'exp-1 '(* ,,? *))
(constant 'exp-2 '(* ,? *))

(define (expand* form , m1 m2)
  (while (or (setq m1 (match exp-1 form)) (setq m2 (match exp-2 form)))
    (if m1 (setq form (append (m1 0) (eval (m1 1)) (m1 2))))
    (if m2 (setq form (append (m2 0) (list (eval (m2 1))) (m2 2)))))
  form)

Single expansion (replacement by value) is done with a single comma. Elements in a list are inserted into an expression using a double-comma.

[rickyboy]

Very good, Jeff!

Now, one more change -- with the current definition of expand*:

Code: Select all

>(setq x 10)
10
> (setq y '(1 2 3 ,,z))
(1 2 3 , , z)
> (setq z '(4 5 6))
(4 5 6)
> 
> (expand* '(+ ,x (- 42 ,,y)))
(+ 10 (- 42 , , y))

However, the last expression should probably evaluate like this:

Code: Select all

> (expand* '(+ ,x (- 42 ,,y)))
(+ 10 (- 42 1 2 3 4 5 6))

Keep up the good hacking!

[Jeff]

Here is a recursive definition that works:

Code: Select all

(define (expand* form , m)
  (cond
    ((atom? form) form)
    ((empty? form) '())
    ((setq m (match '(,,? *) form))
      (append (expand* (eval (m 0))) (apply expand* (rest m))))
    ((setq m (match '(,? *) form))
      (cons (expand* (eval (m 0))) (apply expand* (rest m))))
    ((list? form)
      (cons (expand* (first form)) (expand* (rest form))))))
    

(setq x 10)
(setq y '(1 2 3 ,,z))
(setq z '(4 5 6))
(setq form '(+ ,x (- 42 ,,y)))
(println "Form: " form)
(setq result (expand* form))
(println "Result: " result)

...but that limits lists to the max stack depth.

[Jeff]

Ok, here is what I think may be a working function. I've also made a letex*, which works like letex but uses expand* instead of expand (meaning you must use , and ,@ in the body (also, I figured out a decent way to use ,@ instead of ,,.))

Code: Select all

(define (expand* form , m)
  "Expands form like a Common Lisp backtick expression.  A ,x expression is
   replaced by its evaluated value.  A ,@x expression is inserted as a series
   in the outer list."
  (cond
    ((and (list? form) (empty? form)) '())
	((and (list? form) (= ', (first form)) (starts-with (name (nth 1 form)) "@"))
	 (append (expand* (eval (sym (rest (name (nth 1 form)))) (expand* (slice form 1))))))
	((and (list? form) (= ', (first form)))
	 (cons (expand* (eval (nth 1 form))) (expand* (slice form 2))))
    ((list? form) (cons (expand* (first form)) (expand* (rest form))))
	((atom? form) form)))

(define-macro (letex*)
  (letex ((let-list (args 0)) (body (args 1)))
	(let let-list (eval (expand* 'body)))))

;; this should print true
(letex* ((a 10) (b '(1 2 3 ,@c)) (c '(4 5 ,a)))
  (println (= (+ 10 1 2 3 4 5 10) (+ ,a ,@b))))

[rickyboy]

Very nice hack! (I bet it was fun too!)