Skip to content

Instantly share code, notes, and snippets.

@athos athos/tagbody.clj
Created Sep 4, 2019

Embed
What would you like to do?
(ns jise.extension.tagbody
(:require [jise.emit :as emit]
[jise.parse :as parse])
(:import [clojure.asm Label MethodVisitor Opcodes]))
(defn parse-tagbody-body [body]
(loop [body body
tag nil
block []
blocks []]
(if (empty? body)
(conj blocks [tag block])
(let [[expr & more] body]
(if (keyword? expr)
(recur more expr [] (conj blocks [tag block]))
(recur more tag (conj block expr) blocks))))))
(defmethod parse/parse-expr* `tagbody* [cenv [_ & body]]
(let [blocks (parse-tagbody-body body)
[last-tag last-body] (last blocks)
cenv' (parse/inherit-context cenv cenv :return? false)
last' (parse/parse-expr cenv' `(do ~@last-body))]
(-> {:op ::tagbody
:type (:type last')
:blocks (conj (mapv (fn [[tag body]]
(let [cenv' (parse/with-context cenv :statement)]
[tag (parse/parse-expr cenv'`(do ~@body))]))
(butlast blocks))
[last-tag last'])}
(parse/inherit-context cenv))))
(defmethod parse/parse-expr* `go* [cenv [_ tag]]
(-> {:op ::go :tag tag}
(parse/inherit-context (parse/with-context cenv :statement))))
(defmacro tagbody [& body]
`(tagbody* ~@body))
(defmacro go [tag]
`(go* ~tag))
(defmethod emit/emit-expr* ::tagbody [{:keys [^MethodVisitor mv] :as emitter} {:keys [blocks context]}]
(let [tag->label (zipmap (map first blocks) (repeatedly #(Label.)))
emitter' (assoc emitter ::tag->label tag->label)]
(doseq [[tag body] blocks]
(when-let [label (some-> tag tag->label)]
(.visitLabel mv label))
(emit/emit-expr emitter' body))))
(defmethod emit/emit-expr* ::go [{:keys [^MethodVisitor mv ::tag->label]} {:keys [tag]}]
(.visitJumpInsn mv Opcodes/GOTO (get tag->label tag)))
(comment
(require '[jise.core :refer [defclass]])
(alias 'tb 'jise.extension.tagbody)
^:public
(defclass Hello
^:public ^:static
(defm hello []
(let [n 3]
(tb/tagbody
:point-a
(.print System/out "h")
(tb/go :point-c)
:point-b
(.println System/out "world")
(if (> (dec! n) 0)
(tb/go :point-a)
(return))
:point-c
(.print System/out "el")
:point-d
(.print System/out "lo ")
(tb/go :point-b)))))
(Hello/hello)
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.