core: Stage 2 Task 2 tier 3 — compile (var x) + binding
binding keys its thread-binding frame on var cells via (var x), so it needed (var x) to compile. Added a the-var IR node that emits the embedded var cell itself (vs var-ref, which derefs): - ir.clj: the-var node. - analyzer: 'var' added to handled; analyze-special resolves the symbol to its var and emits the-var (uncompilable for a non-var, matching Clojure). - backend: :the-var emits (quote cell) — the exact per-ctx cell var-get keys on, so a compiled binding overrides + restores correctly. - removed var from loader stateful-head? + host_iface special-names, and binding from special-names so it expands+compiles. Dynamic binding now compiles end-to-end (override/restore, and a compiled fn reading the dynamic var under the binding) in both modes. Gate green: conformance 267x3, fallback-zero 31/5, bootstrap-fixpoint stage1==2==3, self-host, clojure-test-suite >=4034/67, features 78/78, all unit + spec (state/metadata).
This commit is contained in:
parent
cd5a971434
commit
117b4d86f4
5 changed files with 17 additions and 5 deletions
|
|
@ -14,7 +14,7 @@
|
||||||
Definitions are ordered so only `analyze` (mutually recursive) is forward
|
Definitions are ordered so only `analyze` (mutually recursive) is forward
|
||||||
declared — the bootstrap compiles forward refs through var cells, but keeping
|
declared — the bootstrap compiles forward refs through var cells, but keeping
|
||||||
them to one keeps the compiled namespace simple."
|
them to one keeps the compiled namespace simple."
|
||||||
(:require [jolt.ir :refer [const local var-ref host-ref if-node do-node invoke
|
(:require [jolt.ir :refer [const local var-ref the-var host-ref if-node do-node invoke
|
||||||
def-node let-node fn-node vector-node map-node set-node
|
def-node let-node fn-node vector-node map-node set-node
|
||||||
quote-node throw-node]]
|
quote-node throw-node]]
|
||||||
[jolt.host :refer [form-sym? form-sym-name form-sym-ns form-list?
|
[jolt.host :refer [form-sym? form-sym-name form-sym-ns form-list?
|
||||||
|
|
@ -28,7 +28,7 @@
|
||||||
|
|
||||||
(def ^:private handled
|
(def ^:private handled
|
||||||
#{"quote" "if" "do" "def" "fn*" "let*" "loop*" "recur" "throw" "try"
|
#{"quote" "if" "do" "def" "fn*" "let*" "loop*" "recur" "throw" "try"
|
||||||
"syntax-quote"})
|
"syntax-quote" "var"})
|
||||||
|
|
||||||
(defn- uncompilable [why]
|
(defn- uncompilable [why]
|
||||||
(throw (str "jolt/uncompilable: " why)))
|
(throw (str "jolt/uncompilable: " why)))
|
||||||
|
|
@ -163,6 +163,11 @@
|
||||||
;; Lower the backtick to construction code (zero runtime cost), then analyze
|
;; Lower the backtick to construction code (zero runtime cost), then analyze
|
||||||
;; it — the macroexpand/compile-time step, per read -> macroexpand -> compile.
|
;; it — the macroexpand/compile-time step, per read -> macroexpand -> compile.
|
||||||
"syntax-quote" (analyze ctx (form-syntax-quote-lower ctx (second items)) env)
|
"syntax-quote" (analyze ctx (form-syntax-quote-lower ctx (second items)) env)
|
||||||
|
"var" (let [sym (second items)
|
||||||
|
r (resolve-global ctx sym)]
|
||||||
|
(if (= :var (:kind r))
|
||||||
|
(the-var (:ns r) (:name r))
|
||||||
|
(uncompilable (str "var of non-var " (form-sym-name sym)))))
|
||||||
(uncompilable (str "special form " op))))
|
(uncompilable (str "special form " op))))
|
||||||
|
|
||||||
(defn- analyze-symbol [ctx form env]
|
(defn- analyze-symbol [ctx form env]
|
||||||
|
|
|
||||||
|
|
@ -16,6 +16,10 @@
|
||||||
;; A global var reference, by name. The back end resolves it to a host var.
|
;; A global var reference, by name. The back end resolves it to a host var.
|
||||||
(defn var-ref [ns name] {:op :var :ns ns :name name})
|
(defn var-ref [ns name] {:op :var :ns ns :name name})
|
||||||
|
|
||||||
|
;; The var object itself — (var x) / #'x. Unlike var-ref (which derefs), the back
|
||||||
|
;; end emits the embedded var cell so `binding`'s thread-binding frame can key on it.
|
||||||
|
(defn the-var [ns name] {:op :the-var :ns ns :name name})
|
||||||
|
|
||||||
;; A runtime primitive (cons, +, get, apply, …) the back end maps to the host RT.
|
;; A runtime primitive (cons, +, get, apply, …) the back end maps to the host RT.
|
||||||
(defn rt [name] {:op :rt :name name})
|
(defn rt [name] {:op :rt :name name})
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -250,6 +250,9 @@
|
||||||
# reference (a bare table in arg position would be re-evaluated as
|
# reference (a bare table in arg position would be re-evaluated as
|
||||||
# a constructor — deep-copying it, and any atom in :root, each call).
|
# a constructor — deep-copying it, and any atom in :root, each call).
|
||||||
(tuple var-get (tuple 'quote cell))))
|
(tuple var-get (tuple 'quote cell))))
|
||||||
|
# (var x): the var object itself (not its value) — the embedded cell, by
|
||||||
|
# reference. binding keys its thread-binding frame on this exact cell.
|
||||||
|
:the-var (tuple 'quote (cell-for ctx (node :ns) (node :name)))
|
||||||
:if ['if (emit ctx (node :test)) (emit ctx (node :then)) (emit ctx (node :else))]
|
:if ['if (emit ctx (node :test)) (emit ctx (node :then)) (emit ctx (node :else))]
|
||||||
:do (emit-seq ctx node)
|
:do (emit-seq ctx node)
|
||||||
:loop (emit-loop ctx node)
|
:loop (emit-loop ctx node)
|
||||||
|
|
|
||||||
|
|
@ -71,7 +71,7 @@
|
||||||
(def- special-names
|
(def- special-names
|
||||||
(let [t @{}]
|
(let [t @{}]
|
||||||
(each n ["quote" "syntax-quote" "unquote" "unquote-splicing" "do" "if" "def"
|
(each n ["quote" "syntax-quote" "unquote" "unquote-splicing" "do" "if" "def"
|
||||||
"defmacro" "fn*" "let*" "loop*" "recur" "throw" "try" "set!" "var"
|
"defmacro" "fn*" "let*" "loop*" "recur" "throw" "try" "set!"
|
||||||
"locking" "eval" "instance?" "defmulti" "defmethod" "deftype" "new"
|
"locking" "eval" "instance?" "defmulti" "defmethod" "deftype" "new"
|
||||||
"." "var-get" "var-set" "var?" "alter-var-root" "find-var" "intern"
|
"." "var-get" "var-set" "var?" "alter-var-root" "find-var" "intern"
|
||||||
"alter-meta!" "reset-meta!" "satisfies?"
|
"alter-meta!" "reset-meta!" "satisfies?"
|
||||||
|
|
@ -89,7 +89,7 @@
|
||||||
"gen-class"
|
"gen-class"
|
||||||
# letfn stays: its let* expansion needs letrec semantics (mutual
|
# letfn stays: its let* expansion needs letrec semantics (mutual
|
||||||
# recursion between the fns), which compiled sequential let* lacks.
|
# recursion between the fns), which compiled sequential let* lacks.
|
||||||
"monitor-enter" "monitor-exit" "binding" "letfn"]
|
"monitor-enter" "monitor-exit" "letfn"]
|
||||||
(put t n true))
|
(put t n true))
|
||||||
t))
|
t))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -17,7 +17,7 @@
|
||||||
(= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod")
|
(= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod")
|
||||||
(= head-name "require") (= head-name "in-ns")
|
(= head-name "require") (= head-name "in-ns")
|
||||||
(= head-name "set!")
|
(= head-name "set!")
|
||||||
(= head-name "var") (= head-name ".") (= head-name "new")
|
(= head-name ".") (= head-name "new")
|
||||||
(= head-name "eval")))
|
(= head-name "eval")))
|
||||||
|
|
||||||
(defn- form-head-name [form]
|
(defn- form-head-name [form]
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue