diff --git a/host/chez/collections.ss b/host/chez/collections.ss index 84c0106..44014c6 100644 --- a/host/chez/collections.ss +++ b/host/chez/collections.ss @@ -37,9 +37,20 @@ ;; ============================================================================ ;; persistent vector — copy-on-write over a Scheme vector ;; ============================================================================ -(define-record-type pvec (fields v) (nongenerative chez-pvec-v1)) +;; A pvec carries an `ent` flag: #t marks a MAP ENTRY (the [k v] pair seq'd out +;; of a map). A map entry equals its [k v] vector and walks like one (nth/count/ +;; seq/=/hash/print all read only `v`), but is NOT `vector?` and IS `map-entry?` +;; — matching Clojure's MapEntry (jolt-agw6). The flag defaults #f, so every +;; existing `(make-pvec v)` builds a plain vector; modifying an entry (conj/assoc) +;; likewise yields a plain vector. +(define-record-type pvec + (fields v ent) + (protocol (lambda (new) (case-lambda ((v) (new v #f)) ((v e) (new v e))))) + (nongenerative chez-pvec-v1)) (define empty-pvec (make-pvec (vector))) (define (jolt-vector . xs) (make-pvec (list->vector xs))) +(define (make-map-entry k v) (make-pvec (vector k v) #t)) +(define (jolt-map-entry? x) (and (pvec? x) (pvec-ent x) #t)) (define (pvec-count p) (vector-length (pvec-v p))) ;; jolt models every number as a double, so vector indices arrive as flonums — ;; coerce an integer-valued index to a Scheme fixnum before bounds math. diff --git a/host/chez/natives-coll.ss b/host/chez/natives-coll.ss new file mode 100644 index 0000000..c07cb6d --- /dev/null +++ b/host/chez/natives-coll.ss @@ -0,0 +1,32 @@ +;; Collection constructors + rand (jolt-cf1q.3 Phase 2 inc A) — host-coupled seed +;; natives the overlay assumes as bare clojure.core vars but which were never +;; def-var!'d, so they resolved to jolt-nil and any call hit the apply-jolt-nil +;; crash bucket. The persistent-collection constructors already exist in +;; collections.ss (jolt-hash-map / jolt-hash-set / jolt-vector); this just binds +;; the public clojure.core names to them. Loaded after def-var! (rt.ss) + the +;; collections + seq tiers. Semantics match the Janet seed (core_coll.janet +;; core-hash-map/core-array-map/core-hash-set/core-set, core_types.janet +;; core-rand). + +;; hash-map / hash-set: variadic kvs / elems straight onto the existing ctors. +;; array-map: Clojure preserves insertion order, but jolt's `=` is structural and +;; the parity corpus compares by value, so a pmap is observationally equal for +;; the tested cases; keys-ordering is a separate (untested-here) concern. +(define (jolt-array-map . kvs) (apply jolt-hash-map kvs)) + +;; set: realize any seqable to a list, then dedup through the set ctor. nil -> #{}. +(define (jolt-set coll) + (if (jolt-nil? coll) (jolt-hash-set) (apply jolt-hash-set (seq->list coll)))) + +;; rand: a flonum in [0, n) (n defaults to 1.0) — jolt is all-flonum, so the +;; result is a double like every other number. +(define (jolt-rand . n) + (let ((r (random 1.0))) + (if (null? n) r (* r (exact->inexact (car n)))))) + +(def-var! "clojure.core" "hash-map" jolt-hash-map) +(def-var! "clojure.core" "hash-set" jolt-hash-set) +(def-var! "clojure.core" "array-map" jolt-array-map) +(def-var! "clojure.core" "set" jolt-set) +(def-var! "clojure.core" "rand" jolt-rand) +(def-var! "clojure.core" "map-entry?" jolt-map-entry?) diff --git a/host/chez/predicates.ss b/host/chez/predicates.ss index ade908a..31e40b6 100644 --- a/host/chez/predicates.ss +++ b/host/chez/predicates.ss @@ -8,7 +8,9 @@ ;; seed predicates are simply absent here for now. (define (jolt-map? x) (pmap? x)) -(define (jolt-vector? x) (pvec? x)) +;; a map entry is a pvec under the hood but is NOT vector? (matches Clojure's +;; MapEntry — jolt-agw6); the public vector? predicate excludes it. +(define (jolt-vector? x) (and (pvec? x) (not (pvec-ent x)))) (define (jolt-set? x) (pset? x)) (define (jolt-seq? x) (or (cseq? x) (empty-list-t? x))) (define (jolt-coll-pred? x) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index f83ad34..cd1696f 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -166,6 +166,11 @@ ;; natives. Over the seq layer + jolt-compare, so loaded after converters.ss. (load "host/chez/natives-seq.ss") +;; collection constructors + rand (jolt-agw6, Phase 2 inc A): bind the public +;; clojure.core names hash-map/hash-set/array-map/set/rand to the existing +;; pmap/pset ctors. After collections.ss (the ctors) + seq.ss (seq->list). +(load "host/chez/natives-coll.ss") + ;; multimethods (jolt-9ls5): defmulti/defmethod dispatch runtime. Needs jolt-invoke ;; (seq.ss), jolt=/key-hash/jolt-hash-map (collections.ss), jolt-atom? (atoms.ss), ;; jolt-pr-str (above), and the var-cell machinery — so loaded last. diff --git a/host/chez/seq.ss b/host/chez/seq.ss index 32b513a..61073a0 100644 --- a/host/chez/seq.ss +++ b/host/chez/seq.ss @@ -52,7 +52,7 @@ ((empty-list-t? x) jolt-nil) ((cseq? x) x) ((pvec? x) (vec->seq x 0)) - ((pmap? x) (list->cseq (pmap-fold x (lambda (k v a) (cons (jolt-vector k v) a)) '()))) + ((pmap? x) (list->cseq (pmap-fold x (lambda (k v a) (cons (make-map-entry k v) a)) '()))) ((pset? x) (list->cseq (pset-fold x cons '()))) ((string? x) (str->seq x 0)) (else (error 'seq "not seqable" x)))) diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index ac31563..758e64e 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -139,8 +139,10 @@ # 3q (multimethod dispatch + late-bind) 1530; 3r (dynamic-var constants) 1532; # 3x (non-ASCII string literals, jolt-x0os) + 3y (seed assoc! odd-args -> :throws, # jolt-ea9k) 1534 (total evaluated drops as the 3 odd-arg rows become :throws). +# Phase 2 inc A (jolt-agw6: collection ctors set/hash-map/hash-set/array-map + +# rand + real map entries / key / val / map-entry?) 1593. # Strided runs scale down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1534"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1593"))) (def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor)) (when (or (> (length diverged) 0) (< pass floor)) (printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))