Eigentlich sind BLOCK und RETURN-FROM ja Sonderoperatoren. Da ich meinen Interpreter aber nicht zu sehr aufblähen möchte (schon erst recht nicht, weil er irgendwann einen Compiler zur Seite bekommen wird, der dieselben Sonderoperatoren auch alle nochmal verstehen muß), versuche ich, die Anzahl dieser zu minimieren, weshalb ich BLOCK und RETURN-FROM als Makros über CATCH und THROW implementiert habe.

Es gibt ein Paper darüber, wie das geht, doch hat der dort angegebene Code leider einen fatalen Fehler: Er setzt die Existenz eines Operators BLOCK-TO-TAGNAME voraus, der aus einem Symbol ein anderes Symbol macht, das erstens (wie ein GENSYM) nirgendwo sonst vorkommen und andererseits für jede Eingabe eindeutig sein soll (d.h. BLOCK-TO-TAGNAME ist eine injektive Funktion im mathematischen Sinne von SYMBOL nach SYMBOL). Das Schreiben einer solchen Funktion ist nun dummerweise nicht möglich*, wenn man sich nicht Nebenwirkungen zunutze macht, wie z.B. das Auffüllen einer Hashtable. Letzteres wäre wiederum speicherverwaltungstechnisch ein furchtbares Problem, weil die Einträge, jedenfalls in einem einigermaßen einfachen Ansatz, niemals wieder entfernt werden könnten und immer mehr würden.

Also einen Schritt zurück. Wofür ist BLOCK-TO-TAGNAME eigentlich da? Der Grund für seine Existenz liegt darin, daß man gerne das Mapping zwischen Blocknamen und CATCH-Tagnamen vom Makro BLOCK, in dem der CATCH-Tag eingeführt wird, zum Makro RETURN-FROM übermitteln möchte, in dem es verwendet werden muß. Diese Zuordnung muß lexikalisch eindeutig sein, d.h. folgendes liefert 3 zurück, nicht 2:

(block mulk  
  (let ((fn (lambda () (return-from mulk 3))))  
    (block mulk (funcall fn))  
    2) 

Folglich muß der äußere MULK-Block einen anderen CATCH-Tag verwenden als der innere. Ich löse das zur Kompilierzeit, indem ich in der Auswertungsumgebung der Makros eine Zuordnungstabelle anlege, die nach dem Kompilieren verschwindet:

(defmacro block (block-name &body body)  
  (let ((catch-tag (gensym)))  
    `(compiler-let ((%block-mapping% (acons ',block-name ',catch-tag %block-mapping%))))  
       (catch ',catch-tag  
         ,@body))))  
 
(defmacro return-from (block-name &optional value &environment env)  
  `(throw #,(cdr (assoc block-name %block-mapping% :test #'eq))  
     ,value)) 

Dem geneigten Leser wird aufgefallen sein, daß ich hier zwei Features verwendet habe, die es in ANSI Common Lisp nicht mehr gibt, obgleich es sie früher einmal gab: #, und COMPILER-LET. Den Platz von #, hat heute LOAD-TIME-VALUE eingenommen. In der Tat läßt sich LOAD-TIME-VALUE in SBCL ähnlich wie #, verwenden und respektiert sogar die Auswertungsumgebung des Compilers:

CL-USER> (sb-cltl2:compiler-let ((x 10))  
           (load-time-value x))  
10 

Was ist aber mit COMPILER-LET? Nicht, daß mich jemand daran hindern würde, es in Toilet Lisp zu implementieren -- vielleicht mache ich das auch noch. Doch wollte ich nicht möglichst wenige Sonderoperatoren definieren? Wenn es doch schon einen gäbe, der diesen Zweck erfüllte...

Und den gibt es: MACROLET läßt sich effektiv für dieselben Sachen einsetzen wie einstmals COMPILER-LET, auch wenn sein Existenzsinn eigentlich woanders liegt. Ein bißchen Hacking hier und da, et voilà:

(defmacro block (block-name &body body)  
  (let ((catch-tag (gensym)))  
    `(macrolet ((%block-mapping% () `(quote ,(acons ',block-name ',catch-tag (%block-mapping%)))))  
       (catch ',catch-tag  
         ,@body))))  
 
(defmacro return-from (block-name &optional value &environment env)  
  `(throw ',(cdr (assoc block-name (cadr (macroexpand `(%block-mapping%)  
                                                      env))  
                        :test 'eq))  
     ,value)) 

Häßlicher als zuvor mit #, und COMPILER-LET, soviel ist sicher. Dafür funktionieren die Definitionen auch in CMU CL, und das ist doch auch ganz schön. Es schadet dem Debuggingaufwand jedenfalls sicherlich nicht.