Merge pull request #23 from jolt-lang/stage2-tier6-var-fns

Stage 2 tier 6a: var fns compile as ordinary invokes

src/jolt/compiler.janet

@@ -158,11 +158,14 @@
              "macroexpand-1" "defonce" "defmacro" "deftype" "defmulti"
              "defmethod" "prefer-method" "remove-method" "remove-all-methods"
              "get-method" "methods"
-             "satisfies?" "instance?" "set!" "var" "var-get"
+             # var-get/var-set/var?/alter-var-root/alter-meta!/reset-meta!/
-             "var-set" "var?" "ns" "in-ns" "require" "create-ns" "remove-ns"
+             # find-var/intern are plain clojure.core fns now (core-bindings +
-             "find-ns" "all-ns" "the-ns" "find-var" "intern" "resolve"
+             # install-stateful-fns!) — ordinary invokes, no punt (Stage 2 tier 6).
+             "satisfies?" "instance?" "set!" "var"
+             "ns" "in-ns" "require" "create-ns" "remove-ns"
+             "find-ns" "all-ns" "the-ns" "resolve"
              "ns-resolve" "ns-aliases" "ns-imports" "ns-interns"
-             "alter-var-root" "alter-meta!" "reset-meta!" "locking" "new"
+             "locking" "new"
              # Definitional/host macros that mutate context or build runtime
              # values the emitter doesn't model.
              "defrecord" "defprotocol" "definterface" "reify" "proxy"

src/jolt/core.janet

@@ -2131,7 +2131,7 @@
 (defn core-alter-meta! [v f & args] (apply alter-meta! v f args))
 (defn core-reset-meta! [v meta] (reset-meta! v meta))
 
-(defn core-intern [ns-name sym-name val] val)
+# intern is a ctx-capturing clojure.core fn now (install-stateful-fns!).
 
 # Hierarchy stubs for sci bootstrap
 (def core-make-hierarchy make-hierarchy)
@@ -3143,7 +3143,6 @@
     "alter-var-root" core-alter-var-root
     "alter-meta!" core-alter-meta!
     "reset-meta!" core-reset-meta!
-    "intern" core-intern
     "push-thread-bindings" core-push-thread-bindings
     "pop-thread-bindings" core-pop-thread-bindings
     # Dynamic vars — stubs for SCI bootstrap

src/jolt/evaluator.janet

@@ -23,9 +23,9 @@
       (= name "eval")
       (= name "instance?")
       (= name "new") (= name ".")
-      (= name "var-get") (= name "var-set") (= name "var?")
+      # var-get/var-set/var?/alter-var-root/alter-meta!/reset-meta! are plain
-      (= name "alter-var-root") (= name "find-var") (= name "intern")
+      # clojure.core fns (core-bindings); find-var/intern are ctx-capturing fns
-      (= name "alter-meta!") (= name "reset-meta!")
+      # (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")))
@@ -950,6 +950,13 @@
   (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)))
+  # 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)))
+  (ns-intern core "intern"
+    (fn [ns-name sym-name &opt val]
+      (def ns (ctx-find-ns ctx (if (struct? ns-name) (ns-name :name) ns-name)))
+      (ns-intern ns (if (struct? sym-name) (sym-name :name) sym-name) val)))
   core)
 
 # Dispatch a special form by its string name.
@@ -1354,24 +1361,10 @@
     "var" (let [target-sym (in form 1)
                  v (resolve-var ctx bindings target-sym)]
              (if v v (error (string "Unable to resolve var: " (sym-name-str target-sym) " in var"))))
-    "var-get" (var-get (eval-form ctx bindings (in form 1)))
+    # var-get/var-set/var?/alter-var-root/alter-meta!/reset-meta! are plain
-    "var-set" (var-set (eval-form ctx bindings (in form 1))
+    # clojure.core fns; find-var/intern are ctx-capturing clojure.core fns
-                       (eval-form ctx bindings (in form 2)))
+    # (install-stateful-fns!) — they fall through to the function-call default
-    "var?" (var? (eval-form ctx bindings (in form 1)))
+    # and compile as ordinary invokes (Stage 2 tier 6).
-    "alter-var-root" (alter-var-root (eval-form ctx bindings (in form 1))
-                                      (eval-form ctx bindings (in form 2)))
-    "find-var" (find-var ctx (eval-form ctx bindings (in form 1)))
-    "alter-meta!" (let [v (eval-form ctx bindings (in form 1))
-                         f (eval-form ctx bindings (in form 2))
-                         args (map |(eval-form ctx bindings $) (tuple/slice form 3))]
-                    (apply alter-meta! v f args))
-    "reset-meta!" (reset-meta! (eval-form ctx bindings (in form 1))
-                                (eval-form ctx bindings (in form 2)))
-    "intern" (let [ns-name (eval-form ctx bindings (in form 1))
-                   sym-name (eval-form ctx bindings (in form 2))
-                   val (eval-form ctx bindings (in form 3))
-                   ns (ctx-find-ns ctx (if (struct? ns-name) (ns-name :name) ns-name))]
-               (ns-intern ns (if (struct? sym-name) (sym-name :name) sym-name) val))
     # set?/disj are plain clojure.core fns now (core-set?/core-disj) — no longer
     # special-cased here, the analyzer, or compiler.janet (jolt-g3h).
     # protocol-dispatch / register-method / make-reified are now ordinary

src/jolt/host_iface.janet

@@ -74,8 +74,10 @@
              "defmacro" "fn*" "let*" "loop*" "recur" "throw" "try" "set!"
              # defmulti/defmethod/deftype now compile (macros over *-setup fns).
              "locking" "eval" "instance?" "new"
-             "." "var-get" "var-set" "var?" "alter-var-root" "find-var" "intern"
+             # var-get/var-set/var?/alter-var-root/alter-meta!/reset-meta! are
-             "alter-meta!" "reset-meta!" "satisfies?"
+             # 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"

test/integration/conformance-test.janet

@@ -138,6 +138,14 @@
    ["deftype inline methods" "7" "(do (defprotocol Pi (mi [x])) (deftype Ti [v] Pi (mi [x] v)) (mi (->Ti 7)))"]
    ["deftype two protocols"  "[1 2]" "(do (defprotocol Pa (ma [x])) (defprotocol Pb (mb [x])) (deftype Tab [a b] Pa (ma [x] a) Pb (mb [x] b)) (let [t (->Tab 1 2)] [(ma t) (mb t)]))"]
 
+   ### ---- var fns as ordinary invokes (Stage 2 tier 6) ----
+   ["var-get + call"     "2"     "((var-get (var inc)) 1)"]
+   ["var? true"          "true"  "(var? (var map))"]
+   ["var? false"         "false" "(var? 5)"]
+   ["intern + find-var"  "41"    "(do (intern (quote user) (quote iv) 41) (var-get (find-var (quote user/iv))))"]
+   ["alter-var-root rest args" "11" "(do (def avr 1) (alter-var-root (var avr) + 4 6) avr)"]
+   ["alter-meta! + meta" "7"     "(do (def amv 1) (alter-meta! (var amv) assoc :k 7) (:k (meta (var amv))))"]
+
    ### ---- 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\"))"]

test/integration/fallback-zero-test.janet

@@ -52,7 +52,12 @@
    "(reify P (m [this] 1))" "(var map)"
    # Stage 2 tier 5: type/dispatch definitional forms compile too
    "(deftype Pt [x y])" "(deftype Sq [s] P (m [this] s))"
-   "(defrecord Rec [a b])" "(defmulti mf :k)" "(defmethod mf :a [x] x)"])
+   "(defrecord Rec [a b])" "(defmulti mf :k)" "(defmethod mf :a [x] x)"
+   # Stage 2 tier 6: var fns are ordinary invokes now
+   "(var-get (var map))" "(var? (var map))" "(var-set (var map) map)"
+   "(alter-var-root (var map) identity)" "(find-var (quote clojure.core/map))"
+   "(intern (quote user) (quote tier6-sym) 42)"
+   "(alter-meta! (var map) assoc :k 1)" "(reset-meta! (var map) {})"])
 
 # --- Intentional fallback (sanity sample): these SHOULD punt to the interpreter.
 # The remaining frozen/uncompiled set keeps the harness honest in the punt