Hi Jason,

Thank you for the writeup of Henry G. Baker (1992). The implementation of tagbody/go by catch/throw seems important to internalize. It will definitely help with testing the semantics of tagbody/go.

Unfortunately, as Philipp mentioned in a later email, support for tail-call optimization (TCO) is currently lacking according to [stackoverflow.com (2017)]. Worse, it was *removed* from Google's V8 JavaScript implementation in late 2017. This seems to necessitate a (loop (case ...)) based approach, because SERIES may be used for loops with iteration counts greater than the stack size. Nevertheless, not all is lost.

PARENSCRIPT already compiles (block nil ((lambda () (return 3)))) as catch/throw correctly. Note, the call in the body of the BLOCK. So at least some dynamic ((lambda () (go ...))) calls should be compilable; hopefully all of them. Even if it only captures 70% of all use cases, that is way more than zero.

Cheers, Andrew

Henry G. Baker (1992): TITLE: Metacircular Semantics for Common Lisp Special Forms URL: https://plover.com/~mjd/misc/hbaker-archive/MetaCircular.html

[stackoverflow.com (2017)], Answer by T.J. Crowder: TITLE: ES6 Tail Recursion Optimisation Stack Overflow, URL: https://stackoverflow.com/questions/42788139/es6-tail-recursion-optimisation...

On Thu, May 19, 2022 at 08:32:34PM -0700, Jason Miller wrote:

FWIW, I don't know if parenscript's catch/throw is sufficiently full featured for it, but here's an implementation of tagbody with throw/catch

https://plover.com/~mjd/misc/hbaker-archive/MetaCircular.html

On Fri, 20 May 2022 10:13:03 +0930 Andrew Easton andrew@easton24.de wrote:

...

Hello everyone,

It seems valuable to compile SERIES [1] macros with PARENSCRIPT [2], however, parenscript does not currently seem to support CL:TAGBODY [3,4]. Even poking around the HyperSpec and discovering that CL:DO provides *not* an implicit progn, but an implicit tagbody [5], does not help. The (PARENSCRIPT:DO ...)-form only has an implicit progn around the body [3].

I have started to implement TAGBODY for PARENSCRIPT [A,B,C]. The general idea is to imitate a jump table by looping over a switch-case. A GO (C-terminology: jump) then sets the switch-variable to the next jump destination. The loop subsequently causes the switch to branch to the jump target in the switch-variable. Leaving the tagbody means leaving the loop.

There are complications. Common Lisp allows nested tagbody-forms. Common Lisp allows go-tags to be referenced within the lexical scope *and* the dynamic extent of a tagbody form. This means that a LAMBDA can close over a go-tag and jump there, see an example in [B], of how inconvenient this can become for compilation to JavaScript.

PARENSCRIPT is well-designed. Its compilation of BLOCKs, LOOPs and SWITCHes seems to permit compilation of a TAGBODY to JavaScript code. PARENSCRIPT even handles RETURNing from a BLOCK via a LAMBDA by automatically creating a JavaScript try-catch. This seems to curb the inconveniences brought on by lexical closures jumping to go-tags in the TAGBODY's dynamic extent.

I need help in the following points:

1. I need a code review of the algorithm. The implementation in [B] seems to be satisfactory. There are some test cases and examples. Most there is the most hairy example I could find up to now. I may have missed crucial details.

2. My understanding of the CL:TAGBODY definition in the CLHS [4] may be wrong. Which alternate interpretations does anybody here know of?

3. What examples of PARENSCRIPT:DEFPSMACRO do you know, that might help me understand its semantics? I would hazard a guess at DEFPSMACRO being a facility to add TAGBODY to PARENSCRIPT, however, my understanding of DEFPSMACRO is very bad and I do not know where to start tinkering with it to further my understanding.

Kind regards, Andrew Easton

=== Attachments ===

[A] 2022-05-20_defmacro-series-expand.lisp

[B] 2022-05-20_parenscript-devel_tagbody-code-short.lisp

[C] 2022-05-20_parenscript-devel_tagbody-code-long.lisp The long version contains some dead-ends that were encountered during development. This is an important source of counter-examples.

=== References ===

[1] The SERIES macro package a. https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node347.html#SECTION003400000...

b. https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node362.html#SECTION003500000...

c. https://dspace.mit.edu/handle/1721.1/6035

d. https://dspace.mit.edu/handle/1721.1/6031

e. (ql:quickload :series)

f. https://sourceforge.net/projects/series/

[2] Parenscript https://parenscript.common-lisp.dev/

[3] Parenscript Reference manual (updated 2019-10-15) https://parenscript.common-lisp.dev/reference.html

[4] Common Lisp HyperSpec (CLHS) entry for CL:TAGBODY http://www.lispworks.com/documentation/HyperSpec/Body/s_tagbod.htm#tagbody

[5] Common Lisp HyperSpec (CLHS) entry for CL:DO http://www.lispworks.com/documentation/HyperSpec/Body/m_do_do.htm#do ;; The functions codify, mergify and ;; graphify handle the actual compilation ;; of series expressions. ;; Excellent work, Mr. Waters and all your ;; co-workers as well as the subsequent ;; maintainers of package SERIES. ;; (defmacro series-expand (&body body) `(let (series::*renames* series::*env*) (series::codify (series::mergify (series::graphify (quote (progn ,@body)))))))

;; Look at series:process-top and ;; series:starting-series-expr. (ql:quickload '(:series :parenscript :trivial-macroexpand-all))

(series::install :shadow t)

(import '(parenscript:ps parenscript:ps* trivial-macroexpand-all:macroexpand-all))

;; Explicitly circumvent package lock ;; on package CL to allow shadowing ;; by macrolet for series to paren- ;; script translation. (shadow '(tagbody go))

;; Default to standard CL form. (defmacro tagbody (&body body) "See CL:tagbody." `(cl:tagbody ,@body))

;; Default to standard CL form. (defmacro go (&body body) "See CL:go." `(cl:go ,@body))

(load #p"2022-05-20_defmacro-series-expand.lisp")

(parenscript:ps* (series-expand (collect (map-fn '(values T T) #'floor #z(9 99 999) #z(1 2 3)))))

;; Problem: Parenscript does *not* know ;; how to compile TAGBODY. Suggestion: ;; compile into (loop (case ...)) with ;; a go-variable where the (case ...) ;; selects between the jump targets. ;; This should be easily made compatible ;; with (series::producing ...) given ;; the additional constraints for ;; series::producing.

(defun go-tag-p (obj) (or (integerp obj) (symbolp obj)))

(defun first-go-tag (tagbody-body) "Remember, that (cl:tagbody ...) is a *special* form." (flet ((rec (pos body-rest) (cond ((go-tag-p (first body-rest)) (values pos (first body-rest))) (t (rec (1+ pos) (rest body-rest)))))) (rec 0 tagbody-body)))

(defmacro with-ps-from-series-tagbody (&body body) (let ((outside-block (gensym (symbol-name 'outside-block-))) (case-block (gensym (symbol-name 'case-block-))) (case-tag-var (gensym (symbol-name 'case-tag-var-))) go-tags) ; an alist `(macrolet ((tagbody (&rest body) (let* ((case-body (reduce (lambda (acc body-entry) (cond ;; Case 1: A go-tag. ((or (integerp body-entry) (symbolp body-entry)) (append acc `(((,body-entry)))))

		      ;; Case 2: Executable code.
		      (t
		       (append
			 (butlast acc)
			 (list
		           (append (car (last acc))
				   (list body-entry)))))))
	         body
		 :initial-value `(case ,case-tag-var)))
                     ;; How are tagbody forms
	 ;;  where the first tag is not
	 ;;  the first element of the body
	 ;;  to be detected and handled?
                     (first-tag)
         ;; Terminate when walking
	 ;;  past the end of the original
	 ;;  tagbody form.
         (case-body-with-terminator
	   (append
	     (butlast case-body)
             (list (append (car (last case-body))
			   '((return-from ,outside-block)))))))
    `(block ,outside-block
       (let ((,case-tag-var))
         (loop do
	   (block ,case-block
	       ,case-body-with-terminator))))))
           (go (tag)
 `(progn
    (setf ,case-tag-var ,tag)
    (return-from ,case-block)))))))

;; (ps (case :foo (:foo 3))) ;; (ps (case 'foo ('foo 3))) ;; (ps (case 4 (4 :bar)))

;; =============================== ;; 2022-02-18

(defmacro with-tagbody-helpers (&body body) `(labels ((go-tag-p (obj) (or (symbolp obj) (integerp obj)))

    (tb-go-tags (tb-body)
      (remove-if-not #'go-tag-p tb-body))

    (split-and-group-tb-body (tb-body)
      "Returns two values.
      1. The preamble -- code without a preceding tag
      2. Grouping of tags and subsequent code."

      (if (null tb-body)
   (return-from split-and-group-tb-body
         (values nil nil)))
      (let ((acc `((,(first tb-body))))
       (preamble-p (not (go-tag-p (first tb-body)))))
   (loop for tbf in (rest tb-body) do
     (if (go-tag-p tbf)
       (push `(,tbf) acc)
       (push tbf (first acc))))
        (setf acc (nreverse (mapcar #'nreverse acc)))
   (if preamble-p
     (values (first acc) (rest acc))
     (values nil acc))))
 ,@body)))

(defmacro with-tagbody-parenscript-helpers (&body body) `(with-tagbody-helpers (labels ((tb-body-to-switch (switch-var old-and-new-go-tags grouped-tb-body) `(switch ,switch-var ,@(mapcar (lambda (go-tag-case) (destructuring-bind (go-tag &rest case-body) go-tag-case `(case ,go-tag ;; Handle nested tagbody ;; forms correctly. (tagbody-recursive (,old-and-new-go-tags) ,@case-body)))) grouped-tb-body)))

 (new-go-bindings (while-var switch-var break-p-var new-tb-go-tags)
   (mapcar (lambda (go-tag)
      `(,go-tag
	(,while-var T)
	(,switch-var ,go-tag)
	(,break-p-var nil)))
    new-tb-go-tags))

 (add-breakout-to-old-go-bindings (while-var
			    break-p-var
			    old-go-bindings-alist)
   (mapcar (lambda (gtb)
      `(,@gtb (,while-var nil) (,break-p-var T)))
    old-go-bindings-alist))

 (update-go-bindings (while-var
	       switch-var
	       break-p-var
	       new-tb-go-tags
	       old-go-bindings-alist)
        ;; Order matters. New bindings must shadow
   ;;  old bindings during alist lookups.
        (append (new-go-bindings while-var
		     switch-var
                            break-p-var
		     new-tb-go-tags)
                (add-breakout-to-old-go-bindings
      while-var
      break-p-var
      old-go-bindings-alist))))
   ,@body)))

(defmacro tagbody-recursive ((&optional outer-go-bindings) &body body) "Recursion information only by nested calls. Confer recursion flag of #'CL:READ." `(with-tagbody-parenscript-helpers (let ((while-var (gensym (symbol-name 'while-var-))) (switch-var (gensym (symbol-name 'switch-var-))) (break-p-var (gensym (symbol-name 'break-p-var-)))) (declare (ignorable break-p-var)) (macrolet ((tagbody (&body tb-body) (let* ((new-go-tags (tb-go-tags tb-body)) (old-and-new-go-bindings (update-go-bindings while-var switch-var break-p-var new-go-tags ',outer-go-bindings))) (multiple-value-bind (preamble tb-groups) (split-and-group-tb-body tb-body) `(progn ,@preamble (do ((,while-var T)) ((null ,while-var)) (macrolet ((go (go-tag) `(progn (setf ,@(reduce #'append (cdr (assoc go-tag ,',old-and-new-go-bindings)))) (break) #|switch|#))) ,@(tb-body-to-switch switch-var old-and-new-go-bindings tb-groups))) ;; Necessary for jump from inner ;; tagbody to outer tagbody ;; with trailing code ;; behind the inner tagbody. ;; This trailing code ;; needs to be skipped. ,@(if outer-go-bindings ((if ,break-p-var (break)))))))) )

   ))))

#| Hairy Example:

(tagbody (outer-prologue) outer-a (tagbody (inner-prologue) inner-a (go inner-b) inner-b (go outer-a) inner-c ;; Note, that the following two jumps are valid, ;; because they fall both within the lexical scope as ;; well as the dynamic extent of the inner and the ;; outer tagbody forms. (if (foo) (funcall (lambda () (go inner-d))) (funcall (lambda () (go outer-a)))) inner-d (inner-epilogue)) (inner-epilogue-outside-of-the-inner-tagbody) outer-b outer-c (outer-epilogue))

;; 2022-02-23: (lambda () (go ...))

// Firefox 78.15.0esr (64-bit) var go_tag = 'foo'; var while_var = true; while(while_var) {var cls = undefined; switch (go_tag) { case 'foo': cls = function () {break;}; case 'bar': while_var = false; cls(); }}

// => Uncaught SyntaxError: unlabeled break must be inside loop or switch

while(while_var) while_block: {var cls = undefined; switch (go_tag) { case 'foo': cls = function () {break while_block;}; case 'bar': while_var = false; cls(); }}

// => Uncaught SyntaxError: label not found

while_block: { while(while_var) {var cls = undefined; switch (go_tag) { case 'foo': cls = function () {break while_block;}; case 'bar': while_var = false; cls(); }}}

// => Uncaught SyntaxError: label not found

while_block: { while(while_var) {var cls = undefined; switch (go_tag) { case 'foo': break while_block; case 'bar': while_var = false; cls(); }}}

// => undefined

(ps (block outer-block (switch svar (foo ((lambda () (return-from outer-block 123)))))))

;; => "(function () { try { switch (svar) { case foo: __PS_MV_REG = []; return (function () { __PS_MV_REG = [];

          throw
          { '__ps_block_tag' : 'outerBlock',
            '__ps_value' : 123 };
      })(); 
  };
}
catch (_ps_err2)
{ if (_ps_err2 && 'outerBlock' === _ps_err2['__ps_block_tag'])
  { return _ps_err2['__ps_value']; 
  }
  else {
    throw _ps_err2; 
  };
};

})();"

;; So either I compile try-catch manually, or I fall ;; back to using (block ... (while T (switch ...))) for now.

;; Use (def-ps-macro tagbody-rec ...) to define ;; tagbody as a ps macro. Does this mean that the ;; macro only exists in the scope of a (ps ...) form?

;; Use (block gs-outer (loop do (block gs-inner (switch ...)))) ;; to handle (tagbody tag ((lambda () (go tag)))). The ;; (go ...) form is insinde a lexical closure. ;; Parenscript handles this nicely, when the closure ;; adjusted to ((lambda () (setf gs-switch-var 'tag) ;; (return-from gs-inner))).

;; Set up the switch-var correctly. It needs to be ;; initialized with the first tag. The prologue ;; should be handled separately anyway to keep the jump ;; table of the resulting switch case small for the ;; benefit of the CPUs branch predictor and instruction ;; cache while looping over the switch-case. ;; ;; (let ((gs-switch-var first-tag)) (switch gs-switch-var ...))

;; 2022-02-24

;; Parenscript example:

(let ((outer-block-1 (gensym (symbol-name 'outer-block-1-))) (inner-block-1 (gensym (symbol-name 'inner-block-1-))) (switch-var-1 (gensym (symbol-name 'switch-var-1-))) (outer-block-2 (gensym (symbol-name 'outer-block-2-))) (inner-block-2 (gensym (symbol-name 'inner-block-2-)))) `(block ,outer-block-1 (prologue-1) (let ((,switch-var-1 tagbody-1-first-tag)) (loop do (block ,inner-block-1 (switch ,switch-var-1 (case tagbody-1-tag-1 (foo) (block ,outer-block-2 (prologue-2) (let ((,switch-var-2 tagbody-2-first-tag)) (loop do (block ,inner-block-2 (switch ,switch-var-2 (case tagbody-2-tag-1) ;; inner jump: (go tagbody-2-tag-2) (progn (setf ,switch-var-2 'tagbody-2-tag-2) (return-from ,inner-block-2)) ;; outer jump: (go tagbody-1-tag-2) (progn (setf ,switch-var-1 'tagbody-1-tag-2) (return-from ,inner-block-1)) (case tagbody-2-tag-2) ;; Walking off the end of tagbody-2 (return-from ,outer-block-2)))))) ;; Code to skip when jumping from the ;; inner tagbody to a go tag in the ;; outer tagbody. Nevertheless, it has ;; to be run, when walking off the end of ;; the inner tagbody. (bar)) (case tagbody-1-tag-2 (baz) ;; Walking off the end of tagbody-1 (return-from ,outer-block-1))))))))

|#

;; =============================== ;; 2022-03-19

(defmacro with-tagbody-helpers (&body body) `(labels ((go-tag-p (obj) (or (symbolp obj) (integerp obj)))

    (tb-go-tags (tb-body)
      (remove-if-not #'go-tag-p tb-body))

    (first-go-tag (tb-body)
 ;; Find-if does *not* work cleanly.  It fails
 ;;  to distinguish between a tag named nil
 ;;  and the absence of go tags.  The latter
 ;;  is solely having a preamble in the
 ;;  tagbody form.
 "Returns two values like CL:GETHASH.
 1. First tag.
 2. Whether a tag was found. Relevant in case
 the first return value is NIL.

 Note, that NIL is a valid go-tag."
 (block first-go-tag
   (loop for form in tb-body
     do (if (go-tag-p form)
   (return-from first-go-tag
     (values form t))))
        (return-from first-go-tag
     (values nil nil))))

    (split-and-group-tb-body (tb-body)
      "Returns two values.
      1. The preamble -- code without a preceding tag
      2. Grouping of tags and subsequent code."

 (block split-and-group-tb-body
        (if (null tb-body)
     (return-from split-and-group-tb-body
           (values nil nil)))
        (let ((acc `((,(first tb-body))))
         (preamble-p (not (go-tag-p (first tb-body)))))
     (loop for tbf in (rest tb-body) do
       (if (go-tag-p tbf)
         (push `(,tbf) acc)
         (push tbf (first acc))))
          (setf acc (nreverse (mapcar #'nreverse acc)))
     (if preamble-p
       (values (first acc) (rest acc))
       (values nil acc))))))
 ,@body))

#| ;; TESTS (with-tagbody-helpers (and (go-tag-p 'foo) (go-tag-p 'bar) (go-tag-p 3) (go-tag-p -9)

   (not (go-tag-p 1.3))

   (equal
(tb-go-tags
  (rest '(tagbody
    (preamble-1-1)
    (preamble-1-2)
   tag1
    (foo)
   tag2
    (bar))))
     '(tag1 tag2))

   (eq
(first-go-tag
  (rest '(tagbody
    (preamble-1-1)
    (preamble-1-2)
   tag1
    (foo)
   tag2
    (bar))))
     'tag1)

(multiple-value-bind (preamble grouping)
    (split-and-group-tb-body
      (rest '(tagbody
        (preamble-1-1)
        (preamble-1-2)
       tag1
        (foo)
       tag2
        (bar))))
       (and
    (equal preamble
    '((preamble-1-1)
      (preamble-1-2)))
    (equal grouping
    '((tag1 (foo))
      (tag2 (bar))))))))

|#

(defmacro with-tagbody-parenscript-helpers (&body body) `(with-tagbody-helpers (labels ((new-go-bindings (switch-var block-var new-tb-go-tags) (mapcar (lambda (go-tag) ;; alist `(,go-tag (setf ,switch-var ',go-tag) (return-from ,block-var))) new-tb-go-tags)) (grouping-to-case-forms (grouped-tb-body old-and-new-go-bindings) (mapcar (lambda (go-tag-case) (destructuring-bind (go-tag &rest case-body) go-tag-case `(case ,go-tag ;; Handle nested tagbody ;; forms correctly. (tagbody-recursive (,old-and-new-go-bindings) ,@case-body)))) grouped-tb-body))

 (tb-body-to-switch (outer-block-var
                     inner-block-var
	      preamble
                          grouped-tb-body
	      first-tag
	      switch-var
	      old-and-new-go-bindings)
        `(block ,outer-block-var
      ,@preamble
      (let ((,switch-var ',first-tag))
        (loop do
   (block ,inner-block-var
            (macrolet ((go (go-tag)
		  `(progn
	             ,@(cdr (assoc
			      go-tag
			      ',old-and-new-go-bindings)))))
       (switch ,switch-var
         ,@(grouping-to-case-forms
	     grouped-tb-body
	     old-and-new-go-bindings)))
                 ;; Fall-through after end of tagbody form
            (return-from ,outer-block-var)))))))
   ,@body)))

#| ;; TESTS (with-tagbody-parenscript-helpers (and (let ((switch-1-var '#:switch-1-var) (inner-block-1-var '#:inner-block-1-var) (outer-block-1-var '#:outer-block-1-var))

  (equal
    (new-go-bindings switch-1-var
                     inner-block-1-var
                '(tb-1-tag1 tb-1-tag2))
    ;; alist
    `((tb-1-tag1 (setf ,switch-1-var 'tb-1-tag1)
            (return-from ,inner-block-1-var))
      (tb-1-tag2 (setf ,switch-1-var 'tb-1-tag2)
            (return-from ,inner-block-1-var))))

  (equal

(grouping-to-case-forms '((tag1 (foo) (tagbody tb-2-tag-1) (hoge)) (tag2 (bar))) `((tb-1-tag1 (setf ,switch-1-var 'tb-1-tag1) (return-from ,inner-block-1-var)) (tb-1-tag2 (setf ,switch-1-var 'tb-1-tag2) (return-from ,inner-block-1-var)))) `((CASE TAG1 (TAGBODY-RECURSIVE (((TB-1-TAG1 (SETF ,SWITCH-1-VAR 'TB-1-TAG1) (RETURN-FROM ,INNER-BLOCK-1-VAR)) (TB-1-TAG2 (SETF ,switch-1-var 'TB-1-TAG2) (RETURN-FROM ,inner-block-1-var)))) (FOO) (TAGBODY TB-2-TAG-1) (HOGE))) (CASE TAG2 (TAGBODY-RECURSIVE (((TB-1-TAG1 (SETF ,SWITCH-1-VAR 'TB-1-TAG1) (RETURN-FROM ,INNER-BLOCK-1-VAR)) (TB-1-TAG2 (SETF ,switch-1-var 'TB-1-TAG2) (RETURN-FROM ,inner-block-1-var)))) (BAR)))))

      (equalp ; Needs #'cl:equalP instead of #'cl:equal.
   (tb-body-to-switch
     outer-block-1-var
     inner-block-1-var
     '((preamble-1-1) (preamble-1-2))
     '((tb-1-tag-1 (foo)
	    (tagbody tb-2-tag-1)
	    (tagbody tb-1-tag-1) ; Shadows outer tag!
	    (hoge))
(tb-1-tag-2 (bar)))
     'tb-1-tag-1
     switch-1-var
     `((tb-1-tag-1 (setf ,switch-1-var 'tb-1-tag-1)
	    (return-from ,inner-block-1-var))
            (tb-1-tag-2 (setf ,switch-1-var 'tb-1-tag-2)
	    (return-from ,inner-block-1-var))))

   `(BLOCK ,OUTER-BLOCK-1-VAR
      (PREAMBLE-1-1)
      (PREAMBLE-1-2)
      (LET ((,SWITCH-1-VAR 'TB-1-TAG-1))
 (LOOP DO
   (BLOCK ,INNER-BLOCK-1-VAR
     (MACROLET
	 ((GO (GO-TAG)
            `(PROGN
	       ,@(CDR
		   (ASSOC GO-TAG
		          '((TB-1-TAG-1
			      (SETF ,switch-1-var 'TB-1-TAG-1)
			      (RETURN-FROM ,inner-block-1-var))
			    (TB-1-TAG-2
			      (SETF ,switch-1-var 'TB-1-TAG-2)
			      (RETURN-FROM ,inner-block-1-var))))))))
                   (SWITCH ,switch-1-var
	 (CASE TB-1-TAG-1
	   (TAGBODY-RECURSIVE
	       (((TB-1-TAG-1 (SETF ,switch-1-var 'TB-1-TAG-1)
			     (RETURN-FROM ,inner-block-1-var))
		 (TB-1-TAG-2 (SETF ,switch-1-var 'TB-1-TAG-2)
			     (RETURN-FROM ,inner-block-1-var))))
             (FOO)
	     (TAGBODY TB-2-TAG-1)
	     (TAGBODY TB-1-TAG-1) ; Shadows outer tag!
	     (HOGE)))
	 (CASE TB-1-TAG-2
	   (TAGBODY-RECURSIVE
	       (((TB-1-TAG-1 (SETF ,switch-1-var 'TB-1-TAG-1)
			     (RETURN-FROM ,inner-block-1-var))
		 (TB-1-TAG-2 (SETF ,switch-1-var 'TB-1-TAG-2)
			     (RETURN-FROM ,inner-block-1-var))))
	     (BAR)))))
                 (RETURN-FROM ,outer-block-1-var)))))))))

|#

(defmacro tagbody-recursive ((&optional outer-go-bindings) &body body) "Recursion information OUTER-GO-BINDINGS only by nested calls. Confer recursion flag of #'CL:READ." `(with-tagbody-parenscript-helpers (let ((outer-block-var (gensym (symbol-name 'outer-block-var-))) (inner-block-var (gensym (symbol-name 'inner-block-var-))) (switch-var (gensym (symbol-name 'switch-var-)))) (macrolet ((tagbody (&body tb-body) (let* ((new-go-tags (tb-go-tags tb-body)) (first-go-tag (first-go-tag tb-body)) (old-and-new-go-bindings ;; alist (append (new-go-bindings switch-var inner-block-var new-go-tags) outer-go-bindings))) (multiple-value-bind (preamble tb-groups) (split-and-group-tb-body tb-body) (tb-body-to-switch (outer-block-var inner-block-var preamble tb-groups first-go-tag switch-var old-and-new-go-bindings)))))) ,@body))))

#| ;; TESTS |# (ql:quickload '(:series :parenscript :trivial-macroexpand-all))

(series::install :shadow t)

(import '(parenscript:ps parenscript:ps* trivial-macroexpand-all:macroexpand-all))

;; Explicitly circumvent package lock ;; on package CL to allow shadowing ;; by macrolet for series to paren- ;; script translation. (shadow '(tagbody go))

;; Default to standard CL form. (defmacro tagbody (&body body) "See CL:tagbody." `(cl:tagbody ,@body))

;; Default to standard CL form. (defmacro go (&body body) "See CL:go." `(cl:go ,@body))

(load #p"2022-05-20_defmacro-series-expand.lisp")

(parenscript:ps* (series-expand (collect (map-fn '(values T T) #'floor #z(9 99 999) #z(1 2 3)))))

;; Problem: Parenscript does *not* know ;; how to compile TAGBODY. Suggestion: ;; compile into (loop (case ...)) with ;; a go-variable where the (case ...) ;; selects between the jump targets. ;; This should be easily made compatible ;; with (series::producing ...) given ;; the additional constraints for ;; series::producing.

;; 2022-02-24

;; Parenscript example:

(let ((outer-block-1 (gensym (symbol-name 'outer-block-1-))) (inner-block-1 (gensym (symbol-name 'inner-block-1-))) (switch-var-1 (gensym (symbol-name 'switch-var-1-))) (outer-block-2 (gensym (symbol-name 'outer-block-2-))) (inner-block-2 (gensym (symbol-name 'inner-block-2-)))) `(block ,outer-block-1 (prologue-1) (let ((,switch-var-1 tagbody-1-first-tag)) (loop do (block ,inner-block-1 (switch ,switch-var-1 (case tagbody-1-tag-1 (foo) (block ,outer-block-2 (prologue-2) (let ((,switch-var-2 tagbody-2-first-tag)) (loop do (block ,inner-block-2 (switch ,switch-var-2 (case tagbody-2-tag-1) ;; inner jump: (go tagbody-2-tag-2) (progn (setf ,switch-var-2 'tagbody-2-tag-2) (return-from ,inner-block-2)) ;; outer jump: (go tagbody-1-tag-2) (progn (setf ,switch-var-1 'tagbody-1-tag-2) (return-from ,inner-block-1)) (case tagbody-2-tag-2) ;; Walking off the end of tagbody-2 (return-from ,outer-block-2)))))) ;; Code to skip when jumping from the ;; inner tagbody to a go tag in the ;; outer tagbody. Nevertheless, it has ;; to be run, when walking off the end of ;; the inner tagbody. (bar)) (case tagbody-1-tag-2 (baz) ;; Walking off the end of tagbody-1 (return-from ,outer-block-1))))))))

|#

;; =============================== ;; 2022-03-19

(defmacro with-tagbody-helpers (&body body) `(labels ((go-tag-p (obj) (or (symbolp obj) (integerp obj)))

    (tb-go-tags (tb-body)
      (remove-if-not #'go-tag-p tb-body))

    (first-go-tag (tb-body)
 ;; Find-if does *not* work cleanly.  It fails
 ;;  to distinguish between a tag named nil
 ;;  and the absence of go tags.  The latter
 ;;  is solely having a preamble in the
 ;;  tagbody form.
 "Returns two values like CL:GETHASH.
 1. First tag.
 2. Whether a tag was found. Relevant in case
 the first return value is NIL.

 Note, that NIL is a valid go-tag."
 (block first-go-tag
   (loop for form in tb-body
     do (if (go-tag-p form)
   (return-from first-go-tag
     (values form t))))
        (return-from first-go-tag
     (values nil nil))))

    (split-and-group-tb-body (tb-body)
      "Returns two values.
      1. The preamble -- code without a preceding tag
      2. Grouping of tags and subsequent code."

 (block split-and-group-tb-body
        (if (null tb-body)
     (return-from split-and-group-tb-body
           (values nil nil)))
        (let ((acc `((,(first tb-body))))
         (preamble-p (not (go-tag-p (first tb-body)))))
     (loop for tbf in (rest tb-body) do
       (if (go-tag-p tbf)
         (push `(,tbf) acc)
         (push tbf (first acc))))
          (setf acc (nreverse (mapcar #'nreverse acc)))
     (if preamble-p
       (values (first acc) (rest acc))
       (values nil acc))))))
 ,@body))

#| ;; TESTS (with-tagbody-helpers (and (go-tag-p 'foo) (go-tag-p 'bar) (go-tag-p 3) (go-tag-p -9)

   (not (go-tag-p 1.3))

   (equal
(tb-go-tags
  (rest '(tagbody
    (preamble-1-1)
    (preamble-1-2)
   tag1
    (foo)
   tag2
    (bar))))
     '(tag1 tag2))

   (eq
(first-go-tag
  (rest '(tagbody
    (preamble-1-1)
    (preamble-1-2)
   tag1
    (foo)
   tag2
    (bar))))
     'tag1)

(multiple-value-bind (preamble grouping)
    (split-and-group-tb-body
      (rest '(tagbody
        (preamble-1-1)
        (preamble-1-2)
       tag1
        (foo)
       tag2
        (bar))))
       (and
    (equal preamble
    '((preamble-1-1)
      (preamble-1-2)))
    (equal grouping
    '((tag1 (foo))
      (tag2 (bar))))))))

|#

(defmacro with-tagbody-parenscript-helpers (&body body) `(with-tagbody-helpers (labels ((new-go-bindings (switch-var block-var new-tb-go-tags) (mapcar (lambda (go-tag) ;; alist `(,go-tag (setf ,switch-var ',go-tag) (return-from ,block-var))) new-tb-go-tags)) (grouping-to-case-forms (grouped-tb-body old-and-new-go-bindings) (mapcar (lambda (go-tag-case) (destructuring-bind (go-tag &rest case-body) go-tag-case `(case ,go-tag ;; Handle nested tagbody ;; forms correctly. (tagbody-recursive (,old-and-new-go-bindings) ,@case-body)))) grouped-tb-body))

 (tb-body-to-switch (outer-block-var
                     inner-block-var
	      preamble
                          grouped-tb-body
	      first-tag
	      switch-var
	      old-and-new-go-bindings)
        `(block ,outer-block-var
      ,@preamble
      (let ((,switch-var ',first-tag))
        (loop do
   (block ,inner-block-var
            (macrolet ((go (go-tag)
		  `(progn
	             ,@(cdr (assoc
			      go-tag
			      ',old-and-new-go-bindings)))))
       (switch ,switch-var
         ,@(grouping-to-case-forms
	     grouped-tb-body
	     old-and-new-go-bindings)))
                 ;; Fall-through after end of tagbody form
            (return-from ,outer-block-var)))))))
   ,@body)))

#| ;; TESTS (with-tagbody-parenscript-helpers (and (let ((switch-1-var '#:switch-1-var) (inner-block-1-var '#:inner-block-1-var) (outer-block-1-var '#:outer-block-1-var))

  (equal
    (new-go-bindings switch-1-var
                     inner-block-1-var
                '(tb-1-tag1 tb-1-tag2))
    ;; alist
    `((tb-1-tag1 (setf ,switch-1-var 'tb-1-tag1)
            (return-from ,inner-block-1-var))
      (tb-1-tag2 (setf ,switch-1-var 'tb-1-tag2)
            (return-from ,inner-block-1-var))))

  (equal

(grouping-to-case-forms '((tag1 (foo) (tagbody tb-2-tag-1) (hoge)) (tag2 (bar))) `((tb-1-tag1 (setf ,switch-1-var 'tb-1-tag1) (return-from ,inner-block-1-var)) (tb-1-tag2 (setf ,switch-1-var 'tb-1-tag2) (return-from ,inner-block-1-var)))) `((CASE TAG1 (TAGBODY-RECURSIVE (((TB-1-TAG1 (SETF ,SWITCH-1-VAR 'TB-1-TAG1) (RETURN-FROM ,INNER-BLOCK-1-VAR)) (TB-1-TAG2 (SETF ,switch-1-var 'TB-1-TAG2) (RETURN-FROM ,inner-block-1-var)))) (FOO) (TAGBODY TB-2-TAG-1) (HOGE))) (CASE TAG2 (TAGBODY-RECURSIVE (((TB-1-TAG1 (SETF ,SWITCH-1-VAR 'TB-1-TAG1) (RETURN-FROM ,INNER-BLOCK-1-VAR)) (TB-1-TAG2 (SETF ,switch-1-var 'TB-1-TAG2) (RETURN-FROM ,inner-block-1-var)))) (BAR)))))

      (equalp ; Needs #'cl:equalP instead of #'cl:equal.
   (tb-body-to-switch
     outer-block-1-var
     inner-block-1-var
     '((preamble-1-1) (preamble-1-2))
     '((tb-1-tag-1 (foo)
	    (tagbody tb-2-tag-1)
	    (tagbody tb-1-tag-1) ; Shadows outer tag!
	    (hoge))
(tb-1-tag-2 (bar)))
     'tb-1-tag-1
     switch-1-var
     `((tb-1-tag-1 (setf ,switch-1-var 'tb-1-tag-1)
	    (return-from ,inner-block-1-var))
            (tb-1-tag-2 (setf ,switch-1-var 'tb-1-tag-2)
	    (return-from ,inner-block-1-var))))

   `(BLOCK ,OUTER-BLOCK-1-VAR
      (PREAMBLE-1-1)
      (PREAMBLE-1-2)
      (LET ((,SWITCH-1-VAR 'TB-1-TAG-1))
 (LOOP DO
   (BLOCK ,INNER-BLOCK-1-VAR
     (MACROLET
	 ((GO (GO-TAG)
            `(PROGN
	       ,@(CDR
		   (ASSOC GO-TAG
		          '((TB-1-TAG-1
			      (SETF ,switch-1-var 'TB-1-TAG-1)
			      (RETURN-FROM ,inner-block-1-var))
			    (TB-1-TAG-2
			      (SETF ,switch-1-var 'TB-1-TAG-2)
			      (RETURN-FROM ,inner-block-1-var))))))))
                   (SWITCH ,switch-1-var
	 (CASE TB-1-TAG-1
	   (TAGBODY-RECURSIVE
	       (((TB-1-TAG-1 (SETF ,switch-1-var 'TB-1-TAG-1)
			     (RETURN-FROM ,inner-block-1-var))
		 (TB-1-TAG-2 (SETF ,switch-1-var 'TB-1-TAG-2)
			     (RETURN-FROM ,inner-block-1-var))))
             (FOO)
	     (TAGBODY TB-2-TAG-1)
	     (TAGBODY TB-1-TAG-1) ; Shadows outer tag!
	     (HOGE)))
	 (CASE TB-1-TAG-2
	   (TAGBODY-RECURSIVE
	       (((TB-1-TAG-1 (SETF ,switch-1-var 'TB-1-TAG-1)
			     (RETURN-FROM ,inner-block-1-var))
		 (TB-1-TAG-2 (SETF ,switch-1-var 'TB-1-TAG-2)
			     (RETURN-FROM ,inner-block-1-var))))
	     (BAR)))))
                 (RETURN-FROM ,outer-block-1-var)))))))))

|#

(defmacro tagbody-recursive ((&optional outer-go-bindings) &body body) "Recursion information OUTER-GO-BINDINGS only by nested calls. Confer recursion flag of #'CL:READ." `(with-tagbody-parenscript-helpers (let ((outer-block-var (gensym (symbol-name 'outer-block-var-))) (inner-block-var (gensym (symbol-name 'inner-block-var-))) (switch-var (gensym (symbol-name 'switch-var-)))) (macrolet ((tagbody (&body tb-body) (let* ((new-go-tags (tb-go-tags tb-body)) (first-go-tag (first-go-tag tb-body)) (old-and-new-go-bindings ;; alist (append (new-go-bindings switch-var inner-block-var new-go-tags) outer-go-bindings))) (multiple-value-bind (preamble tb-groups) (split-and-group-tb-body tb-body) (tb-body-to-switch (outer-block-var inner-block-var preamble tb-groups first-go-tag switch-var old-and-new-go-bindings)))))) ,@body))))

#| ;; TESTS |#

Hi Philipp,

That sounds like a good plan.

From my current vantage point, this seems like step

three. I just got done with at step one. Step two is for me to get acquainted with the parenscript codebase.

I will get a feel the existing code base and then we can take the next steps from there.

I already cloned the git repository to my local development machine. The current commit for branch master seems to be:

commit 1fd720bc4e2bc5ed92064391b730b9d4db35462a (HEAD -> master) | Author: Vladimir Sedach vas@oneofus.la | Date: Wed Jun 17 20:29:19 2020 -0700

Regarding tail-call optimization in JavaScript: Jason Miller also recommended that. Unfortunately, I dug up information indicating that it is unsupported in Google's V8 JavaScript implementation, see [stackoverflow.com (2017)].

Quoting part of my reply to Jason for the benefit of future readers of this specific email:

[...] This seems to necessitate a (loop (case ...)) based approach, because SERIES may be used for loops with iteration counts greater than the stack size. Nevertheless, not all is lost.

PARENSCRIPT already compiles (block nil ((lambda () (return 3)))) as catch/throw correctly. Note, the call in the body of the BLOCK. So at least some dynamic ((lambda () (go ...))) calls should be compilable; hopefully all of them. Even if it only captures 70% of all use cases, that is way more than zero.

Cheers, Andrew

[stackoverflow.com (2017)], Answer by T.J. Crowder: TITLE: ES6 Tail Recursion Optimisation Stack Overflow, URL: https://stackoverflow.com/questions/42788139/es6-tail-recursion-optimisation...

On Sat, May 21, 2022 at 10:58:57AM +0200, Philipp Marek wrote:

Hi Andrew,

first of all -- how about registering on gitlab.common-lisp.net, so that you can become a developer for [1] and work with a branch using a Merge Request? It would be much easier to track your progress (and individual changes) that way.

...

I have started to implement TAGBODY for PARENSCRIPT [A,B,C]. The general idea is to imitate a jump table by looping over a switch-case. A GO (C-terminology: jump) then sets the switch-variable to the next jump destination. The loop subsequently causes the switch to branch to the jump target in the switch-variable. Leaving the tagbody means leaving the loop.

Hmmm, okay. My first thought would've been to use a function for each part and just do tail recursion... but it seems that this isn't really supported in Javascript?!

...

There are complications. Common Lisp allows nested tagbody-forms. Common Lisp allows go-tags to be referenced within the lexical scope *and* the dynamic extent of a tagbody form. This means that a LAMBDA can close over a go-tag and jump there, see an example in [B], of how inconvenient this can become for compilation to JavaScript.

Yeah... that would be a good reason for simple function calls and tail recursion.

...

1. I need a code review of the algorithm. The implementation in [B] seems to be satisfactory. There are some test cases and examples. Most there is the most hairy example I could find up to now. I may have missed crucial details.

I'll take a look - but please let's try to get it into the git repo first, so that any discussions have some common state to refer to.

...

2. My understanding of the CL:TAGBODY definition in the CLHS [4] may be wrong. Which alternate interpretations does anybody here know of?

What are your questions, or points of confusion?

Ad 1: https://gitlab.common-lisp.net/parenscript/parenscript

Neat! I'll take a closer look later.

Does it fully support the strange combination of lexical scope and dynamic extent that CL:TAGBODY does?

For example:

(defun foo (x) (funcall x)) (tagbody (foo (lambda () (go x))) (format t "This does not happen~%") x)

-Jason

On Fri, 27 Jan 2023 09:00:58 -0700 Andrew Easton Andrew@Easton24.com wrote:

Hello everyone,

How’s it going?

There is now a working version of (parenscript:defpsmacro tagbody (&body body) …)), See my blog post here: "https://dapperdrake.neocities.org/faster-loops-javascript https://dapperdrake.neocities.org/faster-loops-javascript” .

This adds nestable (tagbody … (tagbody …) …)) forms as a user-land library to parenscript.

Apologies for missing documentation. It will be added gradually. Also, hosting a tarball on Neocities.org is planned in future as well as somehow getting the library into quicklisp. A name like parenscript-tagbody-go seems useful.

This code is still missing the check of *DEFINED-OPERATORS*. How is that supposed to look?

Cheers, Andrew

...

On May 29, 2022, at 20:24, Andrew Easton andrew@easton24.de wrote:

Hi Philipp,

That sounds like a good plan.

From my current vantage point, this seems like step three. I just got done with at step one. Step two is for me to get acquainted with the parenscript codebase.

I will get a feel the existing code base and then we can take the next steps from there.

I already cloned the git repository to my local development machine. The current commit for branch master seems to be:

commit 1fd720bc4e2bc5ed92064391b730b9d4db35462a (HEAD -> master) | Author: Vladimir Sedach vas@oneofus.la | Date: Wed Jun 17 20:29:19 2020 -0700

Regarding tail-call optimization in JavaScript: Jason Miller also recommended that. Unfortunately, I dug up information indicating that it is unsupported in Google's V8 JavaScript implementation, see [stackoverflow.com (2017)].

Quoting part of my reply to Jason for the benefit of future readers of this specific email:

...

[...] This seems to necessitate a (loop (case ...)) based approach, because SERIES may be used for loops with iteration counts greater than the stack size. Nevertheless, not all is lost.

PARENSCRIPT already compiles (block nil ((lambda () (return 3)))) as catch/throw correctly. Note, the call in the body of the BLOCK. So at least some dynamic ((lambda () (go ...))) calls should be compilable; hopefully all of them. Even if it only captures 70% of all use cases, that is way more than zero.

Cheers, Andrew

[stackoverflow.com (2017)], Answer by T.J. Crowder: TITLE: ES6 Tail Recursion Optimisation Stack Overflow, URL: https://stackoverflow.com/questions/42788139/es6-tail-recursion-optimisation...

On Sat, May 21, 2022 at 10:58:57AM +0200, Philipp Marek wrote:

...

Hi Andrew,

first of all -- how about registering on gitlab.common-lisp.net, so that you can become a developer for [1] and work with a branch using a Merge Request? It would be much easier to track your progress (and individual changes) that way.

...

I have started to implement TAGBODY for PARENSCRIPT [A,B,C]. The general idea is to imitate a jump table by looping over a switch-case. A GO (C-terminology: jump) then sets the switch-variable to the next jump destination. The loop subsequently causes the switch to branch to the jump target in the switch-variable. Leaving the tagbody means leaving the loop.

Hmmm, okay. My first thought would've been to use a function for each part and just do tail recursion... but it seems that this isn't really supported in Javascript?!

...

There are complications. Common Lisp allows nested tagbody-forms. Common Lisp allows go-tags to be referenced within the lexical scope *and* the dynamic extent of a tagbody form. This means that a LAMBDA can close over a go-tag and jump there, see an example in [B], of how inconvenient this can become for compilation to JavaScript.

Yeah... that would be a good reason for simple function calls and tail recursion.

...

1. I need a code review of the algorithm.

The implementation in [B] seems to be satisfactory. There are some test cases and examples. Most there is the most hairy example I could find up to now. I may have missed crucial details.

I'll take a look - but please let's try to get it into the git repo first, so that any discussions have some common state to refer to.

...

2. My understanding of the CL:TAGBODY definition in

the CLHS [4] may be wrong. Which alternate interpretations does anybody here know of?

What are your questions, or points of confusion?

Ad 1: https://gitlab.common-lisp.net/parenscript/parenscript

Hi Jason,

Thank you very much for raising the preamble issue. It seems like it is fixable, see below. The idea of a “preamble” will probably be removed. Fix still needs to be implemented by me.

The blog post has been amended to document this bug. Search for “TODO BUG #2”.

;; TODO BUG #2 2023-02-28

(parenscript:ps* '(defun bar () (tagbody (go x) (alert "hi") x)))

#| returns

"defun(bar, null, (function () { go(x); alert('hi'); var switchVar295 = 1; while (true) { switch (switchVar295) { case 1: 'tagbody-go-tag: X'; }; __PS_MV_REG = []; return; }; })());” |#

This output is incorrect. There should be no "go(x);" under any relevant circumstances as by the CLHS definition of (tagbody ...) and (go ...) .

The problem seems to be that the search for the "preamble" only checks for go-tags and not for (go ...) forms. This seems to be easily fixable by amending the preamble search to terminate upon encountering a top-level (go ...) form. Problem: (tagbody (funcall (lambda () (go x))) (alert "hi") x) still has the same behaviour, *without* involving a (go ...) form at the top level of the (tagbody ...).

Alternative proposal: Do away with the preamble and instead add a dummy gensymmed jump tag at the beginning of the (tagbody ...). That jump-tag should, conceptually, be unreachable. All (go ...) forms are then affected by the (macrolet ((go ...)) ...) wrappers being placed already. Then the preamble analysis becomes dead code and can be removed.

See Jason Miller's first bug reported on 2023-01-27 for current problems with wrapping (go ...) forms inside of (lambda ...) forms.

Cheers, Andrew

On Jan 27, 2023, at 15:16, Jason Miller jason@milr.com wrote:

(parenscript:ps (defun bar () (tagbody (go x) (alert "hi") x)))

Hi Jason,

Thank you very much for raising the dynamic scope issue. It seems like it is fixable, see below. I will digest the example and see whether I can implement with a fix.

The blog post has been amended to document this bug. Search for “TODO BUG #1”.

;; TODO BUG #1 2023-02-28

(defun foo (x) (funcall x)) (tagbody (foo (lambda () (go x))) (format t "This does not happen~%") x)

(parenscript::ps* '(tagbody (foo (lambda () (go x))) (format t "This does not happen~%") x))

#| Output: "(function () { foo(function () { __PS_MV_REG = []; return go(x); }); format(true, 'This does not happen~%'); var switchVar243 = 1; while (true) { switch (switchVar243) { case 1: 'tagbody-go-tag: X'; }; __PS_MV_REG = []; return; }; })();"

This output demonstrates a bug: "return go(x);" is not what is supposed to happen.

So, what is supposed to happen? The switch-var needs to be set. Then the conceptual inner block within the loop needs to returned from. The loop will re-enter the switch-case and jump to the last branch which should fall through beyond the end. Falling through is implemented by breaking out of the conceptual outer block surrounding the loop. Note, that parenscript sometimes compiles this outer block to a "function() {...}" with "try ... catch". This seems useful and reasonable. It is pointed out to help with understanding the compiler's output.

Start by analyzing what parenscript does when a (lambda ...) returns from a (block ...). Perhaps it is sufficient to wrap (lambda ...) bodies like so: `(macrolet ((go (...) ...)) ,@lambda-body). |#

(parenscript:ps* '(block foo (funcall (lambda () (return-from foo 3)))))

#| The following output looks promising:

"(function () { try { __PS_MV_REG = []; return funcall(function () { __PS_MV_REG = []; throw { '__ps_block_tag' : 'foo', '__ps_value' : 3 }; }); } catch (_ps_err1) { if (_ps_err1 && 'foo' === _ps_err1['__ps_block_tag']) { return _ps_err1['__ps_value']; } else { throw _ps_err1; }; }; })();" |#

Cheers, Andrew

On Jan 27, 2023, at 14:54, Jason Miller jason@milr.com wrote:

Neat! I'll take a closer look later.

Does it fully support the strange combination of lexical scope and dynamic extent that CL:TAGBODY does?

For example:

(defun foo (x) (funcall x)) (tagbody (foo (lambda () (go x))) (format t "This does not happen~%") x)

-Jason

On Fri, 27 Jan 2023 09:00:58 -0700 Andrew Easton Andrew@Easton24.com wrote:

...

Hello everyone,

How’s it going?

There is now a working version of (parenscript:defpsmacro tagbody (&body body) …)), See my blog post here: "https://dapperdrake.neocities.org/faster-loops-javascript https://dapperdrake.neocities.org/faster-loops-javascript” .

This adds nestable (tagbody … (tagbody …) …)) forms as a user-land library to parenscript.

Apologies for missing documentation. It will be added gradually. Also, hosting a tarball on Neocities.org is planned in future as well as somehow getting the library into quicklisp. A name like parenscript-tagbody-go seems useful.

This code is still missing the check of *DEFINED-OPERATORS*. How is that supposed to look?

Cheers, Andrew

...

On May 29, 2022, at 20:24, Andrew Easton andrew@easton24.de wrote:

Hi Philipp,

That sounds like a good plan.

From my current vantage point, this seems like step three. I just got done with at step one. Step two is for me to get acquainted with the parenscript codebase.

I will get a feel the existing code base and then we can take the next steps from there.

I already cloned the git repository to my local development machine. The current commit for branch master seems to be:

commit 1fd720bc4e2bc5ed92064391b730b9d4db35462a (HEAD -> master) | Author: Vladimir Sedach vas@oneofus.la | Date: Wed Jun 17 20:29:19 2020 -0700

Regarding tail-call optimization in JavaScript: Jason Miller also recommended that. Unfortunately, I dug up information indicating that it is unsupported in Google's V8 JavaScript implementation, see [stackoverflow.com (2017)].

Quoting part of my reply to Jason for the benefit of future readers of this specific email:

...

[...] This seems to necessitate a (loop (case ...)) based approach, because SERIES may be used for loops with iteration counts greater than the stack size. Nevertheless, not all is lost.

PARENSCRIPT already compiles (block nil ((lambda () (return 3)))) as catch/throw correctly. Note, the call in the body of the BLOCK. So at least some dynamic ((lambda () (go ...))) calls should be compilable; hopefully all of them. Even if it only captures 70% of all use cases, that is way more than zero.

Cheers, Andrew

[stackoverflow.com (2017)], Answer by T.J. Crowder: TITLE: ES6 Tail Recursion Optimisation Stack Overflow, URL: https://stackoverflow.com/questions/42788139/es6-tail-recursion-optimisation...

On Sat, May 21, 2022 at 10:58:57AM +0200, Philipp Marek wrote:

...

Hi Andrew,

first of all -- how about registering on gitlab.common-lisp.net, so that you can become a developer for [1] and work with a branch using a Merge Request? It would be much easier to track your progress (and individual changes) that way.

...

I have started to implement TAGBODY for PARENSCRIPT [A,B,C]. The general idea is to imitate a jump table by looping over a switch-case. A GO (C-terminology: jump) then sets the switch-variable to the next jump destination. The loop subsequently causes the switch to branch to the jump target in the switch-variable. Leaving the tagbody means leaving the loop.

Hmmm, okay. My first thought would've been to use a function for each part and just do tail recursion... but it seems that this isn't really supported in Javascript?!

...

There are complications. Common Lisp allows nested tagbody-forms. Common Lisp allows go-tags to be referenced within the lexical scope *and* the dynamic extent of a tagbody form. This means that a LAMBDA can close over a go-tag and jump there, see an example in [B], of how inconvenient this can become for compilation to JavaScript.

Yeah... that would be a good reason for simple function calls and tail recursion.

...

1. I need a code review of the algorithm.

The implementation in [B] seems to be satisfactory. There are some test cases and examples. Most there is the most hairy example I could find up to now. I may have missed crucial details.

I'll take a look - but please let's try to get it into the git repo first, so that any discussions have some common state to refer to.

...

2. My understanding of the CL:TAGBODY definition in

the CLHS [4] may be wrong. Which alternate interpretations does anybody here know of?

What are your questions, or points of confusion?

Ad 1: https://gitlab.common-lisp.net/parenscript/parenscript