From: Spiros Bousbouras on
This is a sequel to "Remembering information during compilation"
< http://groups.google.co.uk/group/comp.lang.lisp/browse_thread/thread/460e44871936c99c >

For this we want 2 macros:

jumpbody (&body body)

Creates a tagbody and puts body inside the tagbody.

jump (&optional depth)

depth must be a positive integer known at compile time ; default is 1.
jump transfers control through the use of a go to the beginning of the
depth-th lexically enclosing jumpbody where "beginning" means before
the first form of body of the corresponding jumpbody. So for depth = 1
control is transferred to the beginning of the innermost jumpbody , for
depth = 2 to the next one and so forth. If there are less than depth
enclosing jumpbodies an error is signalled.


First question: Is this a complete specification i.e. is it enough to
decide what should happen in each situation the above macros are used as
part of otherwise conforming code ?


Examples/tests:

(let ((b 1))
(jumpbody
(format t "A: b is ~a~%" b)
tag
(format t "B: b is ~a~%" b)
(unless (> b 1)
(incf b)
(go tag))
(unless (> b 2)
(incf b)
(jump))
(jumpbody
(format t "C: b is ~a~%" b)
(when (< b 4) (incf b) (jump))
(when (< b 5) (incf b) (jump 1))
(when (< b 6) (incf b) (jump 2)))
(when (< b 7) (incf b) (jump 1))))

A: b is 1
B: b is 1
B: b is 2
A: b is 3
B: b is 3
C: b is 3
C: b is 4
C: b is 5
A: b is 6
B: b is 6
C: b is 6
A: b is 7
B: b is 7
C: b is 7
NIL


(defun f2 (escape)
(funcall escape))


(defmacro mac (depth)
`(let ((n 1))
(jumpbody
(format t "A~%")
(jumpbody
(format t "B~%")
(jumpbody
(format t "C~%")
(when (= n 1)
(incf n)
(f2 #'(lambda () (jump ,depth))))
(format t "D~%"))))))

(mac 1)
A
B
C
C
D
NIL

(mac 2)
A
B
C
B
C
D
NIL

(mac3)
A
B
C
A
B
C
D
NIL


Implementation (watch for wraparound):


(let ((jump-storage (gensym)))
(defmacro jumpbody (&body body &environment env)
(multiple-value-bind (old-jump-storage
in-jumpbodyp
new-jump-storage)
(macroexpand jump-storage env)
(unless in-jumpbodyp
(setq old-jump-storage nil))
(setq new-jump-storage (cons (gensym) old-jump-storage))
`(symbol-macrolet ((,jump-storage ,new-jump-storage))
(tagbody
,(first new-jump-storage)
,@body))))
(defmacro jump (&optional depth &environment env)
(if depth
(unless (and (typep depth 'integer) (> depth 0))
(error "Macro jump received illegal argument ~a~%" depth))
(setq depth 1))
(multiple-value-bind (l in-jumpbodyp)
(macroexpand jump-storage env)
(unless in-jumpbodyp
(error "Macro jump called not inside a jumpbody~%"))
(unless (<= depth (length l))
(error "Macro jump : argument ~a was too large~%"
depth))
`(go ,(nth (1- depth) l)))))



or


; SBCL specific
(require "sb-cltl2")
(let ((jump-storage nil))
(defmacro jumpbody (&body body &aux new-tag)
(setq new-tag (gensym))
(setq jump-storage (cons new-tag jump-storage))
(prog1
(sb-cltl2:macroexpand-all `(tagbody ,new-tag ,@body))
(setq jump-storage (cdr jump-storage))))
(defmacro jump (&optional depth &aux m)
(if depth
(unless (and (typep depth 'integer) (> depth 0))
(setq jump-storage nil)
(error "Macro jump received illegal argument ~a~%" depth))
(setq depth 1))
(setq m (length jump-storage))
(when (= m 0)
(setq jump-storage nil)
(error "Macro jump called not inside a jumpbody~%"))
(unless (<= depth m)
(setq jump-storage nil)
(error "Macro jump : argument ~a was too large~%" depth))
`(go ,(nth (1- depth) jump-storage))))



Are the above definitions correct as far as you can see ? They seem
correct to me and work with my examples.

--
THE COURT: "Erotic," did you say?
THE WITNESS: Erotic.
THE COURT: E-R-O-T-I-C?
THE WITNESS: Eros. That means love, your Honor.
THE COURT: I know, I know. I wanted to be sure I didn't mishear you
http://www.law.umkc.edu/faculty/projects/ftrials/Chicago7/Leary.html
From: Spiros Bousbouras on
On Mon, 30 Nov 2009 02:47:47 GMT
Spiros Bousbouras <spibou(a)gmail.com> wrote:
>
> Are the above definitions correct as far as you can see ? They seem
> correct to me and work with my examples.

Forgot to ask , any other implementations you like better ?
From: Kaz Kylheku on
On 2009-11-30, Spiros Bousbouras <spibou(a)gmail.com> wrote:
> This is a sequel to "Remembering information during compilation"
>< http://groups.google.co.uk/group/comp.lang.lisp/browse_thread/thread/460e44871936c99c >
>
> For this we want 2 macros:
>
> jumpbody (&body body)
>
> Creates a tagbody and puts body inside the tagbody.
>
> jump (&optional depth)
>
> depth must be a positive integer known at compile time ; default is 1.
> jump transfers control through the use of a go to the beginning of the
> depth-th lexically enclosing jumpbody where "beginning" means before
> the first form of body of the corresponding jumpbody.

This feature sucks compared to named blocks.
From: Spiros Bousbouras on
On Mon, 30 Nov 2009 03:39:11 +0000 (UTC)
Kaz Kylheku <kkylheku(a)gmail.com> wrote:
> On 2009-11-30, Spiros Bousbouras <spibou(a)gmail.com> wrote:
> > This is a sequel to "Remembering information during compilation"
> >< http://groups.google.co.uk/group/comp.lang.lisp/browse_thread/thread/460e44871936c99c >
> >
> > For this we want 2 macros:
> >
> > jumpbody (&body body)
> >
> > Creates a tagbody and puts body inside the tagbody.
> >
> > jump (&optional depth)
> >
> > depth must be a positive integer known at compile time ; default is 1.
> > jump transfers control through the use of a go to the beginning of the
> > depth-th lexically enclosing jumpbody where "beginning" means before
> > the first form of body of the corresponding jumpbody.
>
> This feature sucks compared to named blocks.

I'm not planning to use it , I'm just refining my macro writing
techniques. Having said that I don't see how you would implement the
same functionality with named blocks.
From: Pascal Costanza on
Spiros Bousbouras wrote:
> This is a sequel to "Remembering information during compilation"
> < http://groups.google.co.uk/group/comp.lang.lisp/browse_thread/thread/460e44871936c99c >
>
> For this we want 2 macros:
>
> jumpbody (&body body)
>
> Creates a tagbody and puts body inside the tagbody.
>
> jump (&optional depth)
>
> depth must be a positive integer known at compile time ; default is 1.
> jump transfers control through the use of a go to the beginning of the
> depth-th lexically enclosing jumpbody where "beginning" means before
> the first form of body of the corresponding jumpbody. So for depth = 1
> control is transferred to the beginning of the innermost jumpbody , for
> depth = 2 to the next one and so forth. If there are less than depth
> enclosing jumpbodies an error is signalled.
>
>
> First question: Is this a complete specification i.e. is it enough to
> decide what should happen in each situation the above macros are used as
> part of otherwise conforming code ?

Do you want this to be hygienic?

So for example, given the following macro:

(defmacro user-space-macro (wrapper)
`(jumpbody
,(wrapper (jump 1))))

(user-space-macro jumpbody)

Where do you want this to jump?

More importantly: How can you ensure that it jumps to the place you
actually want it to jump?

Pascal

>
>
> Examples/tests:
>
> (let ((b 1))
> (jumpbody
> (format t "A: b is ~a~%" b)
> tag
> (format t "B: b is ~a~%" b)
> (unless (> b 1)
> (incf b)
> (go tag))
> (unless (> b 2)
> (incf b)
> (jump))
> (jumpbody
> (format t "C: b is ~a~%" b)
> (when (< b 4) (incf b) (jump))
> (when (< b 5) (incf b) (jump 1))
> (when (< b 6) (incf b) (jump 2)))
> (when (< b 7) (incf b) (jump 1))))
>
> A: b is 1
> B: b is 1
> B: b is 2
> A: b is 3
> B: b is 3
> C: b is 3
> C: b is 4
> C: b is 5
> A: b is 6
> B: b is 6
> C: b is 6
> A: b is 7
> B: b is 7
> C: b is 7
> NIL
>
>
> (defun f2 (escape)
> (funcall escape))
>
>
> (defmacro mac (depth)
> `(let ((n 1))
> (jumpbody
> (format t "A~%")
> (jumpbody
> (format t "B~%")
> (jumpbody
> (format t "C~%")
> (when (= n 1)
> (incf n)
> (f2 #'(lambda () (jump ,depth))))
> (format t "D~%"))))))
>
> (mac 1)
> A
> B
> C
> C
> D
> NIL
>
> (mac 2)
> A
> B
> C
> B
> C
> D
> NIL
>
> (mac3)
> A
> B
> C
> A
> B
> C
> D
> NIL
>
>
> Implementation (watch for wraparound):
>
>
> (let ((jump-storage (gensym)))
> (defmacro jumpbody (&body body &environment env)
> (multiple-value-bind (old-jump-storage
> in-jumpbodyp
> new-jump-storage)
> (macroexpand jump-storage env)
> (unless in-jumpbodyp
> (setq old-jump-storage nil))
> (setq new-jump-storage (cons (gensym) old-jump-storage))
> `(symbol-macrolet ((,jump-storage ,new-jump-storage))
> (tagbody
> ,(first new-jump-storage)
> ,@body))))
> (defmacro jump (&optional depth &environment env)
> (if depth
> (unless (and (typep depth 'integer) (> depth 0))
> (error "Macro jump received illegal argument ~a~%" depth))
> (setq depth 1))
> (multiple-value-bind (l in-jumpbodyp)
> (macroexpand jump-storage env)
> (unless in-jumpbodyp
> (error "Macro jump called not inside a jumpbody~%"))
> (unless (<= depth (length l))
> (error "Macro jump : argument ~a was too large~%"
> depth))
> `(go ,(nth (1- depth) l)))))
>
>
>
> or
>
>
> ; SBCL specific
> (require "sb-cltl2")
> (let ((jump-storage nil))
> (defmacro jumpbody (&body body &aux new-tag)
> (setq new-tag (gensym))
> (setq jump-storage (cons new-tag jump-storage))
> (prog1
> (sb-cltl2:macroexpand-all `(tagbody ,new-tag ,@body))
> (setq jump-storage (cdr jump-storage))))
> (defmacro jump (&optional depth &aux m)
> (if depth
> (unless (and (typep depth 'integer) (> depth 0))
> (setq jump-storage nil)
> (error "Macro jump received illegal argument ~a~%" depth))
> (setq depth 1))
> (setq m (length jump-storage))
> (when (= m 0)
> (setq jump-storage nil)
> (error "Macro jump called not inside a jumpbody~%"))
> (unless (<= depth m)
> (setq jump-storage nil)
> (error "Macro jump : argument ~a was too large~%" depth))
> `(go ,(nth (1- depth) jump-storage))))
>
>
>
> Are the above definitions correct as far as you can see ? They seem
> correct to me and work with my examples.
>


--
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/