Phase 7: LazySeq + PersistentHashSet completion
- phm.janet: LazySeq (realize-once with caching, ls-first/ls-rest/ls-seq/ls-count) PersistentHashSet (backed by PHM, phs-conj/phs-disj/phs-contains?/phs-count/...) make-lazy-seq creates lazy thunk wrapper with :jolt/lazy-seq type tag make-phs creates hash set with :jolt/set type tag - evaluator.janet: :jolt/set handler in eval-form, disj/set? special forms, special-symbol? entries, phm import for compile-time visibility - core.janet: lazy-seq/iterate macros, set?/disj core fns, make-phs wired into hash-set, core-bindings entries for set?/disj/lazy-seq/make-lazy-seq/iterate Set support in core-conj/core-contains?/core-count/core-empty?/core-seq/core-get LazySeq support in core-first/core-rest/core-count/core-seq - 9 tests (32-33): lazy-seq basic ops, realize-once caching PersistentHashSet construction, conj, disj, count, set? predicate - 315 ok, 2 fail (pre-existing, unchanged)
This commit is contained in:
Yogthos
parent
f410f5c48b
commit
fe22fea3e4
7 changed files with 286 additions and 133 deletions
|
|
@ -33,9 +33,10 @@
|
|||
|
||||
(defn core-empty? [coll]
|
||||
(if (nil? coll) true
|
||||
(if (phm? coll) (= 0 (coll :cnt))
|
||||
(if (struct? coll) (= 0 (length (keys coll)))
|
||||
(= 0 (length coll))))))
|
||||
(if (set? coll) (= 0 (coll :cnt))
|
||||
(if (phm? coll) (= 0 (coll :cnt))
|
||||
(if (struct? coll) (= 0 (length (keys coll)))
|
||||
(= 0 (length coll)))))))
|
||||
|
||||
(defn core-every? [pred coll]
|
||||
(var result true)
|
||||
|
|
@ -103,10 +104,8 @@
|
|||
|
||||
(defn core-conj [coll & xs]
|
||||
(if (tuple? coll)
|
||||
# vector: add to end
|
||||
(tuple/slice (tuple ;(array/concat (array/slice coll) xs)))
|
||||
(if (array? coll)
|
||||
# list: add to front (reverse xs, push each)
|
||||
(do
|
||||
(var result coll)
|
||||
(var i 0)
|
||||
|
|
@ -114,15 +113,25 @@
|
|||
(set result (array/insert result 0 (xs i)))
|
||||
(++ i))
|
||||
result)
|
||||
# struct/map: add [k v] pairs
|
||||
(do
|
||||
(var result coll)
|
||||
(var i 0)
|
||||
(while (< i (length xs))
|
||||
(let [pair (xs i)]
|
||||
(set result (merge result {(pair 0) (pair 1)})))
|
||||
(++ i))
|
||||
result))))
|
||||
(if (set? coll)
|
||||
(apply phs-conj coll xs)
|
||||
(if (phm? coll)
|
||||
(do
|
||||
(var result coll)
|
||||
(var i 0)
|
||||
(while (< i (length xs))
|
||||
(let [pair (xs i)]
|
||||
(set result (phm-assoc result (pair 0) (pair 1))))
|
||||
(++ i))
|
||||
result)
|
||||
(do
|
||||
(var result coll)
|
||||
(var i 0)
|
||||
(while (< i (length xs))
|
||||
(let [pair (xs i)]
|
||||
(set result (merge result {(pair 0) (pair 1)})))
|
||||
(++ i))
|
||||
result))))))
|
||||
|
||||
(defn core-assoc [m & kvs]
|
||||
(if (phm? m)
|
||||
|
|
@ -140,13 +149,14 @@
|
|||
(defn core-get [m k &opt default]
|
||||
(default default nil)
|
||||
(if (nil? m) default
|
||||
(if (phm? m) (phm-get m k default)
|
||||
(if (or (struct? m) (table? m))
|
||||
(let [v (m k)]
|
||||
(if (nil? v) default v))
|
||||
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
|
||||
(in m k)
|
||||
default)))))
|
||||
(if (set? m) (phs-get m k default)
|
||||
(if (phm? m) (phm-get m k default)
|
||||
(if (or (struct? m) (table? m))
|
||||
(let [v (m k)]
|
||||
(if (nil? v) default v))
|
||||
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
|
||||
(in m k)
|
||||
default))))))
|
||||
|
||||
(defn core-get-in [m ks &opt default]
|
||||
(default default nil)
|
||||
|
|
@ -159,28 +169,33 @@
|
|||
(if (nil? current) default current))
|
||||
|
||||
(defn core-contains? [coll key]
|
||||
(if (phm? coll) (let [b (get (coll :buckets) (phm-hash-key key))] (if b (phm-bucket-contains? b key) false))
|
||||
(if (struct? coll) (not (nil? (coll key)))
|
||||
(if (table? coll) (not (nil? (coll key)))
|
||||
(if (or (tuple? coll) (array? coll))
|
||||
(and (number? key) (>= key 0) (< key (length coll)))
|
||||
false)))))
|
||||
(if (set? coll) (phs-contains? coll key)
|
||||
(if (phm? coll) (let [b (get (coll :buckets) (phm-hash-key key))] (if b (phm-bucket-contains? b key) false))
|
||||
(if (struct? coll) (not (nil? (coll key)))
|
||||
(if (table? coll) (not (nil? (coll key)))
|
||||
(if (or (tuple? coll) (array? coll))
|
||||
(and (number? key) (>= key 0) (< key (length coll)))
|
||||
false))))))
|
||||
|
||||
(defn core-count [coll]
|
||||
(if (phm? coll) (coll :cnt)
|
||||
(if (and (table? coll) (get coll :jolt/deftype)) (- (length (keys coll)) 1)
|
||||
(length coll))))
|
||||
(if (lazy-seq? coll) (ls-count coll)
|
||||
(if (set? coll) (coll :cnt)
|
||||
(if (phm? coll) (coll :cnt)
|
||||
(if (and (table? coll) (get coll :jolt/deftype)) (- (length (keys coll)) 1)
|
||||
(length coll))))))
|
||||
|
||||
(defn core-first [coll]
|
||||
(if (or (nil? coll) (= 0 (length coll))) nil
|
||||
(in coll 0)))
|
||||
(if (lazy-seq? coll) (ls-first coll)
|
||||
(if (or (nil? coll) (= 0 (length coll))) nil
|
||||
(in coll 0))))
|
||||
|
||||
(defn core-rest [coll]
|
||||
(if (or (nil? coll) (= 0 (length coll)))
|
||||
@[]
|
||||
(if (tuple? coll)
|
||||
(tuple/slice coll 1)
|
||||
(array/slice coll 1))))
|
||||
(if (lazy-seq? coll) (ls-rest coll)
|
||||
(if (or (nil? coll) (= 0 (length coll)))
|
||||
@[]
|
||||
(if (tuple? coll)
|
||||
(tuple/slice coll 1)
|
||||
(array/slice coll 1)))))
|
||||
|
||||
(defn core-next [coll]
|
||||
(let [r (core-rest coll)]
|
||||
|
|
@ -196,11 +211,13 @@
|
|||
(defn core-seq [coll]
|
||||
(if (or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll))))
|
||||
nil
|
||||
(if (phm? coll) (tuple ;(phm-entries coll))
|
||||
(if (tuple? coll) (tuple/slice coll)
|
||||
(if (string? coll) (map |(string/from-bytes $) (string/bytes coll))
|
||||
(if (struct? coll) (tuple ;(keys coll))
|
||||
coll))))))
|
||||
(if (lazy-seq? coll) (ls-seq coll)
|
||||
(if (set? coll) (phs-seq coll)
|
||||
(if (phm? coll) (tuple ;(phm-entries coll))
|
||||
(if (tuple? coll) (tuple/slice coll)
|
||||
(if (string? coll) (map |(string/from-bytes $) (string/bytes coll))
|
||||
(if (struct? coll) (tuple ;(keys coll))
|
||||
coll))))))))
|
||||
|
||||
(defn core-vec [coll]
|
||||
(if (tuple? coll) coll
|
||||
|
|
@ -445,6 +462,19 @@
|
|||
(++ i))
|
||||
result))
|
||||
|
||||
(defn core-iterate [f x]
|
||||
"Macro: (iterate f x) → lazy infinite sequence x, (f x), (f (f x)), ..."
|
||||
(def sym-x (gensym "x"))
|
||||
(def sym-f (gensym "f"))
|
||||
@[{:jolt/type :symbol :ns nil :name "lazy-seq"}
|
||||
@[{:jolt/type :symbol :ns nil :name "let*"}
|
||||
@[sym-x x sym-f f]
|
||||
@[{:jolt/type :symbol :ns nil :name "cons"}
|
||||
sym-x
|
||||
@[{:jolt/type :symbol :ns nil :name "iterate"}
|
||||
sym-f
|
||||
@[{:jolt/type :symbol :ns nil :name sym-f} sym-x]]]]])
|
||||
|
||||
(defn core-repeatedly [n f]
|
||||
(var result @[])
|
||||
(var i 0)
|
||||
|
|
@ -522,9 +552,15 @@
|
|||
(table/to-struct result))
|
||||
|
||||
(defn core-hash-set [& xs]
|
||||
(var result @{})
|
||||
(each x xs (put result x true))
|
||||
{:jolt/type :jolt/set :value (tuple ;(keys result))})
|
||||
(apply make-phs xs))
|
||||
|
||||
(defn core-set? [x] (set? x))
|
||||
(defn core-disj [s & ks]
|
||||
(if (set? s) (apply phs-disj s ks) (error "disj expects a set")))
|
||||
|
||||
(defn core-lazy-seq [& body]
|
||||
@[{:jolt/type :symbol :ns nil :name "make-lazy-seq"}
|
||||
@[{:jolt/type :symbol :ns nil :name "fn*"} [] ;body]])
|
||||
|
||||
(defn core-set [coll]
|
||||
(apply core-hash-set (if (tuple? coll) (array/slice coll) coll)))
|
||||
|
|
@ -1104,6 +1140,7 @@
|
|||
"partition-by" core-partition-by
|
||||
"range" core-range
|
||||
"repeat" core-repeat
|
||||
"iterate" core-iterate
|
||||
"repeatedly" core-repeatedly
|
||||
"identity" core-identity
|
||||
"constantly" core-constantly
|
||||
|
|
@ -1118,6 +1155,10 @@
|
|||
"hash-set" core-hash-set
|
||||
"set" core-set
|
||||
"list" core-list
|
||||
"set?" core-set?
|
||||
"disj" core-disj
|
||||
"lazy-seq" core-lazy-seq
|
||||
"make-lazy-seq" make-lazy-seq
|
||||
"str" core-str
|
||||
"name" core-name
|
||||
"subs" core-subs
|
||||
|
|
@ -1229,7 +1270,7 @@
|
|||
(defn core-macro-names
|
||||
"Set of core binding names that are macros."
|
||||
[]
|
||||
@{"and" true "or" true "when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "doto" true "defn" true "defn-" true "declare" true "fn" true "let" true "loop" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true "binding" true})
|
||||
@{"and" true "or" true "when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "doto" true "defn" true "defn-" true "declare" true "fn" true "let" true "loop" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true "binding" true "lazy-seq" true})
|
||||
|
||||
(def init-core!
|
||||
(fn [& args]
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
# Direct interpreter for Clojure forms on Janet.
|
||||
|
||||
(use ./types)
|
||||
(use ./phm)
|
||||
|
||||
(defn- sym-name?
|
||||
[sym-s name-str]
|
||||
|
|
@ -18,7 +19,8 @@
|
|||
(= name "deftype") (= name "new") (= name ".")
|
||||
(= name "var-get") (= name "var-set") (= name "var?")
|
||||
(= name "alter-var-root") (= name "find-var") (= name "intern")
|
||||
(= name "alter-meta!") (= name "reset-meta!")))
|
||||
(= name "alter-meta!") (= name "reset-meta!")
|
||||
(= name "disj") (= name "set?")))
|
||||
|
||||
(var eval-form nil)
|
||||
|
||||
|
|
@ -602,6 +604,12 @@
|
|||
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))
|
||||
"disj" (let [s (eval-form ctx bindings (in form 1))
|
||||
ks (map |(eval-form ctx bindings $) (tuple/slice form 2))]
|
||||
(if (set? s)
|
||||
(apply phs-disj s ks)
|
||||
(error "disj expects a set")))
|
||||
"set?" (set? (eval-form ctx bindings (in form 1)))
|
||||
"locking" (eval-form ctx bindings (in form 2))
|
||||
"instance?" (let [type-sym (in form 1)
|
||||
val (eval-form ctx bindings (in form 2))]
|
||||
|
|
@ -785,6 +793,8 @@
|
|||
(struct? form)
|
||||
(if (= :symbol (form :jolt/type))
|
||||
(resolve-sym ctx bindings form)
|
||||
(if (= :jolt/set (form :jolt/type))
|
||||
(apply make-phs (form :value))
|
||||
(if (= :jolt/tagged (form :jolt/type))
|
||||
(let [tag (form :tag)
|
||||
data-readers (get (ctx :env) :data-readers)
|
||||
|
|
@ -794,7 +804,7 @@
|
|||
(error (string "No reader function for tag " tag))))
|
||||
(if (get form :jolt/type)
|
||||
(error (string "Unexpected tagged form: " (form :jolt/type)))
|
||||
form)))
|
||||
form))))
|
||||
(array? form)
|
||||
(if (= 0 (length form))
|
||||
@[]
|
||||
|
|
|
|||
|
|
@ -98,6 +98,12 @@
|
|||
(++ bi))
|
||||
(table/to-struct result))
|
||||
|
||||
(defn phm-count [m] (m :cnt))
|
||||
|
||||
(defn phm-contains? [m k]
|
||||
(let [bucket (get (m :buckets) (phm-hash-key k))]
|
||||
(if bucket (phm-bucket-contains? bucket k) false)))
|
||||
|
||||
(defn make-phm [&opt kvs]
|
||||
(default kvs nil)
|
||||
(var m @{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap"
|
||||
|
|
@ -106,3 +112,85 @@
|
|||
(var i 0) (var n (length kvs))
|
||||
(while (< i n) (set m (phm-assoc m (kvs i) (kvs (+ i 1)))) (+= i 2)))
|
||||
m)
|
||||
|
||||
# ============================================================
|
||||
# LazySeq — realize-once lazy sequence
|
||||
# ============================================================
|
||||
|
||||
(defn lazy-seq?
|
||||
"Check if x is a LazySeq."
|
||||
[x]
|
||||
(and (table? x) (= :jolt/lazy-seq (x :jolt/type))))
|
||||
|
||||
(defn- realize-ls
|
||||
"Force a LazySeq. Returns the realized value, caching it."
|
||||
[ls]
|
||||
(if (get ls :realized)
|
||||
(ls :val)
|
||||
(let [v ((ls :fn))
|
||||
vf (if (lazy-seq? v) (realize-ls v) v)]
|
||||
(put ls :realized true)
|
||||
(put ls :val vf)
|
||||
vf)))
|
||||
|
||||
(defn ls-first [ls]
|
||||
(let [val (realize-ls ls)]
|
||||
(if (nil? val) nil
|
||||
(if (and (indexed? val) (> (length val) 0)) (in val 0) nil))))
|
||||
|
||||
(defn ls-rest [ls]
|
||||
(let [val (realize-ls ls)]
|
||||
(if (nil? val) nil
|
||||
(if (indexed? val) (if (tuple? val) (tuple/slice val 1) (array/slice val 1)) nil))))
|
||||
|
||||
(defn ls-seq [ls]
|
||||
(let [val (realize-ls ls)]
|
||||
(when val (if (tuple? val) (tuple/slice val) (if (array? val) (array/slice val) val)))))
|
||||
|
||||
(defn ls-count [ls]
|
||||
(let [val (realize-ls ls)]
|
||||
(if (nil? val) 0 (length val))))
|
||||
|
||||
(defn make-lazy-seq [thunk]
|
||||
@{:jolt/type :jolt/lazy-seq :fn thunk :realized false :val nil})
|
||||
|
||||
# ============================================================
|
||||
# PersistentHashSet — backed by PersistentHashMap
|
||||
# ============================================================
|
||||
|
||||
(defn set?
|
||||
"Check if x is a PersistentHashSet."
|
||||
[x]
|
||||
(and (table? x) (= :jolt/set (x :jolt/type))))
|
||||
|
||||
(defn make-phs [& xs]
|
||||
"Create a PersistentHashSet from items."
|
||||
(var m (make-phm))
|
||||
(each x xs (set m (phm-assoc m x true)))
|
||||
@{:jolt/type :jolt/set :phm m :cnt (phm-count m)})
|
||||
|
||||
(defn phs-conj [s & xs]
|
||||
(var m (s :phm))
|
||||
(each x xs (set m (phm-assoc m x true)))
|
||||
@{:jolt/type :jolt/set :phm m :cnt (phm-count m)})
|
||||
|
||||
(defn phs-disj [s & xs]
|
||||
(var m (s :phm))
|
||||
(each x xs (set m (phm-dissoc m x)))
|
||||
@{:jolt/type :jolt/set :phm m :cnt (phm-count m)})
|
||||
|
||||
(defn phs-contains? [s x]
|
||||
(phm-contains? (s :phm) x))
|
||||
|
||||
(defn phs-count [s]
|
||||
(s :cnt))
|
||||
|
||||
(defn phs-empty? [s]
|
||||
(= 0 (s :cnt)))
|
||||
|
||||
(defn phs-seq [s]
|
||||
(tuple ;(keys (phm-to-struct (s :phm)))))
|
||||
|
||||
(defn phs-get [s x &opt default]
|
||||
(default default nil)
|
||||
(if (phm-contains? (s :phm) x) x default))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue