Page 1 of 1
Template expansion
Posted: Wed May 21, 2008 8:46 pm
by 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)).
Posted: Thu May 22, 2008 12:28 am
by 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 [/*].
Posted: Thu May 22, 2008 12:59 pm
by 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.
Posted: Thu May 22, 2008 5:28 pm
by 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!
Posted: Thu May 22, 2008 5:58 pm
by 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.
Posted: Thu May 22, 2008 7:20 pm
by 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))))
Posted: Thu May 22, 2008 11:21 pm
by rickyboy
Very nice hack! (I bet it was fun too!)