Merge pull request #72 from jolt-lang/seed-shrink-r1-dead-code

core: delete seed fns shadowed by the overlay; fix methods/remove-all-methods

src/jolt/core.janet

@@ -1408,10 +1408,8 @@
 
 # complement now lives in the Clojure collection tier (core/20-coll.clj).
 
-# Jolt has no inst/uri/uuid host types, so these are always false; inst-ms has
-# nothing valid to read.
-(defn core-inst? [x] false)
-(defn core-inst-ms [x] (error "Not an instant (no inst type in Jolt)"))
+# inst?/inst-ms live in the Clojure collection tier (core/20-coll.clj).
+# Jolt has no uri host type, so uri? is always false.
 (defn core-uri? [x] false)
 # uuid? now lives in the Clojure collection tier (tagged-value predicate).
 (defn core-bytes? [x] (buffer? x))
@@ -2211,20 +2209,8 @@
 
 # intern is a ctx-capturing clojure.core fn now (install-stateful-fns!).
 
-# Hierarchy stubs for sci bootstrap
-(def core-get-method (fn [mm-var dispatch-val]
-  (let [methods (get mm-var :jolt/methods)]
-    (or (get methods dispatch-val) (get methods :default)))))
-(def core-methods (fn [mm-var] (get mm-var :jolt/methods)))
-(def core-remove-method (fn [mm-var dispatch-val]
-  (let [methods (get mm-var :jolt/methods)]
-    (put methods dispatch-val nil) mm-var)))
-(def core-remove-all-methods (fn [mm-var]
-  (put mm-var :jolt/methods @{}) mm-var))
-(defn core-prefer-method [mm-var dispatch-val-a dispatch-val-b]
-  (let [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) mm-var))
+# get-method/methods/remove-method/remove-all-methods/prefer-method are
+# overlay macros (core/30-macros.clj) over the evaluator's *-setup fns.
 
 (defn core-with-meta [obj meta]
   # Functions and scalars can't carry metadata in Jolt's model — return as-is
@@ -2814,8 +2800,6 @@
     "mapcat" core-mapcat
     "transduce" core-transduce
     "sequence" core-sequence
-    "eduction" core-sequence
-    "unreduced" core-unreduced
     "keyword" core-keyword
     "symbol" core-symbol
     "namespace" core-namespace
@@ -2965,10 +2949,6 @@
     "num" core-num
     "char" core-char
     "char?" core-char?
-    "unchecked-inc" core-unchecked-inc
-    "unchecked-dec" core-unchecked-dec
-    "unchecked-add" core-unchecked-add
-    "unchecked-subtract" core-unchecked-subtract
     # Hash
     "hash" core-hash
     "atom" core-atom
@@ -2976,11 +2956,6 @@
     "reset!" core-reset!
     "swap!" core-swap!
     "not" core-not
-    "get-method" core-get-method
-    "methods" core-methods
-    "remove-method" core-remove-method
-    "remove-all-methods" core-remove-all-methods
-    "prefer-method" core-prefer-method
     "Object" core-Object
     "make-protocol" core-make-protocol
     "satisfies?" core-satisfies?
@@ -2998,8 +2973,6 @@
     "__local-var" core-local-var
     "__close" core-close-resource
     "avoid-method-too-large" core-avoid-method-too-large
-    "inst?" core-inst?
-    "inst-ms" core-inst-ms
     "uri?" core-uri?
     "bytes?" core-bytes?
     "meta" core-meta

src/jolt/evaluator.janet

@@ -1301,7 +1301,10 @@
     (fn [mm-sym]
       (def mm-var (mm-var-of mm-sym false))
       (when mm-var
-        (put mm-var :jolt/methods @{})
+        # clear IN PLACE: the dispatch closure captured this table at defmulti
+        # time, so swapping in a fresh one leaves dispatch seeing stale methods
+        (let [methods (get mm-var :jolt/methods)]
+          (when methods (each k (keys methods) (put methods k nil))))
         (clear-dispatch-cache! mm-var))
       mm-var))
   (ns-intern core "prefers-setup"
@@ -1317,7 +1320,13 @@
   (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))))
+      (when mm-var
+        # a jolt map, not the live host table (and phm so vector dispatch
+        # values look up by value, same reason build-eval-map promotes)
+        (var m (make-phm))
+        (let [tbl (get mm-var :jolt/methods)]
+          (when tbl (each k (keys tbl) (set m (phm-assoc m k (get tbl k))))))
+        m)))
   # satisfies?: evaluated protocol value + instance (matches the prior arm).
   (ns-intern core "satisfies?"
     (fn [proto obj]

test/spec/multimethods-spec.janet

@@ -15,7 +15,15 @@
   ["get-method"         "\"one\""
    "(do (defmulti f identity) (defmethod f 1 [_] \"one\") ((get-method f 1) 1))"]
   ["remove-method"      :throws
-   "(do (defmulti f identity) (defmethod f 1 [_] \"one\") (remove-method f 1) (f 1))"])
+   "(do (defmulti f identity) (defmethod f 1 [_] \"one\") (remove-method f 1) (f 1))"]
+  ["methods"            "\"one\""
+   "(do (defmulti f identity) (defmethod f 1 [_] \"one\") ((get (methods f) 1) 1))"]
+  ["methods count"      "2"
+   "(do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f 2 [_] \"two\") (count (methods f)))"]
+  ["remove-all-methods" :throws
+   "(do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f 2 [_] \"two\") (remove-all-methods f) (f 1))"]
+  ["remove-all-methods empties the table" "0"
+   "(do (defmulti f identity) (defmethod f 1 [_] \"one\") (remove-all-methods f) (count (methods f)))"])
 
 (defspec "multimethods / hierarchies"
   ["derive + isa?"      "true"   "(do (derive ::child ::parent) (isa? ::child ::parent))"]