diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index dc54a97..118f80e 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -286,6 +286,15 @@ ;; a seq of field keywords; spliced into a vector LITERAL below ([~@…]) so ;; the analyzer sees a vector form, not a runtime pvec value. field-kws (map (fn [f] (keyword (name f))) fields) + ;; per-field TYPE HINT (jolt-3ko): ^Vec3 origin -> "Vec3" (a record type + ;; name), ^:num x -> "num", else nil. Lets the inference know a field's + ;; exact type up front, so reading it back carries that type (not :any) — + ;; the key to fast nested-record code. Spliced as a vector literal too. + field-tags (map (fn [f] (let [mt (meta f)] + (cond (and mt (:tag mt)) (:tag mt) + (and mt (:num mt)) "num" + :else nil))) + fields) impl (fn [proto specs] `(extend-type ~tname ~proto ~@(map (fn [spec] @@ -295,7 +304,7 @@ `(~(first spec) ~argv (let [~@binds] ~@(drop 2 spec))))) specs)))] `(do - (def ~tname (make-deftype-ctor (quote ~tname) [~@field-kws])) + (def ~tname (make-deftype-ctor (quote ~tname) [~@field-kws] [~@field-tags])) (def ~arrow ~tname) ~@(map (fn [g] (impl (first g) (rest g))) (group-by-head body)) ~tname))) diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index 88d99c1..bbd00ec 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -23,7 +23,7 @@ form-map-pairs form-set-items form-special? compile-ns form-macro? form-expand-1 resolve-global form-sym-meta host-intern! form-syntax-quote-lower - record-type? form-position]])) + record-type? record-ctor-key form-position]])) (declare analyze) @@ -61,6 +61,16 @@ (defn- add-hint [env nm h] (if h (assoc env :hints (assoc (:hints env) nm h)) env)) +;; The resolved record ctor-key ("ns/->Name") for a ^Type param hint, or nil. +;; Unlike hint-of (which collapses any record hint to the coarse :struct guard- +;; skip marker), this carries the SPECIFIC record type — cross-namespace aware — +;; so the inference can seed the param's type and read its fields shaped/typed, +;; not just :any (the lever for a typed multi-namespace program without whole- +;; program inference). +(defn- phint-of [ctx sym] + (let [m (form-sym-meta sym)] + (when m (let [t (get m :tag)] (when t (record-ctor-key ctx t)))))) + (defn- analyze-seq [ctx forms env] (let [v (mapv #(analyze ctx % env) forms) n (count v)] @@ -83,18 +93,21 @@ (defn- parse-params [ctx pvec] ;; :hints is a vector of [name hint] pairs (vector, not a map, so the caller ;; folds it with a plain reduce — no reduce-over-map in the kernel subset). - (loop [i 0 fixed [] rest-name nil hints []] + ;; :phints is the parallel vector of [name ctor-key] for record param hints, + ;; carrying the specific type for the inference to seed. + (loop [i 0 fixed [] rest-name nil hints [] phints []] (if (< i (count pvec)) (let [p (nth pvec i)] (when-not (form-sym? p) (uncompilable "destructuring fn param")) (if (= "&" (form-sym-name p)) (let [r (nth pvec (inc i))] (when-not (form-sym? r) (uncompilable "destructuring fn rest")) - (recur (+ i 2) fixed (form-sym-name r) hints)) - (let [nm (form-sym-name p) h (hint-of ctx p)] + (recur (+ i 2) fixed (form-sym-name r) hints phints)) + (let [nm (form-sym-name p) h (hint-of ctx p) ph (phint-of ctx p)] (recur (inc i) (conj fixed nm) rest-name - (if h (conj hints [nm h]) hints))))) - {:fixed fixed :rest rest-name :hints hints}))) + (if h (conj hints [nm h]) hints) + (if ph (conj phints [nm ph]) phints))))) + {:fixed fixed :rest rest-name :hints hints :phints phints}))) (defn- analyze-arity [ctx pvec body env fn-name] (let [pp (parse-params ctx (vec (form-vec-items pvec))) @@ -113,7 +126,10 @@ env0 (-> (add-locals env names) (with-recur rname)) env* (reduce (fn [e pr] (add-hint e (nth pr 0) (nth pr 1))) env0 (:hints pp)) arity {:params fixed :recur-name rname - :body (analyze-seq ctx body env*)}] + :body (analyze-seq ctx body env*)} + ;; carry record param hints (name -> ctor-key) for the inference to seed + ;; the param type; only when present so a hintless arity stays a struct. + arity (if (seq (:phints pp)) (assoc arity :phints (:phints pp)) arity)] ;; :rest only when variadic — an absent :rest reads back nil, same as before, ;; but keeps a fixed arity a nil-free struct rather than a phm. (if rst (assoc arity :rest rst) arity))) diff --git a/jolt-core/jolt/passes.clj b/jolt-core/jolt/passes.clj index ad08082..8f50542 100644 --- a/jolt-core/jolt/passes.clj +++ b/jolt-core/jolt/passes.clj @@ -884,6 +884,27 @@ ;; jolt-41m: protocol-method registry "ns/method" -> [proto method], for ;; devirtualizing a protocol call whose receiver is a known record type. (def ^:private protocol-methods-box (atom {})) + +;; jolt-3ko: build a record's struct TYPE from its registry entry, resolving each +;; field's declared type hint. A field tagged with a record type (its ctor-key) +;; recurses, so a Vec3 stored in a Ray field reads back as Vec3 — not :any — +;; which is what lets nested-record code prove its reads. Depth-bounded so a +;; self/cyclic-referencing record type can't loop. +(declare record-type-from-entry) +(defn- field-type-from-tag [tag depth] + (cond + (or (nil? tag) (<= depth 0)) :any + (= tag "num") :num + :else (let [e (get @record-shapes-box tag)] + (if e (record-type-from-entry e depth) :any)))) +(defn- record-type-from-entry [rs depth] + (let [fields (get rs :fields) + tags (get rs :tags) + fmap (reduce (fn [m i] + (assoc m (nth fields i) + (field-type-from-tag (when tags (nth tags i)) (dec depth)))) + {} (range (count fields)))] + (assoc (mk-struct fmap) :shape (vec fields) :type (get rs :type)))) ;; jolt-t34: whether to shape generic const-key MAP literals (opt-in, JOLT_SHAPE). ;; Records are shaped regardless; maps only when this is on. (def ^:private map-shapes-box (atom false)) @@ -912,11 +933,10 @@ (= op :var) (let [rs (get @record-shapes-box (var-key fnode))] (if rs ;; record ctor -> struct of declared shape (jolt-t34); :shape - ;; is the DECLARED field order the back end indexes by, and - ;; :type is the record tag (for devirtualizing protocol calls) - (let [fields (get rs :fields)] - (assoc (mk-struct (reduce (fn [m k] (assoc m k :any)) {} fields)) - :shape (vec fields) :type (get rs :type))) + ;; is the DECLARED field order the back end indexes by, :type + ;; the record tag (devirt), and field types come from the + ;; declared hints so nested records stay typed (jolt-3ko) + (record-type-from-entry rs type-depth) (let [r (get @rtenv-box (var-key fnode))] (if r r (let [nm (and (= "clojure.core" (get fnode :ns)) (get fnode :name))] (cond (nil? nm) :any @@ -1405,7 +1425,20 @@ (if (= :fn (get fnode :op)) (assoc def-node :init (assoc fnode :arities - (mapv (fn [a] (assoc a :body (nth (infer (get a :body) ptmap) 1))) + (mapv (fn [a] + ;; seed declared record param hints (:phints, name -> + ;; ctor-key) so a record param is typed even with no + ;; inferred caller type — the open-world / cross-ns + ;; case. An inferred type in ptmap wins (it's at least + ;; as precise), so this only fills the gaps. + (let [pt (reduce (fn [m pr] + (let [nm (nth pr 0) + e (get @record-shapes-box (nth pr 1))] + (if (and e (not (contains? m nm))) + (assoc m nm (record-type-from-entry e type-depth)) + m))) + ptmap (get a :phints))] + (assoc a :body (nth (infer (get a :body) pt) 1)))) (get fnode :arities)))) def-node))) diff --git a/src/jolt/backend.janet b/src/jolt/backend.janet index c2abfb6..157f784 100644 --- a/src/jolt/backend.janet +++ b/src/jolt/backend.janet @@ -123,7 +123,24 @@ (and (get (ctx :env) :direct-linking?) (not (cell :dynamic)) (not (let [m (cell :meta)] (and m (get m :redef)))) - (function? (cell :root)))) + (let [r (cell :root)] (or (function? r) (cfunction? r))))) + +# Whole-program constant-linking (closed world): under JOLT_WHOLE_PROGRAM every +# non-dynamic var has a stable root we can embed as a CONSTANT, eliminating the +# per-reference cell deref the indirect path pays. This covers what direct-var? +# can't: ^:redef vars (no reloading under the flag, so redef is moot), data vars +# (def of a number/vector/etc.), and record-type / non-fn callable roots. The +# value is quoted at the emit site unless it's callable (a function/cfunction is +# valid in head AND value position as-is). Dynamic vars stay indirect — thread +# binding is a runtime mechanism, not redefinition. A nil root (a not-yet-run +# forward def) stays indirect so the live deref picks the value up; the +# whole-program re-emit (infer-program!, callee-first after full load) then +# const-links it once its root is in place. +(defn- const-link? [ctx cell] + (and (get (ctx :env) :whole-program?) + (get (ctx :env) :direct-linking?) + (not (cell :dynamic)) + (not (nil? (cell :root))))) # Fresh Janet symbol for back-end-introduced bindings (arity dispatch). NOT # Janet's `gensym` — `(use ./core)` shadows it with Jolt's, which returns a jolt @@ -579,6 +596,13 @@ :var (let [cell (cell-for ctx (node :ns) (node :name))] (if (direct-var? ctx cell) (cell :root) # direct link: embed the fn value + (if (const-link? ctx cell) + # whole-program closed world: embed the stable root as a constant. + # Callable roots go in bare (valid in head/value position); any + # other value is quoted so Janet returns it rather than evaluating + # it as code (a bare tuple/struct in code position would be called). + (let [r (cell :root)] + (if (or (function? r) (cfunction? r)) r (tuple 'quote r))) # Indirect: live deref, with the var-get FN CALL inlined away # (jolt-8sq): a non-dynamic var's value is always its root, so # the common case is two native table ops + a branch instead of @@ -597,7 +621,7 @@ (let [qcell (tuple 'quote cell)] ['if ['in qcell :dynamic] (tuple var-get qcell) - ['in qcell :root]]))) + ['in qcell :root]])))) # (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))) diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index df84c71..47ea5ac 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -1366,33 +1366,101 @@ (when dc (each k (keys dc) (put dc k nil)))) mm-var) +(defn- hint-cross-ns-key + "Resolve a record-typed field hint (\"Vec3\", \"v/Vec3\", \"rt.vec/Vec3\") to the + home namespace's ctor key (\"rt.vec/->Vec3\") when the type is defined in a + DIFFERENT namespace and referred/aliased into the one being defined. The local + current-ns/->Type lookup misses those; this resolves the hint name through the + ns's :refer/:as bindings to the type var, then maps its root ctor value back to + the home key via the ctor-value index. Using the ctor VALUE, not the var's :ns, + is what makes :refer work — a :refer re-interns a fresh var whose :ns is the + referring ns, but its root is the same shared ctor closure. nil if unresolved." + [ctx t cix] + # Resolve against the COMPILE ns (the user ns being analyzed), not ctx-current-ns + # — during compilation the analyzer rebinds ctx-current-ns to jolt.analyzer, so a + # bare referred name would otherwise miss. Qualified alias/Name resolves the alias + # against the compile ns; a bare name looks up the compile ns's own mappings + # (which include :refer-interned vars). + (def cur-name (or (get (ctx :env) :compile-ns) (ctx-current-ns ctx))) + (def cur-ns (ctx-find-ns ctx cur-name)) + (def slash (string/find "/" t)) + (def v (when cur-ns + (if slash + (let [a (string/slice t 0 slash) nm (string/slice t (inc slash)) + home (or (ns-alias-lookup cur-ns a) (ns-import-lookup cur-ns a))] + (when home (ns-find (ctx-find-ns ctx home) nm))) + (ns-find cur-ns t)))) + (when (and v (table? v)) (get cix (v :root)))) + +(defn record-hint-ctor-key + "Resolve a record-type hint NAME (as written on a ^Type field/param — bare, + aliased, or fully qualified) to its home ctor key in the record-shapes registry + (\"rt.vec/->Vec3\"), or nil if it is not a known record type. Local + current-ns/->Name wins; otherwise cross-ns via the ctor-value index. Public so + the analyzer (through jolt.host) can type a ^Type PARAM hint exactly as a field + hint resolves, which is what carries a record param's type across a namespace + boundary without whole-program inference." + [ctx name] + (def rs (get (ctx :env) :record-shapes)) + (when rs + (def cur (or (get (ctx :env) :compile-ns) (ctx-current-ns ctx))) + (def local (string cur "/->" name)) + (if (get rs local) + local + (let [cix (get (ctx :env) :record-ctor-index)] + (when cix (hint-cross-ns-key ctx name cix)))))) + (defn make-deftype-ctor-impl "Build a deftype constructor closure. The ns-qualified type tag is baked at definition time (this runs during the deftype's (def …), in the type's ns), so instances carry a stable tag matching what extend-type registers methods under. field-kws is the [:f1 :f2 …] keyword vector; the ctor maps positional args to those keys. A ctx-capturing closure (make-deftype-ctor) is the public handle." - [ctx type-name-sym field-kws] + [ctx type-name-sym field-kws &opt field-tags] (def type-tag (string (ctx-current-ns ctx) "." (type-name-sym :name))) (def kws (d-realize field-kws)) + # per-field type hints (jolt-3ko): a tuple parallel to kws — "Vec3" (a record + # type name), "num", or nil. The inference resolves these to the field's exact + # type so reading a field back carries it (a nested record stays typed). + (def tags (if field-tags (d-realize field-tags) (array/new-filled (length kws)))) + # The ctor closure itself. Built FIRST so it can be indexed by value below. + # Records are shape-recs when shapes are active (:shapes? = direct-link, where + # the inference proves the reads) — the whole field-access pipeline handles + # them; otherwise the original :jolt/deftype tables. Read at ctor-BUILD time so + # a type is consistently one representation or the other. + (def the-ctor + (if (get (ctx :env) :shapes?) + (fn [& args] (make-record type-tag kws args)) + (fn [& args] + (var inst @{:jolt/deftype type-tag}) + (var i 0) (each kw kws (put inst kw (in args i)) (++ i)) + inst))) # jolt-t34: register this record's ctor return shape (DECLARED field order) so # the inference types (->Name ...) as a struct of these fields and field reads # on the result bare-index. Keyed by the ctor var-key "ns/->Name" to match how # the IR names the call head. Harmless when records aren't shaped (sidx gated). (let [rs (or (get (ctx :env) :record-shapes) - (let [t @{}] (put (ctx :env) :record-shapes t) t))] + (let [t @{}] (put (ctx :env) :record-shapes t) t)) + # ctor-value index: maps each ctor closure to its rs key, so a ^Type hint + # in another namespace can resolve home through the type var's root value + # (jolt-3ko cross-ns hints; see hint-cross-ns-key). + cix (or (get (ctx :env) :record-ctor-index) + (let [t @{}] (put (ctx :env) :record-ctor-index t) t)) + # resolve a record-typed hint ("Vec3") to its ctor-key ("ns/->Vec3") so + # the inference resolves it with a direct lookup. "num" stays as-is; a + # local def wins; else try cross-ns resolution; an unresolved name (not a + # known record type) stays bare -> :any. + resolved (map (fn [t] + (cond (nil? t) nil + (= t "num") "num" + (let [ck (string (ctx-current-ns ctx) "/->" t)] + (if (get rs ck) ck + (or (hint-cross-ns-key ctx t cix) t))))) + tags)] (put rs (string (ctx-current-ns ctx) "/->" (type-name-sym :name)) - {:fields (tuple ;kws) :type type-tag})) - # Records are shape-recs when shapes are active (:shapes? = direct-link, where - # the inference proves the reads) — the whole field-access pipeline handles - # them; otherwise the original :jolt/deftype tables. Read at ctor-BUILD time so - # a type is consistently one representation or the other. - (if (get (ctx :env) :shapes?) - (fn [& args] (make-record type-tag kws args)) - (fn [& args] - (var inst @{:jolt/deftype type-tag}) - (var i 0) (each kw kws (put inst kw (in args i)) (++ i)) - inst))) + {:fields (tuple ;kws) :type type-tag :tags (tuple ;resolved)}) + (put cix the-ctor (string (ctx-current-ns ctx) "/->" (type-name-sym :name)))) + the-ctor) (defn install-stateful-fns! "Intern ctx-capturing closures for the stateful primitives into clojure.core, so @@ -1467,7 +1535,7 @@ (ns-intern core "refer-clojure" (fn [& args] (refer-clojure-impl ctx ;args))) (ns-intern core "defmulti-setup" (fn [name-sym dispatch & opts] (defmulti-setup ctx name-sym dispatch ;opts))) (ns-intern core "defmethod-setup" (fn [mm-sym dval impl] (defmethod-setup ctx mm-sym dval impl))) - (ns-intern core "make-deftype-ctor" (fn [name-sym field-kws] (make-deftype-ctor-impl ctx name-sym field-kws))) + (ns-intern core "make-deftype-ctor" (fn [name-sym field-kws &opt field-tags] (make-deftype-ctor-impl ctx name-sym field-kws field-tags))) # Var/namespace lookups that need the ctx (the rest of the var fns — var-get/ # var-set/var?/alter-var-root/alter-meta!/reset-meta! — are plain core-bindings). (ns-intern core "find-var" (fn [sym] (find-var ctx sym))) diff --git a/src/jolt/host_iface.janet b/src/jolt/host_iface.janet index 2bcf20e..9c1ca01 100644 --- a/src/jolt/host_iface.janet +++ b/src/jolt/host_iface.janet @@ -228,12 +228,16 @@ # presence is the marker. Lets the analyzer resolve a ^Record type hint to the # struct fast path: record instances are tables tagged :jolt/deftype (NOT # :jolt/type), so a raw keyword get is correct for them (jolt-94n). +(defn h-record-ctor-key [ctx name] + # The home ctor key ("ns/->Name") for a ^Type hint, resolving cross-ns + # (referred/aliased) records too — nil if `name` is not a known record type. + (record-hint-ctor-key ctx name)) + (defn h-record-type? [ctx name] - (def ctor (string "->" name)) - (def cns (ctx-find-ns ctx (h-current-ns ctx))) - (if (or (and cns (ns-find cns ctor)) - (ns-find (ctx-find-ns ctx "clojure.core") ctor)) - true false)) + # A ^Type hint names a record iff it resolves to a ctor key (local OR cross-ns, + # via record-hint-ctor-key — so a referred/aliased foreign record is recognized, + # not just one whose ->Name happens to be interned in the current ns). + (if (record-hint-ctor-key ctx name) true false)) (def- exports {"form-sym?" h-sym? "form-sym-name" h-sym-name "form-sym-ns" h-sym-ns @@ -250,7 +254,8 @@ "form-syntax-quote-lower" h-syntax-quote-lower "host-intern!" h-intern! "inline-enabled?" h-inline-enabled? "inline-ir" h-inline-ir - "record-type?" h-record-type? "form-position" h-form-position}) + "record-type?" h-record-type? "form-position" h-form-position + "record-ctor-key" h-record-ctor-key}) (defn install! [ctx] (def ns (ctx-find-ns ctx "jolt.host")) diff --git a/src/jolt/reader.janet b/src/jolt/reader.janet index a6220f7..9673b6d 100644 --- a/src/jolt/reader.janet +++ b/src/jolt/reader.janet @@ -613,7 +613,14 @@ [meta-form] (cond (keyword? meta-form) {meta-form true} - (and (struct? meta-form) (= :symbol (meta-form :jolt/type))) {:tag (meta-form :name)} + # A symbol tag keeps its namespace qualifier (^t/Ray -> "t/Ray", not "Ray") so + # an aliased/qualified record hint resolves through the ns's aliases the same + # way a bare referred one does; dropping it silently mis-hinted across + # namespaces. Bare symbols (^Ray, ^String) are unchanged. + (and (struct? meta-form) (= :symbol (meta-form :jolt/type))) + {:tag (if (meta-form :ns) + (string (meta-form :ns) "/" (meta-form :name)) + (meta-form :name))} (string? meta-form) {:tag meta-form} nil)) diff --git a/test/integration/cross-ns-hints-test.janet b/test/integration/cross-ns-hints-test.janet new file mode 100644 index 0000000..d67fa0c --- /dev/null +++ b/test/integration/cross-ns-hints-test.janet @@ -0,0 +1,72 @@ +# Cross-namespace ^Type field hints (jolt-3ko follow-up): a record field hinted +# with a record type defined in ANOTHER namespace — referred (:refer) or aliased +# (:as) in — must resolve to that type's HOME ctor key in the record-shapes +# registry, the same as a same-namespace hint does. That resolved key is what +# lets the inference type a field read back to the foreign record type instead of +# :any (the lever for fast nested-record code across a multi-namespace program). +# Guards both the :refer and :as spellings — for record FIELD hints and for +# fn PARAM hints (which seed the inference so a record param's reads are typed +# across a namespace boundary without whole-program). Also guards that the +# reader keeps a tag's namespace qualifier (^g/Pt -> "g/Pt", not "Pt"). +(use ../../src/jolt/api) +(import ../../src/jolt/types :as ty) +(import ../../src/jolt/core :as jc) +(import ../../src/jolt/reader :as rd) + +(var failures 0) +(defn- check [label got want] + (unless (deep= got want) + (++ failures) + (printf "FAIL [%s] got %q want %q" label got want))) + +(def dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-xns-hints")) +(os/mkdir dir) +(os/mkdir (string dir "/geo")) +# Pt lives in geo.pt; shape records in geo.shape hint ^Pt across the boundary. +(spit (string dir "/geo/pt.clj") + "(ns geo.pt)\n(defrecord Pt [x y z])\n") +(spit (string dir "/geo/shape.clj") + (string "(ns geo.shape (:require [geo.pt :as g :refer [Pt]]))\n" + "(defrecord Seg [^Pt a ^Pt b])\n" # :refer field hint + "(defrecord Tri [^g/Pt a ^g/Pt b ^g/Pt c])\n" # :as field hint + # param hints, both spellings: ^Pt (referred), ^g/Pt (aliased) + "(defn mid [^Pt a ^g/Pt b] a)\n")) + +(def ctx (init {:compile? true :direct-linking? true})) +(array/push (get (ctx :env) :source-paths) dir) +(eval-string ctx "(require '[geo.shape])") +(def rs (get (ctx :env) :record-shapes)) + +(check ":refer ^Pt field hint resolves to home ctor key" + (get (get rs "geo.shape/->Seg") :tags) + ["geo.pt/->Pt" "geo.pt/->Pt"]) +(check ":as ^g/Pt field hint resolves to home ctor key" + (get (get rs "geo.shape/->Tri") :tags) + ["geo.pt/->Pt" "geo.pt/->Pt" "geo.pt/->Pt"]) +# the foreign type's own shape is registered under its home key +(check "home type registered" + (get (get rs "geo.pt/->Pt") :fields) + [:x :y :z]) + +# --- param hints: the arity carries [name ctor-key] for each record param, both +# the :refer (^Pt) and :as (^g/Pt) spellings resolved to the home key ---------- +(def shape-ns (ty/ctx-find-ns ctx "geo.shape")) +(def mid-ir (get (get (get shape-ns :mappings) "mid") :infer-ir)) +(def mid-arity (first (jc/vview (get (get mid-ir :init) :arities)))) +(def phints (when (get mid-arity :phints) + (map jc/vview (jc/vview (get mid-arity :phints))))) +(check "param hints resolve cross-ns (refer + as)" + phints + @[@["a" "geo.pt/->Pt"] @["b" "geo.pt/->Pt"]]) + +# --- reader keeps a tag's namespace qualifier --------------------------------- +(check "reader preserves qualified tag ^g/Pt" + (get (get (rd/parse-string "^g/Pt x") :meta) :tag) + "g/Pt") +(check "reader bare tag ^Pt unchanged" + (get (get (rd/parse-string "^Pt x") :meta) :tag) + "Pt") + +(if (= 0 failures) + (print "cross-ns-hints: all cases passed") + (do (printf "cross-ns-hints: %d FAILURES" failures) (os/exit 1))) diff --git a/test/integration/whole-program-test.janet b/test/integration/whole-program-test.janet index ba8aea9..3839f65 100644 --- a/test/integration/whole-program-test.janet +++ b/test/integration/whole-program-test.janet @@ -13,10 +13,15 @@ (spit (string dir "/wputil.clj") (string "(ns wputil)\n" "(defrecord V [x y z])\n" + # const-link targets (jolt-rvt): a data def and a ^:redef fn are + # indirect (cell deref) per-ns but embedded as constants under + # whole-program. Soundness => both modes must give the same answer. + "(def scale 2.0)\n" + "(defn ^:redef bump [x] (+ x 1.0))\n" # recursive => never inlined; params proven only whole-program "(defn dot [a b n]\n" " (if (<= n 0) 0.0\n" - " (+ (* (:x a) (:x b)) (* (:y a) (:y b)) (* (:z a) (:z b)) (dot a b (dec n)))))\n")) + " (+ (* (:x a) (:x b)) (* (:y a) (:y b)) (* (:z a) (:z b)) (bump (* scale (dot a b (dec n)))))))\n")) (spit (string dir "/wpmain.clj") (string "(ns wpmain (:require [wputil :as v]))\n" "(defn -main []\n"