fork download
copy 
  1. (defun show (x)
  2.   (format nil "~A" x))
  3.  
  4. (defmacro %tagbody (&body body &aux exprs tags)
  5.   (loop :with xs :for x :in body
  6.         :if (consp x) :do (push x xs)
  7.         :else :collect (nreverse xs) :into @exprs
  8.               :and :collect (cons x (gensym (show x))) :into @tags
  9.               :and :do (setf xs nil)
  10.         :finally (setf exprs (nconc @exprs (list (nreverse xs)))
  11.                        tags  @tags))
  12.   `(macrolet ((goto (x) `(return (,(cdr (assoc x ',tags))))))
  13.      (block nil
  14.        (labels ,(loop :for (tc tn) :on tags :and x :in (cdr exprs)
  15.                       :collect `(,(cdr tc) nil ,@x 
  16.                                  ,(and tn `(goto ,(car tn)))))
  17.          ,@(car exprs) (goto ,(caar tags))))))
  18.  
  19. (defun factorial (x &aux (f 1))
  20.   (%tagbody
  21.    0 (if (zerop x) (goto 4))
  22.    1 (setf f (* f x))
  23.    2 (decf x)
  24.    3 (goto 0)
  25.    4 (return-from factorial f)))
  26.  
  27. (format t "Fact(~d) -> ~d" #1=42 (factorial #1#))
Success #stdin #stdout 0.01s 10840KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Fact(42) -> 1405006117752879898543142606244511569936384000000000
https://ideone.com/Bik8D7
language:
Common Lisp (clisp 2.49.92)
created:
9 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!