Merge pull request #25 from jolt-lang/stage2-tier6-dispatch-misc
Stage 2 tier 6c: dispatch-table ops + misc compile as macros/plain invokes
This commit is contained in:
Dmitri Sotnikov
GitHub
commit
f1ccc4b7f2
7 changed files with 193 additions and 133 deletions
|
|
@ -27,6 +27,42 @@
|
|||
(defmacro defmethod [mm dispatch-val & fn-tail]
|
||||
`(defmethod-setup (quote ~mm) ~dispatch-val (fn ~@fn-tail)))
|
||||
|
||||
;; Multimethod table ops (tier 6c): a multimethod's method table lives on its
|
||||
;; VAR (the value is just the dispatch closure), so these pass the name quoted
|
||||
;; to ctx-capturing setups — the same shape as defmulti/defmethod above.
|
||||
(defmacro prefer-method [mm dval-a dval-b]
|
||||
`(prefer-method-setup (quote ~mm) ~dval-a ~dval-b))
|
||||
|
||||
(defmacro remove-method [mm dval]
|
||||
`(remove-method-setup (quote ~mm) ~dval))
|
||||
|
||||
(defmacro remove-all-methods [mm]
|
||||
`(remove-all-methods-setup (quote ~mm)))
|
||||
|
||||
(defmacro get-method [mm dval]
|
||||
`(get-method-setup (quote ~mm) ~dval))
|
||||
|
||||
(defmacro methods [mm]
|
||||
`(methods-setup (quote ~mm)))
|
||||
|
||||
;; instance?: class names don't evaluate to values on jolt, so the type arg is
|
||||
;; passed quoted to the ctx-capturing checker; the value evaluates normally.
|
||||
(defmacro instance? [t x]
|
||||
`(instance-check (quote ~t) ~x))
|
||||
|
||||
;; Single-threaded host: evaluate the monitor expr (for its effects, matching
|
||||
;; Clojure's evaluation order) and the body — no lock to take.
|
||||
(defmacro locking [x & body]
|
||||
`(do ~x ~@body))
|
||||
|
||||
;; defonce: define name only if it isn't already bound to a non-nil root;
|
||||
;; returns the existing var untouched otherwise (matching the prior arm).
|
||||
(defmacro defonce [name expr]
|
||||
`(let [v# (resolve (quote ~name))]
|
||||
(if (and v# (some? (var-get v#)))
|
||||
v#
|
||||
(def ~name ~expr))))
|
||||
|
||||
;; Single arglist (Jolt defmacro is single-arity); the optional else defaults nil
|
||||
;; via rest-destructuring.
|
||||
(defmacro if-not [test then & [else]]
|
||||
|
|
|
|||
|
|
@ -154,19 +154,20 @@
|
|||
# Interpreter special forms the compiler does NOT itself implement (it
|
||||
# handles quote/do/if/def/fn*/let*/loop*/recur/throw/try). Kept in sync with
|
||||
# eval-form's special-form match in evaluator.janet.
|
||||
(each n ["syntax-quote" "unquote" "unquote-splicing" "eval" "read-string"
|
||||
"macroexpand-1" "defonce" "defmacro" "deftype" "defmulti"
|
||||
"defmethod" "prefer-method" "remove-method" "remove-all-methods"
|
||||
"get-method" "methods"
|
||||
(each n ["syntax-quote" "unquote" "unquote-splicing" "eval"
|
||||
# read-string/macroexpand-1/defonce/satisfies?/instance?/locking and
|
||||
# the multimethod table ops are core fns / overlay macros now
|
||||
# (Stage 2 tier 6c) — plain invokes / macro-expanded, no punt.
|
||||
"defmacro" "deftype" "defmulti" "defmethod"
|
||||
# var-get/var-set/var?/alter-var-root/alter-meta!/reset-meta!/
|
||||
# find-var/intern are plain clojure.core fns now (core-bindings +
|
||||
# install-stateful-fns!) — ordinary invokes, no punt (Stage 2 tier 6).
|
||||
# create-ns/remove-ns/find-ns/all-ns/the-ns/resolve/ns-resolve/
|
||||
# ns-aliases/ns-imports/ns-interns are ctx-capturing core fns now
|
||||
# (tier 6b) — ordinary invokes, no punt.
|
||||
"satisfies?" "instance?" "set!" "var"
|
||||
"set!" "var"
|
||||
"ns" "in-ns" "require"
|
||||
"locking" "new"
|
||||
"new"
|
||||
# Definitional/host macros that mutate context or build runtime
|
||||
# values the emitter doesn't model.
|
||||
"defrecord" "defprotocol" "definterface" "reify" "proxy"
|
||||
|
|
|
|||
|
|
@ -19,16 +19,16 @@
|
|||
(= name "unquote-splicing") (= name "do") (= name "if")
|
||||
(= name "def") (= name "defmacro") (= name "fn*") (= name "let*") (= name "loop*")
|
||||
(= name "recur") (= name "throw") (= name "try")
|
||||
(= name "set!") (= name "var") (= name "locking")
|
||||
(= name "set!") (= name "var")
|
||||
(= name "eval")
|
||||
(= name "instance?")
|
||||
(= name "new") (= name ".")
|
||||
# var-get/var-set/var?/alter-var-root/alter-meta!/reset-meta! are plain
|
||||
# clojure.core fns (core-bindings); find-var/intern are ctx-capturing fns
|
||||
# (install-stateful-fns!) — no longer special forms (Stage 2 tier 6).
|
||||
(= name "satisfies?")
|
||||
(= name "prefer-method") (= name "remove-method") (= name "remove-all-methods")
|
||||
(= name "get-method") (= name "methods")))
|
||||
# locking/instance?/satisfies?/defonce/read-string/macroexpand-1 and the
|
||||
# multimethod table ops are overlay macros / clojure.core fns now
|
||||
# (Stage 2 tier 6c) — not special forms.
|
||||
))
|
||||
|
||||
(var eval-form nil)
|
||||
|
||||
|
|
@ -1006,6 +1006,111 @@
|
|||
# refer: bring another ns's public vars into the current ns. Reuses use-impl's
|
||||
# refer-all behavior; the :only/:exclude/:rename filters are not yet honored.
|
||||
(ns-intern core "refer" (fn [ns-sym & filters] (use-impl ctx ns-sym)))
|
||||
# --- dispatch-table / type fns (Stage 2 tier 6c) ------------------------
|
||||
# A multimethod's method table lives on its VAR (the value is the dispatch
|
||||
# closure), so the overlay macros pass the NAME quoted — the defmulti/
|
||||
# defmethod pattern — and these resolve the var. prefer-method auto-creates
|
||||
# a missing multimethod (matching the prior interpreter arm).
|
||||
(def mm-var-of (fn [mm-sym auto-create?]
|
||||
(def r (protect (resolve-var ctx @{} mm-sym)))
|
||||
(def found (if (r 0) (r 1) nil))
|
||||
(if found
|
||||
found
|
||||
(when auto-create?
|
||||
(def ns (ctx-find-ns ctx (ctx-current-ns ctx)))
|
||||
(def nv (ns-intern ns (mm-sym :name) (fn [& args] nil)))
|
||||
(put nv :jolt/methods @{})
|
||||
nv))))
|
||||
(def clear-dispatch-cache! (fn [mm-var]
|
||||
(let [dc (get mm-var :jolt/dispatch-cache)]
|
||||
(when dc (each k (keys dc) (put dc k nil))))))
|
||||
(ns-intern core "prefer-method-setup"
|
||||
(fn [mm-sym dval-a dval-b]
|
||||
(def mm-var (mm-var-of mm-sym true))
|
||||
(def prefs (or (get mm-var :jolt/prefers)
|
||||
(do (put mm-var :jolt/prefers @{}) (mm-var :jolt/prefers))))
|
||||
(put prefs dval-a dval-b)
|
||||
(clear-dispatch-cache! mm-var)
|
||||
mm-var))
|
||||
(ns-intern core "remove-method-setup"
|
||||
(fn [mm-sym dval]
|
||||
(def mm-var (mm-var-of mm-sym false))
|
||||
(when mm-var
|
||||
(let [methods (get mm-var :jolt/methods)]
|
||||
(when methods (put methods dval nil)))
|
||||
(clear-dispatch-cache! mm-var))
|
||||
mm-var))
|
||||
(ns-intern core "remove-all-methods-setup"
|
||||
(fn [mm-sym]
|
||||
(def mm-var (mm-var-of mm-sym false))
|
||||
(when mm-var
|
||||
(put mm-var :jolt/methods @{})
|
||||
(clear-dispatch-cache! mm-var))
|
||||
mm-var))
|
||||
(ns-intern core "get-method-setup"
|
||||
(fn [mm-sym dval]
|
||||
(def mm-var (mm-var-of mm-sym false))
|
||||
(when mm-var
|
||||
(let [methods (get mm-var :jolt/methods)]
|
||||
(or (get methods dval) (get methods :default))))))
|
||||
(ns-intern core "methods-setup"
|
||||
(fn [mm-sym]
|
||||
(def mm-var (mm-var-of mm-sym false))
|
||||
(and mm-var (get mm-var :jolt/methods))))
|
||||
# satisfies?: evaluated protocol value + instance (matches the prior arm).
|
||||
(ns-intern core "satisfies?"
|
||||
(fn [proto obj]
|
||||
(def type-tag (if (and (table? obj) (get obj :jolt/deftype))
|
||||
(get obj :jolt/deftype)
|
||||
(if (get obj :jolt/protocol-methods)
|
||||
(get obj :jolt/deftype))))
|
||||
(if type-tag
|
||||
(let [pn (proto :name)
|
||||
pn-str (if (struct? pn) (pn :name) pn)]
|
||||
(type-satisfies? ctx type-tag pn-str))
|
||||
false)))
|
||||
# instance?: the overlay macro passes the TYPE NAME quoted (class names don't
|
||||
# evaluate to values on jolt); the value arg arrives evaluated.
|
||||
(ns-intern core "instance-check"
|
||||
(fn [type-sym val]
|
||||
(if (get val :jolt/deftype)
|
||||
(let [type-tag (val :jolt/deftype)
|
||||
type-name (type-sym :name)]
|
||||
(or (= type-tag type-name)
|
||||
(and (> (length type-tag) (length type-name))
|
||||
(= (string/slice type-tag (- (length type-tag) (length type-name)))
|
||||
type-name))))
|
||||
(match (type-sym :name)
|
||||
"Number" (number? val)
|
||||
"java.lang.Number" (number? val)
|
||||
"Long" (number? val)
|
||||
"java.lang.Long" (number? val)
|
||||
"Integer" (number? val)
|
||||
"Double" (number? val)
|
||||
"String" (string? val)
|
||||
"java.lang.String" (string? val)
|
||||
"Boolean" (or (= true val) (= false val))
|
||||
"Keyword" (keyword? val)
|
||||
"clojure.lang.Atom" (and (table? val) (= :jolt/atom (val :jolt/type)))
|
||||
"clojure.lang.Volatile" (and (table? val) (= :jolt/volatile (val :jolt/type)))
|
||||
"clojure.lang.Delay" (and (table? val) (= :jolt/delay (val :jolt/type)))
|
||||
"clojure.lang.IPersistentMap" (or (phm? val) (struct? val))
|
||||
"clojure.lang.IPersistentVector" (or (tuple? val) (pvec? val))
|
||||
"clojure.lang.IPersistentSet" (set? val)
|
||||
"Object" true
|
||||
false))))
|
||||
# Reader / expansion as plain fns: read-string parses one form; macroexpand-1
|
||||
# expands a (quoted, already-evaluated) call form once via its macro var.
|
||||
(ns-intern core "read-string" (fn [s] (parse-string s)))
|
||||
(ns-intern core "macroexpand-1"
|
||||
(fn [the-form]
|
||||
(if (and (array? the-form) (> (length the-form) 0)
|
||||
(struct? (first the-form)) (= :symbol ((first the-form) :jolt/type)))
|
||||
(let [v (resolve-var ctx @{} (first the-form))]
|
||||
(if (and v (var-macro? v))
|
||||
(apply (var-get v) (tuple/slice the-form 1))
|
||||
the-form))
|
||||
the-form)))
|
||||
core)
|
||||
|
||||
# Dispatch a special form by its string name.
|
||||
|
|
@ -1041,22 +1146,8 @@
|
|||
"unquote" (error "Unquote not valid outside of syntax-quote")
|
||||
"unquote-splicing" (error "Unquote-splicing not valid outside of syntax-quote")
|
||||
"eval" (eval-form ctx bindings (eval-form ctx bindings (in form 1)))
|
||||
"read-string" (parse-string (eval-form ctx bindings (in form 1)))
|
||||
"defonce" (let [name-sym (unwrap-meta-name (in form 1))
|
||||
ns (ctx-find-ns ctx (ctx-current-ns ctx))
|
||||
existing (ns-find ns (name-sym :name))]
|
||||
(if (and existing (not (nil? (get existing :root))))
|
||||
existing
|
||||
(eval-form ctx bindings @[{:jolt/type :symbol :ns nil :name "def"}
|
||||
(in form 1) (in form 2)])))
|
||||
"macroexpand-1" (let [the-form (eval-form ctx bindings (in form 1))]
|
||||
(if (and (array? the-form) (> (length the-form) 0)
|
||||
(struct? (first the-form)) (= :symbol ((first the-form) :jolt/type)))
|
||||
(let [v (resolve-var ctx bindings (first the-form))]
|
||||
(if (and v (var-macro? v))
|
||||
(apply (var-get v) (tuple/slice the-form 1))
|
||||
the-form))
|
||||
the-form))
|
||||
# read-string/macroexpand-1 are ctx-capturing clojure.core fns and defonce
|
||||
# an overlay macro now (Stage 2 tier 6c) — no special-form arms.
|
||||
"do" (do
|
||||
(var result nil)
|
||||
(var i 1)
|
||||
|
|
@ -1409,100 +1500,9 @@
|
|||
# clojure.core fns (install-stateful-fns!) — the defprotocol/extend-type/reify
|
||||
# macros call them with name STRINGS, so they compile + interpret as plain
|
||||
# invokes (no special-form arms).
|
||||
"satisfies?" (let [proto-sym (eval-form ctx bindings (in form 1))
|
||||
obj (eval-form ctx bindings (in form 2))
|
||||
type-tag (if (and (table? obj) (get obj :jolt/deftype))
|
||||
(get obj :jolt/deftype)
|
||||
(if (get obj :jolt/protocol-methods)
|
||||
(get obj :jolt/deftype)))]
|
||||
(if type-tag
|
||||
(let [pn (proto-sym :name)
|
||||
pn-str (if (struct? pn) (pn :name) pn)]
|
||||
(type-satisfies? ctx type-tag pn-str))
|
||||
false))
|
||||
"locking" (eval-form ctx bindings (in form 2))
|
||||
"instance?" (let [type-sym (in form 1)
|
||||
val (eval-form ctx bindings (in form 2))]
|
||||
(if (get val :jolt/deftype)
|
||||
(let [type-tag (val :jolt/deftype)
|
||||
type-name (type-sym :name)]
|
||||
(or (= type-tag type-name)
|
||||
(and (> (length type-tag) (length type-name))
|
||||
(= (string/slice type-tag (- (length type-tag) (length type-name)))
|
||||
type-name))))
|
||||
(match (type-sym :name)
|
||||
"Number" (number? val)
|
||||
"java.lang.Number" (number? val)
|
||||
"Long" (number? val)
|
||||
"java.lang.Long" (number? val)
|
||||
"Integer" (number? val)
|
||||
"Double" (number? val)
|
||||
"String" (string? val)
|
||||
"java.lang.String" (string? val)
|
||||
"Boolean" (or (= true val) (= false val))
|
||||
"Keyword" (keyword? val)
|
||||
"clojure.lang.Atom" (and (table? val) (= :jolt/atom (val :jolt/type)))
|
||||
"clojure.lang.Volatile" (and (table? val) (= :jolt/volatile (val :jolt/type)))
|
||||
"clojure.lang.Delay" (and (table? val) (= :jolt/delay (val :jolt/type)))
|
||||
"clojure.lang.IPersistentMap" (or (phm? val) (struct? val))
|
||||
"clojure.lang.IPersistentVector" (or (tuple? val) (pvec? val))
|
||||
"clojure.lang.IPersistentSet" (set? val)
|
||||
"Object" true
|
||||
false)))
|
||||
# defmulti / defmethod are now macros (30-macros) over defmulti-setup /
|
||||
# defmethod-setup (ctx-capturing clojure.core fns) — they compile as plain
|
||||
# invokes; no special-form arms. defmethod's impl is a compiled (fn …).
|
||||
"prefer-method" (let [mm-arg (in form 1)
|
||||
mm-var (if (and (struct? mm-arg) (= :symbol (mm-arg :jolt/type)))
|
||||
(resolve-var ctx bindings mm-arg)
|
||||
(eval-form ctx bindings mm-arg))
|
||||
# Auto-create multimethod if it doesn't exist
|
||||
mm-var (if mm-var mm-var
|
||||
(let [ns (ctx-find-ns ctx (ctx-current-ns ctx))
|
||||
dummy-fn (fn [& args] nil)]
|
||||
(def v (ns-intern ns (mm-arg :name) dummy-fn))
|
||||
(put v :jolt/methods @{})
|
||||
v))
|
||||
dispatch-val-a (eval-form ctx bindings (in form 2))
|
||||
dispatch-val-b (eval-form ctx bindings (in form 3))
|
||||
prefs (or (get mm-var :jolt/prefers)
|
||||
(do (put mm-var :jolt/prefers @{}) (mm-var :jolt/prefers)))]
|
||||
(put prefs dispatch-val-a dispatch-val-b)
|
||||
(let [dc (get mm-var :jolt/dispatch-cache)]
|
||||
(when dc (each k (keys dc) (put dc k nil))))
|
||||
mm-var)
|
||||
# A multimethod's methods live on its VAR, but the value is the dispatch fn;
|
||||
# so resolve the var from the symbol rather than evaluating it.
|
||||
"get-method" (let [mm-arg (in form 1)
|
||||
mm-var (if (and (struct? mm-arg) (= :symbol (mm-arg :jolt/type)))
|
||||
(resolve-var ctx bindings mm-arg)
|
||||
(eval-form ctx bindings mm-arg))
|
||||
dispatch-val (eval-form ctx bindings (in form 2))]
|
||||
(when mm-var
|
||||
(let [methods (get mm-var :jolt/methods)]
|
||||
(or (get methods dispatch-val) (get methods :default)))))
|
||||
"methods" (let [mm-arg (in form 1)
|
||||
mm-var (if (and (struct? mm-arg) (= :symbol (mm-arg :jolt/type)))
|
||||
(resolve-var ctx bindings mm-arg)
|
||||
(eval-form ctx bindings mm-arg))]
|
||||
(and mm-var (get mm-var :jolt/methods)))
|
||||
"remove-method" (let [mm-arg (in form 1)
|
||||
mm-var (if (and (struct? mm-arg) (= :symbol (mm-arg :jolt/type)))
|
||||
(resolve-var ctx bindings mm-arg)
|
||||
(eval-form ctx bindings mm-arg))
|
||||
dispatch-val (eval-form ctx bindings (in form 2))]
|
||||
(when mm-var
|
||||
(let [methods (get mm-var :jolt/methods)]
|
||||
(when methods (put methods dispatch-val nil)))
|
||||
(let [dc (get mm-var :jolt/dispatch-cache)]
|
||||
(when dc (each k (keys dc) (put dc k nil)))))
|
||||
mm-var)
|
||||
"remove-all-methods" (let [mm-var (eval-form ctx bindings (in form 1))]
|
||||
(when mm-var
|
||||
(put mm-var :jolt/methods @{})
|
||||
(let [dc (get mm-var :jolt/dispatch-cache)]
|
||||
(when dc (each k (keys dc) (put dc k nil)))))
|
||||
mm-var)
|
||||
# satisfies?/instance?/locking and the multimethod table ops
|
||||
# (prefer-method/remove-method/remove-all-methods/get-method/methods) are
|
||||
# clojure.core fns / overlay macros now (Stage 2 tier 6c) — no special arms.
|
||||
# deftype is now a macro (30-macros) over make-deftype-ctor + extend-type —
|
||||
# compiles as a plain (do …); no special-form arm.
|
||||
"new" (let [type-sym (in form 1)
|
||||
|
|
|
|||
|
|
@ -73,20 +73,19 @@
|
|||
(each n ["quote" "syntax-quote" "unquote" "unquote-splicing" "do" "if" "def"
|
||||
"defmacro" "fn*" "let*" "loop*" "recur" "throw" "try" "set!"
|
||||
# defmulti/defmethod/deftype now compile (macros over *-setup fns).
|
||||
"locking" "eval" "instance?" "new"
|
||||
"eval" "new"
|
||||
# var-get/var-set/var?/alter-var-root/alter-meta!/reset-meta! are
|
||||
# plain core fns; find-var/intern are ctx-capturing core fns — all
|
||||
# compile as ordinary invokes now (Stage 2 tier 6).
|
||||
"." "satisfies?"
|
||||
# protocol-dispatch/register-method/make-reified are now clojure.core
|
||||
# fns (compile as plain invokes).
|
||||
"prefer-method"
|
||||
"remove-method" "remove-all-methods" "get-method" "methods"
|
||||
"."
|
||||
# satisfies?/instance?/locking/defonce/read-string/macroexpand-1 and
|
||||
# the multimethod table ops (prefer-method/remove-method/
|
||||
# remove-all-methods/get-method/methods) are clojure.core fns /
|
||||
# overlay macros now (Stage 2 tier 6c) — ordinary invokes.
|
||||
# create-ns/remove-ns/find-ns/all-ns/the-ns/resolve/ns-resolve/
|
||||
# ns-aliases/ns-imports/ns-interns/refer are ctx-capturing
|
||||
# clojure.core fns now (compile as plain invokes — tier 6b), like
|
||||
# ns/require/in-ns/use/import/refer-clojure before them.
|
||||
"read-string" "macroexpand-1" "defonce"
|
||||
# defprotocol/extend-type/extend-protocol/reify/defrecord now expand to
|
||||
# plain def + protocol-dispatch/register-method/make-reified/deftype.
|
||||
"gen-class"
|
||||
|
|
|
|||
|
|
@ -156,6 +156,21 @@
|
|||
["resolve + call" "3" "((var-get (resolve (quote inc))) 2)"]
|
||||
["resolve absent" "nil" "(resolve (quote no-such-sym-xyz))"]
|
||||
|
||||
### ---- dispatch-table ops + misc as macros/fns (Stage 2 tier 6c) ----
|
||||
["get-method + call" "1" "(do (defmulti t6f :k) (defmethod t6f :a [x] 1) ((get-method t6f :a) {:k :a}))"]
|
||||
["remove-method" "nil" "(do (defmulti t6g :k) (defmethod t6g :b [x] 2) (remove-method t6g :b) (get (methods t6g) :b))"]
|
||||
["remove-all-methods" "nil" "(do (defmulti t6h :k) (defmethod t6h :c [x] 3) (remove-all-methods t6h) (get (methods t6h) :c))"]
|
||||
# NOTE: dispatch does not yet CONSULT prefers in ambiguous isa dispatch
|
||||
# (jolt-bug filed) — this asserts prefer-method records the preference.
|
||||
["prefer-method records" ":shape" "(do (defmulti t6p identity) (prefer-method t6p :rect :shape) (get (get (var t6p) :jolt/prefers) :rect))"]
|
||||
["instance? deftype" "true" "(do (deftype T6i [a]) (instance? T6i (->T6i 1)))"]
|
||||
["instance? String" "true" "(instance? String \"s\")"]
|
||||
["locking evals body" "3" "(locking :anything (+ 1 2))"]
|
||||
["locking evals monitor" "[3 1]" "(let [a (atom 0)] [(locking (swap! a inc) 3) @a])"]
|
||||
["defonce keeps first" "5" "(do (defonce d6o 5) (defonce d6o 9) d6o)"]
|
||||
["read-string + eval" "3" "(eval (read-string \"(+ 1 2)\"))"]
|
||||
["macroexpand-1 when" "2" "(count (rest (macroexpand-1 (quote (when true 1)))))"]
|
||||
|
||||
### ---- HIGH: aliased namespace calls ----
|
||||
["require :as alias" "\"1,2,3\"" "(do (require (quote [clojure.string :as s])) (s/join \",\" [1 2 3]))"]
|
||||
["ns form + alias" "\"HI\"" "(do (ns my.a (:require [clojure.string :as s])) (s/upper-case \"hi\"))"]
|
||||
|
|
|
|||
|
|
@ -64,7 +64,13 @@
|
|||
"(the-ns (quote clojure.core))" "(ns-interns (quote clojure.core))"
|
||||
"(ns-aliases (quote user))" "(ns-imports (quote user))"
|
||||
"(ns-resolve (quote clojure.core) (quote map))" "(resolve (quote map))"
|
||||
"(refer (quote clojure.string))"])
|
||||
"(refer (quote clojure.string))"
|
||||
# Stage 2 tier 6c: dispatch-table ops + misc compile as macros/plain invokes
|
||||
"(prefer-method mf :a :b)" "(remove-method mf :a)" "(remove-all-methods mf)"
|
||||
"(get-method mf :a)" "(methods mf)"
|
||||
"(satisfies? P 5)" "(instance? String \"x\")" "(locking :x 1)"
|
||||
"(defonce fz-once 1)" "(read-string \"[1 2]\")"
|
||||
"(macroexpand-1 (quote (when true 1)))"])
|
||||
|
||||
# --- Intentional fallback (sanity sample): these SHOULD punt to the interpreter.
|
||||
# The remaining frozen/uncompiled set keeps the harness honest in the punt
|
||||
|
|
|
|||
|
|
@ -100,14 +100,17 @@
|
|||
(print " passed")
|
||||
|
||||
(print "13: locking...")
|
||||
# locking is a no-op in single-threaded Janet — just executes body
|
||||
(assert (= 42 (eval-str "(locking :lock 42)")) "locking returns body result")
|
||||
# locking/instance? are overlay macros now (Stage 2 tier 6c) — they need the
|
||||
# full env (init loads the overlay), not a bare make-ctx.
|
||||
(let [ctx (init)]
|
||||
(assert (= 42 (eval-string ctx "(locking :lock 42)")) "locking returns body result"))
|
||||
(print " passed")
|
||||
|
||||
(print "14: instance?...")
|
||||
# instance? checks type
|
||||
(assert (= true (eval-str "(instance? Number 42)")) "instance? Number matches number")
|
||||
(assert (= false (eval-str "(instance? Number \"hello\")")) "instance? Number doesn't match string")
|
||||
(let [ctx (init)]
|
||||
(assert (= true (eval-string ctx "(instance? Number 42)")) "instance? Number matches number")
|
||||
(assert (= false (eval-string ctx "(instance? Number \"hello\")")) "instance? Number doesn't match string"))
|
||||
(print " passed")
|
||||
|
||||
(print "15: defmulti/defmethod...")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue