diff --git a/.gitignore b/.gitignore index e0c09fd9..791e9204 100644 --- a/.gitignore +++ b/.gitignore @@ -40,3 +40,6 @@ pom.xml.asc .lein-repl-history *.class +*.extract-native-dependencies +*.swp +*.swo diff --git a/README.md b/README.md index 34e3982e..515cfac8 100644 --- a/README.md +++ b/README.md @@ -14,7 +14,7 @@ quantum ![](./doc/readme-image.jpg) *(Image credit: @deviantart/deepbluerenegade, "Bubble Chamber")* -- +--- To paraphrase the [poet of xkcd](http://xkcd.com/224/): @@ -33,7 +33,7 @@ To paraphrase the [poet of xkcd](http://xkcd.com/224/): `quantum`. Summary -- +--- ``` Java -> Google Guava @@ -56,7 +56,7 @@ and others. It aims to unify and abstract away conceptually irrelevant implement It adapts, in the author's opinion, the best and most useful functions from existing libraries (in accordance with their respective copyrights) and adds much more of its own. General Usage -- +--- **In `project.clj`:** @@ -71,12 +71,12 @@ Walkthrough and Code Examples - This library is big enough to be split into numerous sub-libraries. Someday I'll do just that (using `lein-repack`, as zcaudate/hara, whose rationale is explained [here](http://z.caudate.me/finding-a-middle-ground/)). For now, it's an admittedly monolithic, though well-organized, library. I don't like the Clojure approach of "have one library that only does this one thing" because it often leads to an unhealthy amount of disunity and disorganization. Better to import/require the library and abstract it under a more universal name. If there are various implementations of the same thing, `quantum` abstracts it to a function which calls your desired implementation, but defaults to the most sensible one. -###quantum.core.* +### quantum.core.* The "meat" of Quantum is in [quantum.core.*](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core). Among many other functions and namespaces, it includes the following: -####[quantum.core.macros](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/macros.cljc) -#####`defnt` +#### [quantum.core.macros](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/macros.cljc) +##### `defnt` `defnt` is a way of defining a strongly typed function without resorting to using the un-function-like syntax of `defprotocol` and/or using the tedious `reify`. An example of it is the following: ``` @@ -96,19 +96,19 @@ As another example, if three entirely unrelated objects all use `.quit` to free ``` Voila! No type hints needed anymore, and no performance hit or repetitive code with `cond` + `instance?` checks. -####[quantum.core.thread](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/thread.cljc) +#### [quantum.core.thread](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/thread.cljc) Sane global thread(pool) management. I was tired of core.async/go blocks hanging and me not being able to interrupt/cancel them. Also I was tired of having them all run on one threadpool. -####[quantum.core.convert](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/convert.cljc) +#### [quantum.core.convert](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/convert.cljc) Easy type conversion (e.g. among InputStream, ByteBuffer, CharSequence, String, File etc.). Much of the code is adapted from [ztellman/byte-streams](https://github.com/ztellman/byte-streams) into a [`defnt`](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/macros.cljc) context (as opposed to the memoized graph-walking of [`byte-streams/convert`](https://github.com/ztellman/byte-streams/blob/master/src/byte_streams.clj), which is quite admittedly quite innovative, as is characteristic of Zach Tellman). Other conversions have been added to make it more universal and less restricted to variations of byte streams and buffers. -####[quantum.core.cryptography](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/cryptography.cljc) +#### [quantum.core.cryptography](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/cryptography.cljc) Abstractions for cryptography functions including bcrypt, scrypt, etc., and also so you don't have to remember every time how those annoying javax.crypto.* namespaces work. Similar rationale as [ztellman/byte-streams](https://github.com/ztellman/byte-streams) — a cryptographic Rosetta Stone of sorts. -####[quantum.core.reducers](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/reducers.cljc) +#### [quantum.core.reducers](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/reducers.cljc) Reducers operations in quantum.core.reducers (exposed via quantum.core.collections) so you can do chains of operations like: ``` @@ -120,44 +120,44 @@ Reducers operations in quantum.core.reducers (exposed via quantum.core.collectio ``` without creating intermediate sequences or incurring the cost of laziness. This has already been accomplished in [clojure.core.reducers](http://clojure.org/reducers), so it's not a new idea, but it does add various reducer functions to the existing clojure.core.reducers ones. -####[quantum.core.log](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/log.cljc) +#### [quantum.core.log](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/core/log.cljc) Easy logging which uses macros + conditionals so you don't incur the cost of always performing whatever the arguments are to your logging function even if you're not enabling that logging level. -###The rest of Quantum +### The rest of Quantum -####[quantum.compile.core](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/compile/core.cljc) -#####`transpile` +#### [quantum.compile.core](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/compile/core.cljc) +##### `transpile` (Alpha-quality) language translation from e.g. Clojure to Java, Java to Clojure, Clojure to C#, Java to C# by way of Clojure, Clojure to (raw) JavaScript, etc. You might use it when you want to write something out and test it in Clojure but need to deliver the code in a different language. -####[quantum.measure.convert](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/measure/convert.cljc) -#####`convert` +#### [quantum.measure.convert](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/measure/convert.cljc) +##### `convert` Conversion from any unit of measurement to any other (compatible) unit of measurement (at least the ones I've added so far). It does this by walking a graph at compile time (like the one in src/cljc/quantum/measure/length.cljc) and replacing the conversion inline if sufficiently short. For instance, one can write (convert :parsecs :ft) instead of having to remember what the parsecs-to-feet conversion is. I believe I've also added runtime support for this so you can dynamically change the unit keywords. -####[quantum.ui.*](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/ui/) +#### [quantum.ui.*](https://github.com/alexandergunnarson/quantum/tree/master/src/cljc/quantum/ui/) UI-related things, specifically HTML5 and JavaFX so far. It needs more work, but it's served me well fo e.g. revision management in JavaFX (via the undo! and redo! functions especially), as well as for easier creation of JavaFX nodes via a declarative [Hiccup](https://github.com/weavejester/hiccup/)-like syntax as opposed to the standard procedural one. Performance -- +--- -#####Reducers +##### Reducers It uses clojure.reducers wherever possible to maximize performance, but falls back on clojure.core collections functions when laziness is required or desired, or when the overhead of creating an anonymous function within `reduce` is greater than the overhead eliminated by using `reduce` instead of [`first` and [`next` or `rest`] within `loop`/`recur`]. -#####Transients and Mutable Locals +##### Transients and Mutable Locals It uses transients and/or mutable local variables wherever a performance boost can be achieved by such. Expectations -- +--- This is a work in progress and, as such, is currently in no way as rich and polished a library as I hope it to ultimately be. When you find bugs (and you will), please report the issue(s) and/or create a pull request. -I've been coding in Clojure for over two years, but expect some rustiness. Expect some gems as well. +I've been coding in Clojure for five years, but expect some rustiness. Expect some gems as well. I welcome any and all contributions, comments, thoughts, suggestions, and/or feedback you may wish to provide. This endeavor towards greater efficiency in thought, processing power, and time spent programming should be a joint one. Appendix -- +--- -###Why is `quantum` a monorepo? +### Why is `quantum` a monorepo? *TL;DR:* It's *much* easier and has few (if any) real disadvantages. @@ -170,12 +170,12 @@ React, Meteor, and Ember follow this pattern. See [here](https://github.com/babel/babel/blob/master/doc/design/monorepo.md) and [here](http://danluu.com/monorepo/) for a more complete justification. -###Good practices for dependency hell +### Good practices for dependency hell - When two dependencies A and B have a conflicting common dependency C, try to explicitly declare C and its version in the project.clj and annotate the conflict. Copyright and License -- +--- *Copyright © 2017 Alex Gunnarson* *Distributed under the Creative Commons Attribution-ShareAlike 3.0 US (CC-SA) license.* diff --git a/benchmarks/jvm.clj b/benchmarks/jvm.clj index d563621a..abe8d80a 100644 --- a/benchmarks/jvm.clj +++ b/benchmarks/jvm.clj @@ -1,20 +1,24 @@ (ns quantum.test.benchmarks.jvm (:require - [quantum.core.macros.defnt + [criterium.core + :refer [bench quick-bench]] + #_[quantum.core.macros.defnt :refer [defnt defnt' defntp]] - [quantum.core.collections :as coll - :refer [reduce-pair]] - [quantum.core.meta.bench - :refer [bench complete-bench]] - [quantum.core.type :as t - :refer [static-cast]]) + [quantum.untyped.core.form.type-hint + :refer [static-cast]] + [quantum.untyped.core.reducers + :refer [reduce-pair]]) (:import [quantum.core Numeric Fn] [quantum.core.data Array] [clojure.lang BigInt] + [it.unimi.dsi.fastutil.ints Int2ObjectOpenHashMap] [java.util Map HashMap IdentityHashMap] - [java.lang.invoke MethodHandle MethodHandles MethodType] - #_[cern.colt.map OpenIntObjectHashMap])) + [java.lang.invoke MethodHandle MethodHandles MethodType])) + +;; To avoid extraneous overhead from a loop +(defmacro repeat-test [n expr] + `(do ~@(for [i (range n)] expr))) ; TODO try to use static methods instead of `invokevirtual` on the `reify`? @@ -283,123 +287,66 @@ ~(compile-hash Double) (+*-static (double x#) (double y#)))))) ; ===== LOOKUP MAP, IMMUTABLE ===== ; +;; Could have done something like `(reify Primitive (invoke [^whatever0 x ^whatever1 y] ...))` but +;; then when we went to call the retrieved fn we wouldn't know what input classes to call it with (defn gen-dispatch-map [create-map] (create-map Byte (create-map - Byte (fn [x y] (+*-static (byte x) (byte y))) - Character (fn [x y] (+*-static (byte x) (char y))) - Short (fn [x y] (+*-static (byte x) (short y))) - Integer (fn [x y] (+*-static (byte x) (int y))) - Long (fn [x y] (+*-static (byte x) (long y))) - Float (fn [x y] (+*-static (byte x) (float y))) - Double (fn [x y] (+*-static (byte x) (double y)))) - Character (create-map - Byte (fn [x y] (+*-static (char x) (byte y))) - Character (fn [x y] (+*-static (char x) (char y))) - Short (fn [x y] (+*-static (char x) (short y))) - Integer (fn [x y] (+*-static (char x) (int y))) - Long (fn [x y] (+*-static (char x) (long y))) - Float (fn [x y] (+*-static (char x) (float y))) - Double (fn [x y] (+*-static (char x) (double y)))) - Short (create-map - Byte (fn [x y] (+*-static (short x) (byte y))) - Character (fn [x y] (+*-static (short x) (char y))) - Short (fn [x y] (+*-static (short x) (short y))) - Integer (fn [x y] (+*-static (short x) (int y))) - Long (fn [x y] (+*-static (short x) (long y))) - Float (fn [x y] (+*-static (short x) (float y))) - Double (fn [x y] (+*-static (short x) (double y)))) - Integer (create-map - Byte (fn [x y] (+*-static (int x) (byte y))) - Character (fn [x y] (+*-static (int x) (char y))) - Short (fn [x y] (+*-static (int x) (short y))) - Integer (fn [x y] (+*-static (int x) (int y))) - Long (fn [x y] (+*-static (int x) (long y))) - Float (fn [x y] (+*-static (int x) (float y))) - Double (fn [x y] (+*-static (int x) (double y)))) - Long (create-map - Byte (fn [x y] (+*-static (long x) (byte y))) - Character (fn [x y] (+*-static (long x) (char y))) - Short (fn [x y] (+*-static (long x) (short y))) - Integer (fn [x y] (+*-static (long x) (int y))) - Long (fn [x y] (+*-static (long x) (long y))) - Float (fn [x y] (+*-static (long x) (float y))) - Double (fn [x y] (+*-static (long x) (double y)))) - Float (create-map - Byte (fn [x y] (+*-static (float x) (byte y))) - Character (fn [x y] (+*-static (float x) (char y))) - Short (fn [x y] (+*-static (float x) (short y))) - Integer (fn [x y] (+*-static (float x) (int y))) - Long (fn [x y] (+*-static (float x) (long y))) - Float (fn [x y] (+*-static (float x) (float y))) - Double (fn [x y] (+*-static (float x) (double y)))) - Double (create-map - Byte (fn [x y] (+*-static (double x) (byte y))) - Character (fn [x y] (+*-static (double x) (char y))) - Short (fn [x y] (+*-static (double x) (short y))) - Integer (fn [x y] (+*-static (double x) (int y))) - Long (fn [x y] (+*-static (double x) (long y))) - Float (fn [x y] (+*-static (double x) (float y))) - Double (fn [x y] (+*-static (double x) (double y)))))) - -(defn gen-inlined-dispatch-map [create-map] - (create-map - Byte (create-map - Byte (fn [x y] (Numeric/add (byte x) (byte y))) - Character (fn [x y] (Numeric/add (byte x) (char y))) - Short (fn [x y] (Numeric/add (byte x) (short y))) - Integer (fn [x y] (Numeric/add (byte x) (int y))) - Long (fn [x y] (Numeric/add (byte x) (long y))) - Float (fn [x y] (Numeric/add (byte x) (float y))) - Double (fn [x y] (Numeric/add (byte x) (double y)))) + Byte (fn [x y] (Numeric/add (unchecked-byte x) (unchecked-byte y))) + Character (fn [x y] (Numeric/add (unchecked-byte x) (unchecked-char y))) + Short (fn [x y] (Numeric/add (unchecked-byte x) (unchecked-short y))) + Integer (fn [x y] (Numeric/add (unchecked-byte x) (unchecked-int y))) + Long (fn [x y] (Numeric/add (unchecked-byte x) (unchecked-long y))) + Float (fn [x y] (Numeric/add (unchecked-byte x) (unchecked-float y))) + Double (fn [x y] (Numeric/add (unchecked-byte x) (unchecked-double y)))) Character (create-map - Byte (fn [x y] (Numeric/add (char x) (byte y))) - Character (fn [x y] (Numeric/add (char x) (char y))) - Short (fn [x y] (Numeric/add (char x) (short y))) - Integer (fn [x y] (Numeric/add (char x) (int y))) - Long (fn [x y] (Numeric/add (char x) (long y))) - Float (fn [x y] (Numeric/add (char x) (float y))) - Double (fn [x y] (Numeric/add (char x) (double y)))) + Byte (fn [x y] (Numeric/add (unchecked-char x) (unchecked-byte y))) + Character (fn [x y] (Numeric/add (unchecked-char x) (unchecked-char y))) + Short (fn [x y] (Numeric/add (unchecked-char x) (unchecked-short y))) + Integer (fn [x y] (Numeric/add (unchecked-char x) (unchecked-int y))) + Long (fn [x y] (Numeric/add (unchecked-char x) (unchecked-long y))) + Float (fn [x y] (Numeric/add (unchecked-char x) (unchecked-float y))) + Double (fn [x y] (Numeric/add (unchecked-char x) (unchecked-double y)))) Short (create-map - Byte (fn [x y] (Numeric/add (short x) (byte y))) - Character (fn [x y] (Numeric/add (short x) (char y))) - Short (fn [x y] (Numeric/add (short x) (short y))) - Integer (fn [x y] (Numeric/add (short x) (int y))) - Long (fn [x y] (Numeric/add (short x) (long y))) - Float (fn [x y] (Numeric/add (short x) (float y))) - Double (fn [x y] (Numeric/add (short x) (double y)))) + Byte (fn [x y] (Numeric/add (unchecked-short x) (unchecked-byte y))) + Character (fn [x y] (Numeric/add (unchecked-short x) (unchecked-char y))) + Short (fn [x y] (Numeric/add (unchecked-short x) (unchecked-short y))) + Integer (fn [x y] (Numeric/add (unchecked-short x) (unchecked-int y))) + Long (fn [x y] (Numeric/add (unchecked-short x) (unchecked-long y))) + Float (fn [x y] (Numeric/add (unchecked-short x) (unchecked-float y))) + Double (fn [x y] (Numeric/add (unchecked-short x) (unchecked-double y)))) Integer (create-map - Byte (fn [x y] (Numeric/add (int x) (byte y))) - Character (fn [x y] (Numeric/add (int x) (char y))) - Short (fn [x y] (Numeric/add (int x) (short y))) - Integer (fn [x y] (Numeric/add (int x) (int y))) - Long (fn [x y] (Numeric/add (int x) (long y))) - Float (fn [x y] (Numeric/add (int x) (float y))) - Double (fn [x y] (Numeric/add (int x) (double y)))) + Byte (fn [x y] (Numeric/add (unchecked-int x) (unchecked-byte y))) + Character (fn [x y] (Numeric/add (unchecked-int x) (unchecked-char y))) + Short (fn [x y] (Numeric/add (unchecked-int x) (unchecked-short y))) + Integer (fn [x y] (Numeric/add (unchecked-int x) (unchecked-int y))) + Long (fn [x y] (Numeric/add (unchecked-int x) (unchecked-long y))) + Float (fn [x y] (Numeric/add (unchecked-int x) (unchecked-float y))) + Double (fn [x y] (Numeric/add (unchecked-int x) (unchecked-double y)))) Long (create-map - Byte (fn [x y] (Numeric/add (long x) (byte y))) - Character (fn [x y] (Numeric/add (long x) (char y))) - Short (fn [x y] (Numeric/add (long x) (short y))) - Integer (fn [x y] (Numeric/add (long x) (int y))) - Long (fn [x y] (Numeric/add (long x) (long y))) - Float (fn [x y] (Numeric/add (long x) (float y))) - Double (fn [x y] (Numeric/add (long x) (double y)))) + Byte (fn [x y] (Numeric/add (unchecked-long x) (unchecked-byte y))) + Character (fn [x y] (Numeric/add (unchecked-long x) (unchecked-char y))) + Short (fn [x y] (Numeric/add (unchecked-long x) (unchecked-short y))) + Integer (fn [x y] (Numeric/add (unchecked-long x) (unchecked-int y))) + Long (fn [x y] (Numeric/add (unchecked-long x) (unchecked-long y))) + Float (fn [x y] (Numeric/add (unchecked-long x) (unchecked-float y))) + Double (fn [x y] (Numeric/add (unchecked-long x) (unchecked-double y)))) Float (create-map - Byte (fn [x y] (Numeric/add (float x) (byte y))) - Character (fn [x y] (Numeric/add (float x) (char y))) - Short (fn [x y] (Numeric/add (float x) (short y))) - Integer (fn [x y] (Numeric/add (float x) (int y))) - Long (fn [x y] (Numeric/add (float x) (long y))) - Float (fn [x y] (Numeric/add (float x) (float y))) - Double (fn [x y] (Numeric/add (float x) (double y)))) + Byte (fn [x y] (Numeric/add (unchecked-float x) (unchecked-byte y))) + Character (fn [x y] (Numeric/add (unchecked-float x) (unchecked-char y))) + Short (fn [x y] (Numeric/add (unchecked-float x) (unchecked-short y))) + Integer (fn [x y] (Numeric/add (unchecked-float x) (unchecked-int y))) + Long (fn [x y] (Numeric/add (unchecked-float x) (unchecked-long y))) + Float (fn [x y] (Numeric/add (unchecked-float x) (unchecked-float y))) + Double (fn [x y] (Numeric/add (unchecked-float x) (unchecked-double y)))) Double (create-map - Byte (fn [x y] (Numeric/add (double x) (byte y))) - Character (fn [x y] (Numeric/add (double x) (char y))) - Short (fn [x y] (Numeric/add (double x) (short y))) - Integer (fn [x y] (Numeric/add (double x) (int y))) - Long (fn [x y] (Numeric/add (double x) (long y))) - Float (fn [x y] (Numeric/add (double x) (float y))) - Double (fn [x y] (Numeric/add (double x) (double y)))))) + Byte (fn [x y] (Numeric/add (unchecked-double x) (unchecked-byte y))) + Character (fn [x y] (Numeric/add (unchecked-double x) (unchecked-char y))) + Short (fn [x y] (Numeric/add (unchecked-double x) (unchecked-short y))) + Integer (fn [x y] (Numeric/add (unchecked-double x) (unchecked-int y))) + Long (fn [x y] (Numeric/add (unchecked-double x) (unchecked-long y))) + Float (fn [x y] (Numeric/add (unchecked-double x) (unchecked-float y))) + Double (fn [x y] (Numeric/add (unchecked-double x) (unchecked-double y)))))) (def dispatch-map (gen-dispatch-map hash-map)) @@ -410,35 +357,53 @@ ; ===== LOOKUP MAP, MUTABLE ===== ; -(defn map!* [constructor & args] - (assert (-> args count even?)) - (reduce-pair (fn [ret k v] (.put ^Map ret k v) ret) (constructor) args)) +(defn map!* [constructor & kvs] + (assert (-> kvs count even?)) + (reduce-pair (fn [ret k v] (.put ^Map ret k v) ret) (constructor) kvs)) (def hash-map! (partial map!* #(HashMap.))) -(def ^HashMap dispatch-map-mutable (gen-dispatch-map hash-map!)) +(def ^HashMap !dispatch-map (gen-dispatch-map hash-map!)) -(defn dispatch-with-map-mutable [x y] - (let [f (some-> dispatch-map-mutable ^HashMap (.get (class x)) (.get (class y)))] - (assert (some? f)) - (f x y))) +(defn dispatch-with-!map [x y] + (if-some [a0 (.get !dispatch-map (clojure.lang.Util/classOf x))] + (if-some [a1 (.get ^HashMap a0 (clojure.lang.Util/classOf y))] + (.invoke ^clojure.lang.IFn a1 x y) + (throw (Exception. "Method not found"))) + (throw (Exception. "Method not found")))) ; ===== LOOKUP MAP, IDENTITY MUTABLE ===== ; (def identity-hash-map! (partial map!* #(IdentityHashMap.))) -(def ^IdentityHashMap dispatch-identity-map-mutable (gen-dispatch-map identity-hash-map!)) +(def ^IdentityHashMap !dispatch-identity-map (gen-dispatch-map identity-hash-map!)) -(defn dispatch-with-identity-map-mutable [x y] - (if-let [a0 (.get dispatch-identity-map-mutable (clojure.lang.Util/classOf x))] - (if-let [a1 (.get ^IdentityHashMap a0 (clojure.lang.Util/classOf y))] - (a1 x y) +(defn dispatch-with-!identity-map [x y] + (if-some [a0 (.get !dispatch-identity-map (clojure.lang.Util/classOf x))] + (if-some [a1 (.get ^IdentityHashMap a0 (clojure.lang.Util/classOf y))] + (.invoke ^clojure.lang.IFn a1 x y) (throw (Exception. "Method not found"))) (throw (Exception. "Method not found")))) ; ===== LOOKUP MAP, INT->OBJECT MUTABLE ===== ; -; Colt's OpenIntObjectHashMap doesn't help here +(defn >!int-map [& kvs] + (assert (-> kvs count even?)) + (reduce-pair + (fn [ret k v] (.put ^Int2ObjectOpenHashMap ret (System/identityHashCode k) v) ret) + (Int2ObjectOpenHashMap.) + kvs)) + +(def ^Int2ObjectOpenHashMap !dispatch-int-map (gen-dispatch-map >!int-map)) + +(defn dispatch-with-!int-map [x y] + (if-some [a0 (.get !dispatch-int-map + (-> x clojure.lang.Util/classOf System/identityHashCode))] + (if-some [a1 (.get ^Int2ObjectOpenHashMap a0 + (-> y clojure.lang.Util/classOf System/identityHashCode))] + (.invoke ^clojure.lang.IFn a1 x y) + (throw (Exception. "Method not found"))) + (throw (Exception. "Method not found")))) ; ===== CUSTOMIZED (CLOJURE NUMERICS) ===== ; @@ -456,11 +421,11 @@ (.unreflect Fn/fnLookup (.getMethod (class +*-static-reified) "_PLUS__STAR_Static"))) ; 13.650164 ns -(complete-bench (do (Fn/invoke method-double-double +*-static-reified 1.0 3.0) - #_(Fn/invoke method +*-static-reified 1 3 ))) +(bench (do (Fn/invoke method-double-double +*-static-reified 1.0 3.0) + #_(Fn/invoke method +*-static-reified 1 3 ))) -(complete-bench (do (Fn/invoke method +*-static-reified 1.0 3.0) - #_(Fn/invoke method +*-static-reified 1 3 ))) +(bench (do (Fn/invoke method +*-static-reified 1.0 3.0) + #_(Fn/invoke method +*-static-reified 1 3 ))) ; ===== BENCHMARKS ===== ; @@ -468,74 +433,78 @@ ; It's more fair to benchmark this way. ; Also, all benchmarks were run multiple times to ensure complete and utter JVM warmup. -; 4.911254 ns -(complete-bench (do (+ 1.0 3.0) - (+ 1 3 ))) +; 4.911254 ns (2.983740 ns new computer) +(bench (do (+ 1.0 3.0) + (+ 1 3 ))) ; Same time -(complete-bench (do (Numeric/add 1.0 3.0) - (Numeric/add 1 3 ))) +(bench (do (Numeric/add 1.0 3.0) + (Numeric/add 1 3 ))) ; 5.970614 ns ; May currently have slightly worse performance since it isn't inlined, and is an instance instead of a static method (let [^quantum.test.benchmarks.jvm._PLUS__STAR_StaticInterface +*-static-reified-direct @#'+*-static-reified] ; to get rid of var indirection, which can't be optimized away by the JVM because is marked as `volatile` - (complete-bench (do (. +*-static-reified-direct _PLUS__STAR_Static 1.0 3.0) + (bench (do (. +*-static-reified-direct _PLUS__STAR_Static 1.0 3.0) (. +*-static-reified-direct _PLUS__STAR_Static 1 3 )))) ; 6.361026 ns ; May currently have slightly worse performance since it isn't inlined, and is an instance instead of a static method -(complete-bench (do (+*-static 1.0 3.0) - (+*-static 1 3 ))) +(bench (do (+*-static 1.0 3.0) + (+*-static 1 3 ))) + +; 14.300336 ns new computer, 4.79x +(bench (do (dispatch-with-!int-map 1.0 3.0) + (dispatch-with-!int-map 1 3 ))) -; 22.369795 ns (4.55x) -(complete-bench (do (argtypes-unknown 1.0 3.0) - (argtypes-unknown 1 3 ))) +; 22.369795 ns (4.55x) (18.556532 ns new computer) +(bench (do (argtypes-unknown 1.0 3.0) + (argtypes-unknown 1 3 ))) ; 30.778042 ns (6.27x) (on first run is 23.467812 ns, 4.78x) -(complete-bench (do (Fn/dispatch2 dispatch-identity-map-mutable 1.0 3.0) - (Fn/dispatch2 dispatch-identity-map-mutable 1 3 ))) +(bench (do (Fn/dispatch2 !dispatch-identity-map 1.0 3.0) + (Fn/dispatch2 !dispatch-identity-map 1 3 ))) ; 34.343497 ns -#_(complete-bench (do (Fn/dispatch2 dispatch-map-mutable 1.0 3.0) - (Fn/dispatch2 dispatch-map-mutable 1 3 ))) +#_(bench (do (Fn/dispatch2 !dispatch-map 1.0 3.0) + (Fn/dispatch2 !dispatch-map 1 3 ))) ; 37.636059 ns (7.66x) -(complete-bench (do (case-hash-dispatch 1.0 3.0) - (case-hash-dispatch 1 3 ))) +(bench (do (case-hash-dispatch 1.0 3.0) + (case-hash-dispatch 1 3 ))) ; 38.843166 ns -(complete-bench (do (case-string-dispatch 1.0 3.0) - (case-string-dispatch 1 3 ))) +(bench (do (case-string-dispatch 1.0 3.0) + (case-string-dispatch 1 3 ))) ; 51.184897 ns (10.42x) (on first run is 33.707466 ns, 6.86x) -(complete-bench (do (+*-protocol-0 1.0 3.0) - (+*-protocol-0 1 3 ))) +(bench (do (+*-protocol-0 1.0 3.0) + (+*-protocol-0 1 3 ))) -; 40.611242 ns -(complete-bench (do (dispatch-with-identity-map-mutable 1.0 3.0) - (dispatch-with-identity-map-mutable 1 3 ))) +; 40.611242 ns (15.944187 ns new computer) +(bench (do (dispatch-with-!identity-map 1.0 3.0) + (dispatch-with-!identity-map 1 3 ))) -; 42.714549 ns -(complete-bench (do (dispatch-with-map-mutable 1.0 3.0) - (dispatch-with-map-mutable 1 3 ))) +; 42.714549 ns (19.076145 ns new computer) +(bench (do (dispatch-with-!map 1.0 3.0) + (dispatch-with-!map 1 3 ))) ; 48.844710 ns -(complete-bench (do (dispatch 1.0 3.0) - (dispatch 1 3 ))) +(bench (do (dispatch 1.0 3.0) + (dispatch 1 3 ))) ; 79.343540 ns -#_(complete-bench (do (dispatch-with-int->object-map-mutable 1.0 3.0) +#_(bench (do (dispatch-with-int->object-map-mutable 1.0 3.0) (dispatch-with-int->object-map-mutable 1 3 ))) ; 188.686935 ns -(complete-bench (.invokeWithArguments method (Array/newObjectArray +*-static-reified 1.0 3.0))) +(bench (.invokeWithArguments method (Array/newObjectArray +*-static-reified 1.0 3.0))) ; 212.066270 ns -(complete-bench (do (dispatch-with-map 1.0 3.0) - (dispatch-with-map 1 3 ))) +(bench (do (dispatch-with-map 1.0 3.0) + (dispatch-with-map 1 3 ))) ; Didn't even complete -(complete-bench +(bench (Fn/invoke (.findVirtual Fn/fnLookup (compile-time-class +*-static-boxed-reified) "_PLUS__STAR_StaticBoxed" @@ -564,37 +533,113 @@ ; 5.580126 ns (let [v [1 2 3 4 5]] - (complete-bench (.get v 3))) + (bench (.get v 3))) ; 7.644827 ns ; will be same as direct dispatch when inlined (let [v [1 2 3 4 5]] - (complete-bench (quantum.core.collections.core/get v 3))) + (bench (quantum.core.collections.core/get v 3))) ; 10.542661 ns (let [v [1 2 3 4 5]] - (complete-bench (clojure.core/get v 3))) + (bench (clojure.core/get v 3))) ; 10.686585 ns ; because it's on the fast track (let [v [1 2 3 4 5]] - (complete-bench (quantum.core.collections.core/get-protocol v 3))) + (bench (quantum.core.collections.core/get-protocol v 3))) ; 7.438636 ns (let [v (long-array [1 2 3 4 5])] - (complete-bench (clojure.core/aget v 3))) + (bench (clojure.core/aget v 3))) ; 7.649213 ns — statistically equivalent (let [v (long-array [1 2 3 4 5])] - (complete-bench (quantum.core.data.Array/get v 3))) + (bench (quantum.core.data.Array/get v 3))) ; 8.691139 ns (let [v (long-array [1 2 3 4 5])] - (complete-bench (quantum.core.collections.core/get v 3))) + (bench (quantum.core.collections.core/get v 3))) ; 15.832480 ns ; good performance, but not on the fast track (let [v (long-array [1 2 3 4 5])] - (complete-bench (quantum.core.collections.core/get-protocol v 3))) + (bench (quantum.core.collections.core/get-protocol v 3))) ; 53.855997 ns ; semi-reflection going on here (let [v (long-array [1 2 3 4 5])] - (complete-bench (clojure.core/get v 3))) + (bench (clojure.core/get v 3))) + +;; ================================================================================================= +;; Memory strategies: off-heap vs. on-heap +;; +;; Key takeaways: +;; - Perhaps in the small, there isn't much difference +;; - That said, off-heap allocation is an order of magnitude more expensive than on-heap +;; - The real advantages of off-heap are: +;; - Cache locality / memory contiguity +;; - GC-lessness and thus GC-pauselessness + +(def ^sun.misc.Unsafe unsafe + (-> (.getDeclaredField sun.misc.Unsafe "theUnsafe") + (doto (.setAccessible true)) + (.get nil))) + +;; Allocating one byte of off-heap memory: avg 91.902 ns +;; NOTE: This benchmark will allocate a lot of memory that won't be reclaimed till process killed +;; In one case with 161031248 calls it allocated 161031248/1024/1024 -> 154 MB +(let [^sun.misc.Unsafe u unsafe] + (bench (repeat-test 100 (.allocateMemory u 1)))) + +;; Allocating one byte of heap memory: avg 0.0384 ns (or less depending on bench overhead) +;; My guess is that it's being optimized and it knows that it's just being thrown away +(bench (repeat-test 100 (Array/newUninitialized1dByteArray 1))) + +(defmacro gen-off-heap-set-test [n] + `(do ~@(for [i (range n)] + (let [x (byte (rand-int Byte/MAX_VALUE))] `(.putByte ~'u ~'pointer ~x))))) + +;; Writing one byte of off-heap memory: avg 0.0318 ns (or less depending on bench overhead) +;; My guess is that somehow it knows where it's being set and/or knows it's already set? +(let [^sun.misc.Unsafe u unsafe + pointer (.allocateMemory u 1) + b (byte 1)] + (bench (gen-off-heap-set-test 100))) + +(defmacro gen-heap-set-test [n] + `(do ~@(for [i (range n)] + (let [x (byte (rand-int Byte/MAX_VALUE))] `(Array/set ~'bs ~x ~'i))))) + +;; Writing one byte of on-heap memory: avg 0.0329 ns (or less depending on bench overhead) +;; My guess is that somehow it knows where it's being set and/or knows it's already set? +(let [bs (Array/newUninitialized1dByteArray 1) + i (int 0)] + (bench (gen-heap-set-test 100))) + +;; Accessing one byte of off-heap memory: avg 0.0367 ns (or less depending on bench overhead) +;; My guess is that once it's in the register then it only reads from L1 cache at that point +(let [^sun.misc.Unsafe u unsafe + n 100 + pointer (.allocateMemory u 1)] + (bench (repeat-test 100 (.getByte u pointer)))) + +;; Accessing one byte of on-heap memory: 0.0371 ns (or less depending on bench overhead) +;; My guess is that once it's in the register then it only reads from L1 cache at that point +(let [bs (Array/newUninitialized1dByteArray 1) + i (int 0)] + (bench (repeat-test 100 (Array/get bs i)))) + +;; ===== Miscellaneous + +(defmacro gen-incrementing-test [f x n] + `(do ~@(for [i (range n)] `(~f ~(+ x i))))) + +(defmacro abs-bit-shift-test [x] + `(let [mask# (bit-shift-right ~x 32)] + (- (bit-xor ~x mask#) mask#))) + +(defmacro abs-simple-test [x] `(if (< ~x 0) (- ~x) ~x)) + +;; 0.0374 ns avg +(bench (gen-incrementing-test abs-bit-shift-test -100203 100)) + +;; 0.0378 ns avg +(bench (gen-incrementing-test abs-simple-test -100203 100)) diff --git a/doc/cljc/quantum/_performance.md b/doc/cljc/quantum/_performance.md index 61929757..6250157b 100644 --- a/doc/cljc/quantum/_performance.md +++ b/doc/cljc/quantum/_performance.md @@ -2,6 +2,7 @@ https://github.com/druid-io/druid/issues/3892 (Move from `ByteBuffer` to `Memory`) - Yahoo's `Memory` submodule of `DataSketches` is faster than `ByteBuffer` (!) + - https://github.com/DataSketches/memory/tree/master/src/main/java/com/yahoo/memory ## quantum.net.http diff --git a/doc/cljc/quantum/core/defnt.md b/doc/cljc/quantum/core/defnt.md index 96601267..9804dcea 100644 --- a/doc/cljc/quantum/core/defnt.md +++ b/doc/cljc/quantum/core/defnt.md @@ -40,7 +40,7 @@ public class NumberLessThan7 { public final Number x; public NumberLessThan7 (Number x_) { - if (lessThan(x_, 7)) {// imagine here a `lessThan` function that worked on any two numbers + if (lessThan(x_, 7)) {// imagine here a `lessThan` function that worked on any two `Number`s x = x_; } else { throw new Exception("Number must be less than 7"); @@ -228,3 +228,55 @@ Output constraints: Unlike most static languages, a `nil` value is not considered as having a type except that of nil. + +## Why type inference is not a great idea + +Take the below code: + +```clojure +(defnt transduce + ([ f ?, xs ?] (transduce identity f xs)) + ([xf ?, f ?, xs ?] (transduce xf f (f) xs)) + ([xf ?, f ?, init ?, xs ?] + (let [f' (xf f)] (f' (reduce f' init xs))))) +``` + +- For the `f` in the 1-arity overload: + - Inferred from `(transduce identity f xs)` + - The `f` in the 3-arity overload is then inferred: + - We know that `xf` can be called on `f`, so `xf` must be at least a 1-arity `t/callable?` on `f` + - We know that `f'` can be called on `(reduce f' init xs)`, so `xf` must be at least a 1-arity `t/callable?` on `f` + - Other than that we don't really have any information about `f` +- For the `f` in the 2-arity overload: + - We know that `f` can be called with no arguments, so it must be at least a 0-arity `t/callable?` + - We know that it can be passed to `(transduce xf f (f) xs)` + - We tried to infer the `f` in the 3-arity but it can't be known + +It is infeasible to do inferences in the general case for the following reasons: +- The code will be complex and greatly increase time it takes to get any value out of `defnt` +- The code will likely have high computational complexity even if some impressive algorithm comes out of it +- **Even if the code could do it instantly, it would still be a maintenance issue to try to mentally work out for each inference what that ends up being. Labels help quite a lot.** + +I think the best approach is not inference, but rather being able to at least do: +- Input/output specs that rely on the input/output specs of other spec'ed fns +- Conditional specs + +Thus the code turns into: + +```clojure +(def rf? "Reducing function" + (t/fn [ {:doc "seed arity"}] + [:_ {:doc "completing arity"}] + [:_ :_ {:doc "reducing arity"}])) + +(def xf? "Transforming function" + (t/fn [rf? :> rf?])) + +(defnt transduce + ([ f rf?, xs t/reducible?] (transduce identity f xs)) + ([xf xf?, f rf?, xs t/reducible?] (transduce xf f (f) xs)) + ([xf xf?, f rf?, init _ xs t/reducible?] + (let [f' (xf f)] (f' (reduce f' init xs))))) +``` + +which is much, much nicer because it's much better documented, much more clear what each input and output does, and just overall much easier to follow and reason about, without introducing a meaningful increase in code size, and certainly without adding unnecessary information. diff --git a/doc/naming.md b/doc/naming.md index 1300fd1a..7bdec158 100644 --- a/doc/naming.md +++ b/doc/naming.md @@ -3,13 +3,18 @@ ## Symbols - `->`+ : constructor - : 'convert to' -- +`->` : 'convert from' + : 'convert to' ; TODO phase out +; `>`+ : 'convert to' +- +`->` : 'convert from' ; TODO phase out +- +`>` : 'convert from' +- `=>` : map from to ; TODO phase out +- `->` : map from to - `<`+ : calculate/compute (of functions) — as if to "take off the chan" of computed vals -- `:` : specificity relationship; of type +- `:` : specificity relationship; of type ; TODO phase out +- `|` : specificity relationship; of type - +`?` : predicate - `?`+ : 'maybe' — if null, return null, otherwise do something -- +`*` : 'variant' — as ambiguous as it sounds +- +`*` : 'variant' — as ambiguous as it sounds ; TODO phase out : 'relaxed' — in the context of numerics - +`'` : 'strict' — esp. if numeric : 'prime'/'next' diff --git a/doc/voltdb.sql b/doc/voltdb.sql new file mode 100644 index 00000000..adcaf20e --- /dev/null +++ b/doc/voltdb.sql @@ -0,0 +1,87 @@ +-- ~/voltdb-community-8.3.3/bin/voltdb start --http=8081 +-- ./bin/voltdb/sqlcmd + +-- TODO performance-test this against Datomic! Generate a bunch of random data till it gets big + +drop table entities; + +-- TODO add a `tinyint` column for datatype for more efficient indexing +create table entities ( +-- time (transaction ID/instant; must be increasing; can be in nanos) +-- first for display purposes +t bigint not null, +-- entity ID +e bigint not null, +-- attribute +a varchar(128) not null, +-- value (serialized) +-- TODO change back to varbinary; just varchar for interactive testing +v varchar +); + +-- technically true as you should never assert the same thing in the same transaction +-- create unique index eavt on entities (e, a, v, t) + +-- Idea from https://docs.datomic.com/on-prem/indexes.html +-- TODO only index non- byte arrays +create index eavt on entities (e, a, v, t); +create index aevt on entities (a, e, v, t); +create index avet on entities (a, v, e, t); +create index vaet on entities (v, a, e, t); + +-- This is in order to do time-based iteration +create index t on entities (t); + +-- TODO is this wise? It seems the best partitioning but might not be +partition table entities on column e; + +-- Multiple insert in one clause is not supported +insert into entities (t, e, a, v) values (0, -9223372036854775807, 'db|attribute' , 'db|attribute'); +insert into entities (t, e, a, v) values (0, -9223372036854775807, 'db|doc' , 'Marker for an attribute name'); +insert into entities (t, e, a, v) values (0, -9223372036854775806, 'db|attribute' , 'db|doc'); +insert into entities (t, e, a, v) values (0, -9223372036854775806, 'db|doc' , 'Attribute whose value supplies documentation'); +insert into entities (t, e, a, v) values (0, -9223372036854775805, 'db|attribute' , 'my|attribute'); +insert into entities (t, e, a, v) values (0, -9223372036854775805, 'db|doc' , 'Documentation for my attribute'); + +insert into entities (t, e, a, v) values (1, -9223372036854775804, 'my|attribute' , 'A value for my attribute. Yay!'); + +insert into entities (t, e, a, v) values (2, -9223372036854775803, 'db|attribute' , 'my|indexed-attribute'); + +-- Be careful to sanitize the names — shouldn't include `hash` in the name unless intentional +create index my_BAR_indexed_attribute__evt on entities (e, v, t) where a = 'db|attribute'; +create index my_BAR_indexed_attribute__vet on entities (v, e, t) where a = 'db|attribute'; + +insert into entities (t, e, a, v) values (3, -9223372036854775803, 'my|indexed-attribute', 'A value for my indexed attribute. Woohoo!'); + +-- next entity ID +select max(e) + 1 from entities; + +-- (BigInteger. (.getBytes "my-value!!")) -> "my-value!!" +-- (String. (.toByteArray (BigInteger. "516973278578607596577057"))) -> "my-value!!" + +-- Having a view of the DB at a point in time really is as trivial as `where t <= my_timestamp` + + + +-- [:find (count ?customer) . :in $ ?organization :where +-- [?concert :concert/organization ?organization] +-- [?booking :booking/concert ?concert] +-- [?booking :booking/customer ?customer]]-- + +-- TODO make sure revisions (changes in value of an identity across time) are addressed here +select customer.e + from s as concert, + entities as booking, + entities as customer + where ( concert.a = "concert/organization" + and concert.v = "the-organization") + or ( booking.a = "booking/concert" + and booking.v = concert.e) + or ( booking.a = "booking/customer" + and booking.v = customer.e); + +-- This is probably as much effort as the type system. I think we should do it only when we start to +-- scale, and only if it proves to have performance gains that Datomic can't match. We should code +-- to the Datomic interface though. Plus if we preserve all the data in datom format, it's about the +-- easiest thing to migrate (in theory). Perhaps we should do it either way — having source code we +-- can configure and edit will be really helpful. diff --git a/hs_err_pid65691.log b/hs_err_pid65691.log new file mode 100644 index 00000000..66846e0b --- /dev/null +++ b/hs_err_pid65691.log @@ -0,0 +1,811 @@ +# +# A fatal error has been detected by the Java Runtime Environment: +# +# Internal Error (signature.cpp:120), pid=65691, tid=0x0000000000001b03 +# Error: ShouldNotReachHere() +# +# JRE version: Java(TM) SE Runtime Environment (8.0_102-b14) (build 1.8.0_102-b14) +# Java VM: Java HotSpot(TM) 64-Bit Server VM (25.102-b14 mixed mode bsd-amd64 compressed oops) +# Failed to write core dump. Core dumps have been disabled. To enable core dumping, try "ulimit -c unlimited" before starting Java again +# +# If you would like to submit a bug report, please visit: +# http://bugreport.java.com/bugreport/crash.jsp +# + +--------------- T H R E A D --------------- + +Current thread (0x00007fe51f802800): JavaThread "main" [_thread_in_vm, id=6915, stack(0x000070000fd2e000,0x000070000fe2e000)] + +Stack: [0x000070000fd2e000,0x000070000fe2e000], sp=0x000070000fe20620, free space=969k +Native frames: (J=compiled Java code, j=interpreted, Vv=VM code, C=native code) +V [libjvm.dylib+0x5afd6a] VMError::report_and_die()+0x3f8 +V [libjvm.dylib+0x1e7afb] report_vm_error(char const*, int, char const*, char const*)+0x54 +V [libjvm.dylib+0x4ffe35] SignatureIterator::parse_type()+0x20f +V [libjvm.dylib+0x5000bb] SignatureIterator::iterate_returntype()+0x61 +V [libjvm.dylib+0x18535a] ClassFileParser::parse_method(bool, AccessFlags*, Thread*)+0x165a +V [libjvm.dylib+0x185ede] ClassFileParser::parse_methods(bool, AccessFlags*, bool*, bool*, Thread*)+0x112 +V [libjvm.dylib+0x188970] ClassFileParser::parseClassFile(Symbol*, ClassLoaderData*, Handle, KlassHandle, GrowableArray*, TempNewSymbol&, bool, Thread*)+0xbdc +V [libjvm.dylib+0x53a8af] SystemDictionary::resolve_from_stream(Symbol*, Handle, Handle, ClassFileStream*, bool, Thread*)+0xff +V [libjvm.dylib+0x34fc26] jvm_define_class_common(JNIEnv_*, char const*, _jobject*, signed char const*, int, _jobject*, char const*, unsigned char, Thread*)+0x23a +V [libjvm.dylib+0x34fdba] JVM_DefineClassWithSource+0x77 +C [libjava.dylib+0x2e0f] Java_java_lang_ClassLoader_defineClass1+0x142 +J 567 java.lang.ClassLoader.defineClass1(Ljava/lang/String;[BIILjava/security/ProtectionDomain;Ljava/lang/String;)Ljava/lang/Class; (0 bytes) @ 0x00000001152ec74b [0x00000001152ec640+0x10b] +J 6056 C2 java.lang.ClassLoader.defineClass(Ljava/lang/String;[BIILjava/security/ProtectionDomain;)Ljava/lang/Class; (43 bytes) @ 0x00000001166a1d84 [0x00000001166a1200+0xb84] +J 2169 C1 clojure.lang.DynamicClassLoader.defineClass(Ljava/lang/String;[BLjava/lang/Object;)Ljava/lang/Class; (43 bytes) @ 0x000000011590276c [0x0000000115902520+0x24c] +j clojure.core$gen_interface.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object;+151 +j clojure.core$gen_interface.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+12 +J 6372 C2 clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object; (3076 bytes) @ 0x0000000115d4d41c [0x0000000115d490e0+0x433c] +J 5008 C2 clojure.lang.Compiler.macroexpand1(Ljava/lang/Object;)Ljava/lang/Object; (343 bytes) @ 0x0000000115fe1d60 [0x0000000115fe08a0+0x14c0] +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0218 [0x00000001165af640+0xbd8] +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0468 [0x00000001165af640+0xe28] +J 4554 C1 clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object; (498 bytes) @ 0x0000000116162534 [0x0000000116160ba0+0x1994] +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;Z)V+53 +J 5942 C1 clojure.lang.RT.load(Ljava/lang/String;Z)V (342 bytes) @ 0x000000011666089c [0x000000011665b9c0+0x4edc] +J 5678 C1 clojure.core$load$fn__6548.invoke()Ljava/lang/Object; (38 bytes) @ 0x000000011644efa4 [0x000000011644ed20+0x284] +j clojure.core$load.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+531 +J 5675 C1 clojure.core$load.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x00000001164535b4 [0x0000000116453440+0x174] +J 3757 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;)Ljava/lang/Object; (73 bytes) @ 0x00000001156727c0 [0x00000001156725e0+0x1e0] +J 5762 C1 clojure.core$load_one.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (107 bytes) @ 0x00000001164dd32c [0x00000001164dd060+0x2cc] +J 5761 C1 clojure.core$load_one.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (13 bytes) @ 0x00000001164db3c4 [0x00000001164db340+0x84] +J 5938 C1 clojure.core$load_lib$fn__6493.invoke()Ljava/lang/Object; (70 bytes) @ 0x00000001166491ac [0x0000000116648f80+0x22c] +J 4703 C1 clojure.core$load_lib.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object; (1214 bytes) @ 0x000000011592fbdc [0x000000011592e320+0x18bc] +J 4432 C1 clojure.core$load_lib.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (16 bytes) @ 0x00000001160a59f4 [0x00000001160a5940+0xb4] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+195 +J 5952 C1 clojure.core$load_libs.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object; (1057 bytes) @ 0x0000000116671a24 [0x000000011666c6c0+0x5364] +J 5951 C1 clojure.core$load_libs.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x000000011664edf4 [0x000000011664ec80+0x174] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+136 +J 6409 C1 clojure.core$require.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object; (16 bytes) @ 0x0000000115a61b4c [0x0000000115a617c0+0x38c] +j clojure.core$require.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.lang.RestFn.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+174 +j quantum.core.refs$eval48055$loading__6434__auto____48056.invoke()Ljava/lang/Object;+92 +j quantum.core.refs$eval48055.invokeStatic()Ljava/lang/Object;+10 +j quantum.core.refs$eval48055.invoke()Ljava/lang/Object;+0 +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0988 [0x00000001165af640+0x1348] +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0468 [0x00000001165af640+0xe28] +J 4554 C1 clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object; (498 bytes) @ 0x0000000116162534 [0x0000000116160ba0+0x1994] +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;Z)V+53 +J 5942 C1 clojure.lang.RT.load(Ljava/lang/String;Z)V (342 bytes) @ 0x000000011666089c [0x000000011665b9c0+0x4edc] +J 5678 C1 clojure.core$load$fn__6548.invoke()Ljava/lang/Object; (38 bytes) @ 0x000000011644efa4 [0x000000011644ed20+0x284] +j clojure.core$load.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+531 +J 5675 C1 clojure.core$load.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x00000001164535b4 [0x0000000116453440+0x174] +J 3757 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;)Ljava/lang/Object; (73 bytes) @ 0x00000001156727c0 [0x00000001156725e0+0x1e0] +J 5762 C1 clojure.core$load_one.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (107 bytes) @ 0x00000001164dd32c [0x00000001164dd060+0x2cc] +J 5761 C1 clojure.core$load_one.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (13 bytes) @ 0x00000001164db3c4 [0x00000001164db340+0x84] +J 5938 C1 clojure.core$load_lib$fn__6493.invoke()Ljava/lang/Object; (70 bytes) @ 0x00000001166491ac [0x0000000116648f80+0x22c] +J 4703 C1 clojure.core$load_lib.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object; (1214 bytes) @ 0x000000011592fbdc [0x000000011592e320+0x18bc] +J 4432 C1 clojure.core$load_lib.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (16 bytes) @ 0x00000001160a59f4 [0x00000001160a5940+0xb4] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+195 +J 5952 C1 clojure.core$load_libs.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object; (1057 bytes) @ 0x0000000116671a24 [0x000000011666c6c0+0x5364] +J 5951 C1 clojure.core$load_libs.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x000000011664edf4 [0x000000011664ec80+0x174] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+136 +J 6409 C1 clojure.core$require.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object; (16 bytes) @ 0x0000000115a61b4c [0x0000000115a617c0+0x38c] +j clojure.core$require.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.lang.RestFn.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+293 +j quantum.core.reducers.reduce$eval48049$loading__6434__auto____48050.invoke()Ljava/lang/Object;+113 +j quantum.core.reducers.reduce$eval48049.invokeStatic()Ljava/lang/Object;+10 +j quantum.core.reducers.reduce$eval48049.invoke()Ljava/lang/Object;+0 +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0988 [0x00000001165af640+0x1348] +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0468 [0x00000001165af640+0xe28] +J 4554 C1 clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object; (498 bytes) @ 0x0000000116162534 [0x0000000116160ba0+0x1994] +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;Z)V+53 +J 5942 C1 clojure.lang.RT.load(Ljava/lang/String;Z)V (342 bytes) @ 0x000000011666089c [0x000000011665b9c0+0x4edc] +J 5678 C1 clojure.core$load$fn__6548.invoke()Ljava/lang/Object; (38 bytes) @ 0x000000011644efa4 [0x000000011644ed20+0x284] +j clojure.core$load.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+531 +J 5675 C1 clojure.core$load.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x00000001164535b4 [0x0000000116453440+0x174] +J 3757 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;)Ljava/lang/Object; (73 bytes) @ 0x00000001156727c0 [0x00000001156725e0+0x1e0] +J 5762 C1 clojure.core$load_one.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (107 bytes) @ 0x00000001164dd32c [0x00000001164dd060+0x2cc] +J 5761 C1 clojure.core$load_one.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (13 bytes) @ 0x00000001164db3c4 [0x00000001164db340+0x84] +J 5938 C1 clojure.core$load_lib$fn__6493.invoke()Ljava/lang/Object; (70 bytes) @ 0x00000001166491ac [0x0000000116648f80+0x22c] +J 4703 C1 clojure.core$load_lib.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object; (1214 bytes) @ 0x000000011592fbdc [0x000000011592e320+0x18bc] +J 4432 C1 clojure.core$load_lib.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (16 bytes) @ 0x00000001160a59f4 [0x00000001160a5940+0xb4] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+195 +J 5952 C1 clojure.core$load_libs.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object; (1057 bytes) @ 0x0000000116671a24 [0x000000011666c6c0+0x5364] +J 5951 C1 clojure.core$load_libs.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x000000011664edf4 [0x000000011664ec80+0x174] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+136 +J 4477 C2 clojure.core$apply.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (24 bytes) @ 0x00000001154251dc [0x00000001154250a0+0x13c] +j clojure.core$require.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+12 +j clojure.core$require.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +J 3668 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (186 bytes) @ 0x0000000115346a74 [0x00000001153467a0+0x2d4] +j quantum.core.collections.logic$eval48041$loading__6434__auto____48042.invoke()Ljava/lang/Object;+74 +j quantum.core.collections.logic$eval48041.invokeStatic()Ljava/lang/Object;+10 +j quantum.core.collections.logic$eval48041.invoke()Ljava/lang/Object;+0 +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0988 [0x00000001165af640+0x1348] +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0468 [0x00000001165af640+0xe28] +J 4554 C1 clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object; (498 bytes) @ 0x0000000116162534 [0x0000000116160ba0+0x1994] +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;Z)V+53 +J 5942 C1 clojure.lang.RT.load(Ljava/lang/String;Z)V (342 bytes) @ 0x000000011666089c [0x000000011665b9c0+0x4edc] +J 5678 C1 clojure.core$load$fn__6548.invoke()Ljava/lang/Object; (38 bytes) @ 0x000000011644efa4 [0x000000011644ed20+0x284] +j clojure.core$load.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+531 +J 5675 C1 clojure.core$load.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x00000001164535b4 [0x0000000116453440+0x174] +J 3757 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;)Ljava/lang/Object; (73 bytes) @ 0x00000001156727c0 [0x00000001156725e0+0x1e0] +...... + +Java frames: (J=compiled Java code, j=interpreted, Vv=VM code) +J 567 java.lang.ClassLoader.defineClass1(Ljava/lang/String;[BIILjava/security/ProtectionDomain;Ljava/lang/String;)Ljava/lang/Class; (0 bytes) @ 0x00000001152ec6d1 [0x00000001152ec640+0x91] +J 6056 C2 java.lang.ClassLoader.defineClass(Ljava/lang/String;[BIILjava/security/ProtectionDomain;)Ljava/lang/Class; (43 bytes) @ 0x00000001166a1d84 [0x00000001166a1200+0xb84] +J 2169 C1 clojure.lang.DynamicClassLoader.defineClass(Ljava/lang/String;[BLjava/lang/Object;)Ljava/lang/Class; (43 bytes) @ 0x000000011590276c [0x0000000115902520+0x24c] +j clojure.core$gen_interface.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object;+151 +j clojure.core$gen_interface.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+12 +J 6372 C2 clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object; (3076 bytes) @ 0x0000000115d4d41c [0x0000000115d490e0+0x433c] +J 5008 C2 clojure.lang.Compiler.macroexpand1(Ljava/lang/Object;)Ljava/lang/Object; (343 bytes) @ 0x0000000115fe1d60 [0x0000000115fe08a0+0x14c0] +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0218 [0x00000001165af640+0xbd8] +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0468 [0x00000001165af640+0xe28] +J 4554 C1 clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object; (498 bytes) @ 0x0000000116162534 [0x0000000116160ba0+0x1994] +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;Z)V+53 +J 5942 C1 clojure.lang.RT.load(Ljava/lang/String;Z)V (342 bytes) @ 0x000000011666089c [0x000000011665b9c0+0x4edc] +J 5678 C1 clojure.core$load$fn__6548.invoke()Ljava/lang/Object; (38 bytes) @ 0x000000011644efa4 [0x000000011644ed20+0x284] +j clojure.core$load.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+531 +J 5675 C1 clojure.core$load.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x00000001164535b4 [0x0000000116453440+0x174] +J 3757 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;)Ljava/lang/Object; (73 bytes) @ 0x00000001156727c0 [0x00000001156725e0+0x1e0] +J 5762 C1 clojure.core$load_one.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (107 bytes) @ 0x00000001164dd32c [0x00000001164dd060+0x2cc] +J 5761 C1 clojure.core$load_one.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (13 bytes) @ 0x00000001164db3c4 [0x00000001164db340+0x84] +J 5938 C1 clojure.core$load_lib$fn__6493.invoke()Ljava/lang/Object; (70 bytes) @ 0x00000001166491ac [0x0000000116648f80+0x22c] +J 4703 C1 clojure.core$load_lib.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object; (1214 bytes) @ 0x000000011592fbdc [0x000000011592e320+0x18bc] +J 4432 C1 clojure.core$load_lib.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (16 bytes) @ 0x00000001160a59f4 [0x00000001160a5940+0xb4] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+195 +J 5952 C1 clojure.core$load_libs.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object; (1057 bytes) @ 0x0000000116671a24 [0x000000011666c6c0+0x5364] +J 5951 C1 clojure.core$load_libs.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x000000011664edf4 [0x000000011664ec80+0x174] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+136 +J 6409 C1 clojure.core$require.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object; (16 bytes) @ 0x0000000115a61b4c [0x0000000115a617c0+0x38c] +j clojure.core$require.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.lang.RestFn.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+174 +j quantum.core.refs$eval48055$loading__6434__auto____48056.invoke()Ljava/lang/Object;+92 +j quantum.core.refs$eval48055.invokeStatic()Ljava/lang/Object;+10 +j quantum.core.refs$eval48055.invoke()Ljava/lang/Object;+0 +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0988 [0x00000001165af640+0x1348] +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0468 [0x00000001165af640+0xe28] +J 4554 C1 clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object; (498 bytes) @ 0x0000000116162534 [0x0000000116160ba0+0x1994] +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;Z)V+53 +J 5942 C1 clojure.lang.RT.load(Ljava/lang/String;Z)V (342 bytes) @ 0x000000011666089c [0x000000011665b9c0+0x4edc] +J 5678 C1 clojure.core$load$fn__6548.invoke()Ljava/lang/Object; (38 bytes) @ 0x000000011644efa4 [0x000000011644ed20+0x284] +j clojure.core$load.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+531 +J 5675 C1 clojure.core$load.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x00000001164535b4 [0x0000000116453440+0x174] +J 3757 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;)Ljava/lang/Object; (73 bytes) @ 0x00000001156727c0 [0x00000001156725e0+0x1e0] +J 5762 C1 clojure.core$load_one.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (107 bytes) @ 0x00000001164dd32c [0x00000001164dd060+0x2cc] +J 5761 C1 clojure.core$load_one.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (13 bytes) @ 0x00000001164db3c4 [0x00000001164db340+0x84] +J 5938 C1 clojure.core$load_lib$fn__6493.invoke()Ljava/lang/Object; (70 bytes) @ 0x00000001166491ac [0x0000000116648f80+0x22c] +J 4703 C1 clojure.core$load_lib.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object; (1214 bytes) @ 0x000000011592fbdc [0x000000011592e320+0x18bc] +J 4432 C1 clojure.core$load_lib.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (16 bytes) @ 0x00000001160a59f4 [0x00000001160a5940+0xb4] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+195 +J 5952 C1 clojure.core$load_libs.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object; (1057 bytes) @ 0x0000000116671a24 [0x000000011666c6c0+0x5364] +J 5951 C1 clojure.core$load_libs.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x000000011664edf4 [0x000000011664ec80+0x174] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+136 +J 6409 C1 clojure.core$require.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object; (16 bytes) @ 0x0000000115a61b4c [0x0000000115a617c0+0x38c] +j clojure.core$require.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.lang.RestFn.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+293 +j quantum.core.reducers.reduce$eval48049$loading__6434__auto____48050.invoke()Ljava/lang/Object;+113 +j quantum.core.reducers.reduce$eval48049.invokeStatic()Ljava/lang/Object;+10 +j quantum.core.reducers.reduce$eval48049.invoke()Ljava/lang/Object;+0 +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0988 [0x00000001165af640+0x1348] +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0468 [0x00000001165af640+0xe28] +J 4554 C1 clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object; (498 bytes) @ 0x0000000116162534 [0x0000000116160ba0+0x1994] +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;Z)V+53 +J 5942 C1 clojure.lang.RT.load(Ljava/lang/String;Z)V (342 bytes) @ 0x000000011666089c [0x000000011665b9c0+0x4edc] +J 5678 C1 clojure.core$load$fn__6548.invoke()Ljava/lang/Object; (38 bytes) @ 0x000000011644efa4 [0x000000011644ed20+0x284] +j clojure.core$load.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+531 +J 5675 C1 clojure.core$load.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x00000001164535b4 [0x0000000116453440+0x174] +J 3757 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;)Ljava/lang/Object; (73 bytes) @ 0x00000001156727c0 [0x00000001156725e0+0x1e0] +J 5762 C1 clojure.core$load_one.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (107 bytes) @ 0x00000001164dd32c [0x00000001164dd060+0x2cc] +J 5761 C1 clojure.core$load_one.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (13 bytes) @ 0x00000001164db3c4 [0x00000001164db340+0x84] +J 5938 C1 clojure.core$load_lib$fn__6493.invoke()Ljava/lang/Object; (70 bytes) @ 0x00000001166491ac [0x0000000116648f80+0x22c] +J 4703 C1 clojure.core$load_lib.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object; (1214 bytes) @ 0x000000011592fbdc [0x000000011592e320+0x18bc] +J 4432 C1 clojure.core$load_lib.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (16 bytes) @ 0x00000001160a59f4 [0x00000001160a5940+0xb4] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+195 +J 5952 C1 clojure.core$load_libs.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object; (1057 bytes) @ 0x0000000116671a24 [0x000000011666c6c0+0x5364] +J 5951 C1 clojure.core$load_libs.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x000000011664edf4 [0x000000011664ec80+0x174] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+136 +J 4477 C2 clojure.core$apply.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (24 bytes) @ 0x00000001154251dc [0x00000001154250a0+0x13c] +j clojure.core$require.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+12 +j clojure.core$require.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +J 3668 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (186 bytes) @ 0x0000000115346a74 [0x00000001153467a0+0x2d4] +j quantum.core.collections.logic$eval48041$loading__6434__auto____48042.invoke()Ljava/lang/Object;+74 +j quantum.core.collections.logic$eval48041.invokeStatic()Ljava/lang/Object;+10 +j quantum.core.collections.logic$eval48041.invoke()Ljava/lang/Object;+0 +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0988 [0x00000001165af640+0x1348] +J 5802 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001165b0468 [0x00000001165af640+0xe28] +J 4554 C1 clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object; (498 bytes) @ 0x0000000116162534 [0x0000000116160ba0+0x1994] +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;Z)V+53 +J 5942 C1 clojure.lang.RT.load(Ljava/lang/String;Z)V (342 bytes) @ 0x000000011666089c [0x000000011665b9c0+0x4edc] +J 5678 C1 clojure.core$load$fn__6548.invoke()Ljava/lang/Object; (38 bytes) @ 0x000000011644efa4 [0x000000011644ed20+0x284] +j clojure.core$load.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+531 +J 5675 C1 clojure.core$load.doInvoke(Ljava/lang/Object;)Ljava/lang/Object; (10 bytes) @ 0x00000001164535b4 [0x0000000116453440+0x174] +J 3757 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;)Ljava/lang/Object; (73 bytes) @ 0x00000001156727c0 [0x00000001156725e0+0x1e0] +J 5762 C1 clojure.core$load_one.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (107 bytes) @ 0x00000001164dd32c [0x00000001164dd060+0x2cc] +J 5761 C1 clojure.core$load_one.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (13 bytes) @ 0x00000001164db3c4 [0x00000001164db340+0x84] +J 5938 C1 clojure.core$load_lib$fn__6493.invoke()Ljava/lang/Object; (70 bytes) @ 0x00000001166491ac [0x0000000116648f80+0x22c] +J 4703 C1 clojure.core$load_lib.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object; (1214 bytes) @ 0x000000011592fbdc [0x000000011592e320+0x18bc] +J 4432 C1 clojure.core$load_lib.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (16 bytes) @ 0x00000001160a59f4 [0x00000001160a5940+0xb4] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+195 +J 4477 C2 clojure.core$apply.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (24 bytes) @ 0x00000001154251dc [0x00000001154250a0+0x13c] +j clojure.core$load_libs.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+693 +j clojure.core$load_libs.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+136 +J 4477 C2 clojure.core$apply.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (24 bytes) @ 0x00000001154251dc [0x00000001154250a0+0x13c] +j clojure.core$require.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+12 +j clojure.core$require.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.lang.RestFn.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+363 +j quantum.core.collections.core$eval35744$loading__6434__auto____35745.invoke()Ljava/lang/Object;+135 +j quantum.core.collections.core$eval35744.invokeStatic()Ljava/lang/Object;+10 +j quantum.core.collections.core$eval35744.invoke()Ljava/lang/Object;+0 +J 5523 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001163e5e24 [0x00000001163e4b40+0x12e4] +J 5523 C2 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001163e591c [0x00000001163e4b40+0xddc] +J 4554 C1 clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object; (498 bytes) @ 0x0000000116162534 [0x0000000116160ba0+0x1994] +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;Z)V+53 +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;)V+3 +j clojure.lang.RT.load(Ljava/lang/String;Z)V+282 +j clojure.lang.RT.load(Ljava/lang/String;)V+2 +j clojure.core$load$fn__6548.invoke()Ljava/lang/Object;+17 +j clojure.core$load.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+531 +j clojure.core$load.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +J 3757 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;)Ljava/lang/Object; (73 bytes) @ 0x00000001156727c0 [0x00000001156725e0+0x1e0] +j clojure.core$load_one.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+13 +j clojure.core$load_one.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+9 +j clojure.core$load_lib$fn__6493.invoke()Ljava/lang/Object;+19 +J 4703 C1 clojure.core$load_lib.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object; (1214 bytes) @ 0x000000011592fbdc [0x000000011592e320+0x18bc] +J 4432 C1 clojure.core$load_lib.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (16 bytes) @ 0x00000001160a59f4 [0x00000001160a5940+0xb4] +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+195 +J 4477 C2 clojure.core$apply.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (24 bytes) @ 0x00000001154251dc [0x00000001154250a0+0x13c] +j clojure.core$load_libs.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+693 +j clojure.core$load_libs.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +J 4643 C2 clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object; (3076 bytes) @ 0x0000000115d0784c [0x0000000115d04040+0x380c] +J 4477 C2 clojure.core$apply.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (24 bytes) @ 0x00000001154251dc [0x00000001154250a0+0x13c] +j clojure.core$require.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+12 +j clojure.core$require.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.lang.RestFn.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+363 +j quantum.core.collections$eval24623$loading__6434__auto____24624.invoke()Ljava/lang/Object;+215 +j quantum.core.collections$eval24623.invokeStatic()Ljava/lang/Object;+10 +j quantum.core.collections$eval24623.invoke()Ljava/lang/Object;+0 +J 2117 C1 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001158db1ac [0x00000001158d5ca0+0x550c] +J 2117 C1 clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object; (393 bytes) @ 0x00000001158dbf2c [0x00000001158d5ca0+0x628c] +J 4554 C1 clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object; (498 bytes) @ 0x0000000116162534 [0x0000000116160ba0+0x1994] +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;Z)V+53 +j clojure.lang.RT.loadResourceScript(Ljava/lang/Class;Ljava/lang/String;)V+3 +j clojure.lang.RT.load(Ljava/lang/String;Z)V+282 +j clojure.lang.RT.load(Ljava/lang/String;)V+2 +j clojure.core$load$fn__6548.invoke()Ljava/lang/Object;+17 +j clojure.core$load.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+531 +j clojure.core$load.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +J 3757 C2 clojure.lang.RestFn.invoke(Ljava/lang/Object;)Ljava/lang/Object; (73 bytes) @ 0x00000001156727c0 [0x00000001156725e0+0x1e0] +j clojure.core$load_one.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+13 +j clojure.core$load_one.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+9 +j clojure.core$load_lib$fn__6493.invoke()Ljava/lang/Object;+19 +J 4703 C1 clojure.core$load_lib.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Lclojure/lang/ISeq;)Ljava/lang/Object; (1214 bytes) @ 0x000000011592fbdc [0x000000011592e320+0x18bc] +J 4432 C1 clojure.core$load_lib.doInvoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (16 bytes) @ 0x00000001160a59f4 [0x00000001160a5940+0xb4] +J 4643 C2 clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object; (3076 bytes) @ 0x0000000115d079ac [0x0000000115d04040+0x396c] +J 4477 C2 clojure.core$apply.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object; (24 bytes) @ 0x00000001154251dc [0x00000001154250a0+0x13c] +j clojure.core$load_libs.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+693 +j clojure.core$load_libs.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +J 1076 C1 clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object; (3076 bytes) @ 0x00000001154ab85c [0x00000001154973a0+0x144bc] +j clojure.core$apply.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+18 +j clojure.core$require.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+12 +j clojure.core$require.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.lang.RestFn.invoke(Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+361 +j quantum.net.http$eval170$loading__6434__auto____171.invoke()Ljava/lang/Object;+119 +j quantum.net.http$eval170.invokeStatic()Ljava/lang/Object;+10 +j quantum.net.http$eval170.invoke()Ljava/lang/Object;+0 +j clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object;+322 +j clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object;+188 +j clojure.lang.Compiler.eval(Ljava/lang/Object;)Ljava/lang/Object;+2 +j clojure.core$eval.invokeStatic(Ljava/lang/Object;)Ljava/lang/Object;+3 +j clojure.core$eval.invoke(Ljava/lang/Object;)Ljava/lang/Object;+3 +j clojure.main$repl$read_eval_print__8572$fn__8575.invoke()Ljava/lang/Object;+11 +j clojure.main$repl$read_eval_print__8572.invoke()Ljava/lang/Object;+178 +j clojure.main$repl$fn__8581.invoke()Ljava/lang/Object;+7 +j clojure.main$repl.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+639 +j clojure.main$repl_opt.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+118 +j clojure.main$main.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+259 +j clojure.main$main.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.lang.RestFn.invoke()Ljava/lang/Object;+26 +J 573 C1 clojure.lang.AFn.applyToHelper(Lclojure/lang/IFn;Lclojure/lang/ISeq;)Ljava/lang/Object; (3238 bytes) @ 0x000000011530bd24 [0x00000001152f6840+0x154e4] +J 1076 C1 clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object; (3076 bytes) @ 0x00000001154ab8dc [0x00000001154973a0+0x1453c] +j clojure.lang.Var.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+5 +j clojure.main.main([Ljava/lang/String;)V+17 +v ~StubRoutines::call_stub +j sun.reflect.NativeMethodAccessorImpl.invoke0(Ljava/lang/reflect/Method;Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+0 +j sun.reflect.NativeMethodAccessorImpl.invoke(Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+100 +j sun.reflect.DelegatingMethodAccessorImpl.invoke(Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+6 +j java.lang.reflect.Method.invoke(Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+56 +j clojure.lang.Reflector.invokeMatchingMethod(Ljava/lang/String;Ljava/util/List;Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+243 +j clojure.lang.Reflector.invokeStaticMethod(Ljava/lang/Class;Ljava/lang/String;[Ljava/lang/Object;)Ljava/lang/Object;+28 +v ~StubRoutines::call_stub +j sun.reflect.NativeMethodAccessorImpl.invoke0(Ljava/lang/reflect/Method;Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+0 +j sun.reflect.NativeMethodAccessorImpl.invoke(Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+100 +j sun.reflect.DelegatingMethodAccessorImpl.invoke(Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+6 +j java.lang.reflect.Method.invoke(Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+56 +j clojure.lang.Reflector.invokeMatchingMethod(Ljava/lang/String;Ljava/util/List;Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;+243 +j clojure.lang.Reflector.invokeStaticMethod(Ljava/lang/Class;Ljava/lang/String;[Ljava/lang/Object;)Ljava/lang/Object;+28 +j user$eval153.invokeStatic()Ljava/lang/Object;+202 +j user$eval153.invoke()Ljava/lang/Object;+0 +j clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object;+322 +j clojure.lang.Compiler.eval(Ljava/lang/Object;Z)Ljava/lang/Object;+208 +j clojure.lang.Compiler.load(Ljava/io/Reader;Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object;+354 +j clojure.lang.Compiler.loadFile(Ljava/lang/String;)Ljava/lang/Object;+42 +j clojure.main$load_script.invokeStatic(Ljava/lang/Object;)Ljava/lang/Object;+67 +j clojure.main$init_opt.invokeStatic(Ljava/lang/Object;)Ljava/lang/Object;+3 +j clojure.main$init_opt.invoke(Ljava/lang/Object;)Ljava/lang/Object;+3 +j clojure.main$initialize.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+110 +j clojure.main$null_opt.invokeStatic(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+305 +j clojure.main$null_opt.invoke(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.main$main.invokeStatic(Lclojure/lang/ISeq;)Ljava/lang/Object;+248 +j clojure.main$main.doInvoke(Ljava/lang/Object;)Ljava/lang/Object;+6 +j clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+136 +j clojure.lang.Var.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object;+5 +j clojure.main.main([Ljava/lang/String;)V+17 +v ~StubRoutines::call_stub + +--------------- P R O C E S S --------------- + +Java Threads: ( => current thread ) + 0x00007fe51f7f7800 JavaThread "dirigiste-pool-controller-0" daemon [_thread_blocked, id=20227, stack(0x0000700010d5e000,0x0000700010e5e000)] + 0x00007fe51f784800 JavaThread "manifold-pool-1-1" daemon [_thread_blocked, id=19715, stack(0x0000700010c5b000,0x0000700010d5b000)] + 0x00007fe52581f800 JavaThread "dirigiste-executor-controller-0" daemon [_thread_blocked, id=4875, stack(0x0000700010b58000,0x0000700010c58000)] + 0x00007fe5220ac800 JavaThread "clojure.core.async.timers/timeout-daemon" daemon [_thread_blocked, id=4359, stack(0x000070000fba5000,0x000070000fca5000)] + 0x00007fe520031000 JavaThread "Service Thread" daemon [_thread_blocked, id=18435, stack(0x0000700010952000,0x0000700010a52000)] + 0x00007fe51f854800 JavaThread "C1 CompilerThread2" daemon [_thread_blocked, id=17923, stack(0x000070001084f000,0x000070001094f000)] + 0x00007fe520030800 JavaThread "C2 CompilerThread1" daemon [_thread_in_native, id=17411, stack(0x000070001074c000,0x000070001084c000)] + 0x00007fe52002f000 JavaThread "C2 CompilerThread0" daemon [_thread_in_native, id=16899, stack(0x0000700010649000,0x0000700010749000)] + 0x00007fe520040800 JavaThread "Signal Dispatcher" daemon [_thread_blocked, id=16395, stack(0x0000700010546000,0x0000700010646000)] + 0x00007fe51f841000 JavaThread "Finalizer" daemon [_thread_blocked, id=13059, stack(0x0000700010443000,0x0000700010543000)] + 0x00007fe51f811800 JavaThread "Reference Handler" daemon [_thread_blocked, id=12547, stack(0x0000700010340000,0x0000700010440000)] +=>0x00007fe51f802800 JavaThread "main" [_thread_in_vm, id=6915, stack(0x000070000fd2e000,0x000070000fe2e000)] + +Other Threads: + 0x00007fe520840000 VMThread [stack: 0x000070001023d000,0x000070001033d000] [id=12035] + 0x00007fe520841000 WatcherThread [stack: 0x0000700010a55000,0x0000700010b55000] [id=18947] + +VM state:not at safepoint (normal execution) + +VM Mutex/Monitor currently owned by a thread: None + +Heap: + PSYoungGen total 1128448K, used 482096K [0x000000076ab00000, 0x00000007c0000000, 0x00000007c0000000) + eden space 1113088K, 41% used [0x000000076ab00000,0x00000007872ccbe8,0x00000007aea00000) + from space 15360K, 99% used [0x00000007aea00000,0x00000007af8ff4a8,0x00000007af900000) + to space 18944K, 0% used [0x00000007bed80000,0x00000007bed80000,0x00000007c0000000) + ParOldGen total 199168K, used 41769K [0x00000006c0000000, 0x00000006cc280000, 0x000000076ab00000) + object space 199168K, 20% used [0x00000006c0000000,0x00000006c28ca4b8,0x00000006cc280000) + Metaspace used 103723K, capacity 155752K, committed 155952K, reserved 1157120K + class space used 30037K, capacity 48585K, committed 48688K, reserved 1048576K + +Card table byte_map: [0x000000010e961000,0x000000010f162000] byte_map_base: 0x000000010b361000 + +Marking Bits: (ParMarkBitMap*) 0x000000010deefd20 + Begin Bits: [0x0000000124049000, 0x0000000128049000) + End Bits: [0x0000000128049000, 0x000000012c049000) + +Polling page: 0x000000010cd55000 + +CodeCache: size=245760Kb used=23102Kb max_used=23559Kb free=222657Kb + bounds [0x0000000115049000, 0x0000000116779000, 0x0000000124049000] + total_blobs=5189 nmethods=4703 adapters=396 + compilation: enabled + +Compilation events (10 events): +Event: 58.669 Thread 0x00007fe51f854800 nmethod 6438 0x000000011594e310 code [0x000000011594e700, 0x00000001159518b8] +Event: 58.768 Thread 0x00007fe51f854800 6440 3 java.lang.StringBuilder::getChars (10 bytes) +Event: 58.769 Thread 0x00007fe51f854800 nmethod 6440 0x0000000115f137d0 code [0x0000000115f13940, 0x0000000115f13ac8] +Event: 58.769 Thread 0x00007fe51f854800 6441 3 java.lang.AbstractStringBuilder::getChars (64 bytes) +Event: 58.769 Thread 0x00007fe51f854800 nmethod 6441 0x0000000115f12e50 code [0x0000000115f13020, 0x0000000115f13578] +Event: 58.813 Thread 0x00007fe51f854800 6442 3 quantum.core.analyze.clojure.core$jvm_typeof_respecting_hints::invoke (10 bytes) +Event: 58.813 Thread 0x00007fe51f854800 nmethod 6442 0x000000011594df90 code [0x000000011594e100, 0x000000011594e288] +Event: 58.813 Thread 0x00007fe51f854800 6443 3 quantum.core.analyze.clojure.core$jvm_typeof_respecting_hints::invokeStatic (103 bytes) +Event: 58.815 Thread 0x00007fe51f854800 nmethod 6443 0x0000000115c64050 code [0x0000000115c64240, 0x0000000115c64da8] +Event: 58.815 Thread 0x00007fe51f854800 6444 3 clojure.core$isa_QMARK_$fn__6367::invoke (65 bytes) + +GC Heap History (10 events): +Event: 28.571 GC heap before +{Heap before GC invocations=15 (full 3): + PSYoungGen total 588288K, used 577024K [0x000000076ab00000, 0x000000079e080000, 0x00000007c0000000) + eden space 577024K, 100% used [0x000000076ab00000,0x000000078de80000,0x000000078de80000) + from space 11264K, 0% used [0x000000078de80000,0x000000078de80000,0x000000078e980000) + to space 12800K, 0% used [0x000000079d400000,0x000000079d400000,0x000000079e080000) + ParOldGen total 155136K, used 24929K [0x00000006c0000000, 0x00000006c9780000, 0x000000076ab00000) + object space 155136K, 16% used [0x00000006c0000000,0x00000006c18585b8,0x00000006c9780000) + Metaspace used 54627K, capacity 77024K, committed 77360K, reserved 1103872K + class space used 15101K, capacity 22750K, committed 22832K, reserved 1048576K +Event: 28.592 GC heap after +Heap after GC invocations=15 (full 3): + PSYoungGen total 824320K, used 9361K [0x000000076ab00000, 0x000000079df00000, 0x00000007c0000000) + eden space 813056K, 0% used [0x000000076ab00000,0x000000076ab00000,0x000000079c500000) + from space 11264K, 83% used [0x000000079d400000,0x000000079dd245d8,0x000000079df00000) + to space 13312K, 0% used [0x000000079c500000,0x000000079c500000,0x000000079d200000) + ParOldGen total 155136K, used 24937K [0x00000006c0000000, 0x00000006c9780000, 0x000000076ab00000) + object space 155136K, 16% used [0x00000006c0000000,0x00000006c185a5b8,0x00000006c9780000) + Metaspace used 54627K, capacity 77024K, committed 77360K, reserved 1103872K + class space used 15101K, capacity 22750K, committed 22832K, reserved 1048576K +} +Event: 37.133 GC heap before +{Heap before GC invocations=16 (full 3): + PSYoungGen total 824320K, used 822417K [0x000000076ab00000, 0x000000079df00000, 0x00000007c0000000) + eden space 813056K, 100% used [0x000000076ab00000,0x000000079c500000,0x000000079c500000) + from space 11264K, 83% used [0x000000079d400000,0x000000079dd245d8,0x000000079df00000) + to space 13312K, 0% used [0x000000079c500000,0x000000079c500000,0x000000079d200000) + ParOldGen total 155136K, used 24937K [0x00000006c0000000, 0x00000006c9780000, 0x000000076ab00000) + object space 155136K, 16% used [0x00000006c0000000,0x00000006c185a5b8,0x00000006c9780000) + Metaspace used 67199K, capacity 97378K, committed 97584K, reserved 1116160K + class space used 19128K, capacity 30448K, committed 30512K, reserved 1048576K +Event: 37.158 GC heap after +Heap after GC invocations=16 (full 3): + PSYoungGen total 826368K, used 13280K [0x000000076ab00000, 0x00000007b0b00000, 0x00000007c0000000) + eden space 813056K, 0% used [0x000000076ab00000,0x000000076ab00000,0x000000079c500000) + from space 13312K, 99% used [0x000000079c500000,0x000000079d1f80e0,0x000000079d200000) + to space 15872K, 0% used [0x00000007afb80000,0x00000007afb80000,0x00000007b0b00000) + ParOldGen total 155136K, used 28120K [0x00000006c0000000, 0x00000006c9780000, 0x000000076ab00000) + object space 155136K, 18% used [0x00000006c0000000,0x00000006c1b761f8,0x00000006c9780000) + Metaspace used 67199K, capacity 97378K, committed 97584K, reserved 1116160K + class space used 19128K, capacity 30448K, committed 30512K, reserved 1048576K +} +Event: 37.631 GC heap before +{Heap before GC invocations=17 (full 3): + PSYoungGen total 826368K, used 69237K [0x000000076ab00000, 0x00000007b0b00000, 0x00000007c0000000) + eden space 813056K, 6% used [0x000000076ab00000,0x000000076e1a55a0,0x000000079c500000) + from space 13312K, 99% used [0x000000079c500000,0x000000079d1f80e0,0x000000079d200000) + to space 15872K, 0% used [0x00000007afb80000,0x00000007afb80000,0x00000007b0b00000) + ParOldGen total 155136K, used 28120K [0x00000006c0000000, 0x00000006c9780000, 0x000000076ab00000) + object space 155136K, 18% used [0x00000006c0000000,0x00000006c1b761f8,0x00000006c9780000) + Metaspace used 68112K, capacity 98478K, committed 98600K, reserved 1118208K + class space used 19362K, capacity 30768K, committed 30768K, reserved 1048576K +Event: 37.648 GC heap after +Heap after GC invocations=17 (full 3): + PSYoungGen total 1125888K, used 8430K [0x000000076ab00000, 0x00000007b0800000, 0x00000007c0000000) + eden space 1113088K, 0% used [0x000000076ab00000,0x000000076ab00000,0x00000007aea00000) + from space 12800K, 65% used [0x00000007afb80000,0x00000007b03bbb28,0x00000007b0800000) + to space 15360K, 0% used [0x00000007aea00000,0x00000007aea00000,0x00000007af900000) + ParOldGen total 155136K, used 33784K [0x00000006c0000000, 0x00000006c9780000, 0x000000076ab00000) + object space 155136K, 21% used [0x00000006c0000000,0x00000006c20fe208,0x00000006c9780000) + Metaspace used 68112K, capacity 98478K, committed 98600K, reserved 1118208K + class space used 19362K, capacity 30768K, committed 30768K, reserved 1048576K +} +Event: 37.648 GC heap before +{Heap before GC invocations=18 (full 4): + PSYoungGen total 1125888K, used 8430K [0x000000076ab00000, 0x00000007b0800000, 0x00000007c0000000) + eden space 1113088K, 0% used [0x000000076ab00000,0x000000076ab00000,0x00000007aea00000) + from space 12800K, 65% used [0x00000007afb80000,0x00000007b03bbb28,0x00000007b0800000) + to space 15360K, 0% used [0x00000007aea00000,0x00000007aea00000,0x00000007af900000) + ParOldGen total 155136K, used 33784K [0x00000006c0000000, 0x00000006c9780000, 0x000000076ab00000) + object space 155136K, 21% used [0x00000006c0000000,0x00000006c20fe208,0x00000006c9780000) + Metaspace used 68112K, capacity 98478K, committed 98600K, reserved 1118208K + class space used 19362K, capacity 30768K, committed 30768K, reserved 1048576K +Event: 37.866 GC heap after +Heap after GC invocations=18 (full 4): + PSYoungGen total 1125888K, used 0K [0x000000076ab00000, 0x00000007b0800000, 0x00000007c0000000) + eden space 1113088K, 0% used [0x000000076ab00000,0x000000076ab00000,0x00000007aea00000) + from space 12800K, 0% used [0x00000007afb80000,0x00000007afb80000,0x00000007b0800000) + to space 15360K, 0% used [0x00000007aea00000,0x00000007aea00000,0x00000007af900000) + ParOldGen total 199168K, used 38047K [0x00000006c0000000, 0x00000006cc280000, 0x000000076ab00000) + object space 199168K, 19% used [0x00000006c0000000,0x00000006c2527ea0,0x00000006cc280000) + Metaspace used 68109K, capacity 98472K, committed 98600K, reserved 1118208K + class space used 19361K, capacity 30766K, committed 30768K, reserved 1048576K +} +Event: 52.597 GC heap before +{Heap before GC invocations=19 (full 4): + PSYoungGen total 1125888K, used 1113088K [0x000000076ab00000, 0x00000007b0800000, 0x00000007c0000000) + eden space 1113088K, 100% used [0x000000076ab00000,0x00000007aea00000,0x00000007aea00000) + from space 12800K, 0% used [0x00000007afb80000,0x00000007afb80000,0x00000007b0800000) + to space 15360K, 0% used [0x00000007aea00000,0x00000007aea00000,0x00000007af900000) + ParOldGen total 199168K, used 38047K [0x00000006c0000000, 0x00000006cc280000, 0x000000076ab00000) + object space 199168K, 19% used [0x00000006c0000000,0x00000006c2527ea0,0x00000006cc280000) + Metaspace used 93976K, capacity 138566K, committed 138800K, reserved 1144832K + class space used 26653K, capacity 42791K, committed 42800K, reserved 1048576K +Event: 52.665 GC heap after +Heap after GC invocations=19 (full 4): + PSYoungGen total 1128448K, used 15357K [0x000000076ab00000, 0x00000007c0000000, 0x00000007c0000000) + eden space 1113088K, 0% used [0x000000076ab00000,0x000000076ab00000,0x00000007aea00000) + from space 15360K, 99% used [0x00000007aea00000,0x00000007af8ff4a8,0x00000007af900000) + to space 18944K, 0% used [0x00000007bed80000,0x00000007bed80000,0x00000007c0000000) + ParOldGen total 199168K, used 41769K [0x00000006c0000000, 0x00000006cc280000, 0x000000076ab00000) + object space 199168K, 20% used [0x00000006c0000000,0x00000006c28ca4b8,0x00000006cc280000) + Metaspace used 93976K, capacity 138566K, committed 138800K, reserved 1144832K + class space used 26653K, capacity 42791K, committed 42800K, reserved 1048576K +} + +Deoptimization events (10 events): +Event: 56.425 Thread 0x00007fe51f802800 Uncommon trap: reason=bimorphic action=maybe_recompile pc=0x0000000116522d0c method=clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object; @ 387 +Event: 56.427 Thread 0x00007fe51f802800 Uncommon trap: reason=bimorphic action=maybe_recompile pc=0x0000000115b4c910 method=clojure.core$map$fn__5587.invoke()Ljava/lang/Object; @ 100 +Event: 56.599 Thread 0x00007fe51f802800 Uncommon trap: reason=unstable_if action=reinterpret pc=0x0000000115d8095c method=clojure.asm.Type.getType(Ljava/lang/Class;)Lclojure/asm/Type; @ 66 +Event: 56.609 Thread 0x00007fe51f802800 Uncommon trap: reason=unstable_if action=reinterpret pc=0x00000001166a8158 method=clojure.lang.Compiler$HostExpr.emitBoxReturn(Lclojure/lang/Compiler$ObjExpr;Lclojure/asm/commons/GeneratorAdapter;Ljava/lang/Class;)V @ 142 +Event: 56.621 Thread 0x00007fe51f802800 Uncommon trap: reason=bimorphic action=maybe_recompile pc=0x0000000115b4c910 method=clojure.core$map$fn__5587.invoke()Ljava/lang/Object; @ 100 +Event: 56.840 Thread 0x00007fe51f802800 Uncommon trap: reason=bimorphic action=maybe_recompile pc=0x0000000115b4c910 method=clojure.core$map$fn__5587.invoke()Ljava/lang/Object; @ 100 +Event: 57.526 Thread 0x00007fe51f802800 Uncommon trap: reason=null_check action=make_not_entrant pc=0x0000000115ae169c method=clojure.lang.Compiler.subsumes([Ljava/lang/Class;[Ljava/lang/Class;)Z @ 46 +Event: 57.892 Thread 0x00007fe51f802800 Uncommon trap: reason=bimorphic action=maybe_recompile pc=0x0000000116522d0c method=clojure.lang.RestFn.applyTo(Lclojure/lang/ISeq;)Ljava/lang/Object; @ 387 +Event: 57.955 Thread 0x00007fe51f802800 Uncommon trap: reason=unstable_if action=reinterpret pc=0x00000001153d02e4 method=clojure.lang.Compiler$InstanceMethodExpr.(Ljava/lang/String;IILclojure/lang/Symbol;Lclojure/lang/Compiler$Expr;Ljava/lang/String;Lclojure/lang/IPersistentVector;Z)V @ +Event: 57.970 Thread 0x00007fe51f802800 Uncommon trap: reason=null_check action=make_not_entrant pc=0x0000000115ed243c method=clojure.lang.BitmapIndexedNodeAndBitmapIndexedNodeSplicer.splice(ILclojure/lang/Counts;ZILjava/lang/Object;Ljava/lang/Object;ZILjava/lang/Object;Ljava/lang/Object;)Lcloj + +Internal exceptions (10 events): +Event: 37.205 Thread 0x00007fe51f802800 Exception (0x000000076b3f2170) thrown at [/Users/java_re/workspace/8-2-build-macosx-x86_64/jdk8u102/7268/hotspot/src/share/vm/prims/jvm.cpp, line 1386] +Event: 37.235 Thread 0x00007fe51f802800 Exception (0x000000076b659290) thrown at [/Users/java_re/workspace/8-2-build-macosx-x86_64/jdk8u102/7268/hotspot/src/share/vm/prims/jvm.cpp, line 1386] +Event: 37.235 Thread 0x00007fe51f802800 Exception (0x000000076b65a998) thrown at [/Users/java_re/workspace/8-2-build-macosx-x86_64/jdk8u102/7268/hotspot/src/share/vm/prims/jvm.cpp, line 1386] +Event: 37.236 Thread 0x00007fe51f802800 Exception (0x000000076b6806f8) thrown at [/Users/java_re/workspace/8-2-build-macosx-x86_64/jdk8u102/7268/hotspot/src/share/vm/prims/jvm.cpp, line 1386] +Event: 37.236 Thread 0x00007fe51f802800 Exception (0x000000076b681e00) thrown at [/Users/java_re/workspace/8-2-build-macosx-x86_64/jdk8u102/7268/hotspot/src/share/vm/prims/jvm.cpp, line 1386] +Event: 40.501 Thread 0x00007fe51f802800 Implicit null exception at 0x000000011564d78c to 0x000000011564da55 +Event: 40.754 Thread 0x00007fe51f802800 Implicit null exception at 0x000000011516e21d to 0x000000011516e4f8 +Event: 45.271 Thread 0x00007fe51f802800 Implicit null exception at 0x00000001163e5c64 to 0x00000001163eb4ed +Event: 50.415 Thread 0x00007fe51f802800 Implicit null exception at 0x0000000115276f7c to 0x00000001152771ad +Event: 57.970 Thread 0x00007fe51f802800 Implicit null exception at 0x0000000115ed02cf to 0x0000000115ed23cd + +Events (10 events): +Event: 58.049 loading class quantum/core/reducers/reduce__init +Event: 58.049 loading class quantum/core/reducers/reduce__init done +Event: 58.062 loading class quantum/core/refs__init +Event: 58.062 loading class quantum/core/refs__init done +Event: 58.072 Thread 0x00007fe51f802800 DEOPT PACKING pc=0x000000011642d9be sp=0x000070000fe22bc0 +Event: 58.072 Thread 0x00007fe51f802800 DEOPT UNPACKING pc=0x0000000115090633 sp=0x000070000fe22ae8 mode 0 +Event: 58.075 loading class quantum/core/type__init +Event: 58.075 loading class quantum/core/type__init done +Event: 58.100 loading class quantum/core/classes__init +Event: 58.100 loading class quantum/core/classes__init done + + +Dynamic libraries: +0x0000000012481000 /System/Library/Frameworks/Cocoa.framework/Versions/A/Cocoa +0x0000000012481000 /System/Library/Frameworks/Security.framework/Versions/A/Security +0x0000000012481000 /System/Library/Frameworks/ApplicationServices.framework/Versions/A/ApplicationServices +0x0000000012481000 /usr/lib/libz.1.dylib +0x0000000012481000 /usr/lib/libSystem.B.dylib +0x0000000012481000 /usr/lib/libobjc.A.dylib +0x0000000012481000 /System/Library/Frameworks/CoreFoundation.framework/Versions/A/CoreFoundation +0x0000000012481000 /System/Library/Frameworks/Foundation.framework/Versions/C/Foundation +0x0000000012481000 /System/Library/Frameworks/AppKit.framework/Versions/C/AppKit +0x0000000012481000 /System/Library/Frameworks/CoreData.framework/Versions/A/CoreData +0x0000000012481000 /System/Library/PrivateFrameworks/RemoteViewServices.framework/Versions/A/RemoteViewServices +0x0000000012481000 /System/Library/PrivateFrameworks/UIFoundation.framework/Versions/A/UIFoundation +0x0000000012481000 /System/Library/PrivateFrameworks/DFRFoundation.framework/Versions/A/DFRFoundation +0x0000000012481000 /System/Library/Frameworks/Metal.framework/Versions/A/Metal +0x0000000012481000 /System/Library/PrivateFrameworks/DesktopServicesPriv.framework/Versions/A/DesktopServicesPriv +0x0000000012481000 /usr/lib/libenergytrace.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/SkyLight.framework/Versions/A/SkyLight +0x0000000012481000 /System/Library/Frameworks/CoreGraphics.framework/Versions/A/CoreGraphics +0x0000000012481000 /usr/lib/libScreenReader.dylib +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Accelerate +0x0000000012481000 /System/Library/Frameworks/IOSurface.framework/Versions/A/IOSurface +0x0000000012481000 /System/Library/Frameworks/AudioToolbox.framework/Versions/A/AudioToolbox +0x0000000012481000 /System/Library/Frameworks/AudioUnit.framework/Versions/A/AudioUnit +0x0000000012481000 /System/Library/PrivateFrameworks/DataDetectorsCore.framework/Versions/A/DataDetectorsCore +0x0000000012481000 /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/HIToolbox.framework/Versions/A/HIToolbox +0x0000000012481000 /usr/lib/libicucore.A.dylib +0x0000000012481000 /System/Library/Frameworks/QuartzCore.framework/Versions/A/QuartzCore +0x0000000012481000 /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/SpeechRecognition.framework/Versions/A/SpeechRecognition +0x0000000012481000 /usr/lib/libauto.dylib +0x0000000012481000 /usr/lib/libxml2.2.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/CoreUI.framework/Versions/A/CoreUI +0x0000000012481000 /System/Library/Frameworks/CoreAudio.framework/Versions/A/CoreAudio +0x0000000012481000 /System/Library/Frameworks/DiskArbitration.framework/Versions/A/DiskArbitration +0x0000000012481000 /usr/lib/liblangid.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/MultitouchSupport.framework/Versions/A/MultitouchSupport +0x0000000012481000 /System/Library/Frameworks/IOKit.framework/Versions/A/IOKit +0x0000000012481000 /usr/lib/libDiagnosticMessagesClient.dylib +0x0000000012481000 /System/Library/Frameworks/CoreServices.framework/Versions/A/CoreServices +0x0000000012481000 /System/Library/PrivateFrameworks/PerformanceAnalysis.framework/Versions/A/PerformanceAnalysis +0x0000000012481000 /System/Library/Frameworks/OpenGL.framework/Versions/A/OpenGL +0x0000000012481000 /System/Library/Frameworks/ColorSync.framework/Versions/A/ColorSync +0x0000000012481000 /System/Library/Frameworks/CoreImage.framework/Versions/A/CoreImage +0x0000000012481000 /System/Library/Frameworks/CoreText.framework/Versions/A/CoreText +0x0000000012481000 /System/Library/Frameworks/ImageIO.framework/Versions/A/ImageIO +0x0000000012481000 /System/Library/PrivateFrameworks/Backup.framework/Versions/A/Backup +0x0000000012481000 /usr/lib/libarchive.2.dylib +0x0000000012481000 /System/Library/Frameworks/CFNetwork.framework/Versions/A/CFNetwork +0x0000000012481000 /System/Library/Frameworks/SystemConfiguration.framework/Versions/A/SystemConfiguration +0x0000000012481000 /usr/lib/libCRFSuite.dylib +0x0000000012481000 /usr/lib/libc++.1.dylib +0x0000000012481000 /usr/lib/libc++abi.dylib +0x0000000012481000 /usr/lib/system/libcache.dylib +0x0000000012481000 /usr/lib/system/libcommonCrypto.dylib +0x0000000012481000 /usr/lib/system/libcompiler_rt.dylib +0x0000000012481000 /usr/lib/system/libcopyfile.dylib +0x0000000012481000 /usr/lib/system/libcorecrypto.dylib +0x0000000012481000 /usr/lib/system/libdispatch.dylib +0x0000000012481000 /usr/lib/system/libdyld.dylib +0x0000000012481000 /usr/lib/system/libkeymgr.dylib +0x0000000012481000 /usr/lib/system/liblaunch.dylib +0x0000000012481000 /usr/lib/system/libmacho.dylib +0x0000000012481000 /usr/lib/system/libquarantine.dylib +0x0000000012481000 /usr/lib/system/libremovefile.dylib +0x0000000012481000 /usr/lib/system/libsystem_asl.dylib +0x0000000012481000 /usr/lib/system/libsystem_blocks.dylib +0x0000000012481000 /usr/lib/system/libsystem_c.dylib +0x0000000012481000 /usr/lib/system/libsystem_configuration.dylib +0x0000000012481000 /usr/lib/system/libsystem_coreservices.dylib +0x0000000012481000 /usr/lib/system/libsystem_darwin.dylib +0x0000000012481000 /usr/lib/system/libsystem_dnssd.dylib +0x0000000012481000 /usr/lib/system/libsystem_info.dylib +0x0000000012481000 /usr/lib/system/libsystem_m.dylib +0x0000000012481000 /usr/lib/system/libsystem_malloc.dylib +0x0000000012481000 /usr/lib/system/libsystem_network.dylib +0x0000000012481000 /usr/lib/system/libsystem_networkextension.dylib +0x0000000012481000 /usr/lib/system/libsystem_notify.dylib +0x0000000012481000 /usr/lib/system/libsystem_sandbox.dylib +0x0000000012481000 /usr/lib/system/libsystem_secinit.dylib +0x0000000012481000 /usr/lib/system/libsystem_kernel.dylib +0x0000000012481000 /usr/lib/system/libsystem_platform.dylib +0x0000000012481000 /usr/lib/system/libsystem_pthread.dylib +0x0000000012481000 /usr/lib/system/libsystem_symptoms.dylib +0x0000000012481000 /usr/lib/system/libsystem_trace.dylib +0x0000000012481000 /usr/lib/system/libunwind.dylib +0x0000000012481000 /usr/lib/system/libxpc.dylib +0x0000000012481000 /usr/lib/closure/libclosured.dylib +0x0000000012481000 /usr/lib/libbsm.0.dylib +0x0000000012481000 /usr/lib/system/libkxld.dylib +0x0000000012481000 /usr/lib/libOpenScriptingUtil.dylib +0x0000000012481000 /usr/lib/libcoretls.dylib +0x0000000012481000 /usr/lib/libcoretls_cfhelpers.dylib +0x0000000012481000 /usr/lib/libpam.2.dylib +0x0000000012481000 /usr/lib/libsqlite3.dylib +0x0000000012481000 /usr/lib/libxar.1.dylib +0x0000000012481000 /usr/lib/libbz2.1.0.dylib +0x0000000012481000 /usr/lib/liblzma.5.dylib +0x0000000012481000 /usr/lib/libnetwork.dylib +0x0000000012481000 /usr/lib/libapple_nghttp2.dylib +0x0000000012481000 /usr/lib/libpcap.A.dylib +0x0000000012481000 /usr/lib/libboringssl.dylib +0x0000000012481000 /usr/lib/libusrtcp.dylib +0x0000000012481000 /usr/lib/libapple_crypto.dylib +0x0000000012481000 /System/Library/Frameworks/CoreServices.framework/Versions/A/Frameworks/FSEvents.framework/Versions/A/FSEvents +0x0000000012481000 /System/Library/Frameworks/CoreServices.framework/Versions/A/Frameworks/CarbonCore.framework/Versions/A/CarbonCore +0x0000000012481000 /System/Library/Frameworks/CoreServices.framework/Versions/A/Frameworks/Metadata.framework/Versions/A/Metadata +0x0000000012481000 /System/Library/Frameworks/CoreServices.framework/Versions/A/Frameworks/OSServices.framework/Versions/A/OSServices +0x0000000012481000 /System/Library/Frameworks/CoreServices.framework/Versions/A/Frameworks/SearchKit.framework/Versions/A/SearchKit +0x0000000012481000 /System/Library/Frameworks/CoreServices.framework/Versions/A/Frameworks/AE.framework/Versions/A/AE +0x0000000012481000 /System/Library/Frameworks/CoreServices.framework/Versions/A/Frameworks/LaunchServices.framework/Versions/A/LaunchServices +0x0000000012481000 /System/Library/Frameworks/CoreServices.framework/Versions/A/Frameworks/DictionaryServices.framework/Versions/A/DictionaryServices +0x0000000012481000 /System/Library/Frameworks/CoreServices.framework/Versions/A/Frameworks/SharedFileList.framework/Versions/A/SharedFileList +0x0000000012481000 /System/Library/Frameworks/NetFS.framework/Versions/A/NetFS +0x0000000012481000 /System/Library/PrivateFrameworks/NetAuth.framework/Versions/A/NetAuth +0x0000000012481000 /System/Library/PrivateFrameworks/login.framework/Versions/A/Frameworks/loginsupport.framework/Versions/A/loginsupport +0x0000000012481000 /System/Library/PrivateFrameworks/TCC.framework/Versions/A/TCC +0x0000000012481000 /usr/lib/libmecabra.dylib +0x0000000012481000 /System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/ATS.framework/Versions/A/ATS +0x0000000012481000 /System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/ColorSyncLegacy.framework/Versions/A/ColorSyncLegacy +0x0000000012481000 /System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/HIServices.framework/Versions/A/HIServices +0x0000000012481000 /System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/LangAnalysis.framework/Versions/A/LangAnalysis +0x0000000012481000 /System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/PrintCore.framework/Versions/A/PrintCore +0x0000000012481000 /System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/QD.framework/Versions/A/QD +0x0000000012481000 /System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/SpeechSynthesis.framework/Versions/A/SpeechSynthesis +0x0000000012481000 /System/Library/Frameworks/CoreDisplay.framework/Versions/A/CoreDisplay +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vImage.framework/Versions/A/vImage +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/vecLib +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libvDSP.dylib +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBNNS.dylib +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libQuadrature.dylib +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libvMisc.dylib +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libLAPACK.dylib +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libLinearAlgebra.dylib +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libSparse.dylib +0x0000000012481000 /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libSparseBLAS.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/IOAccelerator.framework/Versions/A/IOAccelerator +0x0000000012481000 /System/Library/PrivateFrameworks/IOPresentment.framework/Versions/A/IOPresentment +0x0000000012481000 /System/Library/PrivateFrameworks/DSExternalDisplay.framework/Versions/A/DSExternalDisplay +0x0000000012481000 /System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libCoreFSCache.dylib +0x0000000012481000 /System/Library/Frameworks/CoreVideo.framework/Versions/A/CoreVideo +0x0000000012481000 /System/Library/PrivateFrameworks/GraphVisualizer.framework/Versions/A/GraphVisualizer +0x0000000012481000 /System/Library/Frameworks/MetalPerformanceShaders.framework/Versions/A/MetalPerformanceShaders +0x0000000012481000 /usr/lib/libFosl_dynamic.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/FaceCore.framework/Versions/A/FaceCore +0x0000000012481000 /System/Library/Frameworks/OpenCL.framework/Versions/A/OpenCL +0x0000000012481000 /usr/lib/libcompression.dylib +0x0000000012481000 /System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/ATS.framework/Versions/A/Resources/libFontParser.dylib +0x0000000012481000 /System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/ATS.framework/Versions/A/Resources/libFontRegistry.dylib +0x0000000012481000 /System/Library/Frameworks/ImageIO.framework/Versions/A/Resources/libJPEG.dylib +0x0000000012481000 /System/Library/Frameworks/ImageIO.framework/Versions/A/Resources/libTIFF.dylib +0x0000000012481000 /System/Library/Frameworks/ImageIO.framework/Versions/A/Resources/libPng.dylib +0x0000000012481000 /System/Library/Frameworks/ImageIO.framework/Versions/A/Resources/libGIF.dylib +0x0000000012481000 /System/Library/Frameworks/ImageIO.framework/Versions/A/Resources/libJP2.dylib +0x0000000012481000 /System/Library/Frameworks/ImageIO.framework/Versions/A/Resources/libRadiance.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/AppleJPEG.framework/Versions/A/AppleJPEG +0x0000000012481000 /System/Library/PrivateFrameworks/MetalTools.framework/Versions/A/MetalTools +0x0000000012481000 /System/Library/Frameworks/MetalPerformanceShaders.framework/Frameworks/MPSCore.framework/Versions/A/MPSCore +0x0000000012481000 /System/Library/Frameworks/MetalPerformanceShaders.framework/Frameworks/MPSImage.framework/Versions/A/MPSImage +0x0000000012481000 /System/Library/Frameworks/MetalPerformanceShaders.framework/Frameworks/MPSMatrix.framework/Versions/A/MPSMatrix +0x0000000012481000 /System/Library/Frameworks/MetalPerformanceShaders.framework/Frameworks/MPSNeuralNetwork.framework/Versions/A/MPSNeuralNetwork +0x0000000012481000 /System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGLU.dylib +0x0000000012481000 /System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGFXShared.dylib +0x0000000012481000 /System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib +0x0000000012481000 /System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGLImage.dylib +0x0000000012481000 /System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libCVMSPluginSupport.dylib +0x0000000012481000 /System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libCoreVMClient.dylib +0x0000000012481000 /usr/lib/libcups.2.dylib +0x0000000012481000 /System/Library/Frameworks/Kerberos.framework/Versions/A/Kerberos +0x0000000012481000 /System/Library/Frameworks/GSS.framework/Versions/A/GSS +0x0000000012481000 /usr/lib/libresolv.9.dylib +0x0000000012481000 /usr/lib/libiconv.2.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/Heimdal.framework/Versions/A/Heimdal +0x0000000012481000 /usr/lib/libheimdal-asn1.dylib +0x0000000012481000 /System/Library/Frameworks/OpenDirectory.framework/Versions/A/OpenDirectory +0x0000000012481000 /System/Library/PrivateFrameworks/CommonAuth.framework/Versions/A/CommonAuth +0x0000000012481000 /System/Library/Frameworks/OpenDirectory.framework/Versions/A/Frameworks/CFOpenDirectory.framework/Versions/A/CFOpenDirectory +0x0000000012481000 /System/Library/Frameworks/SecurityFoundation.framework/Versions/A/SecurityFoundation +0x0000000012481000 /System/Library/PrivateFrameworks/APFS.framework/Versions/A/APFS +0x0000000012481000 /usr/lib/libutil.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/AppleSauce.framework/Versions/A/AppleSauce +0x0000000012481000 /System/Library/PrivateFrameworks/LinguisticData.framework/Versions/A/LinguisticData +0x0000000012481000 /usr/lib/libmarisa.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/Lexicon.framework/Versions/A/Lexicon +0x0000000012481000 /usr/lib/libChineseTokenizer.dylib +0x0000000012481000 /usr/lib/libcmph.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/LanguageModeling.framework/Versions/A/LanguageModeling +0x0000000012481000 /System/Library/PrivateFrameworks/CoreEmoji.framework/Versions/A/CoreEmoji +0x0000000012481000 /System/Library/Frameworks/ServiceManagement.framework/Versions/A/ServiceManagement +0x0000000012481000 /System/Library/PrivateFrameworks/BackgroundTaskManagement.framework/Versions/A/BackgroundTaskManagement +0x0000000012481000 /usr/lib/libxslt.1.dylib +0x0000000012481000 /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/Ink.framework/Versions/A/Ink +0x0000000012481000 /System/Library/PrivateFrameworks/TextureIO.framework/Versions/A/TextureIO +0x0000000012481000 /usr/lib/libate.dylib +0x0000000012481000 /System/Library/PrivateFrameworks/CrashReporterSupport.framework/Versions/A/CrashReporterSupport +0x0000000012481000 /System/Library/PrivateFrameworks/Sharing.framework/Versions/A/Sharing +0x0000000012481000 /System/Library/PrivateFrameworks/IconServices.framework/Versions/A/IconServices +0x0000000012481000 /System/Library/PrivateFrameworks/ProtocolBuffer.framework/Versions/A/ProtocolBuffer +0x0000000012481000 /System/Library/PrivateFrameworks/Apple80211.framework/Versions/A/Apple80211 +0x0000000012481000 /System/Library/Frameworks/CoreWLAN.framework/Versions/A/CoreWLAN +0x0000000012481000 /System/Library/PrivateFrameworks/CoreUtils.framework/Versions/A/CoreUtils +0x0000000012481000 /System/Library/Frameworks/IOBluetooth.framework/Versions/A/IOBluetooth +0x0000000012481000 /System/Library/PrivateFrameworks/CoreWiFi.framework/Versions/A/CoreWiFi +0x0000000012481000 /System/Library/Frameworks/CoreBluetooth.framework/Versions/A/CoreBluetooth +0x0000000012481000 /System/Library/PrivateFrameworks/SignpostNotification.framework/Versions/A/SignpostNotification +0x0000000012481000 /System/Library/PrivateFrameworks/DebugSymbols.framework/Versions/A/DebugSymbols +0x0000000012481000 /System/Library/PrivateFrameworks/CoreSymbolication.framework/Versions/A/CoreSymbolication +0x0000000012481000 /System/Library/PrivateFrameworks/Symbolication.framework/Versions/A/Symbolication +0x0000000012481000 /System/Library/PrivateFrameworks/AppleFSCompression.framework/Versions/A/AppleFSCompression +0x0000000012481000 /System/Library/PrivateFrameworks/SpeechRecognitionCore.framework/Versions/A/SpeechRecognitionCore +0x000000010d600000 /Library/Java/JavaVirtualMachines/jdk1.8.0_102.jdk/Contents/Home/jre/lib/server/libjvm.dylib +0x0000000012481000 /usr/lib/libstdc++.6.0.9.dylib +0x000000010cd12000 /Library/Java/JavaVirtualMachines/jdk1.8.0_102.jdk/Contents/Home/jre/lib/libverify.dylib +0x000000010cd20000 /Library/Java/JavaVirtualMachines/jdk1.8.0_102.jdk/Contents/Home/jre/lib/libjava.dylib +0x000000010cd9f000 /Library/Java/JavaVirtualMachines/jdk1.8.0_102.jdk/Contents/Home/jre/lib/libzip.dylib +0x0000000012481000 /System/Library/Frameworks/JavaVM.framework/Versions/A/Frameworks/JavaRuntimeSupport.framework/Versions/A/JavaRuntimeSupport +0x0000000012481000 /System/Library/Frameworks/JavaVM.framework/Versions/A/Frameworks/JavaNativeFoundation.framework/Versions/A/JavaNativeFoundation +0x0000000012481000 /System/Library/Frameworks/JavaVM.framework/Versions/A/JavaVM +0x0000000012481000 /System/Library/Frameworks/Carbon.framework/Versions/A/Carbon +0x0000000012481000 /System/Library/PrivateFrameworks/JavaLaunching.framework/Versions/A/JavaLaunching +0x0000000012481000 /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/CommonPanels.framework/Versions/A/CommonPanels +0x0000000012481000 /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/Help.framework/Versions/A/Help +0x0000000012481000 /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/ImageCapture.framework/Versions/A/ImageCapture +0x0000000012481000 /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/OpenScripting.framework/Versions/A/OpenScripting +0x0000000012481000 /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/Print.framework/Versions/A/Print +0x0000000012481000 /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/SecurityHI.framework/Versions/A/SecurityHI +0x00000001134f9000 /Library/Java/JavaVirtualMachines/jdk1.8.0_102.jdk/Contents/Home/jre/lib/libmanagement.dylib +0x0000000113507000 /Library/Java/JavaVirtualMachines/jdk1.8.0_102.jdk/Contents/Home/jre/lib/libnet.dylib + +VM Arguments: +jvm_args: -Dfile.encoding=UTF-8 -Djava.util.logging.config.file=logging.properties -Dquantum.core.cryptography:secure-PRNG=true -Dclojure.compile.path=/Users/alex.gunnarson/code/quantum/target/classes -Dcore.version=c303f6bf -Dclojure.debug=false +java_command: clojure.main -i /private/var/folders/j_/cbs74b711d1bls4ghtnk572w0000gp/T/form-init8451978232571656791.clj +java_class_path (initial): /Users/alex.gunnarson/code/quantum/test:/Users/alex.gunnarson/code/quantum/src:/Users/alex.gunnarson/code/quantum/src-untyped:/Users/alex.gunnarson/code/quantum/resources:/Users/alex.gunnarson/code/quantum/target/classes:/Users/alex.gunnarson/.m2/repository/net/java/dev/jna/platform/3.4.0/platform-3.4.0.jar:/Users/alex.gunnarson/.m2/repository/org/apache/commons/commons-math3/3.6.1/commons-math3-3.6.1.jar:/Users/alex.gunnarson/.m2/repository/lein-doo/lein-doo/0.1.7/lein-doo-0.1.7.jar:/Users/alex.gunnarson/.m2/repository/commons-beanutils/commons-beanutils-core/1.8.0/commons-beanutils-core-1.8.0.jar:/Users/alex.gunnarson/.m2/repository/org/scala-lang/scala-reflect/2.11.7/scala-reflect-2.11.7.jar:/Users/alex.gunnarson/.m2/repository/com/amazonaws/aws-java-sdk-ssm/1.11.32/aws-java-sdk-ssm-1.11.32.jar:/Users/alex.gunnarson/.m2/repository/com/datomic/datomic-lucene-core/3.3.0/datomic-lucene-core-3.3.0.jar:/Users/alex.gunnarson/.m2/repository/org/clojure/math.combinatorics/0.1.3/math.combinatorics-0.1.3.jar:/Users/alex.gunnarson/.m2/repository/com/github/fommil/netlib/native_ref-java/1.1/native_ref-java-1.1.jar:/Users/alex.gunnarson/.m2/repository/org/apache/activemq/artemis-commons/1.4.0/artemis-commons-1.4.0.jar:/Users/alex.gunnarson/.m2/repository/org/apache/parquet/parquet-encoding/1.7.0/parquet-encoding-1.7.0.jar:/Users/alex.gunnarson/.m2/repository/edu/ucar/udunits/4.5.5/udunits-4.5.5.jar:/Users/alex.gunnarson/.m2/repository/org/apache/lucene/lucene-sandbox/4.10.3/lucene-sandbox-4.10.3.jar:/Users/alex.gunnarson/.m2/repository/org/apache/hadoop/hadoop-mapreduce-client-jobclient/2.2.0/hadoop-mapreduce-client-jobclient-2.2.0.jar:/Users/alex.gunnarson/.m2/repository/edu/stanford/nlp/stanford-corenlp/3.7.0/stanford-corenlp-3.7.0.jar:/Users/alex.gunnarson/.m2/repository/org/apache/hadoop/hadoop-yarn-api/2.2.0/hadoop-yarn-api-2.2.0.jar:/Users/alex.gunnarson/.m2/repository/com/rometools/rome/1.5.1/rome-1.5.1.jar:/Users/alex.gunnarson/.m2/reposit +Launcher Type: SUN_STANDARD + +Environment Variables: +JAVA_HOME=/Library/Java/JavaVirtualMachines/jdk1.8.0_102.jdk/Contents/Home +PATH=/Users/alex.gunnarson/anaconda/bin:/Library/Frameworks/Python.framework/Versions/3.5/bin:/Users/alex.gunnarson/.rbenv/shims:/Users/alex.gunnarson/.rbenv/bin:/Users/alex.gunnarson/.rvm/gems/ruby-2.1.1/bin:/Users/alex.gunnarson/.rvm/gems/ruby-2.1.1@global/bin:/Users/alex.gunnarson/.rvm/rubies/ruby-2.1.1/bin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/MacGPG2/bin:/usr/local/munki:/Library/Frameworks/Mono.framework/Versions/Current/Commands:/Users/alex.gunnarson/anaconda/bin:/Library/Frameworks/Python.framework/Versions/3.5/bin:/Users/alex.gunnarson/.rbenv/shims:/Users/alex.gunnarson/.rbenv/bin:/Users/alex.gunnarson/.rvm/gems/ruby-2.1.1/bin:/Users/alex.gunnarson/.rvm/gems/ruby-2.1.1@global/bin:/Users/alex.gunnarson/.rvm/rubies/ruby-2.1.1/bin:/Users/alex.gunnarson/.rvm/bin:/Users/alex.gunnarson/.rvm/bin:/usr/local/bin:/Users/alex.gunnarson/.rvm/bin +SHELL=/bin/bash + +Signal Handlers: +SIGSEGV: [libjvm.dylib+0x5b0579], sa_mask[0]=11111111011111110111111111111111, sa_flags=SA_ONSTACK|SA_RESTART|SA_SIGINFO +SIGBUS: [libjvm.dylib+0x5b0579], sa_mask[0]=11111111011111110111111111111111, sa_flags=SA_RESTART|SA_SIGINFO +SIGFPE: [libjvm.dylib+0x4874e4], sa_mask[0]=11111111011111110111111111111111, sa_flags=SA_RESTART|SA_SIGINFO +SIGPIPE: [libjvm.dylib+0x4874e4], sa_mask[0]=11111111011111110111111111111111, sa_flags=SA_RESTART|SA_SIGINFO +SIGXFSZ: [libjvm.dylib+0x4874e4], sa_mask[0]=11111111011111110111111111111111, sa_flags=SA_RESTART|SA_SIGINFO +SIGILL: [libjvm.dylib+0x4874e4], sa_mask[0]=11111111011111110111111111111111, sa_flags=SA_RESTART|SA_SIGINFO +SIGUSR1: SIG_DFL, sa_mask[0]=11011111011111100000000111000110, sa_flags=none +SIGUSR2: [libjvm.dylib+0x487002], sa_mask[0]=00000000000000000000000000000000, sa_flags=SA_RESTART|SA_SIGINFO +SIGHUP: [libjvm.dylib+0x4855d9], sa_mask[0]=11111111011111110111111111111111, sa_flags=SA_RESTART|SA_SIGINFO +SIGINT: [libjvm.dylib+0x4855d9], sa_mask[0]=11111111011111110111111111111111, sa_flags=SA_RESTART|SA_SIGINFO +SIGTERM: [libjvm.dylib+0x4855d9], sa_mask[0]=11111111011111110111111111111111, sa_flags=SA_RESTART|SA_SIGINFO +SIGQUIT: [libjvm.dylib+0x4855d9], sa_mask[0]=11111111011111110111111111111111, sa_flags=SA_RESTART|SA_SIGINFO + + +--------------- S Y S T E M --------------- + +OS:Bsduname:Darwin 17.2.0 Darwin Kernel Version 17.2.0: Fri Sep 29 18:27:05 PDT 2017; root:xnu-4570.20.62~3/RELEASE_X86_64 x86_64 +rlimit: STACK 8192k, CORE 0k, NPROC 1418, NOFILE 10240, AS infinity +load average:5.64 3.81 3.61 + +CPU:total 4 (2 cores per cpu, 2 threads per core) family 6 model 61 stepping 4, cmov, cx8, fxsr, mmx, sse, sse2, sse3, ssse3, sse4.1, sse4.2, popcnt, avx, avx2, aes, clmul, erms, 3dnowpref, lzcnt, ht, tsc, tscinvbit, bmi1, bmi2, adx + +Memory: 4k page, physical 16777216k(48064k free) + +/proc/meminfo: + + +vm_info: Java HotSpot(TM) 64-Bit Server VM (25.102-b14) for bsd-amd64 JRE (1.8.0_102-b14), built on Jun 22 2016 11:42:36 by "java_re" with gcc 4.2.1 (Based on Apple Inc. build 5658) (LLVM build 2336.11.00) + +time: Fri Mar 9 23:36:12 2018 +elapsed time: 58 seconds (0d 0h 0m 58s) + diff --git a/project-base.clj b/project-base.clj index 36cddbd3..d5e5031d 100644 --- a/project-base.clj +++ b/project-base.clj @@ -6,6 +6,8 @@ [clojure.string :as str] [leiningen.core.project :as project])) +;; ===== Utils ===== ;; + (defn merge-with-k "Like `merge-with`, but the merging function takes the key being merged as the first argument" @@ -25,10 +27,21 @@ (reduce merge-entry (or m1 {}) (seq m2))))] (reduce merge2 maps)))) +(defn remove-nil-vals [m] + (->> m + (remove (fn [[_ v]] (nil? v))) + (into {}))) + +;; ===== Dependencies ===== ;; + (def clj-dependency '[org.clojure/clojure "1.9.0"]) -(def cljs-dependency '[org.clojure/clojurescript "1.9.946"]) +(def cljs-dependency '[org.clojure/clojurescript "1.10.312"]) -(def latest-stable-quantum-version "1e583fc7" #_"0.3.0-c7ed558e" #_"0.3.0-f1a3dc08") +(def latest-stable-quantum-version + "fc7a78bc" ; stable for backend use; mainly stable for frontend + #_"0.3.0-c7ed558e" ; unknown + #_"0.3.0-f1a3dc08" ; unknown + ) (def quantum-source-paths {:typed "../quantum/src" @@ -55,11 +68,6 @@ (defn with-profiles [profiles & args] (into ["with-profile" (->> profiles (map name) (str/join ","))] args)) -(defn remove-nil-vals [m] - (->> m - (remove (fn [[_ v]] (nil? v))) - (into {}))) - (def base-config|quantum {;; ===== Dependencies ===== ;; :repositories @@ -82,7 +90,8 @@ com.esotericsoftware/reflectasm]] [co.paralleluniverse/quasar-core "0.7.6" :exclusions [com.esotericsoftware/reflectasm]] - ; ==== DATA ==== + ; ==== quantum.core.data ==== + [org.dthume/data.interval-treeset "0.1.2" ] [com.carrotsearch/hppc "0.7.1" ] ; High performance primitive collections for Java [it.unimi.dsi/fastutil "7.0.12" ] #_[colt/colt "1.2.0" ] @@ -93,7 +102,10 @@ [quantum/org.clojure.core.rrb-vector "0.0.12"] [org.clojure/data.finger-tree "0.0.2"] ; MAP / SET + ;; Superseded by `frankiesardo/linked` but for now frankiesardo/linked doesn't have e.g. + ;; `.keySet` support so we keep `org.flatland/ordered` for Clojure [org.flatland/ordered "1.5.3"] + [frankiesardo/linked "1.2.9"] [org.clojure/data.avl "0.0.13"] [org.clojure/data.int-map "0.2.4"] ; ==== COMPLEX ==== @@ -105,6 +117,11 @@ [org.clojure/data.xml "0.0.8" :exclusions [org.clojure/clojure]] + ; ==== SPECS ==== + [clojure-future-spec "1.9.0-beta4" + :exclusions [org.clojure/clojure]] + [expound "0.5.0"] + [orchestra "2017.11.12-1"] ; ==== COLLECTIONS ==== [diffit "1.0.0"] ; ==== CONVERT ==== @@ -154,7 +171,6 @@ [org.clojure/math.combinatorics "0.1.3" ] [net.mikera/core.matrix "0.57.0" :exclusions [org.clojure/clojure]] - [quantum/java "1.8.2" ] [uncomplicate/neanderthal "0.8.0" ] ; BLAS ; ==== PRINT ==== [fipp "0.6.10" @@ -182,14 +198,7 @@ #_[binaryage/devtools "0.5.2" ] [environ "1.0.3" ] ; ==== DB ==== - ; DATOMIC - #_[quantum/datomic-pro "0.9.5206" ; Doesn't work, apparnetly - :exclusions [joda-time - org.slf4j/slf4j-nop - org.slf4j/log4j-over-slf4j - org.slf4j/jul-to-slf4j - org.slf4j/jcl-over-slf4j - org.codehaus.janino/commons-compiler-jdk] ] + [org.voltdb/voltdbclient "8.3"] [com.datomic/datomic-free "0.9.5407" :exclusions [org.slf4j/slf4j-nop org.slf4j/log4j-over-slf4j @@ -388,17 +397,29 @@ :aot '[sparkling.serialization sparkling.destructuring] ;; ===== REPL ===== ;; :repl-options - {:init '(do (clojure.core/require - 'quantum.core.print - 'quantum.core.print.prettier) - (quantum.core.print.prettier/extend-pretty-printing!) - (require '[quantum.core.log :refer [prl!]]) - (clojure.main/repl - :print #(binding [*print-meta* true - quantum.core.print/*collapse-symbols?* true - quantum.core.print/*print-as-code?* true] - (quantum.core.print/ppr %)) - :caught quantum.core.print/ppr-error))}}) + {:init + '(do (require + '[clj-java-decompiler.core :refer [decompile disassemble]] + 'quantum.untyped.core.error + 'quantum.untyped.core.meta.debug + 'quantum.untyped.core.print + 'quantum.untyped.core.print.prettier + '[quantum.untyped.core.log :refer [prl!]]) + ;; Otherwise `decompile` won't reliably print anything + (alter-var-root #'clj-java-decompiler.core/output + (constantly (com.strobel.decompiler.PlainTextOutput. *out*))) + (quantum.untyped.core.print.prettier/extend-pretty-printing!) + ;; For use with Atom's Proto-REPL + ;; Interned in `clojure.core` in order to not be clobbered by `refresh` + (intern 'clojure.core 'atom|proto-repl|print-fn + (atom #(binding [*print-meta* true + quantum.untyped.core.print/*collapse-symbols?* true + quantum.untyped.core.print/*print-as-code?* true] + (quantum.untyped.core.print/ppr %)))) + (intern 'clojure.core 'atom|proto-repl|print-err-fn + (atom #(quantum.untyped.core.print/ppr-error %))) + (quantum.untyped.core.meta.debug/print-pretty-exceptions!) + #_(clojure.main/repl :print ... :caught ...))}}) (defn >cljsbuild-builds "Note that for Figwheel to work, no character in the build IDs can necessitate an @@ -413,27 +434,25 @@ ;; relative to `server-root-path` asset-path (str "generated" "/" (name kind) - "/" (if (and (#{:ios :android} id-base) - (= id-suffix :quantum-dynamic-source-untyped)) - (name id-base) - id) + "/" id "/" "js") output-dir (str server-root-path "/" asset-path)] (cond-> - {:source-paths + {:id id + :source-paths (vec (concat source-paths (case id-suffix :quantum-dynamic-source [(:typed quantum-source-paths) (:untyped quantum-source-paths) - (:posh quantum-source-paths)] + #_(:posh quantum-source-paths)] :quantum-dynamic-source-untyped [(:untyped quantum-source-paths) - (:posh quantum-source-paths)] + #_(:posh quantum-source-paths)] :re-frame-trace (cond-> - [(:posh quantum-source-paths) + [#_(:posh quantum-source-paths) (if quantum? "./src-re-frame-trace" (:re-frame-trace quantum-source-paths))] @@ -482,9 +501,9 @@ (->> (conj id-suffixes nil) ; for default non-suffixed version (map (fn [id-suffix] (let [id (str (name id-base) (some->> id-suffix name (str "-")))] - [id (id>config id id-base id-suffix)])))))) + (id>config id id-base id-suffix))))))) (apply concat) - (into {})))] + vec))] (id-bases>configs (cond-> #{:web} react-native? (conj :ios :android))))) (defn >default-config [opts project-config] @@ -619,7 +638,8 @@ ;; ----- Telemetry ----- ;; "-XX:-OmitStackTraceInFastThrow" "-XX:ErrorFile=./JVMErrorDump.log" - "-Dquantum.core.log:out-file=./out.log" + "-Dquantum.core.log|out-file=./out.log" + "-Dquantum.core.log|print-to-stderror=true" ;; ----- Compilation ----- ;; #_(case system-type "t2.micro" @@ -680,9 +700,10 @@ ;; ===== Dependencies ===== ;; :dependencies [clj-dependency cljs-dependency] ;; ===== Paths ===== ;; - :target-path "target" - :test-paths ["test"] - :source-paths ["src"] + :java-source-paths ["src-java"] + :source-paths ["src"] + :target-path "target" + :test-paths ["test"] ;; ===== Compilation ===== ;; :jar-name (str artifact-base-name "-dep.jar") :uberjar-name (str artifact-base-name ".jar") @@ -768,10 +789,17 @@ "autobuilder|frontend|debug" ; accepts 1 arg: the target platform name (with-profiles (cond-> [:frontend :dev :frontend|dev] (not quantum?) (conj :quantum|static-deps)) "cljsbuild" "auto") + "autobuilder|frontend|debug|proto-repl" ; accepts 1 arg: the target platform name + (with-profiles (cond-> [:frontend :dev :frontend|dev :frontend|dev|proto-repl] (not quantum?) (conj :quantum|static-deps)) + "cljsbuild" "auto") "autobuilder|frontend|debug|quantum-dynamic" ; accepts 1 arg: the target platform name (when-not quantum? (with-profiles [:frontend :dev :frontend|dev :quantum|dynamic-deps :quantum|dynamic-source] "cljsbuild" "auto")) + "autobuilder|frontend|debug|quantum-dynamic|proto-repl" ; accepts 1 arg: the target platform name + (when-not quantum? + (with-profiles [:frontend :dev :frontend|dev :frontend|dev|proto-repl :quantum|dynamic-deps :quantum|dynamic-source] + "cljsbuild" "auto")) "autobuilder|frontend|debug|quantum-dynamic-untyped" ; accepts 1 arg: the target platform name (when-not quantum? (with-profiles [:frontend :dev :frontend|dev :quantum|dynamic-deps :quantum|dynamic-source|untyped] @@ -795,7 +823,9 @@ {:dev {:jvm-opts (into ["-Dquantum.core.system|profile=dev"] (>jvm-opts :dev)) :resource-paths ["resources-dev"] - :source-paths ["src-dev"]} + :source-paths ["src-dev"] + :dependencies '[[org.clojure/tools.nrepl "0.2.13"] + [com.clojure-goes-fast/clj-java-decompiler "0.1.1"]]} :test {:jvm-opts (>jvm-opts :test)} :prod @@ -804,22 +834,40 @@ {:source-paths ["src-backend"] :env {:print-pid? true}} :backend|dev - {:plugins '[[lein-nodisassemble "0.1.3"]]} + {} :backend|prod {} :backend|test {:plugins '[[com.jakemccrary/lein-test-refresh "0.16.0"]]} :frontend {:source-paths ["src-frontend"] - :plugins '[[lein-cljsbuild "1.1.7" - :exclusions [org.clojure/clojure org.clojure/clojurescript]]]} + :plugins '[[lein-cljsbuild "1.1.7" + :exclusions [org.clojure/clojure org.clojure/clojurescript]]]} :frontend|dev {:plugins '[[lein-figwheel "0.5.14"]] :cljsbuild - {:builds (>cljsbuild-builds :dev project-config opts ["src" "src-frontend" "src-dev"] artifact-base-name)} + {:builds (>cljsbuild-builds :dev project-config opts + ["src" "src-frontend" "src-dev"] artifact-base-name)} :figwheel {:http-server-root "server-root" ; assumes "resources" is prepended :server-port 3450 :css-dirs ["resources/server-root/css"]}} + :frontend|dev|proto-repl + {:plugins '[[lein-figwheel "0.5.14"]] + :dependencies '[[figwheel-sidecar "0.5.17"] + [com.cemerick/piggieback "0.2.2"] + [proto-repl "0.3.1"] + ;; To ensure Figwheel loads the project.clj correctly + [leiningen-core "2.8.1"]] + :repl-options ^:replace + {:nrepl-middleware '[cemerick.piggieback/wrap-cljs-repl] + :init + `(do (require 'figwheel-sidecar.repl-api) + (figwheel-sidecar.repl-api/start-figwheel! + {:build-ids ["web"] + :all-builds + '~(>cljsbuild-builds :dev project-config opts + ["src" "src-frontend" "src-dev"] artifact-base-name)}) + (figwheel-sidecar.repl-api/cljs-repl))}} :frontend|dev|re-frame-trace {:source-paths [(:re-frame-trace quantum-source-paths)] ;; It might work with React Native: https://github.com/Day8/re-frame-trace/issues/75 @@ -865,7 +913,7 @@ {:source-paths (vals quantum-source-paths)}) :quantum|dynamic-source|untyped (when-not quantum? - {:source-paths [(:untyped quantum-source-paths) (:posh quantum-source-paths)]}) + {:source-paths [(:untyped quantum-source-paths) #_(:posh quantum-source-paths)]}) ;; ----- Special profiles ----- ;; :auto-instrument {:jvm-opts ["-Dco.paralleluniverse.pulsar.instrument.auto=all"] @@ -897,9 +945,11 @@ config# (with-default-config opts# ~config) _# (when (:print-config? opts#) (pprint config#)) root# ~(when f (.getParent f))] - (def ~'project - (project/make - (dissoc config# :name :version) - (:name config#) - (:version config#) - root#)))))) + (let [project-map# + (project/make + (dissoc config# :name :version) + (:name config#) + (:version config#) + root#)] + (def ~'simple-lein-project project-map#) ; for Figwheel+nREPL + (def ~'project project-map#)))))) diff --git a/resources-dev/clojure-lang-numbers-temp.java b/resources-dev/clojure-lang-numbers-temp.java new file mode 100644 index 00000000..d316d468 --- /dev/null +++ b/resources-dev/clojure-lang-numbers-temp.java @@ -0,0 +1,1724 @@ + +public class Numbers{ + +static interface Ops{ + + +static abstract class OpsP implements Ops{ + public Number addP(Number x, Number y){ + return add(x, y); + } + + public Number unchecked_add(Number x, Number y){ + return add(x, y); + } + + public Number multiplyP(Number x, Number y){ + return multiply(x, y); + } + + public Number unchecked_multiply(Number x, Number y){ + return multiply(x, y); + } + + public Number negateP(Number x){ + return negate(x); + } + + public Number unchecked_negate(Number x){ + return negate(x); + } + + public Number incP(Number x){ + return inc(x); + } + + public Number unchecked_inc(Number x){ + return inc(x); + } + + public Number decP(Number x){ + return dec(x); + } + + public Number unchecked_dec(Number x){ + return dec(x); + } + +} + +static public Number minus(Object x){ + return ops(x).negate((Number)x); +} + +static public Number minusP(Object x){ + return ops(x).negateP((Number)x); +} + +static public Number inc(Object x){ + return ops(x).inc((Number)x); +} + +static public Number incP(Object x){ + return ops(x).incP((Number)x); +} + +static public Number dec(Object x){ + return ops(x).dec((Number)x); +} + +static public Number decP(Object x){ + return ops(x).decP((Number)x); +} + +static public Number add(Object x, Object y){ + return ops(x).combine(ops(y)).add((Number)x, (Number)y); +} + +static public Number addP(Object x, Object y){ + return ops(x).combine(ops(y)).addP((Number)x, (Number)y); +} + +static public Number minus(Object x, Object y){ + Ops yops = ops(y); + return ops(x).combine(yops).add((Number)x, yops.negate((Number)y)); +} + +static public Number minusP(Object x, Object y){ + Ops yops = ops(y); + Number negativeY = yops.negateP((Number) y); + Ops negativeYOps = ops(negativeY); + return ops(x).combine(negativeYOps).addP((Number)x, negativeY); +} + +static public Number multiply(Object x, Object y){ + return ops(x).combine(ops(y)).multiply((Number)x, (Number)y); +} + +static public Number multiplyP(Object x, Object y){ + return ops(x).combine(ops(y)).multiplyP((Number)x, (Number)y); +} + +static public Number divide(Object x, Object y){ + if (isNaN(x)){ + return (Number)x; + } else if(isNaN(y)){ + return (Number)y; + } + Ops yops = ops(y); + if(yops.isZero((Number)y)) + throw new ArithmeticException("Divide by zero"); + return ops(x).combine(yops).divide((Number)x, (Number)y); +} + +static public Number quotient(Object x, Object y){ + Ops yops = ops(y); + if(yops.isZero((Number) y)) + throw new ArithmeticException("Divide by zero"); + return ops(x).combine(yops).quotient((Number)x, (Number)y); +} + +static public Number remainder(Object x, Object y){ + Ops yops = ops(y); + if(yops.isZero((Number) y)) + throw new ArithmeticException("Divide by zero"); + return ops(x).combine(yops).remainder((Number)x, (Number)y); +} + +static public double quotient(double n, double d){ + if(d == 0) + throw new ArithmeticException("Divide by zero"); + + double q = n / d; + if(q <= Long.MAX_VALUE && q >= Long.MIN_VALUE) + { + return (double)(long) q; + } + else + { //bigint quotient + return new BigDecimal(q).toBigInteger().doubleValue(); + } +} + +static public double remainder(double n, double d){ + if(d == 0) + throw new ArithmeticException("Divide by zero"); + + double q = n / d; + if(q <= Long.MAX_VALUE && q >= Long.MIN_VALUE) + { + return (n - ((long) q) * d); + } + else + { //bigint quotient + Number bq = new BigDecimal(q).toBigInteger(); + return (n - bq.doubleValue() * d); + } +} + +@WarnBoxedMath(false) +static public Number rationalize(Number x){ + if(x instanceof Float || x instanceof Double) + return rationalize(BigDecimal.valueOf(x.doubleValue())); + else if(x instanceof BigDecimal) + { + BigDecimal bx = (BigDecimal) x; + BigInteger bv = bx.unscaledValue(); + int scale = bx.scale(); + if(scale < 0) + return BigInt.fromBigInteger(bv.multiply(BigInteger.TEN.pow(-scale))); + else + return divide(bv, BigInteger.TEN.pow(scale)); + } + return x; +} + + +@WarnBoxedMath(false) +static public Number reduceBigInt(BigInt val){ + if(val.bipart == null) + return num(val.lpart); + else + return val.bipart; +} + +static public Number divide(BigInteger n, BigInteger d){ + if(d.equals(BigInteger.ZERO)) + throw new ArithmeticException("Divide by zero"); + BigInteger gcd = n.gcd(d); + if(gcd.equals(BigInteger.ZERO)) + return BigInt.ZERO; + n = n.divide(gcd); + d = d.divide(gcd); + if(d.equals(BigInteger.ONE)) + return BigInt.fromBigInteger(n); + else if(d.equals(BigInteger.ONE.negate())) + return BigInt.fromBigInteger(n.negate()); + return new Ratio((d.signum() < 0 ? n.negate() : n), + (d.signum() < 0 ? d.negate() : d)); +} + +static public long shiftLeft(Object x, Object y){ + return shiftLeft(bitOpsCast(x),bitOpsCast(y)); +} +static public long shiftLeft(Object x, long y){ + return shiftLeft(bitOpsCast(x),y); +} +static public long shiftLeft(long x, Object y){ + return shiftLeft(x,bitOpsCast(y)); +} + +static public long shiftRight(Object x, Object y){ + return shiftRight(bitOpsCast(x),bitOpsCast(y)); +} +static public long shiftRight(Object x, long y){ + return shiftRight(bitOpsCast(x),y); +} +static public long shiftRight(long x, Object y){ + return shiftRight(x,bitOpsCast(y)); +} + + +static public long unsignedShiftRight(Object x, Object y){ + return unsignedShiftRight(bitOpsCast(x),bitOpsCast(y)); +} +static public long unsignedShiftRight(Object x, long y){ + return unsignedShiftRight(bitOpsCast(x),y); +} +static public long unsignedShiftRight(long x, Object y){ + return unsignedShiftRight(x,bitOpsCast(y)); +} + +final static class LongOps implements Ops{ + public Ops combine(Ops y){ + return y.opsWith(this); + } + + final public Ops opsWith(LongOps x){ + return this; + } + + final public Ops opsWith(DoubleOps x){ + return DOUBLE_OPS; + } + + final public Ops opsWith(RatioOps x){ + return RATIO_OPS; + } + + final public Ops opsWith(BigIntOps x){ + return BIGINT_OPS; + } + + final public Ops opsWith(BigDecimalOps x){ + return BIGDECIMAL_OPS; + } + + final public Number add(Number x, Number y){ + return num(Numbers.add(x.longValue(),y.longValue())); + } + + final public Number addP(Number x, Number y){ + long lx = x.longValue(), ly = y.longValue(); + long ret = lx + ly; + if ((ret ^ lx) < 0 && (ret ^ ly) < 0) + return BIGINT_OPS.add(x, y); + return num(ret); + } + + final public Number unchecked_add(Number x, Number y){ + return num(Numbers.unchecked_add(x.longValue(), y.longValue())); + } + + final public Number multiply(Number x, Number y){ + return num(Numbers.multiply(x.longValue(), y.longValue())); + } + + final public Number multiplyP(Number x, Number y){ + long lx = x.longValue(), ly = y.longValue(); + if (lx == Long.MIN_VALUE && ly < 0) + return BIGINT_OPS.multiply(x, y); + long ret = lx * ly; + if (ly != 0 && ret/ly != lx) + return BIGINT_OPS.multiply(x, y); + return num(ret); + } + + final public Number unchecked_multiply(Number x, Number y){ + return num(Numbers.unchecked_multiply(x.longValue(), y.longValue())); + } + + static long gcd(long u, long v){ + while(v != 0) + { + long r = u % v; + u = v; + v = r; + } + return u; + } + + public Number divide(Number x, Number y){ + long n = x.longValue(); + long val = y.longValue(); + long gcd = gcd(n, val); + if(gcd == 0) + return num(0); + + n = n / gcd; + long d = val / gcd; + if(d == 1) + return num(n); + if(d < 0) + { + n = -n; + d = -d; + } + return new Ratio(BigInteger.valueOf(n), BigInteger.valueOf(d)); + } + + public Number quotient(Number x, Number y){ + return num(x.longValue() / y.longValue()); + } + + public Number remainder(Number x, Number y){ + return num(x.longValue() % y.longValue()); + } + + //public Number subtract(Number x, Number y); + final public Number negate(Number x){ + long val = x.longValue(); + return num(Numbers.minus(val)); + } + + final public Number negateP(Number x){ + long val = x.longValue(); + if(val > Long.MIN_VALUE) + return num(-val); + return BigInt.fromBigInteger(BigInteger.valueOf(val).negate()); + } + + final public Number unchecked_negate(Number x){ + long val = x.longValue(); + return num(Numbers.unchecked_minus(val)); + } + + public Number inc(Number x){ + long val = x.longValue(); + return num(Numbers.inc(val)); + } + + public Number incP(Number x){ + long val = x.longValue(); + if(val < Long.MAX_VALUE) + return num(val + 1); + return BIGINT_OPS.inc(x); + } + + public Number unchecked_inc(Number x){ + long val = x.longValue(); + return num(Numbers.unchecked_inc(val)); + } + + public Number dec(Number x){ + long val = x.longValue(); + return num(Numbers.dec(val)); + } + + public Number decP(Number x){ + long val = x.longValue(); + if(val > Long.MIN_VALUE) + return num(val - 1); + return BIGINT_OPS.dec(x); + } + + public Number unchecked_dec(Number x){ + long val = x.longValue(); + return num(Numbers.unchecked_dec(val)); + } +} + +final static class DoubleOps extends OpsP{ + public Ops combine(Ops y){ + return y.opsWith(this); + } + + final public Ops opsWith(LongOps x){ + return this; + } + + final public Ops opsWith(DoubleOps x){ + return this; + } + + final public Ops opsWith(RatioOps x){ + return this; + } + + final public Ops opsWith(BigIntOps x){ + return this; + } + + final public Ops opsWith(BigDecimalOps x){ + return this; + } + + final public Number add(Number x, Number y){ + return Double.valueOf(x.doubleValue() + y.doubleValue()); + } + + final public Number multiply(Number x, Number y){ + return Double.valueOf(x.doubleValue() * y.doubleValue()); + } + + public Number divide(Number x, Number y){ + return Double.valueOf(x.doubleValue() / y.doubleValue()); + } + + public Number quotient(Number x, Number y){ + return Numbers.quotient(x.doubleValue(), y.doubleValue()); + } + + public Number remainder(Number x, Number y){ + return Numbers.remainder(x.doubleValue(), y.doubleValue()); + } + + //public Number subtract(Number x, Number y); + final public Number negate(Number x){ + return Double.valueOf(-x.doubleValue()); + } + + public Number inc(Number x){ + return Double.valueOf(x.doubleValue() + 1); + } + + public Number dec(Number x){ + return Double.valueOf(x.doubleValue() - 1); + } +} + +final static class RatioOps extends OpsP{ + public Ops combine(Ops y){ + return y.opsWith(this); + } + + final public Ops opsWith(LongOps x){ + return this; + } + + final public Ops opsWith(DoubleOps x){ + return DOUBLE_OPS; + } + + final public Ops opsWith(RatioOps x){ + return this; + } + + final public Ops opsWith(BigIntOps x){ + return this; + } + + final public Ops opsWith(BigDecimalOps x){ + return BIGDECIMAL_OPS; + } + + static Number normalizeRet(Number ret, Number x, Number y){ +// if(ret instanceof BigInteger && !(x instanceof BigInteger || y instanceof BigInteger)) +// { +// return reduceBigInt((BigInteger) ret); +// } + return ret; + } + + final public Number add(Number x, Number y){ + Ratio rx = toRatio(x); + Ratio ry = toRatio(y); + Number ret = divide(ry.numerator.multiply(rx.denominator) + .add(rx.numerator.multiply(ry.denominator)) + , ry.denominator.multiply(rx.denominator)); + return normalizeRet(ret, x, y); + } + + final public Number multiply(Number x, Number y){ + Ratio rx = toRatio(x); + Ratio ry = toRatio(y); + Number ret = Numbers.divide(ry.numerator.multiply(rx.numerator) + , ry.denominator.multiply(rx.denominator)); + return normalizeRet(ret, x, y); + } + + public Number divide(Number x, Number y){ + Ratio rx = toRatio(x); + Ratio ry = toRatio(y); + Number ret = Numbers.divide(ry.denominator.multiply(rx.numerator) + , ry.numerator.multiply(rx.denominator)); + return normalizeRet(ret, x, y); + } + + public Number quotient(Number x, Number y){ + Ratio rx = toRatio(x); + Ratio ry = toRatio(y); + BigInteger q = rx.numerator.multiply(ry.denominator).divide( + rx.denominator.multiply(ry.numerator)); + return normalizeRet(BigInt.fromBigInteger(q), x, y); + } + + public Number remainder(Number x, Number y){ + Ratio rx = toRatio(x); + Ratio ry = toRatio(y); + BigInteger q = rx.numerator.multiply(ry.denominator).divide( + rx.denominator.multiply(ry.numerator)); + Number ret = Numbers.minus(x, Numbers.multiply(q, y)); + return normalizeRet(ret, x, y); + } + + //public Number subtract(Number x, Number y); + final public Number negate(Number x){ + Ratio r = (Ratio) x; + return new Ratio(r.numerator.negate(), r.denominator); + } + + public Number inc(Number x){ + return Numbers.add(x, 1); + } + + public Number dec(Number x){ + return Numbers.add(x, -1); + } + +} + +final static class BigIntOps extends OpsP{ + public Ops combine(Ops y){ + return y.opsWith(this); + } + + final public Ops opsWith(LongOps x){ + return this; + } + + final public Ops opsWith(DoubleOps x){ + return DOUBLE_OPS; + } + + final public Ops opsWith(RatioOps x){ + return RATIO_OPS; + } + + final public Ops opsWith(BigIntOps x){ + return this; + } + + final public Ops opsWith(BigDecimalOps x){ + return BIGDECIMAL_OPS; + } + + final public Number add(Number x, Number y){ + return toBigInt(x).add(toBigInt(y)); + } + + final public Number multiply(Number x, Number y){ + return toBigInt(x).multiply(toBigInt(y)); + } + + public Number divide(Number x, Number y){ + return Numbers.divide(toBigInteger(x), toBigInteger(y)); + } + + public Number quotient(Number x, Number y){ + return toBigInt(x).quotient(toBigInt(y)); + } + + public Number remainder(Number x, Number y){ + return toBigInt(x).remainder(toBigInt(y)); + } + + //public Number subtract(Number x, Number y); + final public Number negate(Number x){ + return BigInt.fromBigInteger(toBigInteger(x).negate()); + } + + public Number inc(Number x){ + BigInteger bx = toBigInteger(x); + return BigInt.fromBigInteger(bx.add(BigInteger.ONE)); + } + + public Number dec(Number x){ + BigInteger bx = toBigInteger(x); + return BigInt.fromBigInteger(bx.subtract(BigInteger.ONE)); + } +} + + +final static class BigDecimalOps extends OpsP{ + final static Var MATH_CONTEXT = RT.MATH_CONTEXT; + + public Ops combine(Ops y){ + return y.opsWith(this); + } + + final public Ops opsWith(LongOps x){ + return this; + } + + final public Ops opsWith(DoubleOps x){ + return DOUBLE_OPS; + } + + final public Ops opsWith(RatioOps x){ + return this; + } + + final public Ops opsWith(BigIntOps x){ + return this; + } + + final public Ops opsWith(BigDecimalOps x){ + return this; + } + + final public Number add(Number x, Number y){ + MathContext mc = (MathContext) MATH_CONTEXT.deref(); + return mc == null + ? toBigDecimal(x).add(toBigDecimal(y)) + : toBigDecimal(x).add(toBigDecimal(y), mc); + } + + final public Number multiply(Number x, Number y){ + MathContext mc = (MathContext) MATH_CONTEXT.deref(); + return mc == null + ? toBigDecimal(x).multiply(toBigDecimal(y)) + : toBigDecimal(x).multiply(toBigDecimal(y), mc); + } + + public Number divide(Number x, Number y){ + MathContext mc = (MathContext) MATH_CONTEXT.deref(); + return mc == null + ? toBigDecimal(x).divide(toBigDecimal(y)) + : toBigDecimal(x).divide(toBigDecimal(y), mc); + } + + public Number quotient(Number x, Number y){ + MathContext mc = (MathContext) MATH_CONTEXT.deref(); + return mc == null + ? toBigDecimal(x).divideToIntegralValue(toBigDecimal(y)) + : toBigDecimal(x).divideToIntegralValue(toBigDecimal(y), mc); + } + + public Number remainder(Number x, Number y){ + MathContext mc = (MathContext) MATH_CONTEXT.deref(); + return mc == null + ? toBigDecimal(x).remainder(toBigDecimal(y)) + : toBigDecimal(x).remainder(toBigDecimal(y), mc); + } + + //public Number subtract(Number x, Number y); + final public Number negate(Number x){ + MathContext mc = (MathContext) MATH_CONTEXT.deref(); + return mc == null + ? ((BigDecimal) x).negate() + : ((BigDecimal) x).negate(mc); + } + + public Number inc(Number x){ + MathContext mc = (MathContext) MATH_CONTEXT.deref(); + BigDecimal bx = (BigDecimal) x; + return mc == null + ? bx.add(BigDecimal.ONE) + : bx.add(BigDecimal.ONE, mc); + } + + public Number dec(Number x){ + MathContext mc = (MathContext) MATH_CONTEXT.deref(); + BigDecimal bx = (BigDecimal) x; + return mc == null + ? bx.subtract(BigDecimal.ONE) + : bx.subtract(BigDecimal.ONE, mc); + } +} + +static final LongOps LONG_OPS = new LongOps(); +static final DoubleOps DOUBLE_OPS = new DoubleOps(); +static final RatioOps RATIO_OPS = new RatioOps(); +static final BigIntOps BIGINT_OPS = new BigIntOps(); +static final BigDecimalOps BIGDECIMAL_OPS = new BigDecimalOps(); + +static Ops ops(Object x){ + Class xc = x.getClass(); + + if(xc == Long.class) + return LONG_OPS; + else if(xc == Double.class) + return DOUBLE_OPS; + else if(xc == Integer.class) + return LONG_OPS; + else if(xc == Float.class) + return DOUBLE_OPS; + else if(xc == BigInt.class) + return BIGINT_OPS; + else if(xc == BigInteger.class) + return BIGINT_OPS; + else if(xc == Ratio.class) + return RATIO_OPS; + else if(xc == BigDecimal.class) + return BIGDECIMAL_OPS; + else + return LONG_OPS; +} + +@WarnBoxedMath(false) +static int hasheqFrom(Number x, Class xc){ + if(xc == Integer.class + || xc == Short.class + || xc == Byte.class + || (xc == BigInteger.class && lte(x, Long.MAX_VALUE) && gte(x,Long.MIN_VALUE))) + { + long lpart = x.longValue(); + return Murmur3.hashLong(lpart); + //return (int) (lpart ^ (lpart >>> 32)); + } + if(xc == BigDecimal.class) + { + // stripTrailingZeros() to make all numerically equal + // BigDecimal values come out the same before calling + // hashCode. Special check for 0 because + // stripTrailingZeros() does not do anything to values + // equal to 0 with different scales. + if (isZero(x)) + return BigDecimal.ZERO.hashCode(); + else + { + BigDecimal tmp = ((BigDecimal) x).stripTrailingZeros(); + return tmp.hashCode(); + } + } + if(xc == Float.class && x.equals(-0.0f)) + { + return 0; // match 0.0f + } + return x.hashCode(); +} + +@WarnBoxedMath(false) +static int hasheq(Number x){ + Class xc = x.getClass(); + + if(xc == Long.class) + { + long lpart = x.longValue(); + return Murmur3.hashLong(lpart); + //return (int) (lpart ^ (lpart >>> 32)); + } + if(xc == Double.class) + { + if(x.equals(-0.0)) + return 0; // match 0.0 + return x.hashCode(); + } + return hasheqFrom(x, xc); +} + +static long bitOpsCast(Object x){ + Class xc = x.getClass(); + + if(xc == Long.class + || xc == Integer.class + || xc == Short.class + || xc == Byte.class) + return RT.longCast(x); + // no bignums, no decimals + throw new IllegalArgumentException("bit operation not supported for: " + xc); +} + + @WarnBoxedMath(false) + static public float[] float_array(int size, Object init){ + float[] ret = new float[size]; + if(init instanceof Number) + { + float f = ((Number) init).floatValue(); + for(int i = 0; i < ret.length; i++) + ret[i] = f; + } + else + { + ISeq s = RT.seq(init); + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).floatValue(); + } + return ret; + } + + @WarnBoxedMath(false) + static public float[] float_array(Object sizeOrSeq){ + if(sizeOrSeq instanceof Number) + return new float[((Number) sizeOrSeq).intValue()]; + else + { + ISeq s = RT.seq(sizeOrSeq); + int size = RT.count(s); + float[] ret = new float[size]; + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).floatValue(); + return ret; + } + } + +@WarnBoxedMath(false) +static public double[] double_array(int size, Object init){ + double[] ret = new double[size]; + if(init instanceof Number) + { + double f = ((Number) init).doubleValue(); + for(int i = 0; i < ret.length; i++) + ret[i] = f; + } + else + { + ISeq s = RT.seq(init); + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).doubleValue(); + } + return ret; +} + +@WarnBoxedMath(false) +static public double[] double_array(Object sizeOrSeq){ + if(sizeOrSeq instanceof Number) + return new double[((Number) sizeOrSeq).intValue()]; + else + { + ISeq s = RT.seq(sizeOrSeq); + int size = RT.count(s); + double[] ret = new double[size]; + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).doubleValue(); + return ret; + } +} + +@WarnBoxedMath(false) +static public int[] int_array(int size, Object init){ + int[] ret = new int[size]; + if(init instanceof Number) + { + int f = ((Number) init).intValue(); + for(int i = 0; i < ret.length; i++) + ret[i] = f; + } + else + { + ISeq s = RT.seq(init); + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).intValue(); + } + return ret; +} + +@WarnBoxedMath(false) +static public int[] int_array(Object sizeOrSeq){ + if(sizeOrSeq instanceof Number) + return new int[((Number) sizeOrSeq).intValue()]; + else + { + ISeq s = RT.seq(sizeOrSeq); + int size = RT.count(s); + int[] ret = new int[size]; + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).intValue(); + return ret; + } +} + +@WarnBoxedMath(false) +static public long[] long_array(int size, Object init){ + long[] ret = new long[size]; + if(init instanceof Number) + { + long f = ((Number) init).longValue(); + for(int i = 0; i < ret.length; i++) + ret[i] = f; + } + else + { + ISeq s = RT.seq(init); + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).longValue(); + } + return ret; +} + +@WarnBoxedMath(false) +static public long[] long_array(Object sizeOrSeq){ + if(sizeOrSeq instanceof Number) + return new long[((Number) sizeOrSeq).intValue()]; + else + { + ISeq s = RT.seq(sizeOrSeq); + int size = RT.count(s); + long[] ret = new long[size]; + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).longValue(); + return ret; + } +} + +@WarnBoxedMath(false) +static public short[] short_array(int size, Object init){ + short[] ret = new short[size]; + if(init instanceof Short) + { + short s = (Short) init; + for(int i = 0; i < ret.length; i++) + ret[i] = s; + } + else + { + ISeq s = RT.seq(init); + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).shortValue(); + } + return ret; +} + +@WarnBoxedMath(false) +static public short[] short_array(Object sizeOrSeq){ + if(sizeOrSeq instanceof Number) + return new short[((Number) sizeOrSeq).intValue()]; + else + { + ISeq s = RT.seq(sizeOrSeq); + int size = RT.count(s); + short[] ret = new short[size]; + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).shortValue(); + return ret; + } +} + +@WarnBoxedMath(false) +static public char[] char_array(int size, Object init){ + char[] ret = new char[size]; + if(init instanceof Character) + { + char c = (Character) init; + for(int i = 0; i < ret.length; i++) + ret[i] = c; + } + else + { + ISeq s = RT.seq(init); + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = (Character) s.first(); + } + return ret; +} + +@WarnBoxedMath(false) +static public char[] char_array(Object sizeOrSeq){ + if(sizeOrSeq instanceof Number) + return new char[((Number) sizeOrSeq).intValue()]; + else + { + ISeq s = RT.seq(sizeOrSeq); + int size = RT.count(s); + char[] ret = new char[size]; + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = (Character) s.first(); + return ret; + } +} + +@WarnBoxedMath(false) +static public byte[] byte_array(int size, Object init){ + byte[] ret = new byte[size]; + if(init instanceof Byte) + { + byte b = (Byte) init; + for(int i = 0; i < ret.length; i++) + ret[i] = b; + } + else + { + ISeq s = RT.seq(init); + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).byteValue(); + } + return ret; +} + +@WarnBoxedMath(false) +static public byte[] byte_array(Object sizeOrSeq){ + if(sizeOrSeq instanceof Number) + return new byte[((Number) sizeOrSeq).intValue()]; + else + { + ISeq s = RT.seq(sizeOrSeq); + int size = RT.count(s); + byte[] ret = new byte[size]; + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = ((Number) s.first()).byteValue(); + return ret; + } +} + +@WarnBoxedMath(false) +static public boolean[] boolean_array(int size, Object init){ + boolean[] ret = new boolean[size]; + if(init instanceof Boolean) + { + boolean b = (Boolean) init; + for(int i = 0; i < ret.length; i++) + ret[i] = b; + } + else + { + ISeq s = RT.seq(init); + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = (Boolean)s.first(); + } + return ret; +} + +@WarnBoxedMath(false) +static public boolean[] boolean_array(Object sizeOrSeq){ + if(sizeOrSeq instanceof Number) + return new boolean[((Number) sizeOrSeq).intValue()]; + else + { + ISeq s = RT.seq(sizeOrSeq); + int size = RT.count(s); + boolean[] ret = new boolean[size]; + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = (Boolean)s.first(); + return ret; + } +} + +@WarnBoxedMath(false) +static public boolean[] booleans(Object array){ + return (boolean[]) array; +} + +@WarnBoxedMath(false) +static public byte[] bytes(Object array){ + return (byte[]) array; +} + +@WarnBoxedMath(false) +static public char[] chars(Object array){ + return (char[]) array; +} + +@WarnBoxedMath(false) +static public short[] shorts(Object array){ + return (short[]) array; +} + +@WarnBoxedMath(false) +static public float[] floats(Object array){ + return (float[]) array; +} + +@WarnBoxedMath(false) +static public double[] doubles(Object array){ + return (double[]) array; +} + +@WarnBoxedMath(false) +static public int[] ints(Object array){ + return (int[]) array; +} + +@WarnBoxedMath(false) +static public long[] longs(Object array){ + return (long[]) array; +} + +static public Number num(Object x){ + return (Number) x; +} + +static public Number num(float x){ + return Float.valueOf(x); +} + +static public Number num(double x){ + return Double.valueOf(x); +} + +static public double add(double x, double y){ + return x + y; +} + +static public double addP(double x, double y){ + return x + y; +} + +static public double minus(double x, double y){ + return x - y; +} + +static public double minusP(double x, double y){ + return x - y; +} + +static public double minus(double x){ + return -x; +} + +static public double minusP(double x){ + return -x; +} + +static public double inc(double x){ + return x + 1; +} + +static public double incP(double x){ + return x + 1; +} + +static public double dec(double x){ + return x - 1; +} + +static public double decP(double x){ + return x - 1; +} + +static public double multiply(double x, double y){ + return x * y; +} + +static public double multiplyP(double x, double y){ + return x * y; +} + +static public double divide(double x, double y){ + return x / y; +} + +static int throwIntOverflow(){ + throw new ArithmeticException("integer overflow"); +} + +//static public Number num(int x){ +// return Integer.valueOf(x); +//} + +static public int unchecked_int_add(int x, int y){ + return x + y; +} + +static public int unchecked_int_subtract(int x, int y){ + return x - y; +} + +static public int unchecked_int_negate(int x){ + return -x; +} + +static public int unchecked_int_inc(int x){ + return x + 1; +} + +static public int unchecked_int_dec(int x){ + return x - 1; +} + +static public int unchecked_int_multiply(int x, int y){ + return x * y; +} + +//static public int add(int x, int y){ +// int ret = x + y; +// if ((ret ^ x) < 0 && (ret ^ y) < 0) +// return throwIntOverflow(); +// return ret; +//} + +//static public int not(int x){ +// return ~x; +//} + +static public long not(Object x){ + return not(bitOpsCast(x)); +} +static public long and(Object x, Object y){ + return and(bitOpsCast(x),bitOpsCast(y)); +} +static public long and(Object x, long y){ + return and(bitOpsCast(x),y); +} +static public long and(long x, Object y){ + return and(x,bitOpsCast(y)); +} + +static public long or(Object x, Object y){ + return or(bitOpsCast(x),bitOpsCast(y)); +} +static public long or(Object x, long y){ + return or(bitOpsCast(x),y); +} +static public long or(long x, Object y){ + return or(x,bitOpsCast(y)); +} + +static public long xor(Object x, Object y){ + return xor(bitOpsCast(x),bitOpsCast(y)); +} +static public long xor(Object x, long y){ + return xor(bitOpsCast(x),y); +} +static public long xor(long x, Object y){ + return xor(x,bitOpsCast(y)); +} + +static public long clearBit(Object x, Object y){ + return clearBit(bitOpsCast(x),bitOpsCast(y)); +} +static public long clearBit(Object x, long y){ + return clearBit(bitOpsCast(x),y); +} +static public long clearBit(long x, Object y){ + return clearBit(x,bitOpsCast(y)); +} +static public long clearBit(long x, long n){ + return x & ~(1L << n); +} + +static public long setBit(Object x, Object y){ + return setBit(bitOpsCast(x),bitOpsCast(y)); +} +static public long setBit(Object x, long y){ + return setBit(bitOpsCast(x),y); +} +static public long setBit(long x, Object y){ + return setBit(x,bitOpsCast(y)); +} +static public long setBit(long x, long n){ + return x | (1L << n); +} + +static public long flipBit(Object x, Object y){ + return flipBit(bitOpsCast(x),bitOpsCast(y)); +} +static public long flipBit(Object x, long y){ + return flipBit(bitOpsCast(x),y); +} +static public long flipBit(long x, Object y){ + return flipBit(x,bitOpsCast(y)); +} +static public long flipBit(long x, long n){ + return x ^ (1L << n); +} + +static public boolean testBit(Object x, Object y){ + return testBit(bitOpsCast(x),bitOpsCast(y)); +} +static public boolean testBit(Object x, long y){ + return testBit(bitOpsCast(x),y); +} +static public boolean testBit(long x, Object y){ + return testBit(x,bitOpsCast(y)); +} +static public boolean testBit(long x, long n){ + return (x & (1L << n)) != 0; +} + +//static public int minus(int x, int y){ +// int ret = x - y; +// if (((ret ^ x) < 0 && (ret ^ ~y) < 0)) +// return throwIntOverflow(); +// return ret; +//} + +//static public int minus(int x){ +// if(x == Integer.MIN_VALUE) +// return throwIntOverflow(); +// return -x; +//} + +//static public int inc(int x){ +// if(x == Integer.MAX_VALUE) +// return throwIntOverflow(); +// return x + 1; +//} + +//static public int dec(int x){ +// if(x == Integer.MIN_VALUE) +// return throwIntOverflow(); +// return x - 1; +//} + +//static public int multiply(int x, int y){ +// int ret = x * y; +// if (y != 0 && ret/y != x) +// return throwIntOverflow(); +// return ret; +//} + +static public int unchecked_int_divide(int x, int y){ + return x / y; +} + +static public int unchecked_int_remainder(int x, int y){ + return x % y; +} + +static public Number num(long x){ + return Long.valueOf(x); +} + +static public long unchecked_add(long x, long y){return x + y;} +static public long unchecked_minus(long x, long y){return x - y;} +static public long unchecked_multiply(long x, long y){return x * y;} +static public long unchecked_minus(long x){return -x;} +static public long unchecked_inc(long x){return x + 1;} +static public long unchecked_dec(long x){return x - 1;} + +static public Number unchecked_add(Object x, Object y){ + return ops(x).combine(ops(y)).unchecked_add((Number)x, (Number)y); +} + +static public Number unchecked_minus(Object x, Object y){ + Ops yops = ops(y); + return ops(x).combine(yops).unchecked_add((Number)x, yops.unchecked_negate((Number)y)); +} + +static public Number unchecked_multiply(Object x, Object y){ + return ops(x).combine(ops(y)).unchecked_multiply((Number)x, (Number)y); +} + +static public Number unchecked_minus(Object x){ + return ops(x).unchecked_negate((Number)x); +} + +static public Number unchecked_inc(Object x){ + return ops(x).unchecked_inc((Number)x); +} + +static public Number unchecked_dec(Object x){ + return ops(x).unchecked_dec((Number)x); +} + +static public double unchecked_add(double x, double y){return add(x,y);} +static public double unchecked_minus(double x, double y){return minus(x,y);} +static public double unchecked_multiply(double x, double y){return multiply(x,y);} +static public double unchecked_minus(double x){return minus(x);} +static public double unchecked_inc(double x){return inc(x);} +static public double unchecked_dec(double x){return dec(x);} + +static public double unchecked_add(double x, Object y){return add(x,y);} +static public double unchecked_minus(double x, Object y){return minus(x,y);} +static public double unchecked_multiply(double x, Object y){return multiply(x,y);} +static public double unchecked_add(Object x, double y){return add(x,y);} +static public double unchecked_minus(Object x, double y){return minus(x,y);} +static public double unchecked_multiply(Object x, double y){return multiply(x,y);} + +static public double unchecked_add(double x, long y){return add(x,y);} +static public double unchecked_minus(double x, long y){return minus(x,y);} +static public double unchecked_multiply(double x, long y){return multiply(x,y);} +static public double unchecked_add(long x, double y){return add(x,y);} +static public double unchecked_minus(long x, double y){return minus(x,y);} +static public double unchecked_multiply(long x, double y){return multiply(x,y);} + +static public Number unchecked_add(long x, Object y){return unchecked_add((Object)x,y);} +static public Number unchecked_minus(long x, Object y){return unchecked_minus((Object)x,y);} +static public Number unchecked_multiply(long x, Object y){return unchecked_multiply((Object)x,y);} +static public Number unchecked_add(Object x, long y){return unchecked_add(x,(Object)y);} +static public Number unchecked_minus(Object x, long y){return unchecked_minus(x,(Object)y);} +static public Number unchecked_multiply(Object x, long y){return unchecked_multiply(x,(Object)y);} + +static public Number quotient(double x, Object y){return quotient((Object)x,y);} +static public Number quotient(Object x, double y){return quotient(x,(Object)y);} +static public Number quotient(long x, Object y){return quotient((Object)x,y);} +static public Number quotient(Object x, long y){return quotient(x,(Object)y);} +static public double quotient(double x, long y){return quotient(x,(double)y);} +static public double quotient(long x, double y){return quotient((double)x,y);} + +static public Number remainder(double x, Object y){return remainder((Object)x,y);} +static public Number remainder(Object x, double y){return remainder(x,(Object)y);} +static public Number remainder(long x, Object y){return remainder((Object)x,y);} +static public Number remainder(Object x, long y){return remainder(x,(Object)y);} +static public double remainder(double x, long y){return remainder(x,(double)y);} +static public double remainder(long x, double y){return remainder((double)x,y);} + +static public long add(long x, long y){ + long ret = x + y; + if ((ret ^ x) < 0 && (ret ^ y) < 0) + return throwIntOverflow(); + return ret; +} + +static public Number addP(long x, long y){ + long ret = x + y; + if ((ret ^ x) < 0 && (ret ^ y) < 0) + return addP((Number)x,(Number)y); + return num(ret); +} + +static public long minus(long x, long y){ + long ret = x - y; + if (((ret ^ x) < 0 && (ret ^ ~y) < 0)) + return throwIntOverflow(); + return ret; +} + +static public Number minusP(long x, long y){ + long ret = x - y; + if (((ret ^ x) < 0 && (ret ^ ~y) < 0)) + return minusP((Number)x,(Number)y); + return num(ret); +} + +static public long minus(long x){ + if(x == Long.MIN_VALUE) + return throwIntOverflow(); + return -x; +} + +static public Number minusP(long x){ + if(x == Long.MIN_VALUE) + return BigInt.fromBigInteger(BigInteger.valueOf(x).negate()); + return num(-x); +} + +static public long inc(long x){ + if(x == Long.MAX_VALUE) + return throwIntOverflow(); + return x + 1; +} + +static public Number incP(long x){ + if(x == Long.MAX_VALUE) + return BIGINT_OPS.inc(x); + return num(x + 1); +} + +static public long dec(long x){ + if(x == Long.MIN_VALUE) + return throwIntOverflow(); + return x - 1; +} + +static public Number decP(long x){ + if(x == Long.MIN_VALUE) + return BIGINT_OPS.dec(x); + return num(x - 1); +} + + +static public long multiply(long x, long y){ + if (x == Long.MIN_VALUE && y < 0) + return throwIntOverflow(); + long ret = x * y; + if (y != 0 && ret/y != x) + return throwIntOverflow(); + return ret; +} + +static public Number multiplyP(long x, long y){ + if (x == Long.MIN_VALUE && y < 0) + return multiplyP((Number)x,(Number)y); + long ret = x * y; + if (y != 0 && ret/y != x) + return multiplyP((Number)x,(Number)y); + return num(ret); +} + +static public long quotient(long x, long y){ + return x / y; +} + +static public long remainder(long x, long y){ + return x % y; +} + +//overload resolution +//* + +static public Number add(long x, Object y){ + return add((Object)x,y); +} + +static public Number add(Object x, long y){ + return add(x,(Object)y); +} + +static public Number addP(long x, Object y){ + return addP((Object)x,y); +} + +static public Number addP(Object x, long y){ + return addP(x,(Object)y); +} + +static public double add(double x, Object y){ + return add(x,((Number)y).doubleValue()); +} + +static public double add(Object x, double y){ + return add(((Number)x).doubleValue(),y); +} + +static public double add(double x, long y){ + return x + y; +} + +static public double add(long x, double y){ + return x + y; +} + +static public double addP(double x, Object y){ + return addP(x,((Number)y).doubleValue()); +} + +static public double addP(Object x, double y){ + return addP(((Number)x).doubleValue(),y); +} + +static public double addP(double x, long y){ + return x + y; +} + +static public double addP(long x, double y){ + return x + y; +} + +static public Number minus(long x, Object y){ + return minus((Object)x,y); +} + +static public Number minus(Object x, long y){ + return minus(x,(Object)y); +} + +static public Number minusP(long x, Object y){ + return minusP((Object)x,y); +} + +static public Number minusP(Object x, long y){ + return minusP(x,(Object)y); +} + +static public double minus(double x, Object y){ + return minus(x,((Number)y).doubleValue()); +} + +static public double minus(Object x, double y){ + return minus(((Number)x).doubleValue(),y); +} + +static public double minus(double x, long y){ + return x - y; +} + +static public double minus(long x, double y){ + return x - y; +} + +static public double minusP(double x, Object y){ + return minus(x,((Number)y).doubleValue()); +} + +static public double minusP(Object x, double y){ + return minus(((Number)x).doubleValue(),y); +} + +static public double minusP(double x, long y){ + return x - y; +} + +static public double minusP(long x, double y){ + return x - y; +} + +static public Number multiply(long x, Object y){ + return multiply((Object)x,y); +} + +static public Number multiply(Object x, long y){ + return multiply(x,(Object)y); +} + +static public Number multiplyP(long x, Object y){ + return multiplyP((Object)x,y); +} + +static public Number multiplyP(Object x, long y){ + return multiplyP(x,(Object)y); +} + +static public double multiply(double x, Object y){ + return multiply(x,((Number)y).doubleValue()); +} + +static public double multiply(Object x, double y){ + return multiply(((Number)x).doubleValue(),y); +} + +static public double multiply(double x, long y){ + return x * y; +} + +static public double multiply(long x, double y){ + return x * y; +} + +static public double multiplyP(double x, Object y){ + return multiplyP(x,((Number)y).doubleValue()); +} + +static public double multiplyP(Object x, double y){ + return multiplyP(((Number)x).doubleValue(),y); +} + +static public double multiplyP(double x, long y){ + return x * y; +} + +static public double multiplyP(long x, double y){ + return x * y; +} + +static public Number divide(long x, Object y){ + return divide((Object)x,y); +} + +static public Number divide(Object x, long y){ + return divide(x,(Object)y); +} + +static public double divide(double x, Object y){ + return x / ((Number)y).doubleValue(); +} + +static public double divide(Object x, double y){ + return ((Number)x).doubleValue() / y; +} + +static public double divide(double x, long y){ + return x / y; +} + +static public double divide(long x, double y){ + return x / y; +} + +static public Number divide(long x, long y){ + return divide((Number)x, (Number)y); +} + +static public Object max(double x, long y){ + if(Double.isNaN(x)){ + return x; + } + if(x > y){ + return x; + } else { + return y; + } +} + +static public Object max(long x, double y){ + if(Double.isNaN(y)){ + return y; + } + if(x > y){ + return x; + } else { + return y; + } +} + + +static public Object max(Object x, Object y){ + if(isNaN(x)){ + return x; + } else if(isNaN(y)){ + return y; + } + if(gt(x, y)) { + return x; + } else { + return y; + } +} + +static public Object min(double x, long y){ + if (Double.isNaN(x)){ + return x; + } + if(x < y){ + return x; + } else { + return y; + } +} + +static public Object min(long x, double y){ + if(Double.isNaN(y)){ + return y; + } + if(x < y){ + return x; + } else { + return y; + } +} + +static public Object min(Object x, Object y){ + if (isNaN(x)){ + return x; + } else if(isNaN(y)){ + return y; + } + if(lt(x,y)) { + return x; + } else { + return y; + } +} + +} diff --git a/resources-dev/clojure-lang-rt-temp.java b/resources-dev/clojure-lang-rt-temp.java new file mode 100644 index 00000000..1c69d24e --- /dev/null +++ b/resources-dev/clojure-lang-rt-temp.java @@ -0,0 +1,1758 @@ +package clojure.lang; + +import java.net.MalformedURLException; +import java.util.concurrent.atomic.AtomicInteger; +import java.util.concurrent.Callable; +import java.util.*; +import java.util.regex.Matcher; +import java.util.regex.Pattern; +import java.io.*; +import java.lang.reflect.Array; +import java.math.BigDecimal; +import java.math.BigInteger; +import java.security.AccessController; +import java.security.PrivilegedAction; +import java.net.URL; +import java.net.JarURLConnection; +import java.nio.charset.Charset; +import java.net.URLConnection; + +public class RT{ + +static public final Object[] EMPTY_ARRAY = new Object[]{}; + +static AtomicInteger id = new AtomicInteger(1); + +static public void addURL(Object url) throws MalformedURLException{ + URL u = (url instanceof String) ? (new URL((String) url)) : (URL) url; + ClassLoader ccl = Thread.currentThread().getContextClassLoader(); + if(ccl instanceof DynamicClassLoader) + ((DynamicClassLoader)ccl).addURL(u); + else + throw new IllegalAccessError("Context classloader is not a DynamicClassLoader"); +} + +public static boolean checkSpecAsserts = Boolean.getBoolean("clojure.spec.check-asserts"); +public static boolean instrumentMacros = ! Boolean.getBoolean("clojure.spec.skip-macros"); +static volatile boolean CHECK_SPECS = false; + + +static public int nextID(){ + return id.getAndIncrement(); +} + +////////////// Collections support ///////////////////////////////// + +static public boolean canSeq(Object coll){ + return coll instanceof ISeq + || coll instanceof Seqable + || coll == null + || coll instanceof Iterable + || coll.getClass().isArray() + || coll instanceof CharSequence + || coll instanceof Map; +} + +static public Iterator iter(Object coll){ + if(coll instanceof Iterable) + return ((Iterable)coll).iterator(); + else if(coll == null) + return new Iterator(){ + public boolean hasNext(){ + return false; + } + + public Object next(){ + throw new NoSuchElementException(); + } + + public void remove(){ + throw new UnsupportedOperationException(); + } + }; + else if(coll instanceof Map){ + return ((Map)coll).entrySet().iterator(); + } + else if(coll instanceof String){ + final String s = (String) coll; + return new Iterator(){ + int i = 0; + + public boolean hasNext(){ + return i < s.length(); + } + + public Object next(){ + return s.charAt(i++); + } + + public void remove(){ + throw new UnsupportedOperationException(); + } + }; + } + else if(coll.getClass().isArray()){ + return ArrayIter.createFromObject(coll); + } + else + return iter(seq(coll)); +} + +static public ISeq keys(Object coll){ + if(coll instanceof IPersistentMap) + return APersistentMap.KeySeq.createFromMap((IPersistentMap)coll); + else + return APersistentMap.KeySeq.create(seq(coll)); +} + +static public ISeq vals(Object coll){ + if(coll instanceof IPersistentMap) + return APersistentMap.ValSeq.createFromMap((IPersistentMap)coll); + else + return APersistentMap.ValSeq.create(seq(coll)); +} + +static public IPersistentCollection conj(IPersistentCollection coll, Object x){ + if(coll == null) + return new PersistentList(x); + return coll.cons(x); +} + +static public ISeq cons(Object x, Object coll){ + //ISeq y = seq(coll); + if(coll == null) + return new PersistentList(x); + else if(coll instanceof ISeq) + return new Cons(x, (ISeq) coll); + else + return new Cons(x, seq(coll)); +} + +static public Object first(Object x){ + if(x instanceof ISeq) + return ((ISeq) x).first(); + ISeq seq = seq(x); + if(seq == null) + return null; + return seq.first(); +} + +static public ISeq next(Object x){ + if(x instanceof ISeq) + return ((ISeq) x).next(); + ISeq seq = seq(x); + if(seq == null) + return null; + return seq.next(); +} + +static public ISeq more(Object x){ + if(x instanceof ISeq) + return ((ISeq) x).more(); + ISeq seq = seq(x); + if(seq == null) + return PersistentList.EMPTY; + return seq.more(); +} + +//static public Seqable more(Object x){ +// Seqable ret = null; +// if(x instanceof ISeq) +// ret = ((ISeq) x).more(); +// else +// { +// ISeq seq = seq(x); +// if(seq == null) +// ret = PersistentList.EMPTY; +// else +// ret = seq.more(); +// } +// if(ret == null) +// ret = PersistentList.EMPTY; +// return ret; +//} + +static public Object peek(Object x){ + if(x == null) + return null; + return ((IPersistentStack) x).peek(); +} + +static public Object pop(Object x){ + if(x == null) + return null; + return ((IPersistentStack) x).pop(); +} + +static public Object get(Object coll, Object key){ + if(coll instanceof ILookup) + return ((ILookup) coll).valAt(key); + return getFrom(coll, key); +} + +static Object getFrom(Object coll, Object key){ + if(coll == null) + return null; + else if(coll instanceof Map) { + Map m = (Map) coll; + return m.get(key); + } + else if(coll instanceof IPersistentSet) { + IPersistentSet set = (IPersistentSet) coll; + return set.get(key); + } + else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) { + int n = ((Number) key).intValue(); + if(n >= 0 && n < count(coll)) + return nth(coll, n); + return null; + } + else if(coll instanceof ITransientSet) { + ITransientSet set = (ITransientSet) coll; + return set.get(key); + } + + return null; +} + +static public Object get(Object coll, Object key, Object notFound){ + if(coll instanceof ILookup) + return ((ILookup) coll).valAt(key, notFound); + return getFrom(coll, key, notFound); +} + +static Object getFrom(Object coll, Object key, Object notFound){ + if(coll == null) + return notFound; + else if(coll instanceof Map) { + Map m = (Map) coll; + if(m.containsKey(key)) + return m.get(key); + return notFound; + } + else if(coll instanceof IPersistentSet) { + IPersistentSet set = (IPersistentSet) coll; + if(set.contains(key)) + return set.get(key); + return notFound; + } + else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) { + int n = ((Number) key).intValue(); + return n >= 0 && n < count(coll) ? nth(coll, n) : notFound; + } + else if(coll instanceof ITransientSet) { + ITransientSet set = (ITransientSet) coll; + if(set.contains(key)) + return set.get(key); + return notFound; + } + return notFound; + +} + +static public Associative assoc(Object coll, Object key, Object val){ + if(coll == null) + return new PersistentArrayMap(new Object[]{key, val}); + return ((Associative) coll).assoc(key, val); +} + +static public Object contains(Object coll, Object key){ + if(coll == null) + return F; + else if(coll instanceof Associative) + return ((Associative) coll).containsKey(key) ? T : F; + else if(coll instanceof IPersistentSet) + return ((IPersistentSet) coll).contains(key) ? T : F; + else if(coll instanceof Map) { + Map m = (Map) coll; + return m.containsKey(key) ? T : F; + } + else if(coll instanceof Set) { + Set s = (Set) coll; + return s.contains(key) ? T : F; + } + else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) { + int n = ((Number) key).intValue(); + return n >= 0 && n < count(coll); + } + else if(coll instanceof ITransientSet) + return ((ITransientSet)coll).contains(key) ? T : F; + else if(coll instanceof ITransientAssociative2) + return (((ITransientAssociative2)coll).containsKey(key)) ? T : F; + throw new IllegalArgumentException("contains? not supported on type: " + coll.getClass().getName()); +} + +static public Object find(Object coll, Object key){ + if(coll == null) + return null; + else if(coll instanceof Associative) + return ((Associative) coll).entryAt(key); + else if(coll instanceof Map) { + Map m = (Map) coll; + if(m.containsKey(key)) + return MapEntry.create(key, m.get(key)); + return null; + } + else if(coll instanceof ITransientAssociative2) { + return ((ITransientAssociative2) coll).entryAt(key); + } + throw new IllegalArgumentException("find not supported on type: " + coll.getClass().getName()); +} + +//takes a seq of key,val,key,val + +//returns tail starting at val of matching key if found, else null +static public ISeq findKey(Keyword key, ISeq keyvals) { + while(keyvals != null) { + ISeq r = keyvals.next(); + if(r == null) + throw Util.runtimeException("Malformed keyword argslist"); + if(keyvals.first() == key) + return r; + keyvals = r.next(); + } + return null; +} + +static public Object dissoc(Object coll, Object key) { + if(coll == null) + return null; + return ((IPersistentMap) coll).without(key); +} + +static public Object nth(Object coll, int n){ + if(coll instanceof Indexed) + return ((Indexed) coll).nth(n); + return nthFrom(Util.ret1(coll, coll = null), n); +} + +static Object nthFrom(Object coll, int n){ + if(coll == null) + return null; + else if(coll instanceof CharSequence) + return Character.valueOf(((CharSequence) coll).charAt(n)); + else if(coll.getClass().isArray()) + return Reflector.prepRet(coll.getClass().getComponentType(),Array.get(coll, n)); + else if(coll instanceof RandomAccess) + return ((List) coll).get(n); + else if(coll instanceof Matcher) + return ((Matcher) coll).group(n); + + else if(coll instanceof Map.Entry) { + Map.Entry e = (Map.Entry) coll; + if(n == 0) + return e.getKey(); + else if(n == 1) + return e.getValue(); + throw new IndexOutOfBoundsException(); + } + + else if(coll instanceof Sequential) { + ISeq seq = RT.seq(coll); + coll = null; + for(int i = 0; i <= n && seq != null; ++i, seq = seq.next()) { + if(i == n) + return seq.first(); + } + throw new IndexOutOfBoundsException(); + } + else + throw new UnsupportedOperationException( + "nth not supported on this type: " + coll.getClass().getSimpleName()); +} + +static public Object nth(Object coll, int n, Object notFound){ + if(coll instanceof Indexed) { + Indexed v = (Indexed) coll; + return v.nth(n, notFound); + } + return nthFrom(coll, n, notFound); +} + +static Object nthFrom(Object coll, int n, Object notFound){ + if(coll == null) + return notFound; + else if(n < 0) + return notFound; + + else if(coll instanceof CharSequence) { + CharSequence s = (CharSequence) coll; + if(n < s.length()) + return Character.valueOf(s.charAt(n)); + return notFound; + } + else if(coll.getClass().isArray()) { + if(n < Array.getLength(coll)) + return Reflector.prepRet(coll.getClass().getComponentType(),Array.get(coll, n)); + return notFound; + } + else if(coll instanceof RandomAccess) { + List list = (List) coll; + if(n < list.size()) + return list.get(n); + return notFound; + } + else if(coll instanceof Matcher) { + Matcher m = (Matcher) coll; + if(n < m.groupCount()) + return m.group(n); + return notFound; + } + else if(coll instanceof Map.Entry) { + Map.Entry e = (Map.Entry) coll; + if(n == 0) + return e.getKey(); + else if(n == 1) + return e.getValue(); + return notFound; + } + else if(coll instanceof Sequential) { + ISeq seq = RT.seq(coll); + coll = null; + for(int i = 0; i <= n && seq != null; ++i, seq = seq.next()) { + if(i == n) + return seq.first(); + } + return notFound; + } + else + throw new UnsupportedOperationException( + "nth not supported on this type: " + coll.getClass().getSimpleName()); +} + +static public Object assocN(int n, Object val, Object coll){ + if(coll == null) + return null; + else if(coll instanceof IPersistentVector) + return ((IPersistentVector) coll).assocN(n, val); + else if(coll instanceof Object[]) { + //hmm... this is not persistent + Object[] array = ((Object[]) coll); + array[n] = val; + return array; + } + else + return null; +} + +static boolean hasTag(Object o, Object tag){ + return Util.equals(tag, RT.get(RT.meta(o), TAG_KEY)); +} + +/** + * ********************* Boxing/casts ****************************** + */ +static public char charCast(Object x){ + if(x instanceof Character) + return ((Character) x).charValue(); + + long n = ((Number) x).longValue(); + if(n < Character.MIN_VALUE || n > Character.MAX_VALUE) + throw new IllegalArgumentException("Value out of range for char: " + x); + + return (char) n; +} + +static public char charCast(byte x){ + char i = (char) x; + if(i != x) + throw new IllegalArgumentException("Value out of range for char: " + x); + return i; +} + +static public char charCast(short x){ + char i = (char) x; + if(i != x) + throw new IllegalArgumentException("Value out of range for char: " + x); + return i; +} + +static public char charCast(char x){ + return x; +} + +static public char charCast(int x){ + char i = (char) x; + if(i != x) + throw new IllegalArgumentException("Value out of range for char: " + x); + return i; +} + +static public char charCast(long x){ + char i = (char) x; + if(i != x) + throw new IllegalArgumentException("Value out of range for char: " + x); + return i; +} + +static public char charCast(float x){ + if(x >= Character.MIN_VALUE && x <= Character.MAX_VALUE) + return (char) x; + throw new IllegalArgumentException("Value out of range for char: " + x); +} + +static public char charCast(double x){ + if(x >= Character.MIN_VALUE && x <= Character.MAX_VALUE) + return (char) x; + throw new IllegalArgumentException("Value out of range for char: " + x); +} + +static public boolean booleanCast(Object x){ + if(x instanceof Boolean) + return ((Boolean) x).booleanValue(); + return x != null; +} + +static public boolean booleanCast(boolean x){ + return x; +} + +static public byte byteCast(Object x){ + if(x instanceof Byte) + return ((Byte) x).byteValue(); + long n = longCast(x); + if(n < Byte.MIN_VALUE || n > Byte.MAX_VALUE) + throw new IllegalArgumentException("Value out of range for byte: " + x); + + return (byte) n; +} + +static public byte byteCast(byte x){ + return x; +} + +static public byte byteCast(short x){ + byte i = (byte) x; + if(i != x) + throw new IllegalArgumentException("Value out of range for byte: " + x); + return i; +} + +static public byte byteCast(int x){ + byte i = (byte) x; + if(i != x) + throw new IllegalArgumentException("Value out of range for byte: " + x); + return i; +} + +static public byte byteCast(long x){ + byte i = (byte) x; + if(i != x) + throw new IllegalArgumentException("Value out of range for byte: " + x); + return i; +} + +static public byte byteCast(float x){ + if(x >= Byte.MIN_VALUE && x <= Byte.MAX_VALUE) + return (byte) x; + throw new IllegalArgumentException("Value out of range for byte: " + x); +} + +static public byte byteCast(double x){ + if(x >= Byte.MIN_VALUE && x <= Byte.MAX_VALUE) + return (byte) x; + throw new IllegalArgumentException("Value out of range for byte: " + x); +} + +static public short shortCast(Object x){ + if(x instanceof Short) + return ((Short) x).shortValue(); + long n = longCast(x); + if(n < Short.MIN_VALUE || n > Short.MAX_VALUE) + throw new IllegalArgumentException("Value out of range for short: " + x); + + return (short) n; +} + +static public short shortCast(byte x){ + return x; +} + +static public short shortCast(short x){ + return x; +} + +static public short shortCast(int x){ + short i = (short) x; + if(i != x) + throw new IllegalArgumentException("Value out of range for short: " + x); + return i; +} + +static public short shortCast(long x){ + short i = (short) x; + if(i != x) + throw new IllegalArgumentException("Value out of range for short: " + x); + return i; +} + +static public short shortCast(float x){ + if(x >= Short.MIN_VALUE && x <= Short.MAX_VALUE) + return (short) x; + throw new IllegalArgumentException("Value out of range for short: " + x); +} + +static public short shortCast(double x){ + if(x >= Short.MIN_VALUE && x <= Short.MAX_VALUE) + return (short) x; + throw new IllegalArgumentException("Value out of range for short: " + x); +} + +static public int intCast(Object x){ + if(x instanceof Integer) + return ((Integer)x).intValue(); + if(x instanceof Number) + { + long n = longCast(x); + return intCast(n); + } + return ((Character) x).charValue(); +} + +static public int intCast(char x){ + return x; +} + +static public int intCast(byte x){ + return x; +} + +static public int intCast(short x){ + return x; +} + +static public int intCast(int x){ + return x; +} + +static public int intCast(float x){ + if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE) + throw new IllegalArgumentException("Value out of range for int: " + x); + return (int) x; +} + +static public int intCast(long x){ + int i = (int) x; + if(i != x) + throw new IllegalArgumentException("Value out of range for int: " + x); + return i; +} + +static public int intCast(double x){ + if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE) + throw new IllegalArgumentException("Value out of range for int: " + x); + return (int) x; +} + +static public long longCast(Object x){ + if(x instanceof Integer || x instanceof Long) + return ((Number) x).longValue(); + else if (x instanceof BigInt) + { + BigInt bi = (BigInt) x; + if(bi.bipart == null) + return bi.lpart; + else + throw new IllegalArgumentException("Value out of range for long: " + x); + } + else if (x instanceof BigInteger) + { + BigInteger bi = (BigInteger) x; + if(bi.bitLength() < 64) + return bi.longValue(); + else + throw new IllegalArgumentException("Value out of range for long: " + x); + } + else if (x instanceof Byte || x instanceof Short) + return ((Number) x).longValue(); + else if (x instanceof Ratio) + return longCast(((Ratio)x).bigIntegerValue()); + else if (x instanceof Character) + return longCast(((Character) x).charValue()); + else + return longCast(((Number)x).doubleValue()); +} + +static public long longCast(byte x){ + return x; +} + +static public long longCast(short x){ + return x; +} + +static public long longCast(int x){ + return x; +} + +static public long longCast(float x){ + if(x < Long.MIN_VALUE || x > Long.MAX_VALUE) + throw new IllegalArgumentException("Value out of range for long: " + x); + return (long) x; +} + +static public long longCast(long x){ + return x; +} + +static public long longCast(double x){ + if(x < Long.MIN_VALUE || x > Long.MAX_VALUE) + throw new IllegalArgumentException("Value out of range for long: " + x); + return (long) x; +} + +static public float floatCast(Object x){ + if(x instanceof Float) + return ((Float) x).floatValue(); + + double n = ((Number) x).doubleValue(); + if(n < -Float.MAX_VALUE || n > Float.MAX_VALUE) + throw new IllegalArgumentException("Value out of range for float: " + x); + + return (float) n; + +} + +static public float floatCast(byte x){ + return x; +} + +static public float floatCast(short x){ + return x; +} + +static public float floatCast(int x){ + return x; +} + +static public float floatCast(float x){ + return x; +} + +static public float floatCast(long x){ + return x; +} + +static public float floatCast(double x){ + if(x < -Float.MAX_VALUE || x > Float.MAX_VALUE) + throw new IllegalArgumentException("Value out of range for float: " + x); + + return (float) x; +} + +static public double doubleCast(Object x){ + return ((Number) x).doubleValue(); +} + +static public double doubleCast(byte x){ + return x; +} + +static public double doubleCast(short x){ + return x; +} + +static public double doubleCast(int x){ + return x; +} + +static public double doubleCast(float x){ + return x; +} + +static public double doubleCast(long x){ + return x; +} + +static public double doubleCast(double x){ + return x; +} + +static public byte uncheckedByteCast(Object x){ + return ((Number) x).byteValue(); +} + +static public byte uncheckedByteCast(byte x){ + return x; +} + +static public byte uncheckedByteCast(short x){ + return (byte) x; +} + +static public byte uncheckedByteCast(int x){ + return (byte) x; +} + +static public byte uncheckedByteCast(long x){ + return (byte) x; +} + +static public byte uncheckedByteCast(float x){ + return (byte) x; +} + +static public byte uncheckedByteCast(double x){ + return (byte) x; +} + +static public short uncheckedShortCast(Object x){ + return ((Number) x).shortValue(); +} + +static public short uncheckedShortCast(byte x){ + return x; +} + +static public short uncheckedShortCast(short x){ + return x; +} + +static public short uncheckedShortCast(int x){ + return (short) x; +} + +static public short uncheckedShortCast(long x){ + return (short) x; +} + +static public short uncheckedShortCast(float x){ + return (short) x; +} + +static public short uncheckedShortCast(double x){ + return (short) x; +} + +static public char uncheckedCharCast(Object x){ + if(x instanceof Character) + return ((Character) x).charValue(); + return (char) ((Number) x).longValue(); +} + +static public char uncheckedCharCast(byte x){ + return (char) x; +} + +static public char uncheckedCharCast(short x){ + return (char) x; +} + +static public char uncheckedCharCast(char x){ + return x; +} + +static public char uncheckedCharCast(int x){ + return (char) x; +} + +static public char uncheckedCharCast(long x){ + return (char) x; +} + +static public char uncheckedCharCast(float x){ + return (char) x; +} + +static public char uncheckedCharCast(double x){ + return (char) x; +} + +static public int uncheckedIntCast(Object x){ + if(x instanceof Number) + return ((Number)x).intValue(); + return ((Character) x).charValue(); +} + +static public int uncheckedIntCast(byte x){ + return x; +} + +static public int uncheckedIntCast(short x){ + return x; +} + +static public int uncheckedIntCast(char x){ + return x; +} + +static public int uncheckedIntCast(int x){ + return x; +} + +static public int uncheckedIntCast(long x){ + return (int) x; +} + +static public int uncheckedIntCast(float x){ + return (int) x; +} + +static public int uncheckedIntCast(double x){ + return (int) x; +} + +static public long uncheckedLongCast(Object x){ + return ((Number) x).longValue(); +} + +static public long uncheckedLongCast(byte x){ + return x; +} + +static public long uncheckedLongCast(short x){ + return x; +} + +static public long uncheckedLongCast(int x){ + return x; +} + +static public long uncheckedLongCast(long x){ + return x; +} + +static public long uncheckedLongCast(float x){ + return (long) x; +} + +static public long uncheckedLongCast(double x){ + return (long) x; +} + +static public float uncheckedFloatCast(Object x){ + return ((Number) x).floatValue(); +} + +static public float uncheckedFloatCast(byte x){ + return x; +} + +static public float uncheckedFloatCast(short x){ + return x; +} + +static public float uncheckedFloatCast(int x){ + return x; +} + +static public float uncheckedFloatCast(long x){ + return x; +} + +static public float uncheckedFloatCast(float x){ + return x; +} + +static public float uncheckedFloatCast(double x){ + return (float) x; +} + +static public double uncheckedDoubleCast(Object x){ + return ((Number) x).doubleValue(); +} + +static public double uncheckedDoubleCast(byte x){ + return x; +} + +static public double uncheckedDoubleCast(short x){ + return x; +} + +static public double uncheckedDoubleCast(int x){ + return x; +} + +static public double uncheckedDoubleCast(long x){ + return x; +} + +static public double uncheckedDoubleCast(float x){ + return x; +} + +static public double uncheckedDoubleCast(double x){ + return x; +} + +static public IPersistentMap map(Object... init){ + if(init == null || init.length == 0) + return PersistentArrayMap.EMPTY; + else if(init.length <= PersistentArrayMap.HASHTABLE_THRESHOLD) + return PersistentArrayMap.createWithCheck(init); + return PersistentHashMap.createWithCheck(init); +} + +static public IPersistentMap mapUniqueKeys(Object... init){ + if(init == null) + return PersistentArrayMap.EMPTY; + else if(init.length <= PersistentArrayMap.HASHTABLE_THRESHOLD) + return new PersistentArrayMap(init); + return PersistentHashMap.create(init); +} + +static public IPersistentSet set(Object... init){ + return PersistentHashSet.createWithCheck(init); +} + +static public IPersistentVector vector(Object... init){ + return LazilyPersistentVector.createOwning(init); +} + +static public IPersistentVector subvec(IPersistentVector v, int start, int end){ + if(end < start || start < 0 || end > v.count()) + throw new IndexOutOfBoundsException(); + if(start == end) + return PersistentVector.EMPTY; + return new APersistentVector.SubVector(null, v, start, end); +} + +/** + * **************************************** list support ******************************* + */ + + +static public ISeq list(){ + return null; +} + +static public ISeq list(Object arg1){ + return new PersistentList(arg1); +} + +static public ISeq list(Object arg1, Object arg2){ + return listStar(arg1, arg2, null); +} + +static public ISeq list(Object arg1, Object arg2, Object arg3){ + return listStar(arg1, arg2, arg3, null); +} + +static public ISeq list(Object arg1, Object arg2, Object arg3, Object arg4){ + return listStar(arg1, arg2, arg3, arg4, null); +} + +static public ISeq list(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5){ + return listStar(arg1, arg2, arg3, arg4, arg5, null); +} + +static public ISeq listStar(Object arg1, ISeq rest){ + return (ISeq) cons(arg1, rest); +} + +static public ISeq listStar(Object arg1, Object arg2, ISeq rest){ + return (ISeq) cons(arg1, cons(arg2, rest)); +} + +static public ISeq listStar(Object arg1, Object arg2, Object arg3, ISeq rest){ + return (ISeq) cons(arg1, cons(arg2, cons(arg3, rest))); +} + +static public ISeq listStar(Object arg1, Object arg2, Object arg3, Object arg4, ISeq rest){ + return (ISeq) cons(arg1, cons(arg2, cons(arg3, cons(arg4, rest)))); +} + +static public ISeq listStar(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, ISeq rest){ + return (ISeq) cons(arg1, cons(arg2, cons(arg3, cons(arg4, cons(arg5, rest))))); +} + +static public ISeq arrayToList(Object[] a) { + ISeq ret = null; + for(int i = a.length - 1; i >= 0; --i) + ret = (ISeq) cons(a[i], ret); + return ret; +} + +static public Object[] object_array(Object sizeOrSeq){ + if(sizeOrSeq instanceof Number) + return new Object[((Number) sizeOrSeq).intValue()]; + else + { + ISeq s = RT.seq(sizeOrSeq); + int size = RT.count(s); + Object[] ret = new Object[size]; + for(int i = 0; i < size && s != null; i++, s = s.next()) + ret[i] = s.first(); + return ret; + } +} + +static public Object[] toArray(Object coll) { + if(coll == null) + return EMPTY_ARRAY; + else if(coll instanceof Object[]) + return (Object[]) coll; + else if(coll instanceof Collection) + return ((Collection) coll).toArray(); + else if(coll instanceof Iterable) { + ArrayList ret = new ArrayList(); + for(Object o : (Iterable)coll) + ret.add(o); + return ret.toArray(); + } else if(coll instanceof Map) + return ((Map) coll).entrySet().toArray(); + else if(coll instanceof String) { + char[] chars = ((String) coll).toCharArray(); + Object[] ret = new Object[chars.length]; + for(int i = 0; i < chars.length; i++) + ret[i] = chars[i]; + return ret; + } + else if(coll.getClass().isArray()) { + ISeq s = (seq(coll)); + Object[] ret = new Object[count(s)]; + for(int i = 0; i < ret.length; i++, s = s.next()) + ret[i] = s.first(); + return ret; + } + else + throw Util.runtimeException("Unable to convert: " + coll.getClass() + " to Object[]"); +} + +static public Object[] seqToArray(ISeq seq){ + int len = length(seq); + Object[] ret = new Object[len]; + for(int i = 0; seq != null; ++i, seq = seq.next()) + ret[i] = seq.first(); + return ret; +} + + // supports java Collection.toArray(T[]) + static public Object[] seqToPassedArray(ISeq seq, Object[] passed){ + Object[] dest = passed; + int len = count(seq); + if (len > dest.length) { + dest = (Object[]) Array.newInstance(passed.getClass().getComponentType(), len); + } + for(int i = 0; seq != null; ++i, seq = seq.next()) + dest[i] = seq.first(); + if (len < passed.length) { + dest[len] = null; + } + return dest; + } + +static public Object seqToTypedArray(ISeq seq) { + Class type = (seq != null && seq.first() != null) ? seq.first().getClass() : Object.class; + return seqToTypedArray(type, seq); +} + +static public Object seqToTypedArray(Class type, ISeq seq) { + Object ret = Array.newInstance(type, length(seq)); + if(type == Integer.TYPE){ + for(int i = 0; seq != null; ++i, seq=seq.next()){ + Array.set(ret, i, intCast(seq.first())); + } + } else if(type == Byte.TYPE) { + for(int i = 0; seq != null; ++i, seq=seq.next()){ + Array.set(ret, i, byteCast(seq.first())); + } + } else if(type == Float.TYPE) { + for(int i = 0; seq != null; ++i, seq=seq.next()){ + Array.set(ret, i, floatCast(seq.first())); + } + } else if(type == Short.TYPE) { + for(int i = 0; seq != null; ++i, seq=seq.next()){ + Array.set(ret, i, shortCast(seq.first())); + } + } else if(type == Character.TYPE) { + for(int i = 0; seq != null; ++i, seq=seq.next()){ + Array.set(ret, i, charCast(seq.first())); + } + } else { + for(int i = 0; seq != null; ++i, seq=seq.next()){ + Array.set(ret, i, seq.first()); + } + } + return ret; +} + +///////////////////////////////// reader support //////////////////////////////// + +static Character readRet(int ret){ + if(ret == -1) + return null; + return box((char) ret); +} + +static public Character readChar(Reader r) throws IOException{ + int ret = r.read(); + return readRet(ret); +} + +static public Character peekChar(Reader r) throws IOException{ + int ret; + if(r instanceof PushbackReader) { + ret = r.read(); + ((PushbackReader) r).unread(ret); + } + else { + r.mark(1); + ret = r.read(); + r.reset(); + } + + return readRet(ret); +} + +static public int getLineNumber(Reader r){ + if(r instanceof LineNumberingPushbackReader) + return ((LineNumberingPushbackReader) r).getLineNumber(); + return 0; +} + +static public int getColumnNumber(Reader r){ + if(r instanceof LineNumberingPushbackReader) + return ((LineNumberingPushbackReader) r).getColumnNumber(); + return 0; +} + +static public LineNumberingPushbackReader getLineNumberingReader(Reader r){ + if(isLineNumberingReader(r)) + return (LineNumberingPushbackReader) r; + return new LineNumberingPushbackReader(r); +} + +static public boolean isLineNumberingReader(Reader r){ + return r instanceof LineNumberingPushbackReader; +} + +static public String resolveClassNameInContext(String className){ + //todo - look up in context var + return className; +} + +static public boolean suppressRead(){ + return booleanCast(SUPPRESS_READ.deref()); +} + +static public String printString(Object x){ + try { + StringWriter sw = new StringWriter(); + print(x, sw); + return sw.toString(); + } + catch(Exception e) { + throw Util.sneakyThrow(e); + } +} + +static public Object readString(String s){ + return readString(s, null); +} + +static public Object readString(String s, Object opts) { + PushbackReader r = new PushbackReader(new StringReader(s)); + return LispReader.read(r, opts); +} + +static public void print(Object x, Writer w) throws IOException{ + //call multimethod + if(PRINT_INITIALIZED.isBound() && RT.booleanCast(PRINT_INITIALIZED.deref())) + PR_ON.invoke(x, w); +//* + else { + boolean readably = booleanCast(PRINT_READABLY.deref()); + if(x instanceof Obj) { + Obj o = (Obj) x; + if(RT.count(o.meta()) > 0 && + ((readably && booleanCast(PRINT_META.deref())) + || booleanCast(PRINT_DUP.deref()))) { + IPersistentMap meta = o.meta(); + w.write("#^"); + if(meta.count() == 1 && meta.containsKey(TAG_KEY)) + print(meta.valAt(TAG_KEY), w); + else + print(meta, w); + w.write(' '); + } + } + if(x == null) + w.write("nil"); + else if(x instanceof ISeq || x instanceof IPersistentList) { + w.write('('); + printInnerSeq(seq(x), w); + w.write(')'); + } + else if(x instanceof String) { + String s = (String) x; + if(!readably) + w.write(s); + else { + w.write('"'); + //w.write(x.toString()); + for(int i = 0; i < s.length(); i++) { + char c = s.charAt(i); + switch(c) { + case '\n': + w.write("\\n"); + break; + case '\t': + w.write("\\t"); + break; + case '\r': + w.write("\\r"); + break; + case '"': + w.write("\\\""); + break; + case '\\': + w.write("\\\\"); + break; + case '\f': + w.write("\\f"); + break; + case '\b': + w.write("\\b"); + break; + default: + w.write(c); + } + } + w.write('"'); + } + } + else if(x instanceof IPersistentMap) { + w.write('{'); + for(ISeq s = seq(x); s != null; s = s.next()) { + IMapEntry e = (IMapEntry) s.first(); + print(e.key(), w); + w.write(' '); + print(e.val(), w); + if(s.next() != null) + w.write(", "); + } + w.write('}'); + } + else if(x instanceof IPersistentVector) { + IPersistentVector a = (IPersistentVector) x; + w.write('['); + for(int i = 0; i < a.count(); i++) { + print(a.nth(i), w); + if(i < a.count() - 1) + w.write(' '); + } + w.write(']'); + } + else if(x instanceof IPersistentSet) { + w.write("#{"); + for(ISeq s = seq(x); s != null; s = s.next()) { + print(s.first(), w); + if(s.next() != null) + w.write(" "); + } + w.write('}'); + } + else if(x instanceof Character) { + char c = ((Character) x).charValue(); + if(!readably) + w.write(c); + else { + w.write('\\'); + switch(c) { + case '\n': + w.write("newline"); + break; + case '\t': + w.write("tab"); + break; + case ' ': + w.write("space"); + break; + case '\b': + w.write("backspace"); + break; + case '\f': + w.write("formfeed"); + break; + case '\r': + w.write("return"); + break; + default: + w.write(c); + } + } + } + else if(x instanceof Class) { + w.write("#="); + w.write(((Class) x).getName()); + } + else if(x instanceof BigDecimal && readably) { + w.write(x.toString()); + w.write('M'); + } + else if(x instanceof BigInt && readably) { + w.write(x.toString()); + w.write('N'); + } + else if(x instanceof BigInteger && readably) { + w.write(x.toString()); + w.write("BIGINT"); + } + else if(x instanceof Var) { + Var v = (Var) x; + w.write("#=(var " + v.ns.name + "/" + v.sym + ")"); + } + else if(x instanceof Pattern) { + Pattern p = (Pattern) x; + w.write("#\"" + p.pattern() + "\""); + } + else w.write(x.toString()); + } + //*/ +} + +private static void printInnerSeq(ISeq x, Writer w) throws IOException{ + for(ISeq s = x; s != null; s = s.next()) { + print(s.first(), w); + if(s.next() != null) + w.write(' '); + } +} + +static public void formatAesthetic(Writer w, Object obj) throws IOException{ + if(obj == null) + w.write("null"); + else + w.write(obj.toString()); +} + +static public void formatStandard(Writer w, Object obj) throws IOException{ + if(obj == null) + w.write("null"); + else if(obj instanceof String) { + w.write('"'); + w.write((String) obj); + w.write('"'); + } + else if(obj instanceof Character) { + w.write('\\'); + char c = ((Character) obj).charValue(); + switch(c) { + case '\n': + w.write("newline"); + break; + case '\t': + w.write("tab"); + break; + case ' ': + w.write("space"); + break; + case '\b': + w.write("backspace"); + break; + case '\f': + w.write("formfeed"); + break; + default: + w.write(c); + } + } + else + w.write(obj.toString()); +} + +static public Object format(Object o, String s, Object... args) throws IOException{ + Writer w; + if(o == null) + w = new StringWriter(); + else if(Util.equals(o, T)) + w = (Writer) OUT.deref(); + else + w = (Writer) o; + doFormat(w, s, ArraySeq.create(args)); + if(o == null) + return w.toString(); + return null; +} + +static public ISeq doFormat(Writer w, String s, ISeq args) throws IOException{ + for(int i = 0; i < s.length();) { + char c = s.charAt(i++); + switch(Character.toLowerCase(c)) { + case '~': + char d = s.charAt(i++); + switch(Character.toLowerCase(d)) { + case '%': + w.write('\n'); + break; + case 't': + w.write('\t'); + break; + case 'a': + if(args == null) + throw new IllegalArgumentException("Missing argument"); + RT.formatAesthetic(w, RT.first(args)); + args = RT.next(args); + break; + case 's': + if(args == null) + throw new IllegalArgumentException("Missing argument"); + RT.formatStandard(w, RT.first(args)); + args = RT.next(args); + break; + case '{': + int j = s.indexOf("~}", i); //note - does not nest + if(j == -1) + throw new IllegalArgumentException("Missing ~}"); + String subs = s.substring(i, j); + for(ISeq sargs = RT.seq(RT.first(args)); sargs != null;) + sargs = doFormat(w, subs, sargs); + args = RT.next(args); + i = j + 2; //skip ~} + break; + case '^': + if(args == null) + return null; + break; + case '~': + w.write('~'); + break; + default: + throw new IllegalArgumentException("Unsupported ~ directive: " + d); + } + break; + default: + w.write(c); + } + } + return args; +} +///////////////////////////////// values ////////////////////////// + + +static public ClassLoader makeClassLoader(){ + return (ClassLoader) AccessController.doPrivileged(new PrivilegedAction(){ + public Object run(){ + try{ + Var.pushThreadBindings(RT.map(USE_CONTEXT_CLASSLOADER, RT.T)); +// getRootClassLoader(); + return new DynamicClassLoader(baseLoader()); + } + finally{ + Var.popThreadBindings(); + } + } + }); +} + +static public ClassLoader baseLoader(){ + if(Compiler.LOADER.isBound()) + return (ClassLoader) Compiler.LOADER.deref(); + else if(booleanCast(USE_CONTEXT_CLASSLOADER.deref())) + return Thread.currentThread().getContextClassLoader(); + return Compiler.class.getClassLoader(); +} + +static public InputStream resourceAsStream(ClassLoader loader, String name){ + if (loader == null) { + return ClassLoader.getSystemResourceAsStream(name); + } else { + return loader.getResourceAsStream(name); + } +} + +static public URL getResource(ClassLoader loader, String name){ + if (loader == null) { + return ClassLoader.getSystemResource(name); + } else { + return loader.getResource(name); + } +} + +static public Class classForName(String name, boolean load, ClassLoader loader) { + + try + { + Class c = null; + if (!(loader instanceof DynamicClassLoader)) + c = DynamicClassLoader.findInMemoryClass(name); + if (c != null) + return c; + return Class.forName(name, load, loader); + } + catch(ClassNotFoundException e) + { + throw Util.sneakyThrow(e); + } +} + +static public Class classForName(String name) { + return classForName(name, true, baseLoader()); +} + +static public Class classForNameNonLoading(String name) { + return classForName(name, false, baseLoader()); +} + +static public Class loadClassForName(String name) { + try + { + classForNameNonLoading(name); + } + catch(Exception e) + { + if (e instanceof ClassNotFoundException) + return null; + else + throw Util.sneakyThrow(e); + } + return classForName(name); +} + +static public float aget(float[] xs, int i){ + return xs[i]; +} + +static public float aset(float[] xs, int i, float v){ + xs[i] = v; + return v; +} + +static public int alength(float[] xs){ + return xs.length; +} + +static public float[] aclone(float[] xs){ + return xs.clone(); +} + +static public double aget(double[] xs, int i){ + return xs[i]; +} + +static public double aset(double[] xs, int i, double v){ + xs[i] = v; + return v; +} + +static public int alength(double[] xs){ + return xs.length; +} + +static public double[] aclone(double[] xs){ + return xs.clone(); +} + +static public int aget(int[] xs, int i){ + return xs[i]; +} + +static public int aset(int[] xs, int i, int v){ + xs[i] = v; + return v; +} + +static public int alength(int[] xs){ + return xs.length; +} + +static public int[] aclone(int[] xs){ + return xs.clone(); +} + +static public long aget(long[] xs, int i){ + return xs[i]; +} + +static public long aset(long[] xs, int i, long v){ + xs[i] = v; + return v; +} + +static public int alength(long[] xs){ + return xs.length; +} + +static public long[] aclone(long[] xs){ + return xs.clone(); +} + +static public char aget(char[] xs, int i){ + return xs[i]; +} + +static public char aset(char[] xs, int i, char v){ + xs[i] = v; + return v; +} + +static public int alength(char[] xs){ + return xs.length; +} + +static public char[] aclone(char[] xs){ + return xs.clone(); +} + +static public byte aget(byte[] xs, int i){ + return xs[i]; +} + +static public byte aset(byte[] xs, int i, byte v){ + xs[i] = v; + return v; +} + +static public int alength(byte[] xs){ + return xs.length; +} + +static public byte[] aclone(byte[] xs){ + return xs.clone(); +} + +static public short aget(short[] xs, int i){ + return xs[i]; +} + +static public short aset(short[] xs, int i, short v){ + xs[i] = v; + return v; +} + +static public int alength(short[] xs){ + return xs.length; +} + +static public short[] aclone(short[] xs){ + return xs.clone(); +} + +static public boolean aget(boolean[] xs, int i){ + return xs[i]; +} + +static public boolean aset(boolean[] xs, int i, boolean v){ + xs[i] = v; + return v; +} + +static public int alength(boolean[] xs){ + return xs.length; +} + +static public boolean[] aclone(boolean[] xs){ + return xs.clone(); +} + +static public Object aget(Object[] xs, int i){ + return xs[i]; +} + +static public Object aset(Object[] xs, int i, Object v){ + xs[i] = v; + return v; +} + +static public int alength(Object[] xs){ + return xs.length; +} + +static public Object[] aclone(Object[] xs){ + return xs.clone(); +} + + +} diff --git a/resources-dev/clojure-lang-util-temp.java b/resources-dev/clojure-lang-util-temp.java new file mode 100644 index 00000000..1715d7e7 --- /dev/null +++ b/resources-dev/clojure-lang-util-temp.java @@ -0,0 +1,207 @@ +public class Util{ + +public interface EquivPred{ + boolean equiv(Object k1, Object k2); +} + +static EquivPred equivNull = new EquivPred() { + public boolean equiv(Object k1, Object k2) { + return k2 == null; + } + }; + +static EquivPred equivEquals = new EquivPred(){ + public boolean equiv(Object k1, Object k2) { + return k1.equals(k2); + } + }; + +static EquivPred equivNumber = new EquivPred(){ + public boolean equiv(Object k1, Object k2) { + if(k2 instanceof Number) + return Numbers.equal((Number) k1, (Number) k2); + return false; + } + }; + +static EquivPred equivColl = new EquivPred(){ + public boolean equiv(Object k1, Object k2) { + if(k1 instanceof IPersistentCollection || k2 instanceof IPersistentCollection) + return pcequiv(k1, k2); + return k1.equals(k2); + } + }; + +static public EquivPred equivPred(Object k1){ + if(k1 == null) + return equivNull; + else if (k1 instanceof Number) + return equivNumber; + else if (k1 instanceof String || k1 instanceof Symbol) + return equivEquals; + else if (k1 instanceof Collection || k1 instanceof Map) + return equivColl; + return equivEquals; +} + +static public boolean equiv(Object k1, long k2){ + return equiv(k1, (Object)k2); +} + +static public boolean equiv(long k1, Object k2){ + return equiv((Object)k1, k2); +} + +static public boolean equiv(Object k1, double k2){ + return equiv(k1, (Object)k2); +} + +static public boolean equiv(double k1, Object k2){ + return equiv((Object)k1, k2); +} + +static public boolean equiv(Object k1, boolean k2){ + return equiv(k1, (Object)k2); +} + +static public boolean equiv(boolean k1, Object k2){ + return equiv((Object)k1, k2); +} + +static public boolean equiv(char c1, char c2) { + return c1 == c2; +} + +static public boolean pcequiv(Object k1, Object k2){ + if(k1 instanceof IPersistentCollection) + return ((IPersistentCollection)k1).equiv(k2); + return ((IPersistentCollection)k2).equiv(k1); +} + +static public boolean equals(Object k1, Object k2){ + if(k1 == k2) + return true; + return k1 != null && k1.equals(k2); +} + +static public Class classOf(Object x){ + if(x != null) + return x.getClass(); + return null; +} + +static public int compare(Object k1, Object k2){ + if(k1 == k2) + return 0; + if(k1 != null) + { + if(k2 == null) + return 1; + if(k1 instanceof Number) + return Numbers.compare((Number) k1, (Number) k2); + return ((Comparable) k1).compareTo(k2); + } + return -1; +} + +static public int hash(Object o){ + if(o == null) + return 0; + return o.hashCode(); +} + +public static int hasheq(Object o){ + if(o == null) + return 0; + if(o instanceof IHashEq) + return dohasheq((IHashEq) o); + if(o instanceof Number) + return Numbers.hasheq((Number)o); + if(o instanceof String) + return Murmur3.hashInt(o.hashCode()); + return o.hashCode(); +} + +private static int dohasheq(IHashEq o) { + return o.hasheq(); +} + +static public int hashCombine(int seed, int hash){ + //a la boost + seed ^= hash + 0x9e3779b9 + (seed << 6) + (seed >> 2); + return seed; +} + +static public boolean isPrimitive(Class c){ + return c != null && c.isPrimitive() && !(c == Void.TYPE); +} + +static public boolean isInteger(Object x){ + return x instanceof Integer + || x instanceof Long + || x instanceof BigInt + || x instanceof BigInteger; +} + +static public Object ret1(Object ret, Object nil){ + return ret; +} + +static public ISeq ret1(ISeq ret, Object nil){ + return ret; +} + +static public void clearCache(ReferenceQueue rq, ConcurrentHashMap> cache){ + //cleanup any dead entries + if(rq.poll() != null) + { + while(rq.poll() != null) + ; + for(Map.Entry> e : cache.entrySet()) + { + Reference val = e.getValue(); + if(val != null && val.get() == null) + cache.remove(e.getKey(), val); + } + } +} + +static public RuntimeException runtimeException(String s){ + return new RuntimeException(s); +} + +static public RuntimeException runtimeException(String s, Throwable e){ + return new RuntimeException(s, e); +} + +/** + * Throw even checked exceptions without being required + * to declare them or catch them. Suggested idiom: + *

+ * throw sneakyThrow( some exception ); + */ +static public RuntimeException sneakyThrow(Throwable t) { + // http://www.mail-archive.com/javaposse@googlegroups.com/msg05984.html + if (t == null) + throw new NullPointerException(); + Util.sneakyThrow0(t); + return null; +} + +@SuppressWarnings("unchecked") +static private void sneakyThrow0(Throwable t) throws T { + throw (T) t; +} + +static public Object loadWithClass(String scriptbase, Class loadFrom) throws IOException, ClassNotFoundException{ + Var.pushThreadBindings(RT.map(new Object[] { Compiler.LOADER, loadFrom.getClassLoader() })); + try { + return RT.var("clojure.core", "load").invoke(scriptbase); + } + finally + { + Var.popThreadBindings(); + } +} + +} diff --git a/resources-dev/defnt.cljc b/resources-dev/defnt.cljc new file mode 100644 index 00000000..13140ae2 --- /dev/null +++ b/resources-dev/defnt.cljc @@ -0,0 +1,1881 @@ +;; TODO look at this for type-checked Spec implementation: https://github.com/arohner/spectrum/blob/master/src/spectrum/conform.clj +;; TODO look at this thread for useful discussion on potential type systems in Clojure: https://groups.google.com/forum/#!topic/clojure/Dxk-rCVL5Ss +;; - Reach out to mikera and let him know about the type system when it's done since he was working on something vaguely similar +;; TODO look at HM impl : https://github.com/ericnormand/hindley-milner + +Note that for anything built-in js/, the `t/isa?` predicates might need some special help + +;; TO MOVE + +(defn equinumerous? + [xs0 (t/input count :?), xs1 (t/input count :?) > boolean?] (= (count xs0) (count xs1))) + +#?(:clj (def thread? (isa? java.lang.Thread))) +#?(:clj (def class? (isa? java.lang.Class))) +;; TODO for CLJS based on untyped impl +#?(:clj (def protocol? (>expr (ufn/fn-> :on-interface class?)))) + +;; ===== quantum.core.system + +#?(:clj +(t/defn pid [> (? t/string?)] + (->> (java.lang.management.ManagementFactory/getRuntimeMXBean) + (.getName)))) + +;; TODO TYPED +(defalias u/*registered-components) + +;; ===== UNKNOWN ===== ;; + +(defnt >sentinel [> t/object?] #?(:clj (Object.) :cljs #js {})) +(defalias >object >sentinel) + +;; TODO TYPED +#?(:clj +(defmacro with + "Evaluates @expr, then @body, then returns @expr. + For (side) effects." + [expr #_t/form?, & body #_(? (t/seq-of t/form?))] + `(let [expr# ~expr] ~@body expr#))) + +;; Truncation is different from safe coercion +`>integer` is for e.g.: +- truncation e.g. js/Math.trunc + +>boolean is different than `truthy?` + +Sometimes you want (byte ) to fail at runtime rather than fail at compile time when you can't know everything about the input's range + + + +#_" +Pinned: +- `;; TODO TYPED` is the annotation we're using for this initiative +- There will be some code duplication with untyped code for now and that's okay. +- No typed namespace should refer to any untyped namespace. +- The initial definition of conversion functions belongs in the namespace that their destination + type belongs in, and it may be extended in every namespace in which there is a source type. +- These two should be defined in the `whatever` data namespace: + - `>(whatever)` + - `(whatever)>` +Legend: +- [.] : in progress +- [-] : done as far as possible but not truly complete +- [x] : actually done +- [|] : not possible / N/A +- [!] : refused + +- TODO implement the following: + [ ] Perhaps it's the case that we can't actually have type bases but rather reactive splits. + In the case of `narrowest`, it expects a split and fails without it: + `[a (t/- integer? int?), b integer? > (narrowest (t/type a) (t/type b))]` + [ ] `t/ref`, `t/assume`, `t/run` need to be combined correctly with other types. + E.g. (t/and (t/ref ...) ...) means the whole thing should be `t/ref`, while `(t/or (t/ref ...) + (...))` does not mean the metadata is transferred. Probably `t/assume` and `t/run` should be + combined in the same way. + - What about `(t/and (t/or t/long? (t/ref t/byte?)) pos?)` ? + [ ] t/value-of + - `[x with-metable?, meta' meta? > (t/run with-metable?) #_(TODO TYPED (t/value-of x))]` + [ ] (comp/t== x) + - dependent type such that the passed input must be identical to x + [ ] Non-boxed (primitive) `t/def`s: `(var/def- min-float (Numeric/negate Float/MAX_VALUE))` + - direct linking doesn't help with this; the way around this is seems to be to do `let` bindings for all captured non-dynamic vars, and unbox the var-values that are primitive + [ ] `(t/validate x (t/run t/string?))` for `(t/run t/string?)` needs to be more performant + - Don't re-create type on each call (see `defnt/unanalyzed-overload>overload`) + [ ] replace `deref` with `ref/deref` in typed contexts? So we can do `@` still + - Type Logic and Predicates + - expressions (`quantum.untyped.core.analyze.expr`) + - It is possible to check satisfaction of arities to an `t/ftype` at runtime even if the type + meta is not stripped (well, at least the arity counts can be checked and primitive types in + CLJ): + - In CLJ via e.g.: + - `(clojure.reflect/reflect (fn ([]) ([^long a])))` + -> {:members #{{:parameter-types [] ...} {:parameter-types [long] ...} ...}} + - In CLJS via e.g.: + - `(js/Object.getOwnPropertyNames (fn ([]) ([a])))` + -> `#js [... \"cljs$core$IFn$_invoke$arity$0\" \"cljs$core$IFn$_invoke$arity$1\"]` + - We should probably use DNF (https://en.wikipedia.org/wiki/Disjunctive_normal_form) with sorted + arguments (on creation, order by `t/compare` descending) so we can correctly hash if we do + spec lookup, and so we can split more correctly, and so we can perform faster equality checks + - (t/and (t/or a b) c) should -> (t/or (t/and a c) (t/and b c)) + - `(or (and pred then) (and (not pred) else))` (which is not correct) + - needs to equal `(t/and (t/or (t/not a) b) (t/or a c))` (which is correct) + - `(- (or ?!+vector? !vector? #?(:clj !!vector?)) (isa? clojure.lang.Counted))` is not right + - t/- : fix + - (t/- (t/isa? java.util.Queue) (t/or ?!+queue? !!queue?)) + - (t/- t/any? p/float? p/double?); (t/- number? p/primitive?) + - dc/of + - (dc/of number?) ; implicitly the container is a `reducible?`, because that's now the + fundamental traversal operation + - Maybe we should replace or supplement with: + - `(dc/* number?)` for any collection containing zero or more `number?`s + - `(dc/+ number?)` for any collection containing at least one `number?`s + - Equivalent to `(t/and (dc/* number?) (fn-> count (>= 1)))` + - `(t/and vector? (dc/* number?))` for any collection containing zero or more `number?`s, which satisfies `vector?` + - `t/finite` (reminiscent of `s/tuple`+`s/kv` but with different behavior) + - This is for when we don't want a 'pattern' but rather want the actual thing + - Instead of `(dc/* number?)` we might have `(t/finite number? (t/value 1) map?)`. The order + of inputs to `t/finite` only matters if it's `t/and`ed with a collection type for which + order matters (`(t/or dc/sequential? dc/sorted?)`): + - (t/and vector? (t/finite (t/value :a) (t/value :b))) + - must match `[:a :b]`, in that order + - (t/and set? (t/finite (t/value :a) (t/value :b))) + - must match `#{:a :b}`, not necessarily in that order + - (t/and map? (t/finite (t/finite (t/value :a) (t/value :b)) + (t/finite (t/value :c) (t/value :d)))) + - must match `{:a :b :c :d}`, not necessarily in that kv-order + - (t/and map? (t/finite (t/and map-entry? (t/finite (t/value :a) (t/value :b))) + (t/and vector? (t/finite (t/value :c) (t/value :d))))) + - must match `{:a :b :c :d}`, not necessarily in that kv-order + - (t/and map? (t/finite (t/value :a) (t/value :b))) + - impossible since not all inputs satisfy `map-entry-like?` + - (t/finite (t/value :a) (t/value :b)) + - is satisfied by e.g. [:a :b], (list :a :b), (!list :a :b), (<> :a :b), #{:a :b} + - (t/finite (t/finite (t/value :a) (t/value :b))) + - is satisfied by e.g. [[:a :b]], [(list :a :b)], (list [:a :b]), (!list [:a :b]), + (<> [:a :b]), (<> (<> :a :b)), #{[:a :b]}, {:a :b}, (sorted-map :a :b) + - (dc/of map/+map? symbol? dstr/string?) + - (dc/of t/seq? namespace?) + - dc/map-of + - dc/seq-of + - If we assert: + - [:a :b :c] is equally representable as: + - (t/seq vector? [ (t/value :a) (t/value :b) (t/value :c)]) + - (t/kv vector? {0 (t/value :a) 1 (t/value :b) 2 (t/value :c)}) + - and (sorted-map 0 :a 1 :b 2 :c) as: + - (t/kv sorted-map? { 0 (t/value :a) 1 (t/value :b) 2 (t/value :c)}) + - (t/seq sorted-map? [[0 (t/value :a)] [1 (t/value :b)] [2 (t/value :c)]]) + - then we would have to assert (absurdly) that the following are equivalent representations: + - (t/seq vector? [ (t/value :a) (t/value :b) (t/value :c)]) + - (t/kv vector? { 0 (t/value :a) 1 (t/value :b) 2 (t/value :c)}) + - (t/seq vector? [ [0 (t/value :a)] [1 (t/value :b)] [2 (t/value :c)]]) + - (t/kv vector? { 0 [0 (t/value :a)] 1 [1 (t/value :b)] 2 [2 (t/value :c)]}) + - and so on ad infinitum. Therefore we reserve `t/kv` for `(t/and t/lookup? (t/not indexed?))`. + - TODO why are there two overloads in this case?? + (uana/pr! (uana/analyze `(defn ~'abcde []))) + - Probably comparing a protocol with something else should be a matter for reactivity since + protocols can be extended + - TODO CLJS needs to implement it better + [-] Analysis/Optimization + [ ] ^:inline + - A good example of inlining: + (t/def empty?|rf + (fn/aritoid + (t/fn [] true) + fn/identity + (t/fn [ret _, x _] (dc/reduced false)) + (t/fn [ret _, k _, v _] (dc/reduced false)))) + (t/defn empty? > p/boolean? + ([x p/nil?] true) + ([xs dc/counted?] (-> xs count num/zero?)) + ([xs (t/input educe :_ :_ :?)] (educe empty?|rf x))) + - Should we allow something like `^:analyze-impl` or something to mimic inline optimizations + but avoid actual inlining? + - maybe redefine `untyped.core.type` in a typed way? `t/def` doesn't realize certain things are `t/type?` + - dead code elimination + - in `let*`, we should elide variables that are unused and that have no side effects (or at + least warn) + - `(p/nil? ...)` should probably be inlined to `(?/== ... nil)` rather than using the overhead + of the deftype + - This should realize that we're negating a `<` and change the operator to `<=` + - `(t/def nneg? (fn/comp ?/not neg?))` + - For numbers: + - (< (compare a b) 0) + -> + (< (ifs (< a b) -1 (> a b) 1 0) 0) + -> the only one that can be < 0 is the -1 + -> (< a b) + - Better analysis of compound literals + - Literal seqs need to be better analyzed — (t/finite-of t/built-in-list? [ak-type av-type] ...) + - Peformance analysis (this comes very much later) + - We should be able to do complexity analysis. Similarly to how we can combine and manipulate + types, we could do like `(cplex/assume (cplex/o :n))` or `(cplex/assume (cplex/o :n2))` etc. + - For `reduce` we'd always know it's up to N operations, so O(n * ) + - Record performance for each relevant part and cache? + - (if (dcoll/reduced? ret) + ;; TODO TYPED `(ref/deref ret)` should realize it's dealing with a `reduced?` + (ref/deref ret) + ...) + - (let [ct (count arr)] + (loop [i 0 v init] + (if (comp/< i ct) + (let [ret (f v (get arr i))] + (if (reduced? ret) + @ret + ;; TODO TYPED automatically figure out that `inc` will never go out of bounds here + (recur (inc* i) ret))) + v))) + - (let [xs' (seq xs)] + (if (dcomp/== (class xs') (class xs)) + (reduce-seq rf ret xs') + ;; TODO TYPED automatically figure out that: + ;; - `(not (dcomp/== (class xs') (class xs)))` + ;; - What the possible types of xs' are as a result + (reduce rf init xs'))) + - ([rf rf?, init t/any?, xs #?(:clj (t/isa? clojure.core.protocols/CollReduce) + :cljs (t/isa?|direct cljs.core/IReduce))] + ;; TODO add `^not-native` to `xs` for CLJS + (#?(:clj clojure.core.protocols/coll-reduce + :cljs cljs.core/-reduce) xs rf init)) + - (if (A) ...) should be (if ^boolean (A) ...) if A returns a `p/boolean?` + [ ] t/binding + - We should make a special class or *something* like that to ensure that typed bindings are + only bound within typed contexts. + [ ] t/defrecord + [ ] t/def-concrete-type (i.e. `t/deftype`) + [-] t/ftype + [ ] conditionally optional arities etc. + [-] `t/defn` + [ ] Should not accept `t/none?` as an input type + - Arity elision: if any type in an arity is `t/none?` then elide it and emit a warning + - `([x bigint?] x)` + [ ] All `intern`s/effects in `t/defn` should be atomic (all or nothing). This means that the + interns should probably be put on a queue too. + [ ] `declare` but for `t/defn` + - Currently we can declare that there is an fn, and what its output type is, and its + metadata, but we cannot currently declare type-overloads. Experience will make clearer + what to do in these cases. + [ ] `|` (pre-types) + [ ] t/defn- + - Not just a private var for the dynamic dispatch, but needs to be private for purposes of + the analyzer when doing direct dispatch. Should emit a warning, not just fail. + [ ] handle varargs / variadic arity + - [& args _] shouldn't result in `t/any?` but rather like `t/reducible?` or whatever + - should configurably auto-generate arities and/or perform variadic proxying + [ ] do the defnt-equivalences / `t/defn` test namespace + [ ] a linting warning that you can narrow the type to whatever the deduced type is from whatever + wider declared type there is + [ ] the option of creating a `t/defn` that isn't extensible? Or at least in which the input + types are limited in the same way per-overload output types are limited by the per-fn output + type? + [ ] t/defmacro + [ ] t/deftype + [-] t/extend-defn! + [ ] Ability to add output type restriction after the fact? + [ ] lazy compilation especially around `t/input` + - Let's say you write a `t/defn` with a signature of [t/indexed? t/indexed? t/indexed?]. This + would generate thousands of possibilities if eagerly loaded, but instead it is lazily loaded. + [ ] equivalence of typed predicates (i.e. that which is t/<= `(t/ftype [x t/any? :> p/boolean?])`) + to types: + - [xs (t/fn [x (t/isa? clojure.lang.Range)] ...)] +- TODO transition the quantum.core.* namespaces: + ->>>>>> TODO need to add *all* quantum namespaces in here + - List of semi-approximately topologically ordered namespaces to make typed: + - [.] clojure.core / cljs.core (note that many things unexpectedly have associated macros) + - [! !] .. + - [x x] < + - [x x] <= + - [x .] = — look at coercive-= + - [x x] == + - [x x] > + - [x x] >= + - [. .] + + - [. .] +' + - [. .] - + - [. .] -' + - [! !] -> + - [! !] ->> + - [. .] * + - [. .] *' + - [. .] / + - [! |] accessor + - [x ] aclone + - [ ] add-tap + - [ ] add-watch + - [ |] agent + - [ ] agent-error + - [ ] aget — TODO check out unchecked-aget, checked-aget, checked-aget' and CLJS macro + - [x x] alength + - [ ] alias + - [ ] all-ns + - [ ] alter + - [ ] alter-meta! + - [ ] alter-var-root + - [ ] amap + - [ ] ancestors + - [ ] and — NOTE that CLJS macro has some secrets + - [ ] any? + - [ ] apply + - [ ] areduce + - [| ] array + - [| .] array? — TODO also look at goog/isArrayLike + - [| ] array-chunk + - [| ] array-copy + - [| ] array-copy-downward + - [| ] array-index-of + - [| ] array-iter + - [| !] array-list + - [ ] array-map + - [| ] array-seq + - [! !] as-> + - [ ] aset — TODO check out unchecked-aset, checked-aset, checked-aset' and CLJS macro + - [ ] aset-boolean + - [ ] aset-byte + - [ ] aset-char + - [ ] aset-double + - [ ] aset-float + - [ ] aset-int + - [ ] aset-long + - [ ] aset-short + - [ ] assert + - [! |] assert-args + - [ ] assoc + - [ ] assoc! + - [ ] assoc-in + - [x x] associative? + - [ ] atom + - [ ] await + - [ ] await1 + - [ ] await-for + - [ ] bases + - [x -] bigdec + - [x -] bigint + - [x -] biginteger + - [ ] binding + - [ ] binding-conveyor-fn + - [x x] bit-and + - [! !] bit-and-not + - [x x] bit-clear + - [| ] bit-count + - [x x] bit-flip + - [x x] bit-not + - [x x] bit-or + - [x x] bit-set + - [x x] bit-shift-left + - [x x] bit-shift-right + - [| !] bit-shift-right-zero-fill + - [x x] bit-test + - [x x] bit-xor + - [x .] boolean + - [x x] boolean? + - [ ] boolean-array + - [ ] booleans + - [ ] bound? + - [ ] bound-fn + - [ ] bound-fn* + - [x x] bounded-count + - [ ] butlast + - [x .] byte + - [x x] byte? + - [ ] byte-array + - [ ] bytes + - [ ] bytes? + - [ ] case + - [ |] cast + - [ ] cat + - [x .] char — TODO (.fromCharCode js/String ) might be useful + - [x x] char? + - [ ] char-array + - [ ] chars + - [! |] check-valid-options + - [x x] chunk + - [x x] chunk-append + - [x x] chunk-buffer + - [x x] chunk-cons + - [x x] chunk-first + - [x x] chunk-next + - [x x] chunk-rest + - [x x] chunked-seq? + - [| ] chunkIteratorSeq + - [ |] class + - [x |] class? + - [| ] clj->js + - [! |] clojure-version + - [| ] clone + - [| ] cloneable? + - [| ] coercive-= + - [| ] coercive-not + - [| ] coercive-not= + - [ ] coll? + - [ ] commute + - [ ] comp + - [. .] comparator + - [x x] compare + - [ ] compare-and-set! + - [| ] compare-indexed + - [ ] compile + - [ ] complement + - [ ] completing + - [ ] concat + - [ ] cond + - [! !] cond-> + - [! !] cond->> + - [ ] condp + - [ ] conj + - [ ] conj! + - [x ] cons + - [ ] constantly + - [x ] contains? + - [| ] copy-arguments + - [x x] count + - [x x] counted? + - [ ] create-ns + - [! !] create-struct + - [ ] cycle + - [x ] dec + - [x ] dec' + - [ ] declare + - [x |] decimal? + - [ ] dedupe + - [| ] default-dispatch-val + - [! |] definline + - [ ] defmacro + - [! !] defmethod — rejected because t/defn supersedes + - [! !] defmulti — rejected because t/defn supersedes + - [. .] defn + - [. .] defn- + - [ ] defonce + - [! !] defprotocol + - [ ] defrecord + - [! !] defstruct + - [ ] deftype + - [ ] delay + - [x x] delay? + - [ ] deliver + - [| ] demunge + - [x |] denominator + - [ ] deref + - [ ] derive + - [ ] descendants + - [ ] destructure + - [ ] disj + - [ ] disj! + - [| ] dispatch-fn + - [ ] dissoc + - [ ] dissoc! + - [ ] distinct + - [ ] distinct? + - [ ] doall + - [ ] dorun + - [ ] doseq + - [ ] dosync + - [ ] dotimes + - [ ] doto + - [x .] double + - [x x] double? + - [ ] double-array + - [ ] doubles + - [ ] drop + - [ ] drop-last + - [ ] drop-while + - [ ] eduction + - [ |] elide-top-frames + - [ ] empty + - [. .] empty? + - [| ] enable-console-print! + - [ ] enumeration-seq + - [ ] ensure + - [ ] ensure-reduced + - [| ] equiv-map + - [| ] equiv-sequential + - [ ] error-handler + - [ ] error-mode + - [| ] es6-entries-iterator + - [| !] es6-iterable + - [| ] es6-iterator + - [| ] es6-set-entries-iterator + - [ ] eval + - [ ] even? + - [ ] every? + - [ ] every-pred + - [| ] ex-cause + - [ ] ex-data + - [ ] ex-info + - [| ] ex-message + - [| ] exists? + - [| ] extend-object! + - [! !] extend-protocol + - [! !] extend-type + - [x x] false? + - [ ] file-seq + - [ ] filter + - [! |] filter-key + - [ ] filterv + - [x ] find + - [ |] find-keyword + - [| ] find-macros-ns + - [x ] find-ns + - [| ] find-ns-obj + - [ |] find-var + - [| ] fix + - [ ] ffirst + - [x ] first + - [ ] flatten + - [| ] flatten1 + - [x .] float + - [x x] float? + - [ ] float-array + - [ ] floats + - [ ] flush + - [. .] fn + - [x x] fn? + - [| ] fn->comparator + - [ ] fnext + - [ ] fnil + - [ ] for + - [ ] force + - [ ] format + - [ ] frequencies + - [ ] future + - [ ] future? + - [ ] future-call + - [ ] future-cancel + - [ ] future-cancelled? + - [ ] future-done? + - [| ] gen-apply-to + - [| ] gen-apply-to-simple + - [ ] gensym + - [x ] get + - [ ] get-in + - [ ] get-method + - [ ] get-thread-bindings + - [ ] get-validator + - [ ] group-by + - [ ] halt-when + - [ ] hash + - [| ] hash-coll + - [| ] hash-combine + - [| ] hash-imap + - [| ] hash-iset + - [| ] hash-keyword + - [ ] hash-map + - [ ] hash-ordered-coll + - [ ] hash-unordered-coll + - [ ] hash-set + - [| ] hash-string* + - [| ] hash-string + - [x x] ident? + - [x x] identical? + - [x x] identity + - [ ] if-let + - [ ] if-not (not as performant as we thought) + - [ ] if-some + - [| ] ifind? + - [x x] ifn? + - [| !] implements? + - [ ] import + - [| ] imul + - [x ] inc + - [x ] inc' + - [x x] indexed? + - [| x] infinite? + - [ ] inst? + - [ ] inst-ms + - [ ] instance? — NOTE CLJS has macro + - [x .] int + - [x x] int? + - [ ] int-array + - [| ] int-rotate-left + - [ ] intern + - [ ] into + - [ ] ints + - [x x] integer? + - [ ] interleave + - [ ] interpose + - [ ] into-array + - [ |] is-annotation? + - [ |] is-runtime-annotation? + - [ ] isa? + - [| ] iter + - [| x] iterable? + - [ ] iterate + - [ ] iterator-seq + - [ ] io! + - [| ] js-arguments + - [| ] js-comment + - [| ] js-debugger + - [| ] js-delete + - [| ] js-in + - [| ] js-inline-comment + - [| ] js-invoke + - [| ] js-keys + - [| ] js-mod + - [| ] js-obj + - [| ] js-reserved-arr + - [| ] js-str + - [| ] js->clj + - [ ] juxt + - [ ] keep + - [ ] keep-indexed + - [ ] key + - [| ] key->js + - [x ] keys + - [x x] keyword + - [x x] keyword? + - [| ] keyword-identical? + - [ ] last + - [ ] lazy-cat + - [ ] lazy-seq + - [ ] let + - [! !] letfn — we just don't use it very much + - [ ] line-seq + - [ ] list + - [ ] list* + - [x x] list? + - [ ] load + - [ ] load-reader + - [ ] load-string + - [ ] loaded-libs + - [ |] locking + - [x .] long + - [x x] long? + - [ ] long-array + - [ ] longs + - [ ] loop + - [| ] m3-seed + - [| ] m3-C1 + - [| ] m3-C2 + - [| ] m3-mix-K1 + - [| ] m3-mix-H1 + - [| ] m3-fmix + - [| ] m3-hash-int + - [| ] m3-hash-unencoded-chars + - [ ] macroexpand + - [ ] macroexpand-1 + - [ ] make-array + - [ ] make-hierarchy + - [ ] map + - [x x] map? + - [x x] map-entry? + - [ ] map-indexed + - [ ] mapcat + - [ ] mapv + - [x x] max + - [x x] max-key + - [ ] memfn + - [ ] memoize + - [ ] merge + - [ ] merge-with + - [x x] meta + - [ ] methods + - [x x] min + - [x x] min-key + - [ ] mix-collection-hash + - [| ] mk-bound-fn + - [ ] mod + - [| ] munge + - [x x] name + - [x x] namespace + - [x ] namespace? + - [! |] nary-inline + - [ ] nat-int? + - [x x] neg? + - [ ] neg-int? + - [ ] newline + - [x ] next + - [ ] nfirst + - [x .] nil? — NOTE `nil?` macro in CLJS has some secrets + - [| ] nil-iter + - [ ] nnext + - [ ] not — look at `coercive-not` + - [ ] not-any? + - [ ] not-empty + - [ ] not-every? + - [x .] not= — look at `coercive-not=` + - [ ] ns + - [x |] ns-aliases + - [x |] ns-imports + - [x ] ns-interns + - [x |] ns-map + - [x ] ns-name + - [x |] ns-publics + - [x |] ns-refers + - [ ] ns-resolve + - [ |] ns-unalias + - [x |] ns-unmap + - [x ] nth + - [ ] nthnext + - [ ] nthrest + - [ ] num + - [x x] number? + - [x |] numerator + - [| ] obj-map + - [| x] object? + - [x ] object-array + - [ ] odd? + - [ ] or — NOTE that CLJS macro has some secrets + - [ ] parents + - [ ] partial + - [ ] partition + - [ ] partition-all + - [ ] partition-by + - [ ] pcalls + - [x ] peek + - [ ] persistent! + - [| ] persistent-array-map-seq + - [ ] pmap + - [x ] pop + - [ ] pop! + - [ ] pop-thread-bindings + - [x x] pos? + - [ ] pos-int? + - [ ] pr + - [ ] pr-on + - [| !] pr-seq-writer + - [| !] pr-sequential-writer + - [ ] pr-str + - [| ] pr-str* + - [| ] pr-str-with-opts + - [ ] prefer-method + - [ ] prefers + - [ ] preserving-reduced + - [| ] prn-str-with-opts + - [| ] prim-seq + - [ ] print + - [! |] print-dup + - [| !] print-meta? + - [! |] print-method + - [| !] print-prefix-map + - [ ] print-str + - [ ] printf + - [ ] println + - [ ] println-str + - [ ] prn + - [ ] prn-str + - [ ] promise + - [ ] push-thread-bindings + - [ ] pvalues + - [x x] qualified-ident? + - [x x] qualified-keyword? + - [x x] qualified-symbol? + - [ ] quot + - [| ] quote-string + - [ ] rand + - [ ] rand-int + - [ ] rand-nth + - [ ] random-sample + - [| ] random-uuid + - [ ] range + - [| ] ranged-iterator + - [x |] ratio? + - [ ] rational? + - [ ] rationalize + - [ ] re-find + - [ ] re-groups + - [ ] re-matcher + - [ ] re-matches + - [ ] re-pattern + - [ ] re-seq + - [ ] read + - [ ] read-line + - [ ] read-string + - [ ] read+string + - [ ] reader-conditional + - [ ] reader-conditional? + - [ ] realized? + - [x x] record? + - [x x] reduce + - [x x] reduce-kv + - [| ] reduceable? + - [x x] reduced + - [x x] reduced? + - [! |] reduce1 + - [ ] reductions + - [ ] ref + - [ ] ref-history-count + - [ ] ref-min-history + - [ ] ref-max-history + - [ ] ref-set + - [ ] refer + - [ ] refer-clojure + - [| x] regexp? + - [| ] reify + - [ ] release-pending-sends + - [ ] rem + - [ ] remove + - [ ] remove-all-methods + - [ ] remove-method + - [ |] remove-ns + - [ ] remove-tap + - [ ] remove-watch + - [ ] repeat + - [ ] repeatedly + - [ ] replace + - [ ] require + - [| !] require-macros + - [ ] reset! + - [ ] reset-meta! + - [ ] reset-vals! + - [ ] resolve + - [x ] rest + - [ ] restart-agent + - [ ] resultset-seq + - [ ] reverse + - [ ] reversible? + - [ ] rseq + - [ ] rsubseq + - [ ] run! + - [! !] satisfies? + - [ ] second + - [ ] select-keys + - [ ] send + - [ ] send-off + - [ ] send-via + - [x x] seq + - [x x] seq? + - [| ] seq-iter + - [ ] seqable? + - [ ] seque + - [ ] sequence + - [ ] sequential? + - [ ] set + - [x x] set? + - [ ] set-agent-send-executor! + - [ ] set-agent-send-off-executor! + - [ ] set-error-handler! + - [ ] set-error-mode! + - [| ] set-from-indexed-seq + - [| ] set-print-err-fn! + - [| ] set-print-fn! + - [ ] set-validator! + - [ ] setup-reference + - [x .] short + - [x x] short? + - [ ] short-array + - [ ] shorts + - [ ] shuffle + - [ ] shutdown-agents + - [| !] simple-benchmark + - [x x] simple-ident? + - [x x] simple-keyword? + - [x x] simple-symbol? + - [ ] slurp + - [ ] some + - [x x] some? + - [ ] some-> + - [ ] some->> + - [ ] some-fn + - [ ] sort + - [ ] sort-by + - [x x] sorted? + - [ ] sorted-map + - [ ] sorted-map-by + - [ ] sorted-set + - [ ] sorted-set-by + - [ ] special-symbol? + - [| ] specify + - [| ] specify! + - [ ] spit + - [ ] split-at + - [ ] split-with + - [ ] spread + - [. .] str + - [x x] string? + - [| ] string-iter + - [| !] string-print + - [| ] strip-ns + - [! |] struct + - [! |] struct-map + - [ ] subs + - [ ] subseq + - [ ] subvec + - [ ] supers + - [ ] swap! + - [ ] swap-vals! + - [x x] symbol + - [x x] symbol? + - [| ] symbol-identical? + - [ ] sync + - [| ] system-time + - [ ] tagged-literal + - [ ] tagged-literal? + - [ ] take + - [ ] take-last + - [ ] take-nth + - [ ] take-while + - [ ] tap> + - [ ] test + - [x |] the-ns + - [| !] this-as + - [ ] thread-bound? + - [ ] throw-if + - [ ] time + - [x ] to-array + - [ ] to-array-2d + - [ ] trampoline + - [. .] transduce + - [| ] transformer-iterator + - [ ] transient + - [ ] tree-seq + - [x x] true? + - [ ] type + - [| ] type->str + - [x ] unchecked-add + - [x ] unchecked-add-int + - [x .] unchecked-byte + - [x .] unchecked-char + - [x ] unchecked-dec + - [x ] unchecked-dec-int + - [x ] unchecked-divide + - [x ] unchecked-divide-int + - [x .] unchecked-double + - [x .] unchecked-float + - [x ] unchecked-inc + - [x ] unchecked-inc-int + - [x .] unchecked-int + - [x .] unchecked-long + - [x ] unchecked-multiply + - [x ] unchecked-multiply-int + - [x ] unchecked-negate + - [x ] unchecked-negate-int + - [x ] unchecked-remainder-int + - [x .] unchecked-short + - [x ] unchecked-subtract + - [x ] unchecked-subtract-int + - [| ] undefined? — NOTE has macro too + - [ ] underive + - [ ] unreduced + - [| !] unsafe-cast + - [x .] unsigned-bit-shift-right + - [ ] update + - [ ] update-in + - [ ] uri? + - [! !] use + - [| !] use-macros + - [| ] uuid + - [x x] uuid? + - [ ] val + - [x ] vals + - [x x] var? + - [ ] var-get + - [ ] var-set + - [. .] vary-meta + - [ ] vec + - [ ] vector + - [x x] vector? + - [x x] volatile? + - [ ] volatile! + - [ ] vreset! + - [ ] vswap! + - [! !] when + - [ ] when-first + - [ ] when-let + - [! !] when-not + - [ ] when-some + - [! !] while + - [ ] with-bindings + - [ ] with-bindings* + - [ ] with-in-str + - [ ] with-loading-context + - [ ] with-local-vars + - [x x] with-meta + - [ ] with-open + - [ ] with-out-str + - [ ] with-precision + - [ ] with-redefs + - [ ] with-redefs-fn + - [| !] write-all + - [ ] xml-seq + - [x x] zero? + - [ ] zipmap + - [.] Intrinsics + https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/Intrinsics.java + (Clojure 1.10) + - [ ] Numbers.add(double,double) + - [x] Numbers.and(long,long) + - [ ] Numbers.divide(double,double) + - [x] Numbers.equiv(double,double) + - [x] Numbers.equiv(long,long) + - [x] Numbers.gt(long,long) + - [x] Numbers.gt(double,double) + - [x] Numbers.gte(long,long) + - [x] Numbers.gte(double,double) + - [x] Numbers.isPos(long) + - [x] Numbers.isPos(double) + - [x] Numbers.isNeg(long) + - [x] Numbers.isNeg(double) + - [x] Numbers.isZero(long) + - [x] Numbers.isZero(double) + - [x] Numbers.lt(long,long) + - [x] Numbers.lt(double,double) + - [x] Numbers.lte(long,long) + - [x] Numbers.lte(double,double) + - [ ] Numbers.minus(double) + - [ ] Numbers.minus(double,double) + - [ ] Numbers.multiply(double,double) + - [x] Numbers.or(long,long) + - [x] Numbers.xor(long,long) + - [ ] Numbers.remainder(long,long) + - [ ] Numbers.inc(double) + - [ ] Numbers.dec(double) + - [ ] Numbers.quotient(long,long) + - [x] Numbers.shiftLeftInt(int,int) + - [x] Numbers.shiftLeft(long,long) + - [x] Numbers.shiftRightInt(int,int) + - [x] Numbers.shiftRight(long,long) + - [x] Numbers.unsignedShiftRightInt(int,int) + - [x] Numbers.unsignedShiftRight(long,long) + - [ ] Numbers.unchecked_int_add(int,int) + - [ ] Numbers.unchecked_int_subtract(int,int) + - [ ] Numbers.unchecked_int_negate(int) + - [ ] Numbers.unchecked_int_inc(int) + - [ ] Numbers.unchecked_int_dec(int) + - [ ] Numbers.unchecked_int_multiply(int,int) + - [ ] Numbers.unchecked_int_divide(int,int) + - [ ] Numbers.unchecked_int_remainder(int,int) + - [ ] Numbers.unchecked_add(long,long) + - [ ] Numbers.unchecked_add(double,double) + - [ ] Numbers.unchecked_minus(long) + - [ ] Numbers.unchecked_minus(double) + - [ ] Numbers.unchecked_minus(double,double) + - [ ] Numbers.unchecked_minus(long,long) + - [ ] Numbers.unchecked_multiply(long,long) + - [ ] Numbers.unchecked_multiply(double,double) + - [ ] Numbers.unchecked_inc(double) + - [ ] Numbers.unchecked_inc(long) + - [ ] Numbers.unchecked_dec(double) + - [ ] Numbers.unchecked_dec(long) + - [ ] RT.aget(short[],int) + - [ ] RT.aget(float[],int) + - [ ] RT.aget(double[],int) + - [ ] RT.aget(int[],int) + - [ ] RT.aget(long[],int) + - [ ] RT.aget(char[],int) + - [ ] RT.aget(byte[],int) + - [ ] RT.aget(boolean[],int) + - [ ] RT.aget(java.lang.Object[],int) + - [ ] RT.alength(int[]) + - [ ] RT.alength(long[]) + - [ ] RT.alength(char[]) + - [ ] RT.alength(java.lang.Object[]) + - [ ] RT.alength(byte[]) + - [ ] RT.alength(float[]) + - [ ] RT.alength(short[]) + - [ ] RT.alength(boolean[]) + - [ ] RT.alength(double[]) + - [ ] RT.longCast(byte) + - [ ] RT.longCast(short) + - [ ] RT.longCast(int) + - [!] RT.longCast(long) + - [ ] RT.doubleCast(byte) + - [ ] RT.doubleCast(short) + - [ ] RT.doubleCast(int) + - [ ] RT.doubleCast(long) + - [ ] RT.doubleCast(float) + - [!] RT.doubleCast(double) + - [x] RT.uncheckedIntCast(byte) + - [x] RT.uncheckedIntCast(short) + - [x] RT.uncheckedIntCast(char) + - [!] RT.uncheckedIntCast(int) + - [x] RT.uncheckedIntCast(long) + - [x] RT.uncheckedIntCast(float) + - [x] RT.uncheckedIntCast(double) + - [x] RT.uncheckedLongCast(byte) + - [x] RT.uncheckedLongCast(short) + - [x] RT.uncheckedLongCast(int) + - [!] RT.uncheckedLongCast(long) + - [x] RT.uncheckedLongCast(float) + - [x] RT.uncheckedLongCast(double) + - [x] RT.uncheckedDoubleCast(byte) + - [x] RT.uncheckedDoubleCast(short) + - [x] RT.uncheckedDoubleCast(int) + - [x] RT.uncheckedDoubleCast(long) + - [x] RT.uncheckedDoubleCast(float) + - [!] RT.uncheckedDoubleCast(double) + - [!] Util.equiv(long,long) + - [x] Util.equiv(boolean,boolean) + - [!] Util.equiv(double,double) + - [ ] JS built-in functions (the most common/relevant ones) + - ... + - [ ] Java intrinsics + http://hg.openjdk.java.net/jdk8/jdk8/hotspot/file/87ee5ee27509/src/share/vm/classfile/vmSymbols.hpp + http://hg.openjdk.java.net/jdk9/jdk9/hotspot/file/b756e7a2ec33/src/share/vm/classfile/vmSymbols.hpp + http://hg.openjdk.java.net/jdk10/jdk10/hotspot/file/5ab7a67bc155/src/share/vm/classfile/vmSymbols.hpp + Those marked with a number or numbers mean they are specific to only those JDK versions. + Only starts at Java 8. + Note that Java 10 didn't add any intrinsics. + Unsafe = sun.misc.Unsafe for Java 8 + Unsafe = jdk.internal.misc.Unsafe for Java >= 9 + - [ ] .hashCode() > int + - [ ] System.identityHashCode(Object) > int + - [ ] .getClass() > Class + - [ ] .clone() + - [ ] >=9 : .notify() + - [ ] >=9 : .notifyAll() + - [ ] System.currentTimeMillis() > int + - [ ] System.nanoTime() > int + - [ ] Math.abs(double) > double + - [ ] Math.sin(double) > double + - [ ] Math.cos(double) > double + - [ ] Math.tan(double) > double + - [ ] Math.atan2(double, double) > double + - [ ] Math.sqrt(double) > double + - [ ] Math.log(double) > double + - [ ] Math.log10(double) > double + - [ ] Math.pow(double, double) > double + - [ ] Math.exp(double) > double + - [x] Math.min(int, int) > int + - [x] Math.max(int, int) > int + - [ ] Math.addExact(int, int) > int + - [ ] Math.addExact(long, long) > long + - [ ] Math.decrementExact(int) > int + - [ ] Math.decrementExact(long, long) > long + - [ ] Math.incrementExact(int) > int + - [ ] Math.incrementExact(long, long) > long + - [ ] Math.multiplyExact(int, int) > int + - [ ] Math.multiplyExact(long, long) > long + - [ ] Math.negateExact(int) > int + - [ ] Math.negateExact(long) > long + - [ ] Math.subtractExact(int, int) > int + - [ ] Math.subtractExact(long, long) > long + - [ ] >=9 : Math.fma(float, float, float) > float + - [ ] >=9 : Math.fma(double, double, double) > double + - [ ] >=9 : BigInteger.implMultiplyToLen(ints, int, ints, int, ints) > ints + - [ ] >=9 : BigInteger.implSquareToLen(ints, int, ints, int) > ints + - [ ] >=9 : BigInteger.implMulAdd(ints, ints, int, int, int) > int + - [ ] >=9 : BigInteger.implMontgomeryMultiply(ints, ints, ints, int, long, ints) > ints + - [ ] >=9 : BigInteger.implMontgomerySquare(ints, ints, int, long, ints) > ints + - [ ] Float.floatToRawIntBits(float) > int + - [ ] Float.floatToIntBits(float) > int + - [ ] Float.intBitsToFloat(int) > float + - [ ] Double.doubleToRawLongBits(double) > long + - [ ] Double.doubleToLongBits(double) > long + - [ ] Double.longBitsToDouble(long) > double + - [ ] Integer.numberOfLeadingZeros(int) > int + - [ ] Long.numberOfLeadingZeros(long) > long + - [ ] Integer.numberOfTrailingZeros(int) > int + - [ ] Long.numberOfTrailingZeros(long) > long + - [ ] Integer.bitCount(int) > int + - [ ] Long.bitCount(long) > int + - [ ] Short.reverseBytes(short) > short + - [ ] Character.reverseBytes(char) > char + - [ ] Integer.reverseBytes(int) > int + - [ ] Long.reverseBytes(long) > long + - [ ] System.arrayCopy(objects, int, objects, int, int) + - [ ] .getComponentType() > Class + - [ ] .getModifiers() > int + - [ ] .getSuperclass() > Class + - [ ] .isArray() > boolean + - [ ] .isAssignableFrom(Class) > boolean + - [ ] .isInstance(Class) > boolean + - [ ] .isInterface() > boolean + - [ ] .isPrimitive() > boolean + - [ ] >=9 : .cast(Object) > Object + - [ ] java.lang.reflect.Array.getLength(Object) > int + - [ ] java.lang.reflect.Array.newArray(Class, int) > Object + - [ ] .checkIndex(int) > int + - [ ] >=9 : jdk.internal.util.Preconditions.checkIndex(int, int, java.util.function.BiFunction) > int + - [ ] java.util.Arrays.copyOf(objects, int, Class) > objects + - [ ] java.util.Arrays.copyOfRange(objects, int, int, Class) > objects + - [ ] java.util.Arrays.equals(chars, chars) > boolean + - [ ] java.util.ArraysSupport.vectorizedMismatch(Object, long, Object, long, int, int) > int + - [x] .compareTo(String) > int + - [x] .equals(Object) > boolean + - [ ] .indexOf(String) > int + - [ ] sun.reflect.Reflection.getCallerClass() > Class + - [ ] sun.reflect.Reflection.getClassAccessFlags(Class) > int + - [ ] Thread.currentThread() > Thread + - [ ] Thread.isInterrupted(boolean) > boolean + - [ ] >=9 : Thread.onSpinWait() + - [ ] .get() > Object + - [ ] 8 : .decryptBlock(bytes, int, bytes, int) + - [ ] 8 : .encryptBlock(bytes, int, bytes, int) + - [ ] >=9 : .implDecryptBlock(bytes, int, bytes, int) + - [ ] >=9 : .implEncryptBlock(bytes, int, bytes, int) + - [ ] 8 : .decrypt(bytes, int, int, bytes, int) + - [ ] 8 : .encrypt(bytes, int, int, bytes, int) + - [ ] >=9 : .implDecrypt(bytes, int, int, bytes, int) + - [ ] >=9 : .implEncrypt(bytes, int, int, bytes, int) + - [ ] >=9 : .implCrypt(bytes, int, int, bytes, int) > int + - [ ] >=9 : .implCompress0(bytes, int) + - [ ] >=9 : .implCompress0(bytes, int) + - [ ] >=9 : .implCompress0(bytes, int) + - [ ] >=9 : .implCompressMultiBlock0(bytes, int, int) > int + - [ ] >=9 : com.sun.crypto.provider.GHASH.processBlocks(bytes, int, int, longs, longs) + - [ ] .update(int, int) > int + - [ ] 8 : java.util.zip.CRC32.updateByteBuffer(int, long, int, int) > int + - [ ] >=9 : java.util.zip.CRC32.updateByteBuffer0(int, long, int, int) > int + - [ ] 8 : java.util.zip.CRC32.updateBytes(int, bytes, int, int) > int + - [ ] >=9 : java.util.zip.CRC32.updateBytes0(int, bytes, int, int) > int + - [ ] >=9 : java.util.zip.CRC32C.updateBytes(int, bytes, int, int) > int + - [ ] >=9 : java.util.zip.CRC32C.updateDirectByteBuffer(int, long, int, int) > int + - [ ] >=9 : java.util.zip.Adler32.updateBytes(int, bytes, int, int) > int + - [ ] >=9 : java.util.zip.Adler32.updateByteBuffer(int, long, int, int) > int + - [ ] .allocateInstance(Class) > Object + - [ ] >=9 : .allocateUninitializedArray0(Class, int) > Object + - [ ] 8 : .copyMemory(Object, long, Object, long, long) + - [ ] >=9 : .copyMemory0(Object, long, Object, long, long) + - [ ] .park(boolean, long) + - [ ] .unpark(Object) + - [ ] .loadFence() + - [ ] .storeFence() + - [ ] .fullFence() + - [ ] .getObject (Object, long ) > Object + - [ ] .putObject (Object, long, Object ) + - [ ] .getBoolean(Object, long ) > boolean + - [ ] .putBoolean(Object, long, boolean) + - [ ] .getByte (Object, long ) > byte + - [ ] .putByte (Object, long, byte ) + - [ ] .getShort (Object, long ) > short + - [ ] .putShort (Object, long, short ) + - [ ] .getChar (Object, long ) > char + - [ ] .putChar (Object, long, char ) + - [ ] .getInt (Object, long ) > int + - [ ] .putInt (Object, long, int ) + - [ ] .getLong (Object, long ) > long + - [ ] .putLong (Object, long, long ) + - [ ] .getFloat (Object, long ) > float + - [ ] .putFloat (Object, long, float ) + - [ ] .getDouble (Object, long ) > double + - [ ] .putDouble (Object, long, double ) + - [ ] .getObjectVolatile (Object, long ) > Object + - [ ] .putObjectVolatile (Object, long, Object ) + - [ ] .getBooleanVolatile(Object, long ) > boolean + - [ ] .putBooleanVolatile(Object, long, boolean) + - [ ] .getByteVolatile (Object, long ) > byte + - [ ] .putByteVolatile (Object, long, byte ) + - [ ] .getShortVolatile (Object, long ) > short + - [ ] .putShortVolatile (Object, long, short ) + - [ ] .getCharVolatile (Object, long ) > char + - [ ] .putCharVolatile (Object, long, char ) + - [ ] .getIntVolatile (Object, long ) > int + - [ ] .putIntVolatile (Object, long, int ) + - [ ] .getLongVolatile (Object, long ) > long + - [ ] .putLongVolatile (Object, long, long ) + - [ ] .getFloatVolatile (Object, long ) > float + - [ ] .putFloatVolatile (Object, long, float ) + - [ ] .getDoubleVolatile (Object, long ) > double + - [ ] .putDoubleVolatile (Object, long, double ) + - [ ] .getObjectVolatile (Object, long ) > Object + - [ ] .putObjectVolatile (Object, long, Object ) + - [ ] >=9 : .getBooleanOpaque (Object, long ) > boolean + - [ ] >=9 : .putBooleanOpaque (Object, long, boolean) + - [ ] >=9 : .getByteOpaque (Object, long ) > byte + - [ ] >=9 : .putByteOpaque (Object, long, byte ) + - [ ] >=9 : .getShortOpaque (Object, long ) > short + - [ ] >=9 : .putShortOpaque (Object, long, short ) + - [ ] >=9 : .getCharOpaque (Object, long ) > char + - [ ] >=9 : .putCharOpaque (Object, long, char ) + - [ ] >=9 : .getIntOpaque (Object, long ) > int + - [ ] >=9 : .putIntOpaque (Object, long, int ) + - [ ] >=9 : .getLongOpaque (Object, long ) > long + - [ ] >=9 : .putLongOpaque (Object, long, long ) + - [ ] >=9 : .getFloatOpaque (Object, long ) > float + - [ ] >=9 : .putFloatOpaque (Object, long, float ) + - [ ] >=9 : .getDoubleOpaque (Object, long ) > double + - [ ] >=9 : .putDoubleOpaque (Object, long, double ) + - [ ] >=9 : .getBooleanRelease(Object, long ) > boolean + - [ ] >=9 : .putBooleanRelease(Object, long, boolean) + - [ ] >=9 : .getByteRelease (Object, long ) > byte + - [ ] >=9 : .putByteRelease (Object, long, byte ) + - [ ] >=9 : .getShortRelease (Object, long ) > short + - [ ] >=9 : .putShortRelease (Object, long, short ) + - [ ] >=9 : .getCharRelease (Object, long ) > char + - [ ] >=9 : .putCharRelease (Object, long, char ) + - [ ] >=9 : .getIntRelease (Object, long ) > int + - [ ] >=9 : .putIntRelease (Object, long, int ) + - [ ] >=9 : .getLongRelease (Object, long ) > long + - [ ] >=9 : .putLongRelease (Object, long, long ) + - [ ] >=9 : .getFloatRelease (Object, long ) > float + - [ ] >=9 : .putFloatRelease (Object, long, float ) + - [ ] >=9 : .getDoubleRelease (Object, long ) > double + - [ ] >=9 : .putDoubleRelease (Object, long, double ) + - [ ] >=9 : .getBooleanAcquire(Object, long ) > boolean + - [ ] >=9 : .putBooleanAcquire(Object, long, boolean) + - [ ] >=9 : .getByteAcquire (Object, long ) > byte + - [ ] >=9 : .putByteAcquire (Object, long, byte ) + - [ ] >=9 : .getShortAcquire (Object, long ) > short + - [ ] >=9 : .putShortAcquire (Object, long, short ) + - [ ] >=9 : .getCharAcquire (Object, long ) > char + - [ ] >=9 : .putCharAcquire (Object, long, char ) + - [ ] >=9 : .getIntAcquire (Object, long ) > int + - [ ] >=9 : .putIntAcquire (Object, long, int ) + - [ ] >=9 : .getLongAcquire (Object, long ) > long + - [ ] >=9 : .putLongAcquire (Object, long, long ) + - [ ] >=9 : .getFloatAcquire (Object, long ) > float + - [ ] >=9 : .putFloatAcquire (Object, long, float ) + - [ ] >=9 : .getDoubleAcquire (Object, long ) > double + - [ ] >=9 : .putDoubleAcquire (Object, long, double ) + - [ ] >=9 : .getShortUnaligned(Object, long ) > short + - [ ] >=9 : .putShortUnaligned(Object, long, short ) + - [ ] >=9 : .getCharUnaligned (Object, long ) > char + - [ ] >=9 : .putCharUnaligned (Object, long, char ) + - [ ] >=9 : .getIntUnaligned (Object, long ) > int + - [ ] >=9 : .putIntUnaligned (Object, long, int ) + - [ ] >=9 : .getLongUnaligned (Object, long ) > long + - [ ] >=9 : .putLongUnaligned (Object, long, long ) + - [ ] 8 : .getObject (long ) > Object + - [ ] 8 : .putObject (long, Object ) + - [ ] 8 : .getBoolean(long ) > boolean + - [ ] 8 : .putBoolean(long, boolean) + - [ ] 8 : .getByte (long ) > byte + - [ ] 8 : .putByte (long, byte ) + - [ ] 8 : .getShort (long ) > short + - [ ] 8 : .putShort (long, short ) + - [ ] 8 : .getChar (long ) > char + - [ ] 8 : .putChar (long, char ) + - [ ] 8 : .getInt (long ) > int + - [ ] 8 : .putInt (long, int ) + - [ ] 8 : .getLong (long ) > long + - [ ] 8 : .putLong (long, long ) + - [ ] 8 : .getFloat (long ) > float + - [ ] 8 : .putFloat (long, float ) + - [ ] 8 : .getDouble (long ) > double + - [ ] 8 : .putDouble (long, double ) + - [ ] 8 : .getAddress(long ) > long + - [ ] 8 : .putAddress(long, long ) + - [ ] 8 : .compareAndSwapInt (Object, long, int , int ) > boolean + - [ ] 8 : .compareAndSwapLong (Object, long, long , long ) > boolean + - [ ] 8 : .compareAndSwapObject(Object, long, Object, Object) > boolean + - [ ] 8 : .putOrderedInt (Object, long, int) + - [ ] 8 : .putOrderedLong (Object, long, long) + - [ ] 8 : .putOrderedObject (Object, long, Object) + - [ ] >=9 : .compareAndSetByte (Object, long, byte , byte ) > boolean + - [ ] >=9 : .weakCompareAndSetByte (Object, long, byte , byte ) > boolean + - [ ] >=9 : .weakCompareAndSetBytePlain (Object, long, byte , byte ) > boolean + - [ ] >=9 : .weakCompareAndSetByteAcquire (Object, long, byte , byte ) > boolean + - [ ] >=9 : .weakCompareAndSetByteRelease (Object, long, byte , byte ) > boolean + - [ ] >=9 : .compareAndExchangeByte (Object, long, byte , byte ) > byte + - [ ] >=9 : .compareAndExchangeByteAcquire (Object, long, byte , byte ) > byte + - [ ] >=9 : .compareAndExchangeByteRelease (Object, long, byte , byte ) > byte + - [ ] >=9 : .compareAndSetShort (Object, long, short , short ) > boolean + - [ ] >=9 : .weakCompareAndSetShort (Object, long, short , short ) > boolean + - [ ] >=9 : .weakCompareAndSetShortPlain (Object, long, short , short ) > boolean + - [ ] >=9 : .weakCompareAndSetShortAcquire (Object, long, short , short ) > boolean + - [ ] >=9 : .weakCompareAndSetShortRelease (Object, long, short , short ) > boolean + - [ ] >=9 : .compareAndExchangeShort (Object, long, short , short ) > short + - [ ] >=9 : .compareAndExchangeShortAcquire (Object, long, short , short ) > short + - [ ] >=9 : .compareAndExchangeShortRelease (Object, long, short , short ) > short + - [ ] >=9 : .compareAndSetInt (Object, long, int , int ) > boolean + - [ ] >=9 : .weakCompareAndSetInt (Object, long, int , int ) > boolean + - [ ] >=9 : .weakCompareAndSetIntPlain (Object, long, int , int ) > boolean + - [ ] >=9 : .weakCompareAndSetIntAcquire (Object, long, int , int ) > boolean + - [ ] >=9 : .weakCompareAndSetIntRelease (Object, long, int , int ) > boolean + - [ ] >=9 : .compareAndExchangeInt (Object, long, int , int ) > int + - [ ] >=9 : .compareAndExchangeIntAcquire (Object, long, int , int ) > int + - [ ] >=9 : .compareAndExchangeIntRelease (Object, long, int , int ) > int + - [ ] >=9 : .compareAndSetLong (Object, long, long , long ) > boolean + - [ ] >=9 : .weakCompareAndSetLong (Object, long, long , long ) > boolean + - [ ] >=9 : .weakCompareAndSetLongPlain (Object, long, long , long ) > boolean + - [ ] >=9 : .weakCompareAndSetLongAcquire (Object, long, long , long ) > boolean + - [ ] >=9 : .weakCompareAndSetLongRelease (Object, long, long , long ) > boolean + - [ ] >=9 : .compareAndExchangeLong (Object, long, long , long ) > long + - [ ] >=9 : .compareAndExchangeLongAcquire (Object, long, long , long ) > long + - [ ] >=9 : .compareAndExchangeLongRelease (Object, long, long , long ) > long + - [ ] >=9 : .compareAndSetObject (Object, long, Object, Object) > boolean + - [ ] >=9 : .weakCompareAndSetObject (Object, long, Object, Object) > boolean + - [ ] >=9 : .weakCompareAndSetObjectPlain (Object, long, Object, Object) > boolean + - [ ] >=9 : .weakCompareAndSetObjectAcquire (Object, long, Object, Object) > boolean + - [ ] >=9 : .weakCompareAndSetObjectRelease (Object, long, Object, Object) > boolean + - [ ] >=9 : .compareAndExchangeObject (Object, long, Object, Object) > Object + - [ ] >=9 : .compareAndExchangeObjectAcquire(Object, long, Object, Object) > Object + - [ ] >=9 : .compareAndExchangeObjectRelease(Object, long, Object, Object) > Object + - [ ] >=9 : .getAndAddByte (Object, long, byte ) > byte + - [ ] >=9 : .getAndAddShort (Object, long, short ) > short + - [ ] .getAndAddInt (Object, long, int ) > int + - [ ] .getAndAddLong (Object, long, long ) > long + - [ ] >=9 : .getAndSetByte (Object, long, byte ) > byte + - [ ] >=9 : .getAndSetShort (Object, long, short ) > short + - [ ] .getAndSetInt (Object, long, int ) > int + - [ ] .getAndSetLong (Object, long, long ) > long + - [ ] .getAndSetObject(Object, long, Object) > Object + - [ ] 8 : .prefetchRead (Object, long) + - [ ] 8 : .prefetchWrite (Object, long) + - [ ] 8 : .prefetchReadStatic (Object, long) + - [ ] 8 : .prefetchWriteStatic(Object, long) + - [ ] 8 : .fillInStackTrace() > Throwable + - [ ] >=9 : StringUTF16.compress(chars, int, bytes, int, int) > int + - [ ] >=9 : StringUTF16.compress(bytes, int, bytes, int, int) > int + - [ ] >=9 : StringLatin1.inflate(bytes, int, chars, int, int) + - [ ] >=9 : StringLatin1.inflate(bytes, int, bytes, int, int) + - [ ] >=9 : StringUTF16.toBytes(chars, int, int) > bytes + - [ ] >=9 : StringUTF16.getChars(bytes, int, int, chars, int) + - [ ] >=9 : StringUTF16.getChar(bytes, int) > char + - [ ] >=9 : StringUTF16.putChar(bytes, int, int) + - [ ] >=9 : StringLatin1.compareTo(bytes, bytes) > int + - [ ] >=9 : StringUTF16.compareTo(bytes, bytes) > int + - [ ] >=9 : StringLatin1.compareToUTF16(bytes, bytes) > int + - [ ] >=9 : StringUTF16.compareToLatin1(bytes, bytes) > int + - [ ] >=9 : StringLatin1.indexOf(bytes, bytes) > int + - [ ] >=9 : StringUTF16.indexOf(bytes, bytes) > int + - [ ] >=9 : StringUTF16.indexOfLatin1(bytes, bytes) > int + - [ ] >=9 : StringLatin1.indexOf(bytes, int, bytes, int, int) > int + - [ ] >=9 : StringUTF16.indexOf(bytes, int, bytes, int, int) > int + - [ ] >=9 : StringUTF16.indexOfLatin1(bytes, int, bytes, int, int) > int + - [ ] >=9 : StringUTF16.indexOfChar(bytes, int, int, int) > int + - [ ] >=9 : StringLatin1.equals(bytes, bytes) > boolean + - [ ] >=9 : StringUTF16.equals(bytes, bytes) > boolean + - [ ] >=9 : StringCoding.hasNegatives(bytes, int, int) > boolean + - [ ] sun.nio.cs.ISO_8859_1$Encoder.encodeISOArray(chars, int, bytes, int, int) > int + - [ ] >=9 : StringCoding.encodeISOArray(bytes, int, bytes, int, int) > int + - [ ] new StringBuilder() + - [ ] new StringBuilder(int) + - [ ] new StringBuilder(String) + - [ ] .append(char) > StringBuilder + - [ ] .append(int) > StringBuilder + - [ ] .append(String) > StringBuilder + - [ ] .toString() > String + - [ ] new StringBuffer() + - [ ] new StringBuffer(int) + - [ ] new StringBuffer(String) + - [ ] .append(char) > StringBuffer + - [ ] .append(int) > StringBuffer + - [ ] .append(String) > StringBuffer + - [ ] .toString() > String + - [ ] Integer.toString(int) > String + - [ ] new String(String) + - [ ] new Object() + - [ ] .invoke(Object, objects) > Object + - [ ] .invoke(*) + - [ ] .invokeBasic(*) + - [ ] java.lang.invoke.MethodHandle.invokeVirtual(*) + - [ ] java.lang.invoke.MethodHandle.linkToVirtual(*) + - [ ] java.lang.invoke.MethodHandle.linkToStatic(*) + - [ ] java.lang.invoke.MethodHandle.linkToSpecial(*) + - [ ] java.lang.invoke.MethodHandle.linkToInterface(*) + - [ ] >=9 : java.lang.invoke.MethodHandleImpl.profileBoolean(boolean, ints) > boolean + - [ ] >=9 : java.lang.invoke.MethodHandleImpl.isCompileConstant(object) > boolean + - [x] .booleanValue() > boolean + - [x] .byteValue () > byte + - [x] .shortValue () > short + - [x] .charValue () > char + - [x] .intValue () > int + - [x] .longValue () > long + - [x] .floatValue () > float + - [x] .doubleValue () > double + - [x] Boolean .valueOf (boolean) > Boolean + - [x] Byte .valueOf (byte ) > Byte + - [x] Short .valueOf (short ) > Short + - [x] Character .valueOf (char ) > Character + - [x] Integer .valueOf (int ) > Integer + - [x] Long .valueOf (long ) > Long + - [x] Float .valueOf (float ) > Float + - [x] Double .valueOf (double ) > Double + - [ ] >=9 : .forEachRemaining(java.util.function.IntConsumer) + - [.] clojure.lang.RT + https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/RT.java + - [ ] aclone + - [ ] addURL + - [ ] aget + - [.] alength + - [ ] arrayToList + - [ ] aset + - [ ] assoc + - [ ] assocN + - [ ] baseLoader + - [.] booleanCast + - [x] boundedLength + - [x] box + - [.] byteCast + - [ ] canSeq + - [.] charCast + - [!] chunkIteratorSeq + - [ ] classForName + - [ ] classForNameNonLoading + - [!] compile + - [ ] conj + - [ ] cons + - [ ] contains + - [x] count + - [x] countFrom + - [ ] dissoc + - [ ] doFormat + - [.] doubleCast + - [!] errPrintWriter + - [ ] find + - [ ] findKey + - [ ] first + - [.] floatCast + - [ ] format + - [ ] formatAesthetic + - [ ] formatStandard + - [!] fourth + - [ ] get + - [ ] getColumnNumber + - [ ] getFrom + - [ ] getLineNumber + - [ ] getLineNumberingReader + - [ ] getResource + - [ ] hasTag + - [!] init + - [.] intCast + - [ ] isLineNumberingReader + - [x] isReduced + - [ ] iter + - [ ] keys + - [x] keyword + - [!] lastModified + - [x] length + - [ ] list + - [ ] listStar + - [!] load + - [ ] loadClassForName + - [!] loadLibrary + - [!] loadResourceScript + - [.] longCast + - [ ] makeClassLoader + - [ ] map + - [ ] mapUniqueKeys + - [!] maybeLoadResourceScript + - [x] meta + - [ ] more + - [ ] nextID + - [ ] nth + - [ ] nthFrom + - [ ] object_array + - [ ] peek + - [ ] peekChar + - [ ] pop + - [ ] print + - [ ] printInnerSeq + - [ ] printString + - [!] processCommandLine + - [ ] readChar + - [ ] readString + - [ ] resolveClassNameInContext + - [ ] resourceAsStream + - [ ] rest + - [!] second + - [x] seq + - [x] seqFrom + - [!] seqOrElse + - [ ] seqToArray + - [ ] seqToPassedArray + - [ ] seqToTypedArray + - [ ] set + - [!] setValues + - [.] shortCast + - [ ] subvec + - [ ] suppressRead + - [!] third + - [ ] toArray + - [.] uncheckedByteCast + - [.] uncheckedShortCast + - [.] uncheckedCharCast + - [.] uncheckedIntCast + - [.] uncheckedLongCast + - [.] uncheckedFloatCast + - [.] uncheckedDoubleCast + - [ ] vals + - [!] var + - [ ] vector + - [.] clojure.lang.Numbers + https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/Numbers.java + - [ ] add + - [ ] addP + - [ ] and + - [!] andNot + - [ ] boolean_array + - [ ] booleans + - [ ] byte_array + - [ ] bytes + - [ ] char_array + - [ ] chars + - [ ] clearBit + - [x] compare + - [ ] dec + - [ ] decP + - [ ] denominator + - [ ] divide + - [ ] double_array + - [ ] doubles + - [x] equal + - [ ] equiv + - [ ] flipBit + - [ ] float_array + - [ ] floats + - [x] gt + - [x] gte + - [ ] hasheq + - [ ] hasheqFrom + - [ ] inc + - [ ] incP + - [ ] int_array + - [ ] ints + - [x] isNaN + - [x] isNeg + - [x] isPos + - [x] isZero + - [ ] long_array + - [ ] longs + - [x] lt + - [x] lte + - [x] max + - [x] min + - [ ] minus + - [ ] minusP + - [ ] multiply + - [ ] multiplyP + - [ ] not + - [ ] num + - [x] numerator + - [ ] or + - [ ] quotient + - [ ] rationalize + - [ ] reduceBigInt + - [ ] remainder + - [ ] shiftLeft + - [ ] shiftLeftInt + - [ ] shiftRight + - [ ] shiftRightInt + - [ ] short_array + - [ ] shorts + - [ ] setBit + - [ ] testBit + - [x] toBigDecimal + - [x] toBigInt + - [x] toBigInteger + - [ ] toRatio + - [ ] unchecked_add + - [ ] unchecked_dec + - [ ] unchecked_divide + - [ ] unchecked_inc + - [ ] unchecked_minus + - [ ] unchecked_multiply + - [ ] unchecked_negate + - [ ] unchecked_remainder + - [ ] unchecked_int_add + - [ ] unchecked_int_dec + - [ ] unchecked_int_divide + - [ ] unchecked_int_inc + - [ ] unchecked_int_multiply + - [ ] unchecked_int_negate + - [ ] unchecked_int_remainder + - [ ] unchecked_int_subtract + - [ ] unsignedShiftRight + - [ ] unsignedShiftRightInt + - [ ] xor + - [.] clojure.lang.Util + https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/Util.java + - [ ] classOf + - [ ] clearCache + - [x] compare + - [x] equiv + - [ ] hash + - [ ] hashCombine + - [ ] hasheq + - [x] identical + - [x] isInteger + - [ ] isPrimitive + - [ ] loadWithClass + - [ ] pcequiv + - [|] ret1 + - [|] runtimeException + - [|] sneakyThrow + - [.] (TEMPORARY) collections-typed + - [ ] `get` + - [ ] `merge` + - [ ] `concat` + - [ ] `repeat` + - [ ] quantum.core.core -> TODO just need to delete this from all references + - [ ] quantum.core.type.core + - [x] quantum.core.data.async + - [-] quantum.core.data.queue + - [ ] quantum.core.type.defs + - [.] quantum.core.refs -> quantum.core.data.refs ? + - [ ] quantum.core.logic + - (def nneg? (l/fn-not neg?)) + - (def pos-int? (l/fn-and dn/integer? pos?)) + - [.] quantum.core.fn + - [ ] `apply` + - especially with `t/defn` as the caller + - [.] quantum.core.cache + - [ ] quantum.core.type-old + - [.] quantum.core.data.primitive + - [.] quantum.core.data.string + - [ ] `>str` + - [.] quantum.core.data.map + - [.] quantum.core.data.meta + - [.] quantum.core.compare - should provide comparisons for all data in quantum.core.data + - [ ] `compare` + - [x] quantum.core.ns ; TODO split up into data.ns? + - [.] quantum.core.vars + - [ ] quantum.core.print + - [ ] quantum.core.log + - [.] quantum.core.data.vector + - [ ] quantum.core.spec + - [.] quantum.core.error + - [.] quantum.core.data.string + - [.] quantum.core.data.array + - [.] quantum.core.data.list + - [.] quantum.core.data.collections + - [.] quantum.core.data.tuple + - [x] quantum.core.data.time + - [.] quantum.core.compare.core + - [.] quantum.core.data.numeric + - [x] quantum.core.numeric.predicates + - [.] quantum.core.numeric.convert + - [.] quantum.core.numeric.exponents + - [.] quantum.core.numeric.misc + - [.] quantum.core.numeric.operators + - [.] quantum.core.numeric.trig + - [.] quantum.core.numeric.truncate + - [x] quantum.core.numeric.types + - [.] quantum.core.numeric + - [.] quantum.core.data.set + - [ ] quantum.core.string.regex + - [ ] quantum.core.macros.type-hint + - [ ] quantum.core.analyze.clojure.core + - [ ] quantum.core.analyze.clojure.predicates + - [ ] quantum.core.macros.optimization + - [ ] quantum.core.macros.fn + - [ ] quantum.core.macros.transform + - [ ] quantum.core.macros.protocol + - [ ] quantum.core.macros.reify + - [ ] quantum.core.macros.defnt + - [ ] quantum.core.macros + - [.] quantum.core.reducers.reduce + - [ ] quantum.core.collections.logic + - [.] quantum.core.collections.core + - [ ] quantum.core.form + - [ ] `(t/def langs #{:clj :cljs :clr})` + - [ ] `(t/def lang "The language this code is compiled under" #?(:clj :clj :cljs :cljs))` + - [ ] quantum.core.form.generate + - [ ] ``` + ;; TODO TYPED + (defalias u/externs?) + ``` + + - Worked through all we can for now: + - quantum.core.data.bits + - quantum.core.convert.primitive + - List of corresponding untyped namespaces to incorporate: + - [ ] quantum.untyped.core.compare + - [ ] quantum.untyped.core.core + - [ ] quantum.untyped.core.ns + - [ ] quantum.untyped.core.vars + - [ ] quantum.untyped.core.data.map + - [ ] quantum.untyped.core.type.defs + - [ ] quantum.untyped.core.data + - [ ] quantum.untyped.core.refs + - [ ] quantum.untyped.core.data.bits + - [x] quantum.untyped.core.identifiers + - List of Array fns to implement: + - [ ] count + - [ ] get + - [ ] set + - [ ] new1dObjectArray + - [ ] new1dArray + - [ ] newUninitializeddArray + - [ ] newInitializedNdArray + - [ ] newUninitializedArrayOfType + - [ ] newInitializedArrayOfType + - List of Numeric fns to implement: + - [ ] isTrue (?) + - [ ] isFalse (?) + - [ ] isNil (?) + - [ ] (logical) and (?) + - [ ] (logical) or (?) + - [ ] (logical) not + - [x] lt + - [x] lte + - [x] gt + - [x] gte + - [x] eq + - [x] neq + - [ ] inc + - [ ] dec + - [x] isZero + - [x] isNeg + - [x] isPos + - [x] add + - [ ] subtract + - [ ] negate + - [ ] multiply + - [ ] divide + - [x] max + - [x] min + - [ ] rem + - List of Primitive fns to implement: + - uncheckedByteCast + - uncheckedCharCast + - uncheckedShortCast + - uncheckedIntCast + - uncheckedLongCast + - uncheckedFloatCast + - uncheckedDoubleCast + - Standard metadata + - e.g. `{:alternate-implementations #{'cljs.tools.reader/merge-meta}}` + - :adapted-from (t/or namespace-symbol? class-symbol? url-string?) + - :source + - :todo #{} + - :attribution + - :doc + - :performance + - :incorporated (t/or (t/set-of (t/or )) + (t/map-of (t/or ) + date)) + - :equivalent `{(aritoid vector identity conj) + (fn ([] (vector)) + ([x0] (identity x0)) + ([x0 x1] (conj x0 x1)))}} + - :in — a Clojure or Java intrinsic + - Instead of e.g. `ns-` or `var-` we can do `ns-val` and `var-val` + +[ ] Compile-Time (Direct) Dispatch + - TODO Should we take into account 'actual' types (not just 'declared' types) when performing + dispatch / overload resolution? + - Let's take the example of `(t/defn abcde [] (f (rand/int-between -10 -2)))`. + - Let's say `rand/int-between`'s output is labeled `t/int?`. However, we know based on + further static analysis of its implementation that the output is not only `t/int?` but + also `t/neg?`, or perhaps even further, `(< -10 % -2)`. + - In this case, should we take advantage of this knowledge? + - Let's say we do. Then `(.invoke reify|we-know-specifics (rand/int-between -10 -2))`. + Yay for efficiency! But let's then say we then change the implementation even if we + don't change the 'interface'/typedefs. Now `rand/int-between` returns `(<= -10 % -2)` — + that is, it's now numerically *inclusive* (for instance, maybe the implementation's + previous behavior of generating numbers numerically *exclusive*ly was mistaken). + `reify|we-know-specifics` would then still be invoked but incorrectly (and unsafely) so. + - To be fair, we'll tend to change output specs/typedefs all the time as we do + development. Do we need to keep track of every call site it affects and recompile + accordingly? Perhaps. It seems like overkill though. It should be configurable in any + case. + - I think that because of this last point, we can and should rely on implementational + specifics wherever available to boost performance (Maybe this should be configurable so + it doesn't slow down development? The more we change the implementation, the more it has + to recompile, ostensibly). We can take advantage of the output specs, certainly, if for + nothing else than to ensure that our implementation (as characterized by its 'actual' + output type) matches what we expect (as characterized by its 'expected'/'declared' + output type). + - One option (Option A) is to turn off compile-time overload resolution during + development. This would mean it might get very slow during that time. But if it's in + the same `t/defn` (ignoring `t/extend-defn!` for a minute) — like a recursive call — you + could always leave on compile-time resolution for that. + - Option B — probably better (though we'd still like to have all this configurable) — + is to have each function know its dependencies (this would actually have the bonus + property of enabling `clojure.tools.namespace.repl/refresh`-style function-level + smart auto-recompilation which is nice). So let's go back to the previous example. + `abcde` could keep track of (or the `t/defn` ns could keep track of it, but you get the + point) the fact that it depends on `rand/int-between` and `f`. It has a compile-time- + resolvable call site that depends only on the output type of `rand/int-between` so if + `rand/int-between`'s computed/actual output type (when given the inputs in question) + ever changes, `abcde` needs to be recompiled and `abcde`'s output type recomputed. If, + on the other hand, `f`'s output type (given the input) ever changes, `abcde` need not be + recompiled, but rather, only its output type need be recomputed. + - I think this reactive approach should solve our problems and let us code in a very flexible + way. +[ ] Runtime (Dynamic) Dispatch + [—] Protocol generation + - For now we won't do it because we can very often find the correct overload at compile + time. We will resort to using the `fn`. + - It will be left as an optimization. + [x] `fn` generation + - Performs a worst-case linear check of the typedefs, `cond`-style. +[x] Interface generation + [x] Even if the `t/defn` is redefined, you won't have interface problems. +[ ] `reify` generation + - Which `reify`s get generated is mainly up to the inputs but partially up to the fn body — + If any typed fns are called in the fn body then this can change what gets generated. + - TODO explain this more + - Each of the `reify`s will keep their label (`__2__0` or whatever) as long as the original + typedef of the `reify` is `t/=` to the new typedef of that reify + - If a redefined `t/defn` doesn't have that type overload then the previous reify is uninterned + and thus made unavailable + - That way, according to the dynamicity tests in `quantum.test.core.type.defn`, we can redefine + implementations at will as long as the specs don't change + - To make this process faster we maintain a set of typedefs so at least cheap c/= checks can + be performed + - If c/= succeeds, great; the `reify` corresponding to the label (and reify-type) will be + replaced; the typedef-set will remain unchanged + - Else it must find a corresponding typedef by t/= + - Then if it is found by t/= it will replace the `reify` and the typedef corresponding + with that label and replace the typedef in the typedef-set + - Else a new label will be given to the `reify`; the typedef will be added to the + typedef-set +[ ] Types yielding generative specs +[—] Types using the clojure.spec interface + - Not yet; wait for it to come out of alpha +[ ] We do need to rely on bootstrapped CLJS for Figwheel-style dev-time recompilation, but we don't + need to rely on bootstrapped CLJS per se for advanced compilation. We can try to hook in to the + JS version of the Closure Compiler. All of that is for later. +" diff --git a/src/quantum/ui/style/css/FJPool is a work-stealing pool b/resources-dev/smaller-scratch.md similarity index 62% rename from src/quantum/ui/style/css/FJPool is a work-stealing pool rename to resources-dev/smaller-scratch.md index 8a5d6cd1..a6489315 100644 --- a/src/quantum/ui/style/css/FJPool is a work-stealing pool +++ b/resources-dev/smaller-scratch.md @@ -1,3 +1,127 @@ +https://github.com/clojure/clojure/blob/f572a60262852af68cdb561784a517143a5847cf/src/clj/clojure/core/specs.clj + + + + +(let [ignore? (fn-or fn? t/protocol? t/multimethod? t/unbound? var/namespace? dasync/thread?)] + (->> (all-ns) + (map+ ns-interns) + (join {}) + (map+ val) + (remove+ #{#'clojure.core/*1 + #'clojure.core/*2 + #'clojure.core/*3 + #'clojure.core/*data-readers* + #'clojure.core/default-data-readers + #'clojure.tools.reader/default-data-readers + #'clojure.core.async.impl.timers/timeouts-queue + #'clojure.tools.analyzer.jvm/default-passes + #'aleph.http/default-connection-pool + #'aleph.http/default-response-executor + #'clojure.core.async.impl.ioc-macros/passes + #'byte-streams/inverse-conversions + #'byte-streams/conversions}) + (remove+ (rcomp deref (fn-or ignore? (fn-and var? (fn-> deref ignore?))))) + (map+ (juxt identity (fn-> deref quantum.core.meta.bench/shallow-byte-size))) + (join {}) + (map+ val) + (reduce +) + (#(quantum.measure.convert/convert % :bytes :MB)) + double)) + +; -> 18.21 MB... there must be lots of data not referenced by vars + +; TODO log these stats when every namespace is compiled +(->> (java.lang.management.ManagementFactory/getMemoryPoolMXBeans) + (mapv (juxt #(.getName %) #(.getType %) #(.getUsage %)))) + + {:code-cache 25.52099609375, + :metaspace 203.1375122070312, (some of this is definitely garbage collected) + :compressed-class-space 69.5936279296875} + + +TODO make sure to set a global onerror handler for PhantomJS (via a flag of course) + +TODO decrease memory footprint? (it's huge!) +TODO allow return types for `defnt` like `sequential?` +TODO also allow return types like :whatever/validator + +TODO longs vs. long-array + +; TODO fn (params-match? ->double 1) -> true; (params-match? ->double "asd") -> false +; TODO do fast-as-possible ops given math expr +; (* a (- b c) v) -> (scale (* a (- b c)) v) + +; TODO: + +(fnt [^indexed? x a] + (conj' x a)) ; and have it know what function needs to be looked up + +(:abcde my-validated-map) ; and know what its type will be + + + + +(defn dropr-digit + ([n] (quot n 10)) + ([digits n] + (if (<= digits 0) + n + (recur (dec digits) (dropr-digit n))))) + +(defn count-digits-integral + "Counts the digits of a number `n` not having a decimal portion." + ([n] (count-digits-integral (dropr-digit n) 1)) + ([n d] (if (zero? n) + d + (recur (dropr-digit n) (inc d))))) + +(defn ->integral [n] (- n (->decimal n))) + +(defn ->decimal [n] (rem n 1)) + +(defn pow-10 [n] (long (Math/pow 10 (int n)))) + +(defn decimal->integer-like-decimal + "E.g. 0.003812317M -> 1003812317N + `n` must be 0 ≤ n < 1 + Returns a `bigint`." + [n] + (if (zero? n) + 0 + (bigint (str "1" (subs (str (.stripTrailingZeros (bigdec n))) 2))))) + +(defn integer-like-decimal->decimal + "E.g. 1003812317N -> 0.003812317M + `n` must be an integer. + Returns a `bigdec`." + [n] + (bigdec (str "0." (subs (str n) 1)))) + +(->decimal 1/4) + + +(defn num-decimal-places [n] + (-> n ->decimal bigdec (.stripTrailingZeros) (.scale) (max 0))) + +(defn truncate-digits + "Truncates an integer `n` the specified number of `digits`, replacing + the truncated portion with 0s." + [digits n] + (if (<= digits 0) + n + (* (dropr-digit digits n) + (pow-10 digits)))) + +(defn exact [n] + (if (or (double? n) + (float? n) + (decimal? n)) + (rationalize n) + n)) + + + Take a look at Claypoole. Example code: (require '[com.climate.claypoole :as cp]) @@ -35,66 +159,6 @@ http://eng.climate.com/2014/02/25/claypoole-threadpool-tools-for-clojure/ (throw (ex-info "`view-rest` not supported on type" {:type (type xs)})))) -(defprotocol InternalReduce - "Protocol for concrete seq types that can reduce themselves - faster than first/next recursion. Called by clojure.core/reduce." - (internal-reduce [seq f start])) - -(defn- naive-seq-reduce - "Reduces a seq, ignoring any opportunities to switch to a more - specialized implementation." - [s f val] - (loop [s (seq s) - val val] - (if s - (let [ret (f val (first s))] - (if (reduced? ret) - @ret - (recur (next s) ret))) - val))) - -(defn- interface-or-naive-reduce - "Reduces via IReduceInit if possible, else naively." - [coll f val] - (if (instance? clojure.lang.IReduceInit coll) - (.reduce ^clojure.lang.IReduceInit coll f val) - (naive-seq-reduce coll f val))) - -(extend-protocol InternalReduce - ;; handles vectors and ranges - clojure.lang.IChunkedSeq - (internal-reduce - [s f val] - (if-let [s (seq s)] - (if (chunked-seq? s) - (let [ret (.reduce (chunk-first s) f val)] - (if (reduced? ret) - @ret - (recur (chunk-next s) - f - ret))) - (interface-or-naive-reduce s f val)) - val)) - - - java.lang.Object - (internal-reduce - [s f val] - (loop [cls (class s) - s s - f f - val val] - (if-let [s (seq s)] - (if (identical? (class s) cls) - (let [ret (f val (first s))] - (if (reduced? ret) - @ret - (recur cls (next s) f ret))) - (interface-or-naive-reduce s f val)) - val)))) - - - (defn num-integral-digits [^double n] (-> n Math/abs Math/log10 inc int)) @@ -216,14 +280,6 @@ The core premise is that entities can be found to belong to one or more classes. TODO look at AtomicLong.accumulateAndGet(long x, LongBinaryOperator accumulatorFunction) TODO revisit whether transformers are necessary compared with transducers -The power offered by spec is probably better compared against dependent type systems like Idris. True static type systems run analysis at compile-time, but spec allows you to perform very complex checks because you have the power of full blown language. - -For example, with spec you can write a function spec that says "Union is a function that takes two hashsets. The return value of this function is a hashset that contains all the values found in the hashset arguments". That's impossible to statically check in most languages. Some languages like Idris approach this level of expressibility, but when they fall short, you're sunk. In spec you can always pop the escape hatch and write a custom predicate in Clojure code. - -So for me that's the tradeoff. I lose compile-time checking, but gain a *ton* of power. And since types exist at run-time we can do cool things like introspect them and generate data, documentation, better error messages, or even run logic over them to write a static type checker. - - - http://www.kdgregory.com/?page=java.byteBuffer — useful reading about off-heap memory https://www.akkadia.org/drepper/cpumemory.pdf — what every programmer should know about memory https://mechanical-sympathy.blogspot.com/2012/10/compact-off-heap-structurestuples-in.html — compact off-heap structures and tuples diff --git a/resources-dev/temp-defnt-fixes.clj b/resources-dev/temp-defnt-fixes.clj new file mode 100644 index 00000000..06f7ff3e --- /dev/null +++ b/resources-dev/temp-defnt-fixes.clj @@ -0,0 +1,25 @@ +;; ===== TO FIX ===== + +- test|or : and + not + or + (is= (& (! a) (| a b)) + b) + +TO IMPLEMENT +- (test-comparison ... (! a) (& a (! b))) +- (testing "AndSpec + ClassSpec • #{= >< <>}") ; <- TODO comparison should be 1 +- (testing "AndSpec + ClassSpec • #{> <>}") ; <- TODO comparison should be 1 +- (testing "AndSpec + ClassSpec • #{>< <>}") ; <- TODO comparison should be 3 + + +(time (clojure.test/test-ns 'quantum.test.core.untyped.type)) +668ms -> 3835ms after instrumenting (5.74 times less performant! :/) +Also certain things take *much* longer: + - (= (| t/byte? t/char? t/short? t/int? t/long? t/float? t/double?) + (& (| t/boolean? t/byte? t/char? t/short? t/int? t/long? t/float? t/double?) + (! t/boolean?))) + - 170ms vs 5.5ms — 30 times less performant!! + +(load-file "./test/quantum/test/core/untyped/type.cljc") +(do (require '[orchestra.spec.test :as st]) + (orchestra.spec.test/instrument)) +(clojure.test/test-ns 'quantum.test.core.untyped.type) diff --git a/src-dev/quantum/core/defnt.cljc b/src-dev/quantum/core/defnt.cljc deleted file mode 100644 index 20568e22..00000000 --- a/src-dev/quantum/core/defnt.cljc +++ /dev/null @@ -1,1133 +0,0 @@ -(ns quantum.core.defnt - (:refer-clojure :exclude - [+ #_zero? odd? even? - bit-and - every? vec - == - if-let when-let - assoc-in - macroexpand]) - (:require - [clojure.core :as core] - [clojure.string :as str] - [quantum.core.error :as err - :refer [TODO err!]] - [quantum.core.fn - :refer [aritoid fn1 fnl fn', fn-> fn->> <-, rcomp - firsta seconda]] - [quantum.core.log :as log - :refer [ppr! prl! prlm!]] - [quantum.core.logic - :refer [fn-and fn-or fn-not if-let if-not-let when-let]] - [quantum.core.macros - :refer [macroexpand]] - [quantum.core.macros.type-hint :as th] - [quantum.core.print :as pr] - [quantum.core.spec :as s] - [quantum.core.specs :as ss] - [quantum.core.type.core :as tcore] - [quantum.core.type.defs :as tdef] - [quantum.untyped.core.analyze.ast :as ast] - [quantum.untyped.core.analyze.expr :as xp] - [quantum.untyped.core.analyze.rewrite :as ana-rw] - [quantum.untyped.core.collections :as c - :refer [assoc-in dissoc-if dissoc* lflatten-1 subview]] - [quantum.untyped.core.collections.logic :as ucoll& - :refer [every? seq-or]] - [quantum.untyped.core.collections.tree :as tree - :refer [prewalk postwalk walk]] - [quantum.untyped.core.compare :as comp - :refer [==]] - [quantum.untyped.core.convert :as conv - :refer [>symbol >name]] - [quantum.untyped.core.core - :refer [kw-map istr]] - [quantum.untyped.core.data.set :as set] - [quantum.untyped.core.form :as uform - :refer [unify-gensyms]] - [quantum.untyped.core.form.evaluate :as ufeval] - [quantum.untyped.core.form.generate :as ufgen] - [quantum.untyped.core.loops :as loops - :refer [reduce-2]] - [quantum.untyped.core.numeric.combinatorics :as combo] - [quantum.untyped.core.qualify :as qual :refer [qualify]] - [quantum.untyped.core.reducers :as r - :refer [vec map+ map-vals+ mapcat+ filter+ remove+ partition-all+ - join reducei educe]] - [quantum.untyped.core.refs :as ref - :refer [?deref]] - [quantum.untyped.core.type :as t - :refer [?]] - [quantum.untyped.core.vars :as var - :refer [update-meta]] - [quantum.format.clojure.core ; TODO temporary - :refer [reformat-string]]) - (:import - [quantum.core Numeric] - [quantum.untyped.core.type ClassSpec])) - -;; TODO move -(defn ppr-code [code] - (let [default-indentations '{do [[:inner 2 2]] - if [[:inner 2 2]]}] - (-> code pr/ppr-meta with-out-str - (reformat-string {:indents default-indentations}) - println))) - -#_(:clj (ns-unmap (find-ns 'quantum.core.defnt) 'reformat-string)) - -;; TODO look at https://github.com/clojure/core.typed/blob/master/module-rt/src/main/clojure/clojure/core/typed/ - -;; Apparently I independently came up with an algorithm that is essentially Hindley-Milner (having not seen it before I implemented it)... -;; - `dotyped`, `defnt`, and `fnt` create typed contexts in which their internal forms are analyzed -;; and overloads are resolved. -;; - When a function with type overloads is referenced outside of a typed context, then the -;; overload resolution will be done via protocol dispatch unless the function's overloads only -;; differ by arity. In either case, runtime type checks are required. -;; - At some later date, the analyzer will do its best to infer types. -;; - Even if the `defnt` is redefined, you won't have interface problems. - -;; Any `defnt` argument, if it requires a non-nilable primitive-like value, will be marked as a primitive. -;; If nilable, it will be boxed. -;; The same thing goes for return values. -;; All other cases of primitiveness fall out of these two. - -;; `defnt` is meant to enforce syntactic correctness. -;; It is intended to catch many runtime errors at compile time, but cannot catch -;; all of them; specs will very often have to be validated at runtime. - -; TODO associative sequence over top of a vector (so it'll display like a seq but behave like a vec) - -(do - -;; FNT - -(s/def ::spec s/any?) - -(s/def ::fnt|arg-spec ; TODO expand; make typed destructuring available via ::ss/binding-form - (s/alt :infer #{'?} - :any #{'_} - :spec ::spec)) - -(s/def ::fnt|speced-arg - (s/cat :arg-binding (s/and simple-symbol? - (set/not #{'& '| '>}) - (fn-> meta :tag nil?)) - ::fnt|arg-spec ::fnt|arg-spec)) - -(s/def ::fnt|output-spec (s/? (s/cat :sym (fn1 = '>) ::spec ::spec))) - -(s/def ::fnt|arglist - (s/and vector? - (s/spec - (s/cat :args (s/* ::fnt|speced-arg) - :varargs (s/? (s/cat :sym (fn1 = '&) ::fnt|speced-arg ::fnt|speced-arg)) - :pre (s/? (s/cat :sym (fn1 = '|) ::spec ::spec)) - :post ::fnt|output-spec)) - (s/conformer - #(cond-> % (contains? % :varargs) (update :varargs ::fnt|speced-arg) - (contains? % :pre ) (update :pre ::spec) - (contains? % :post ) (update :post ::spec))) - (fn [{:keys [args varargs]}] - ;; so `env` in `fnt` can work properly in the analysis - ;; TODO need to adjust for destructuring - (ucoll/distinct? - (concat (c/lmap :arg-binding args) - [(:arg-binding varargs)]))))) - -(s/def ::fnt|body (s/alt :body (s/* s/any?))) - -(s/def ::fnt|arglist+body - (s/cat ::fnt|arglist ::fnt|arglist :body ::fnt|body)) - -(s/def ::fnt|overloads - (s/alt :overload-1 ::fnt|arglist+body - :overload-n (s/cat :overloads (s/+ (s/spec ::fnt|arglist+body))))) - -(s/def ::fnt|postchecks - (s/conformer - (fn [f] - (-> f (update :overloads - (fnl mapv (fn [overload] (let [overload' (update overload :body :body)] - (if-let [output-spec (-> f :output-spec ::spec)] - (do (s/validate (-> overload' ::fnt|arglist :post) nil?) - (assoc-in overload' [::fnt|arglist :post] output-spec)) - overload'))))) - (dissoc :output-spec))))) - -(s/def ::fnt - (s/and (s/spec - (s/cat - ::ss/fn|name (s/? ::ss/fn|name) - ::ss/docstring (s/? ::ss/docstring) - ::ss/meta (s/? ::ss/meta) - :output-spec ::fnt|output-spec - :overloads ::fnt|overloads)) - ::ss/fn|postchecks - ::fnt|postchecks)) - -(s/def ::fns|code ::fnt) - -(s/def ::defnt - (s/and (s/spec - (s/cat - ::ss/fn|name ::ss/fn|name - ::ss/docstring (s/? ::ss/docstring) - ::ss/meta (s/? ::ss/meta) - :output-spec ::fnt|output-spec - :overloads ::fnt|overloads)) - ::ss/fn|postchecks - ::fnt|postchecks)) - -(s/def ::defns|code ::defnt) - -(defn spec>most-primitive-class [spec & [throw?]] - (let [{:as class-data c :class} (t/spec>class spec)] - (cond (-> c class? not) - (when throw? - (err! "Found multiple classes corresponding to spec; don't know how to handle yet" - {:spec spec :class-data class-data})) - (-> class-data :nilable? not) - (or (tcore/boxed->unboxed c) c) - :else c))) - -(defn fns|code [kind lang args] - (assert (= lang #?(:clj :clj :cljs :cljs)) lang) - (let [{:keys [::ss/fn|name overloads ::ss/meta] :as args'} - (s/validate args (case kind :defn ::defns|code :fn ::fns|code)) - overload-data>overload - (fn [{{:keys [args varargs pre post]} ::fnt|arglist - body :body}] - (let [spec-code>?class - (fn [spec] (some-> spec eval t/>spec spec>most-primitive-class)) - arg-spec>validation - (fn [{[k spec] ::fnt|arg-spec :keys [arg-binding]}] - ;; TODO this validation is purely temporary until destructuring is supported - (s/validate arg-binding simple-symbol?) - (case k - :any nil - :infer (do (log/pr :warn "Spec inference not yet supported in `defns`. Ignoring request to infer" (str "`" arg-binding "`")) - nil) - :spec (if-let [c|sym (do #?(:clj (some-> spec spec-code>?class th/class->instance?-safe-tag|sym) - ;; TODO for now CLJS only does `validate` which is more expensive - :cljs spec))] - (list `instance? c|sym arg-binding) - (list `s/validate arg-binding spec)))) - spec-validations - (concat (c/lmap arg-spec>validation args) - (some-> varargs arg-spec>validation)) - ;; TODO if an arg has been primitive-type-hinted in the `fn` arglist, then no need to do an `instance?` check - ?hint-arg - (fn [{[k spec] ::fnt|arg-spec :keys [arg-binding]}] - #?(:clj - (if (not= k :spec) - arg-binding - (-> arg-binding - (th/with-type-hint (some-> spec spec-code>?class)) - (th/with-fn-arglist-type-hint lang (count args) varargs))) - :cljs arg-binding)) - arglist' - (->> args - (c/map ?hint-arg) - (<- cond-> varargs (conj '& (?hint-arg varargs)))) - pre-validations - (vec (concat (some->> spec-validations (c/lfilter some?)) - (when pre (list 'assert pre)))) - validations - (->> {:post (when post [(list post (symbol "%"))]) - :pre (when (seq pre-validations) pre-validations)} - (c/remove-vals' empty?))] - (list* arglist' (concat (when (seq validations) [validations]) body)))) - overloads (mapv overload-data>overload overloads) - code (case kind - :fn (list* 'fn (concat - (if (contains? args' ::ss/fn|name) - [fn|name] - []) - [overloads])) - :defn (list* 'defn fn|name overloads))] - code)) - -(defmacro fns - "Like `fnt`, but relies on runtime spec checks. - Does not perform type inference (at least not yet). - Also does not currently handle spec checks in - destructuring contexts yet." - [& args] - (fns|code :fn (ufeval/env-lang) args)) - -(defmacro defns - "Like `defnt`, but relies on runtime spec checks. - Does not perform type inference (at least not yet). - Also does not currently handle spec checks in - destructuring contexts yet." - [& args] - (fns|code :defn (ufeval/env-lang) args)) - -(defns abcde "" - ([a ? b _ > t/integer?] {:pre 1} 1 2) - ([c t/string?, d StringBuilder & e _ > t/number?] - (.substring c 0 1) - (.append d 1) - 3 4) - ([f t/long?] - (core/+ f 1))) - -; ----- TYPED PART ----- ; - -;; NOTE: All this code can be defnt-ized after; this is just for bootstrapping purposes so performance isn't extremely important in most of these functions. - -(defonce *fn->spec (atom {})) - -(defonce defnt-cache (atom {})) ; TODO For now — but maybe lock-free concurrent hash map to come - -(defonce *interfaces (atom {})) - -; ----- REFLECTION ----- ; - -#?(:clj -(defrecord Method [^String name ^Class rtype ^"[Ljava.lang.Class;" argtypes ^clojure.lang.Keyword kind] - fipp.ednize/IOverride - fipp.ednize/IEdn (-edn [this] (tagged-literal (symbol "M") (into (array-map) this))))) - -#?(:clj -(defns class->methods [c t/class?] - (->> (.getMethods c) - (remove+ (fn [^java.lang.reflect.Method x] (java.lang.reflect.Modifier/isPrivate (.getModifiers x)))) - (map+ (fn [^java.lang.reflect.Method x] (Method. (.getName x) (.getReturnType x) (.getParameterTypes x) - (if (java.lang.reflect.Modifier/isStatic (.getModifiers x)) - :static - :instance)))) - (group-by (fn [^Method x] (.-name x))) ; TODO all of these need to be into !vector and !hash-map - (map-vals+ (fn->> (group-by (fn [^Method x] (count (.-argtypes x)))) - (map-vals+ (fn->> (group-by (fn [^Method x] (.-kind x))))) - (join {}))) - (join {})))) - -(defonce class->methods|with-cache - (memoize (fn [c] (class->methods c)))) - -(defrecord Field [^String name ^Class type ^clojure.lang.Keyword kind] - fipp.ednize/IOverride - fipp.ednize/IEdn (-edn [this] (tagged-literal (symbol "F") (into (array-map) this)))) - -(defn class->fields [^Class c] - (->> (.getFields c) - (remove+ (fn [^java.lang.reflect.Field x] (java.lang.reflect.Modifier/isPrivate (.getModifiers x)))) - (map+ (fn [^java.lang.reflect.Field x] - [(.getName x) - (Field. (.getName x) (.getType x) - (if (java.lang.reflect.Modifier/isStatic (.getModifiers x)) - :static - :instance))])) - (join {}))) ; TODO !hash-map - -(defonce class->fields|with-cache - (memoize (fn [c] (class->fields c)))) - -(def ^:dynamic *conditional-branch-pruning?* true) - -(defonce *analyze-i (atom 0)) - -(defn add-file-context [to from] - (let [from-meta (meta from)] - (update-meta to assoc :line (:line from-meta) :column (:column from-meta)))) - -(defn persistent!-and-add-file-context [form ast-ret] - (update ast-ret :form (fn-> persistent! (add-file-context form)))) - -(def special-symbols '#{let* deftype* do fn* def . if}) ; TODO make more complete - -(deftype WatchableMutable - [^:unsynchronized-mutable v ^:unsynchronized-mutable ^clojure.lang.IFn watch] - clojure.lang.IDeref (deref [this] v) - clojure.lang.IRef (addWatch [this _ f] (set! watch f ) this) - (removeWatch [this _] (set! watch nil) this) - clojure.lang.IAtom (reset [this newv] (set! v newv) v) - (swap [this f] - (let [oldv v] - (set! v (f v)) - (when (some? watch) (watch nil this oldv v)) - v)) - Object (equals [this that] - (and (instance? WatchableMutable that) - (= v (.-v ^WatchableMutable that)))) - fipp.ednize/IOverride - fipp.ednize/IEdn (-edn [this] (tagged-literal (symbol "!@") v))) - -(defn !ref - ([v] (->WatchableMutable v nil)) - ([v watch] (->WatchableMutable v watch))) - -(defn truthy-type? [t] - (when (#{Boolean Boolean/TYPE} t) - (TODO "Don't yet known how to handle booleans")) - (if (= t :nil) - false - true)) - -(defn truthy-expr? [expr] - (when (-> expr :constraints some?) - (TODO "Don't yet know how to handle constraints")) - (if-let [classes (->> expr :type-info ?deref :reifieds (lmap truthy-type?) seq)] - (ucoll&/every-val ::unknown classes) - ::unknown)) - -(defn union|type-info [ti0 ti1] - (prl! ti0 ti1) - (TODO)) - -(declare analyze*) - -(defn analyze-non-map-seqable - "Analyzes a non-map seqable." - {:params-doc - '{merge-types-fn "2-arity fn that merges two types (or sets of types). - The first argument is the current deduced type of the - overall expression; the second is the deduced type of - the current subexpression."}} - [env form empty-form rf] - (prl! env form empty-form) - (->> form - (reducei (fn [accum form' i] (rf accum (analyze* (:env accum) form') i)) - {:env env :form (transient empty-form)}) - (persistent!-and-add-file-context form))) - -(defn analyze-map - {:todo #{"If the map is bound to a variable, preserve type info for it such that lookups - can start out with a guarantee of a certain type."}} - [env form] - (TODO "analyze-map") - #_(->> form - (reduce-kv (fn [{env' :env forms :form} form'k form'v] - (let [ast-ret-k (analyze* env' form'k) - ast-ret-v (analyze* env' form'v)] - (->expr-info {:env env' - :form (assoc! forms (:form ast-ret-k) (:form ast-ret-v)) - :type-info nil}))) ; TODO fix; we want the types of the keys and vals to be deduced - (->expr-info {:env env :form (transient {})})) - (persistent!-and-add-file-context form))) - -(defn analyze-seq|do [env form body] - (prl! env body) - (if (empty? body) - (ast/do {:env env - :form form - :body (r/vec body) - :spec t/nil?}) - (let [expr (analyze-non-map-seqable env body [] - (fn [accum expr _] - ;; for types, only the last subexpression ever matters, as each is independent from the others - (assoc expr :form (conj! (:form accum) (:form expr)) - ;; but the env should be the same as whatever it was originally because no new scopes are created - :env (:env accum))))] - (ast/do {:env env - :form form - :body (r/vec body) - :spec (:spec expr)})))) - -(defn analyze-seq|let*|bindings [env bindings] - (TODO "`let*|bindings` analysis") - #_(->> bindings - (partition-all+ 2) - (reduce (fn [{env' :env forms :form} [sym form]] - (let [expr-ret (analyze* env' form)] - (->expr-info - {:env (assoc env' sym (->type-info {:reifieds (:reifieds expr-ret) ; TODO should use type info or exprinfo? - :abstracts (:abstracts expr-ret) - :fn-types (:fn-types expr-ret)})) - :form (conj! (conj! forms sym) (:form expr-ret))}))) - (->expr-info {:env env :form (transient [])})) - (persistent!-and-add-file-context bindings))) - -(defn analyze-seq|let* [env [bindings & body]] - (TODO "`let*` analysis") - #_(let [{env' :env bindings' :form} - (analyze-seq|let*|bindings env bindings) - {env'' :env body' :form type-info' :type-info} - (analyze-seq|do env' body)] - (->expr-info {:env env - :form (list 'let* bindings' body') - :type-info type-info'}))) - -(defns ?resolve-with-env - [sym t/symbol?, env _] - (let [local (c/get env sym)] - (if (some? local) - (if (ast/unbound? local) - local - (TODO "Need to figure out what to do when resolving local vars")) - (let [resolved (ns-resolve *ns* sym)] - (log/ppr :warn "Not sure how to handle non-local symbol; resolved it for now" (kw-map sym resolved)) - resolved)))) - -(defn methods->spec - "Creates a spec given ->`methods`." - [methods #_(t/seq method?)] - ;; TODO room for plenty of optimization here - (let [methods|by-ct (->> methods - (group-by (fn-> :argtypes count)) - (sort-by first <)) - ;; non-primitive classes in Java aren't guaranteed to be non-null - >class-spec (fn [x] - (cond (class? x) - (-> x t/>spec (cond-> (not (t/primitive-class? x)) t/?)) - (t/spec? x) - x - :else (err/not-supported! `>class-spec x))) - partition-deep - (fn partition-deep [spec methods' arglist-size i|arg depth] - (let [_ (when (> depth 3) (TODO)) - methods'|by-class - (->> methods' - ;; TODO optimize further via `group-by-into` - (group-by (fn-> :argtypes (c/get i|arg))) - ;; classes will be sorted from most to least specific - (sort-by (fn-> first t/>spec) t/<))] - (r/for [[c methods''] methods'|by-class - spec' spec] - (update spec' :clauses conj - [(>class-spec c) - (if (= (inc depth) arglist-size) - ;; here, methods'' count will be = 1 - (-> methods'' first :rtype >class-spec) - (partition-deep - (xp/condpf-> t/<= (xp/get (inc i|arg))) - methods'' - arglist-size - (inc i|arg) - (inc depth)))]))))] - (r/for [[ct methods'] methods|by-ct - spec (xp/casef count)] - (if (zero? ct) - (assoc-in spec [:cases 0] (-> methods' first :rtype >class-spec)) - (assoc-in spec [:cases ct] (partition-deep (xp/condpf-> t/<= (xp/get 0)) methods' ct 0 0)))))) - -#?(:clj -(defns ?cast-call->spec - "Given a cast call like `clojure.lang.RT/uncheckedBooleanCast`, returns the - corresponding spec. - - Unchecked fns could be assumed to actually *want* to shift the range over if the - range hits a certain point, but we do not make that assumption here." - [c t/class?, method t/symbol? > (? t/spec?)] - (when (identical? c clojure.lang.RT) - (case method - (uncheckedBooleanCast booleanCast) - t/boolean? - (uncheckedByteCast byteCast) - t/byte? - (uncheckedCharCast charCast) - t/char? - (uncheckedShortCast shortCast) - t/char? - (uncheckedIntCast intCast) - t/int? - (uncheckedLongCast longCast) - t/long? - (uncheckedFloatCast floatCast) - t/float? - (uncheckedDoubleCast doubleCast) - t/double? - nil)))) - -(defn analyze-seq|dot|method-call - "A note will be made of what methods match the argument types. - If only one method is found, that is noted too. If no matching method is found, an - exception is thrown." - {:params-doc '{methods "A reducible of all static/instance `Method`s with the given name, - `method-form`, in the given `target`'s class."}} - [env form target target-class static? #_t/boolean? method-form #_t/unqualified-symbol? args-forms] - ;; TODO cache spec by method - (if-not-let [methods-for-name (-> target-class class->methods|with-cache (c/get (name method-form)))] - (if (empty? args-forms) - (err! "No such method or field in class" {:class target-class :method-or-field method-form}) - (err! "No such method in class" {:class target-class :methods method-form})) - (if-not-let [methods-for-count (c/get methods-for-name (c/count args-forms))] - (err! "Incorrect number of arguments for method" - {:class target-class :method method-form :possible-counts (set (keys methods-for-name))}) - (let [static?>kind (fn [static?] (if static? :static :instance))] - (if-not-let [methods (c/get methods-for-count (static?>kind static?))] - (err! (istr "Method found for arg-count, but was ~(static?>kind (not static?)), not ~(static?>kind static?)") - {:class target-class :method method-form :args args-forms}) - (let [args-ct (c/count args-forms) - call (ast/method-call - {:env env - :form form - :target target - :method method-form - :args [] - :spec (methods->spec methods #_(count arg-forms))}) - with-arg-specs - (r/fori [arg-form args-forms - call' call - i|arg] - (prl! call' arg-form) - (let [arg-node (analyze* env arg-form)] - ;; TODO can incrementally calculate return value, but possibly not worth it - (update call' :args conj arg-node))) - with-ret-spec - (update with-arg-specs :spec - (fn [ret-spec] - (let [arg-specs (->> with-arg-specs :args (mapv :spec))] - (if (seq arg-specs) - (do (err! "TODO arg spec") - #_(if (t/infer? arg-spec) - (swap! arg-spec t/and (get ret-spec i)) - ((get ret-spec i) arg-spec))) - (ret-spec arg-specs))))) - ?cast-spec (?cast-call->spec target-class method-form) - _ (when ?cast-spec - (err! "TODO cast spec") - #_(s/validate (-> with-ret-spec :args first :spec) #(t/>= % (t/numerically ?cast-spec))))] - with-ret-spec)))))) - -(defns analyze-seq|dot|field-access - [env _, form _, target _, field-form _ #_t/unqualified-symbol?, field Field] - (ast/field-access - {:env env - :form form - :target target - :field field-form - :spec (-> field .getType t/>spec)})) - -;; TODO spec these arguments; e.g. check that ?method||field, if present, is an unqualified symbol -(defn analyze-seq|dot [env form [target-form ?method-or-field & ?args]] - {:pre [(prl! env form target-form ?method-or-field ?args)] - :post [(prl! %)]} - (let [target (analyze* #_?resolve-with-env env target-form) - method-or-field (if (symbol? ?method-or-field) ?method-or-field (first ?method-or-field)) - args-forms (if (symbol? ?method-or-field) ?args (rest ?method-or-field))] - (if (t/= (:spec target) t/nil?) - (err! "Cannot use the dot operator on nil." {:form form}) - (let [;; `nilable?` because technically any non-primitive in Java is nilable and we can't - ;; necessarily rely on all e.g. "@nonNull" annotations - {:as ?target-static-class-map target-static-class :class target-static-class-nilable? :nilable?} - (-> target :spec t/spec>?class-value) - {target-class :class target-class-nilable? :nilable?} - (or ?target-static-class-map (-> target :spec t/spec>class))] - ;; TODO determine how to handle `target-class-nilable?`; for now we will just let it slip through - ;; to `NullPointerException` at runtime rather than create a potentially more helpful custom - ;; exception - (if-let [field (and (empty? args-forms) - (-> target-class class->fields|with-cache (c/get (name method-or-field))))] - (analyze-seq|dot|field-access env form target method-or-field field) - (analyze-seq|dot|method-call env form target target-class (boolean ?target-static-class-map) - method-or-field args-forms)))))) - -(defn analyze-seq|if - "If `*conditional-branch-pruning?*` is falsey, the dead branch's original form will be - retained, but it will not be type-analyzed." - [env form [pred true-form false-form :as body]] - {:post [(prl! %)]} - (when (-> body count (not= 3)) - (err! "`if` accepts exactly 3 arguments: one predicate test and two branches; received" {:body body})) - (let [pred-expr (analyze* env pred) - true-expr (delay (analyze* env true-form)) - false-expr (delay (analyze* env false-form)) - whole-expr - (delay - (do (TODO "fix `if` analysis") - #_(->expr-info - {:env env - :form (list 'if pred (:form @true-expr) (:form @false-expr)) - :type-info (union|type-info (:type-info @true-expr) (:type-info @false-expr))})))] - (case (truthy-expr? pred-expr) - ::unknown @whole-expr - true (-> @true-expr (assoc :env env) - (cond-> (not *conditional-branch-pruning?*) - (assoc :form (list 'if pred (:form @true-expr) false-form)))) - false (-> @false-expr (assoc :env env) - (cond-> (not *conditional-branch-pruning?*) - (assoc :form (list 'if pred true-form (:form @false-expr)))))))) - -(defn analyze-seq|quote [env form body] - {:post [(prl! %)]} - (ast/quoted env form (tcore/most-primitive-class-of body))) - -(defn analyze-seq* - "Analyze a seq after it has been macro-expanded. - The ->`form` is post- incremental macroexpansion." - [env [sym & body :as form]] - (ppr! {'expanded-form form}) - (if (special-symbols sym) - (case sym - do - (analyze-seq|do env form body) - let* - (analyze-seq|let* env form body) - deftype* - (TODO "deftype*") - fn* - (TODO "fn*") - def - (TODO "def") - . - (analyze-seq|dot env form body) - if - (analyze-seq|if env form body) - quote - (analyze-seq|quote env form body)) - (if-let [sym-resolved (resolve sym)] - ; See note above on typed function return types - (TODO) - (err! "Form should be a special symbol but isn't" {:form sym})))) - -(defn analyze-seq [env form] - {:post [(prl! %)]} - (prl! form) - (let [expanded-form (macroexpand form)] - (if (== form expanded-form) - (analyze-seq* env expanded-form) - (ast/macro-call {:env env :form form :expanded (analyze-seq* env expanded-form)})))) - -(defn analyze-symbol [env form] - {:post [(prl! %)]} - (let [resolved (?resolve-with-env form env)] - (if-not resolved - (err! "Could not resolve symbol" {:sym form}) - (ast/symbol env form - (cond (ast/node? resolved) - (:spec resolved) - (or (t/literal? resolved) (t/class? resolved)) - (t/value resolved) - :else - (err! "Unsure of what to do in this case" (kw-map env form resolved))))))) - -(defn analyze* [env form] - (prl! env form) - (when (> (swap! *analyze-i inc) 100) (throw (ex-info "Stack too deep" {:form form}))) - (cond (symbol? form) - (analyze-symbol env form) - (t/literal? form) - (ast/literal env form (t/>spec form)) - (or (vector? form) - (set? form)) - (analyze-non-map-seqable env form (empty form) (fn stop [& [a b :as args]] (prl! args) (err! "STOP"))) - (map? form) - (analyze-map env form) - (seq? form) - (analyze-seq env form) - :else - (throw (ex-info "Unrecognized form" {:form form})))) - -(defn analyze - ([body] (analyze {} body)) - ([env body] - (reset! *analyze-i 0) - (analyze* env body))) - -;; ===== (DE)FNT ===== ;; - -#_(s/def :fnt|overload/arglist-code (t/vec-of arg?)) -#_(s/def :fnt|overload/args-classes (t/vec-of t/class?)) -(s/def :fnt|overload/positional-args-ct integer?) -(s/def :fnt|overload/variadic? boolean?) - - #_"Must evaluate to an `s/fspec`" -(s/def :fnt|overload/spec ::ss/code) - -#_(s/def :fnt|overload/body-codelist (t/seq-of ::ss/code)) -(s/def :fnt/overload - (s/keys :req-un [:fnt|overload/arg-classes - :fnt|overload/arg-specs - :fnt|overload/arglist-code|fn|hinted - :fnt|overload/arglist-code|reify|unhinted - :fnt|overload/body-codelist - :fnt|overload/positional-args-ct - :fnt|overload/spec - :fnt|overload/variadic?])) - -(s/def ::reify|overload - (s/keys :req-un [:ss/interface - :reify|overload/out-class - :reify/method-sym - :reify/arglist-code - :reify|overload/body-codelist])) - -(s/def :protocol/overload - (s/keys :req-un [:protocol|overload/name #_simple-symbol? - :protocol|overload/arglist #_(t/vector-of simple-symbol?)])) - -#?(:clj -(defn fnt|arg->class [lang {:as arg [k spec] ::fnt|arg-spec :keys [arg-binding]}] - (cond (not= k :spec) java.lang.Object; default class - (symbol? spec) (pred->class lang spec)))) - -(defn >with-post-spec - [body post-spec] - `(let [~'out ~body] - (s/validate ~'out ~(update-meta post-spec dissoc* :runtime?)))) - -#?(:clj ; really, reserve for metalanguage -(defn fnt|overload-data>overload #_> #_::fnt|overload - "Rather than rigging together something in which either: - 1) the Clojure compiler will try to cross its fingers and evaluate code meant to be evaluated in ClojureScript - 2) we use a CLJS-in-CLJS compiler and alienate the mainstream CLJS-in-CLJ (cljsbuild) workflow, which includes - our own workflow - 3) we wait for CLJS-in-CLJS to become mainstream, which could take years if it really ever happens - - we decide instead to evaluate specs in languages in which the metalanguage (compiler language) is the same as - the object language (e.g. Clojure), and symbolically analyze specs in the rest (e.g. vanilla ClojureScript), - deferring code analyzed as functions to be enforced at runtime." - [{{:keys [args varargs] pre-form :pre post-form :post} ::fnt|arglist body-form :body} - {:as opts :keys [lang symbolic-analysis?]}] - (prl! args body-form) - (if symbolic-analysis? - (err! "Symbolic analysis not supported yet") - (let [varargs-binding (when varargs - ;; TODO this validation is purely temporary until destructuring is supported - (s/validate (:arg-binding varargs) simple-symbol?)) - arg-bindings (mapv :arg-binding args) - arg-specs-initial - (->> args - (mapv (fn [{[kind spec] ::fnt|arg-spec :keys [arg-binding]}] - ;; TODO this validation is purely temporary until destructuring is supported - (s/validate arg-binding simple-symbol?) - (ast/unbound nil arg-binding - (case kind :any t/any? :infer t/? :spec (-> spec eval t/>spec)))))) - env (zipmap arg-bindings arg-specs-initial) - body-form|wrapped-do (list* 'do body-form) - body (analyze env body-form|wrapped-do) - env' (:env body) - arg-specs (->> arg-bindings (mapv #(:spec (c/get env' %)))) - _ (prl! body) - arg-classes (->> arg-specs (mapv #(spec>most-primitive-class % true))) - hint-arg|fn - (fn [i arg-binding] - (th/with-type-hint arg-binding - (th/->fn-arglist-tag - (c/get arg-classes i) - lang - (c/count args) - varargs))) - _ (when pre-form (TODO "Need to handle pre")) - post-spec (when post-form (-> post-form eval t/>spec)) - post-spec|runtime? (-> post-spec meta :runtime?) - out-spec (if post-spec - (if post-spec|runtime? - (case (t/compare post-spec (:spec body)) - -1 post-spec - 1 (:spec body) - 0 post-spec - nil (err! "Body and output spec are unrelated" {:body body :output-spec post-spec})) - (if (t/<= (:spec body) post-spec) - (:spec body) - (err! "Body does not match output spec" {:body body :output-spec post-spec}))) - (:spec body)) - body-codelist - (cond-> (:body body) - post-spec|runtime? (-> ufgen/?wrap-do (>with-post-spec post-spec) vector))] - {:arg-classes arg-classes - :arg-specs arg-specs - :arglist-code|fn|hinted (cond-> (->> arg-bindings (map-indexed hint-arg|fn) vec) - varargs-binding (conj '& varargs-binding)) ; TODO use `` - :arglist-code|reify|unhinted (cond-> arg-bindings varargs-binding (conj varargs-binding)) - :body-codelist body-codelist - :positional-args-ct (count args) - :spec out-spec - ;; when present, varargs are considered to be of class Object - :variadic? (boolean varargs)})))) - -(def fnt-method-sym 'invoke) - -(defn- class>interface-part-name [c] - (let [illegal-pattern #"\|\+"] - (if (->> c >name (re-find illegal-pattern)) - (err! "Class cannot contain pattern" {:class c :pattern illegal-pattern}) - (-> c >name (str/replace "." "|"))))) - -(defn fnt-overload>interface-sym [args-classes out-class] - (>symbol (str (->> args-classes (lmap class>interface-part-name) (str/join "+")) - ">" (class>interface-part-name out-class)))) - -(defn fnt-overload>interface [args-classes out-class] - (let [interface-sym (fnt-overload>interface-sym args-classes out-class) - hinted-method-sym (th/with-type-hint fnt-method-sym (th/>arglist-embeddable-tag out-class)) - interface-code `(~'definterface ~interface-sym (~hinted-method-sym ~(uform/gen-args (count args-classes))))] - (log/pr ::debug "Creating interface" interface-sym "...") - (eval interface-code))) - -#?(:clj -(defn >reify-overload #_> #_(seq-of ::reify|overload) - [out-class primitivized-arg-classes - {:as overload #_:fnt/overload :keys [arglist-code|reify|unhinted body-codelist]}] - (s/validate primitivized-arg-classes vector?) - (let [interface-k {:out out-class :in primitivized-arg-classes} - interface - (-> *interfaces - (swap! update interface-k #(or % (fnt-overload>interface primitivized-arg-classes out-class))) - (c/get interface-k)) - arglist-code - (vec (concat ['_] - (doto (->> arglist-code|reify|unhinted - (map-indexed - (fn [i arg] (th/with-type-hint arg (-> primitivized-arg-classes (doto pr/ppr-meta) (c/get i) (doto pr/ppr-meta) th/>arglist-embeddable-tag))))) - pr/ppr-meta)))] - {:arglist-code arglist-code - :body-codelist body-codelist - :interface interface - :method-sym fnt-method-sym - :out-class out-class}))) - -#?(:clj -(def sort-guide - {tdef/boolean 0 - tdef/byte 1 - tdef/short 2 - tdef/char 3 - tdef/int 4 - tdef/long 5 - tdef/float 6 - tdef/double 7 - Object 8})) - -#?(:clj -(defn fnt-overload>reify-overloads #_> #_(seq-of ::reify|overload) - [{:as overload #_:fnt/overload :keys [arg-classes spec]}] - {:pre [(prlm! overload)] - :post [(prlm! %)]} - (let [out-class-data (t/spec>class spec) - out-class (if (-> out-class-data :class class?) - (:class out-class-data) - ;; we don't need to vary the output class if there are multiple output possibilities - java.lang.Object)] - (->> arg-classes - (c/lmap (fn [arg-class] (->> arg-class tcore/class>prim-subclasses - (set/union #{arg-class}) - (sort-by sort-guide)))) - (apply combo/cartesian-product) - (c/lmap (fn [primitivized-arg-classes] - (>reify-overload out-class (vec primitivized-arg-classes) overload))))))) - -#?(:clj -(defn fnt|overload>reify [{:keys [overload #_:fnt/overload, i #_integer?, fn|name #_::ss/fn|name]}] - (let [reify-overloads (fnt-overload>reify-overloads overload)] - `(~'def ~(>symbol (str fn|name "|__" i)) - (reify ~@(->> reify-overloads - (c/lmap (fn [{:keys [interface out-class method-sym arglist-code body-codelist]} #_::reify|overload] - [(-> interface >name >symbol) - `(~(th/with-type-hint method-sym (th/>arglist-embeddable-tag out-class)) - ~arglist-code ~@body-codelist)])) - lflatten-1)))))) - -(defn >extend-protocol|code [{:keys [protocol|name]}] - `(extend-protocol ~protocol|name)) - -(defn >defprotocol|code - [{:keys [name #_:protocol/name - overloads #_(t/seqable-of :protocol/overload)]}] ; TODO ensure that overload names do not shadow each other - `(defprotocol ~name - ~@(->> overloads - (sort-by (fn-> :arglist count)) - (sort-by :name) - (c/lmap (fn [{:keys [name arglist]}] - `(~name ~arglist)))))) - -(defn fnt|overloads>protocol []) - -(is (code= (defnt|code>protocols 'abc (do defnt|code|class|=|2|1) :clj) - [{:defprotocol - ($ (defprotocol ~'abc|__Protocol__java|io|FilterOutputStream - (~'abc|__protofn__java|io|FilterOutputStream [~'x0 ~'x1]))) - :extend-protocols - [($ (extend-protocol ~'abc|__Protocol__java|io|FilterOutputStream - java.io.FilterOutputStream - (~'abc|__protofn__java|io|FilterOutputStream - [~(tag "java.io.FilterOutputStream" 'x1) ~(tag "java.io.FilterOutputStream" 'x0)] - (.invoke ~'abc|__0 ~'x0 ~'x1))))] - :defn nil} - {:defprotocol - ($ (defprotocol ~'abc|__Protocol__long - (~'abc|__protofn__long [~'x0 ~'x1]))) - :extend-protocols - [($ (extend-protocol ~'abc|__Protocol__long - java.io.FilterOutputStream - (~'abc|__protofn__long - [~(tag "java.io.FilterOutputStream" 'x1) ~(tag "long" 'x0)] - (.invoke ~'abc|__0 ~'x0 ~'x1))))] - :defn nil} - {:defprotocol - ($ (defprotocol ~'abc|__Protocol - (~'abc [~'x0 ~'x1]))) - :extend-protocols - [($ (extend-protocol ~'abc|__Protocol - java.io.FilterOutputStream - (~'abc - [~(tag "java.io.FilterOutputStream" 'x0) ~'x1] - (~'abc|__protofn__java|io|FilterOutputStream ~'x1 ~'x0)) - java.lang.Long - (~'abc - [~(tag "long" 'x0) ~'x1] - (~'abc|__protofn__long ~'x1 ~'x0))))] - :defn nil}])) - - - -(defonce *class>shorthand-tag|cache (atom {:latest "a"})) - -;; dynamic for testing purposes -(def ^:dynamic **class>shorthand-tag|cache* *class>shorthand-tag|cache) - -(def allowed-shorthand-tag-chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") - -(combo/cartesian-product allowed-shorthand-tag-chars - allowed-shorthand-tag-chars) - -(def all-shorthand-tags - (->> (apply concat - (for [n (c/unchunk (range 64))] ; for now - (do (println "n" n) - (apply combo/cartesian-product (repeat n allowed-shorthand-tag-chars))))) - (c/lmap #(apply str %)) - c/unchunk - first - type - println) - 1) - -(defns next-shorthand-tag [tag (t/and t/string? #_#"a-zA-Z")] - (let [c (c/last tag)] - (if (= c \Z) - (str tag \a) - (let [c' (if (= c \z) - \A - (-> c int inc char))] - (if (-> tag count (= 1)) - (str c') - (str (c/subview-or-slice tag 0 (-> tag count dec)) c')))))) - -(defns class>shorthand-tag [c t/class?] - (or (c/get @**class>shorthand-tag|cache* c) - (do (swap! **class>shorthand-tag|cache* - (fn [{:as m :keys [latest]}] - (let [tag (next-shorthand-tag latest)] - (assoc m :latest tag c tag)))) - (recur c)))) - -(defn assert-monotonically-increasing-specs! - "Asserts that each spec in an overload of the same arity and arg-position - are in monotonically increasing order in terms of `t/compare`." - [overloads|grouped-by-arity] - (doseq [[arity-ct overloads] overloads|grouped-by-arity] - (reduce - (fn [prev-overload [i|overload overload]] - (when prev-overload - (reduce-2 - (fn [_ arg|spec|prev [i|arg arg|spec]] - (when (= (t/compare arg|spec arg|spec|prev) -1) - ;; TODO provide code context, line number, etc. - (err! (istr "At overload ~{i|overload}, arg ~{i|arg}: spec is not in monotonically increasing order in terms of `t/compare`") - {:overload overload - :prev-overload prev-overload - :prev-spec arg|spec|prev - :spec arg|spec}))) - (:arg-specs prev-overload) - (c/lindexed (:arg-specs overload)))) - overload) - nil - overloads))) - -(defn fnt|overloads>protocols - [{:keys [overloads #_(t/and t/indexed? (t/seq-of :fnt/overload)) - fn|name #_::ss/fn|name]}] - (when (->> overloads (seq-or (fn-> :positional-args-ct (> 2)))) - (TODO "Doesn't yet handle protocol creation for arglist counts of > 2")) - (when (->> overloads (seq-or :variadic?)) - (TODO "Doesn't yet handle protocol creation for variadic overloads")) - (let [overloads|grouped-by-arity (->> overloads c/indexed+ (group-by (fn-> second :positional-args-ct)))] - (assert-monotonically-increasing-specs! overloads|grouped-by-arity)) - (let [all-arg-classes (->> overloads (mapv :arg-classes)) - protocol|name (str fn|name "__Protocol__" ) - extend-protocols (for [] - (>extend-protocol|code (kw-map protocol|name)))] - {:defprotocol (>defprotocol|code {:name protocol|name - :overloads []}) - :extend-protocols extend-protocols - :defn defn-definition})) - -;; This protocol is so suffixed because of the position of the argument on which - ;; it dispatches - (defprotocol name|gen__Protocol__0 - (name|gen [~'x])) - (extend-protocol name|gen__Protocol__0 - java.lang.String (name|gen [x] (.invoke name|gen|__0 x)) - ;; this is part of the protocol because even though `Named` is an interface, - ;; `String` is final, so they're mutually exclusive - clojure.lang.Named (name|gen [x] (.invoke name|gen|__1 x)))) - -(defn gen-register-spec - "Registers in the map of qualified symbol to input spec, to output spec - - Example output: - (swap! ... assoc `abcde - (fn [args] (case (count args) 1 )))" - [{:keys [fn|name arg-ct->spec variadic-overload]}] - (unify-gensyms - `(swap! *fn->spec assoc '~(qualify fn|name) - (xp/>expr - (fn [args##] (case (count args##) ~@arg-ct->spec - ~@(when variadic-overload - [`(if (>= (count args##) (:positional-args-ct variadic-overload)) - (:spec variadic-overload) - (err! "Arg count not enough for variadic overload"))]))))) - true)) - -(defn fnt|code [kind lang args] - (let [{:keys [::ss/fn|name overloads ::ss/meta] :as args'} - (s/validate args (case kind :defn ::defnt :fn ::fnt)) - _ (prl! args') - inline? - (s/validate (-> fn|name core/meta :inline) (t/? t/boolean?)) - _ (prl! inline?) - fn|name (if inline? - (do (log/pr :warn "requested `:inline`; ignoring until feature is implemented") - (update-meta fn|name dissoc :inline)) - fn|name) - overloads (->> overloads (mapv #(fnt|overload-data>overload % {:lang lang}))) - ;; only one variadic arg allowed - _ (s/validate overloads (fn->> (c/lfilter :variadic?) count (<- <= 1))) - arg-ct->spec (->> overloads - (remove+ :variadic?) - (group-by :positional-args-ct) - (map-vals+ :spec) - join (apply concat)) - variadic-overload (->> overloads (c/lfilter :variadic?) first) - register-spec (gen-register-spec (kw-map fn|name arg-ct->spec variadic-overload)) - direct-dispatch-codelist - (case lang - :clj (for [[i overload] (c/lindexed overloads)] - (fnt|overload>reify (kw-map overload i fn|name))) - :cljs (TODO)) - dynamic-dispatch-codelist - (case lang - :clj (let [protocol (fnt|overloads>protocol {:overloads overloads :fn|name fn|name})] - `[~(:defprotocol protocol) - ~@(:extend-protocols protocol)]) - :cljs (TODO)) - base-fn-codelist [] - fn-codelist - (case lang - :clj `[~@direct-dispatch-codelist - ~@dynamic-dispatch-codelist - ~@base-fn-codelist] - :cljs (TODO)) - overloads|code (->> overloads (mapv :code)) - _ (prl! overloads) - code (case kind - :fn (list* 'fn (concat - (if (contains? args' ::ss/fn|name) - [fn|name] - []) - [overloads|code])) - :defn `(~'do ~register-spec - ~@fn-codelist))] - code)) - -(defmacro fnt [& args] - (fnt|code :fn (ufeval/env-lang) args)) - -(defmacro defnt [& args] - (fnt|code :defn (ufeval/env-lang) args)) - -) diff --git a/src-dev/quantum/core/defnt_equivalences.cljc b/src-dev/quantum/core/defnt_equivalences.cljc deleted file mode 100644 index 61b4d666..00000000 --- a/src-dev/quantum/core/defnt_equivalences.cljc +++ /dev/null @@ -1,937 +0,0 @@ -;; See https://jsperf.com/js-property-access-comparison — all property accesses (at least of length 1) seem to be equal - -(ns quantum.core.test.defnt-equivalences - (:refer-clojure :exclude [name]) - (:require - [clojure.core :as c] - [quantum.core.defnt - :refer [analyze defnt fnt|code *fn->spec]] - [quantum.core.macros.core - :refer [$]] - [quantum.core.macros - :refer [macroexpand-all case-env env-lang quote+]] - [quantum.core.macros.type-hint - :refer [tag]] - [quantum.core.spec :as s] - [quantum.core.test :as test - :refer [deftest testing is is= throws]] - [quantum.untyped.core.analyze.expr :as xp] - [quantum.untyped.core.collections.diff :as diff - :refer [diff]] - [quantum.untyped.core.core :as ucore - :refer [code=]] - [quantum.untyped.core.type :as t - :refer [? !]]) - (:import clojure.lang.Named - clojure.lang.Reduced - quantum.core.data.Array - quantum.core.Primitive)) - -(require '[quantum.core.spec :as s] - '[quantum.core.fn :refer [fn->]]) - -;; =====|=====|=====|=====|===== ;; - -(is (code= - -;; ----- implementation ----- ;; - -(macroexpand ' - (defnt pid > (? t/string?) [] - (->> (java.lang.management.ManagementFactory/getRuntimeMXBean) - (.getName)))) - -;; ----- expanded code ----- ;; - -($ (do (swap! *fn->spec assoc `pid - (xp/>expr - (fn [args##] - (case (count args##) 0 nil)))) - (def ~'pid|__0 - (reify >java|lang|String - (~(tag "java.lang.String" 'invoke) [~'_] - (~'->> (java.lang.management.ManagementFactory/getRuntimeMXBean) - (.getName))))))) - -)) - -;; =====|=====|=====|=====|===== ;; - -(is (code= - -;; ----- implementation ----- ;; - -;; TODO it needs to vary return classes of the overloads with the input -(macroexpand ' -(defnt identity|gen|uninlined ([x t/any?] x)) -) - -;; ----- expanded code ----- ;; - -($ (do #_(swap! *fn->spec assoc `identity|gen|uninlined - (xp/>expr - (fn [args##] (case (count args##) 1 nil #_(fn-> first t/->spec))))) - - ~(case (env-lang) - ;; Because for `any?` it includes primitives as well - :clj ($ (do ;; Direct dispatch - ;; One reify per overload - (def ~'identity|gen|uninlined|__0 ; `t/any?` - (reify boolean>boolean (~(tag "boolean" 'invoke) [~'_ ~(tag "boolean" 'x)] ~'x) - byte>byte (~(tag "byte" 'invoke) [~'_ ~(tag "byte" 'x)] ~'x) - short>short (~(tag "short" 'invoke) [~'_ ~(tag "short" 'x)] ~'x) - char>char (~(tag "char" 'invoke) [~'_ ~(tag "char" 'x)] ~'x) - int>int (~(tag "int" 'invoke) [~'_ ~(tag "int" 'x)] ~'x) - long>long (~(tag "long" 'invoke) [~'_ ~(tag "long" 'x)] ~'x) - float>float (~(tag "float" 'invoke) [~'_ ~(tag "float" 'x)] ~'x) - double>double (~(tag "double" 'invoke) [~'_ ~(tag "double" 'x)] ~'x) - Object>Object (~(tag "java.lang.Object" 'invoke) [~'_ ~(tag "java.lang.Object" 'x)] ~'x))) - ;; Dynamic dispatch (invoked only if incomplete type information (incl. in untyped context)) - ;; in this case no protocol is necessary because it boxes arguments anyway - ;; Var indirection may be avoided by making and using static fields via the Clojure 1.8 flag - (defn ~'identity|gen|uninlined [~'x] (.invoke identity|gen|uninlined|__0 ~'x)))) - :cljs ;; Direct dispatch will be simple functions, not `reify`s; not necessary here - ;; Dynamic dispatch will be approached later; not clear yet whether there is a huge savings - ($ (defn ~'identity|gen|uninlined [~'x] ~'x)))))) - -) - -;; =====|=====|=====|=====|===== ;; - -;; TODO will deal with `inline` later -(defnt ^:inline identity|gen ([x t/any?] x)) - -;; ----- test ----- ;; - -(deftest test|identity|gen - (is= (identity|gen 1 ) 1 ) - (is= (identity|gen "") "")) - -;; =====|=====|=====|=====|===== ;; - -(is (code= - -;; TODO don't ignore `:inline` -;; TODO `.getName` returns `(? string?)` so we need to add an assertion to guarantee -(macroexpand ' -(defnt #_:inline name|gen - ([x t/string? > t/string? ] x) - #?(:clj ([x Named > (! t/string?)] (.getName x)) - :cljs ([x INamed > (! t/string?)] (-name x)))) -) - -;; ----- expanded code ----- ;; - -($ (do (swap! *fn->spec assoc #'name|gen - (xp/casef count - 1 (xp/condpf-> t/<= (xp/get 0) - t/string? (fn-> t/->spec) ; TODO fix this - ~(case (env-lang) :clj `Named :cljs `INamed) t/string?))) - - ~(case (env-lang) - :clj ($ (do ;; Only direct dispatch for primitives or for Object, not for subclasses of Object - ;; Return value can be primitive; in this case it's not - ;; The macro in a typed context will find the appropriate dispatch at compile time - (def ~'name|gen|__0 - (reify java|lang|String>java|lang|String - (~(tag "java.lang.String" 'invoke) [~'_ ~(tag "java.lang.String" 'x)] ~'x))) - (def ~'name|gen|__1 - (reify clojure|lang|Named>java|lang|String - (~(tag "clojure.lang.Named" 'invoke) [~'_ ~(tag "clojure.lang.Named" 'x)] - (let [~'out (.getName ~'x)] - (s/validate ~'out t/string?))))) - - ;; This protocol is so suffixed because of the position of the argument on which - ;; it dispatches - (defprotocol name|gen__Protocol__0 - (name|gen [~'x])) - (extend-protocol name|gen__Protocol__0 - java.lang.String (name|gen [x] (.invoke name|gen|__0 x)) - ;; this is part of the protocol because even though `Named` is an interface, - ;; `String` is final, so they're mutually exclusive - clojure.lang.Named (name|gen [x] (.invoke name|gen|__1 x))))) - :cljs ($ (do ;; No protocol in ClojureScript - (defn name|gen [~'x] - (cond* (string? x) x - (satisfies? INamed x) (-name x) - (err! "Not supported for type" {:fn `name|gen :type (type x)})))))))) - -)) - -;; =====|=====|=====|=====|===== ;; - -;; Perhaps silly in ClojureScript, but avoids boxing in Clojure -(macroexpand ' -(defnt #_:inline some?|gen - ([x t/nil?] false) - ([x t/any?] true)) -) - -;; ----- expanded code ----- ;; - -($ (do (swap! fn->spec assoc #'some?|gen - (xp/casef c/count - 1 (xp/condpf-> t/<= (xp/get 0) - t/nil? (t/value false) - t/any? (t/value true )))) - - ~(case (env-lang) - :clj ($ (do (def some?|gen|__0 ; `nil?` - (reify Object>boolean (^boolean invoke [_# ^java.lang.Object ~'x] false))) - (def some?|gen|__1 ; `t/any?` - (reify boolean>boolean (^boolean invoke [_# ^boolean ~'x] true) - byte>boolean (^boolean invoke [_# ^byte ~'x] true) - short>boolean (^boolean invoke [_# ^short ~'x] true) - char>boolean (^boolean invoke [_# ^char ~'x] true) - int>boolean (^boolean invoke [_# ^int ~'x] true) - long>boolean (^boolean invoke [_# ^long ~'x] true) - float>boolean (^boolean invoke [_# ^float ~'x] true) - double>boolean (^boolean invoke [_# ^double ~'x] true) - Object>boolean (^boolean invoke [_# ^java.lang.Object ~'x] true))) - ;; Dynamic dispatch - (defn some?|gen [~'x] - (cond* (nil? x) (.invoke some?|gen|__0 x) - (.invoke some?|gen|__1 x))))) - :cljs `(do (defn some?|gen [~'x] - (cond* (nil? x) false - true)))))) - -;; =====|=====|=====|=====|===== ;; - -;; Perhaps silly in ClojureScript, but avoids boxing in Clojure -(macroexpand ' -(defnt #_:inline reduced?|gen - ([x Reduced] true) - ([x t/any? ] false)) -) - -;; ----- expanded code ----- ;; - -`(do (swap! fn->spec assoc #'reduced?|gen - (xp/casef c/count - 1 (xp/condpf-> t/<= (xp/get 0) - t/reduced? (t/value true) - t/any? (t/value false)))) - - ~(case-env - :clj `(do (def reduced?|gen|__0 ; `Reduced` - (reify Object>boolean (^boolean invoke [_# ^java.lang.Object ~'x] true))) - (def reduced?|gen|__1 ; `t/any?` - (reify boolean>boolean (^boolean invoke [_# ^boolean ~'x] false) - byte>boolean (^boolean invoke [_# ^byte ~'x] false) - short>boolean (^boolean invoke [_# ^short ~'x] false) - char>boolean (^boolean invoke [_# ^char ~'x] false) - int>boolean (^boolean invoke [_# ^int ~'x] false) - long>boolean (^boolean invoke [_# ^long ~'x] false) - float>boolean (^boolean invoke [_# ^float ~'x] false) - double>boolean (^boolean invoke [_# ^double ~'x] false) - Object>boolean (^boolean invoke [_# ^java.lang.Object ~'x] false))) - ;; No protocol because just one class; TODO evaluate whether this is better performance-wise? probably is - (defn reduced?|gen [~'x] - (cond* (instance? Reduced x) (.invoke reduced?|gen|__0 x) - (.invoke reduced?|gen|__1 x)))) - :cljs `(do (defn reduced?|gen [~'x] - (cond* (instance? Reduced x) true false))))) - -;; =====|=====|=====|=====|===== ;; - -(macroexpand ' -(defnt #_:inline >boolean - ([x t/boolean?] x) - ([x t/nil? ] false) - ([x t/any? ] true)) -) - -;; ----- expanded code ----- ;; - -`(do (swap! fn->spec assoc #'>boolean|gen - (xp/casef c/count - 1 (xp/condpf-> t/<= (xp/get 0) - t/boolean? (fn-> t/->spec) ; TODO fix this - t/nil? (t/value false) - t/any? (t/value true )))) - - ~(case-env - :clj `(do (def >boolean|gen|__0 ; `Reduced` - (reify boolean>boolean (^boolean invoke [_# ^boolean ~'x] x))) - (def >boolean|gen|__1 ; `nil?` - (reify Object>boolean (^boolean invoke [_# ^java.lang.Object ~'x] false))) - (def >boolean|gen|__2 ; `t/any?` - (reify boolean>boolean (^boolean invoke [_# ^boolean ~'x] true) - byte>boolean (^boolean invoke [_# ^byte ~'x] true) - short>boolean (^boolean invoke [_# ^short ~'x] true) - char>boolean (^boolean invoke [_# ^char ~'x] true) - int>boolean (^boolean invoke [_# ^int ~'x] true) - long>boolean (^boolean invoke [_# ^long ~'x] true) - float>boolean (^boolean invoke [_# ^float ~'x] true) - double>boolean (^boolean invoke [_# ^double ~'x] true) - Object>boolean (^boolean invoke [_# ^java.lang.Object ~'x] true))) - - (defprotocol >boolean|gen__Protocol - (>boolean|gen [~'x])) - (extend-protocol >boolean|gen__Protocol - java.lang.Boolean (>boolean|gen [^java.lang.Boolean x] (.invoke >boolean|gen|__0 x)) - java.lang.Object (>boolean|gen [x] - (cond* (nil? x) (.invoke >boolean|gen|__1 x) - (.invoke >boolean|gen|__2 x))))) - :cljs `(do (defn >boolean|gen [~'x] - (cond* (boolean? x) x - (nil? x) false - true))))) - -;; =====|=====|=====|=====|===== ;; - -#?(:clj -;; auto-upcasts to long or double (because 64-bit) unless you tell it otherwise -;; will error if not all return values can be safely converted to the return spec -(defnt #_:inline >int* > int - ([x (t/and t/primitive? (t/not t/boolean?)) #_?] (Primitive/uncheckedIntCast x)) - ([x Number] (.intValue x)))) - -;; ----- expanded code ----- ;; - -#?(:clj -`(do (swap! fn->spec assoc #'>int*|gen - (xp/casef c/count - 1 (xp/condpf-> t/<= (xp/get 0) - (s/and primitive? (s/not boolean?)) t/int? - Number t/int?))) - - ~(case-env - :clj `(do (def >int*|gen|__0 ; `(s/and primitive? (s/not boolean?))` - (reify byte>int (^int invoke [_# ^byte ~'x] (Primitive/uncheckedIntCast x)) - short>int (^int invoke [_# ^short ~'x] (Primitive/uncheckedIntCast x)) - char>int (^int invoke [_# ^char ~'x] (Primitive/uncheckedIntCast x)) - int>int (^int invoke [_# ^int ~'x] (Primitive/uncheckedIntCast x)) - long>int (^int invoke [_# ^long ~'x] (Primitive/uncheckedIntCast x)) - float>int (^int invoke [_# ^float ~'x] (Primitive/uncheckedIntCast x)) - double>int (^int invoke [_# ^double ~'x] (Primitive/uncheckedIntCast x)))) - (def >int*|gen|__1 ; `Number` - (reify Object>int (^int invoke [_# ^java.lang.Object ~'x] (.intValue ^Number x)))) - - (defprotocol >int*|gen__Protocol - (>int*|gen [~'x])) - (extend-protocol >int*|gen__Protocol - java.lang.Byte (>int*|gen [^java.lang.Byte x] (.invoke >int*|gen|__0 x)) - java.lang.Short (>int*|gen [^java.lang.Short x] (.invoke >int*|gen|__0 x)) - java.lang.Character (>int*|gen [^java.lang.Character x] (.invoke >int*|gen|__0 x)) - java.lang.Integer (>int*|gen [^java.lang.Integer x] (.invoke >int*|gen|__0 x)) - java.lang.Long (>int*|gen [^java.lang.Long x] (.invoke >int*|gen|__0 x)) - java.lang.Float (>int*|gen [^java.lang.Float x] (.invoke >int*|gen|__0 x)) - java.lang.Double (>int*|gen [^java.lang.Double x] (.invoke >int*|gen|__0 x)) - java.lang.Number (>int*|gen [ x] (.invoke >int*|gen|__1 x))))))) - -;; =====|=====|=====|=====|===== ;; - -(defnt !str - ([] #?(:clj (StringBuilder.) :cljs (StringBuffer.))) - ;; `?*` means infer with opts - ;; This means that e.g., `x` can be an `int`, and since `:any-in-numeric-range?` is `true`, `x` can be - ;; anything in the numeric range of an `int`. - ;; TODO the `:any-in-numeric-range?` option could simply be reduced to a `(if numeric? in-range? identity)` - ;; sort of predicate — `(s/and integer-value? (s/range-of int))` - ;; By default it enforces reasonably strict type checks (i.e. not allowing strange byte manipulation), - ;; so it does not allow e.g. short strings convertible to an arbitrary `int` representation. - ([x #?(:clj (?* {:any-in-numeric-range? true}) :cljs t/any?)] ; TODO unknown if `t/any?` is really allowed here - #?(:clj (StringBuilder. x) :cljs (StringBuffer. x)))) - -;; ----- expanded code ----- ;; - -`(do (swap! fn->spec assoc #'!str|gen - (xp/casef c/count - 0 ~(case-env :clj (t/>spec StringBuilder) - :cljs (t/>spec StringBuffer )) - 1 (xp/condpf-> t/<= (xp/get 0) - (s/and primitive? (s/not boolean?)) t/int? - Number t/int?))) - - ~(case-env - :clj `(do (def !str|gen|__0 - (reify >Object (^java.lang.Object invoke [_# ] (StringBuilder.)))) - ;; `(?* {:any-in-numeric-range? true})` - (def !str|gen|__1__0 ; (StringBuilder. ) - (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'x] (StringBuilder. ^CharSequence x)))) - (def !str|gen|__1__1 ; (StringBuilder. <(range-of t/int?)>) - (reify int>Object (^java.lang.Object invoke [_# ^int ~'x] (StringBuilder. x))) - ...) - (def !str|gen|__1__2 ; (StringBuilder. ) - (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'x] (StringBuilder. ^String x)))) - - (defprotocol !str|gen__Protocol - (!str|gen__protocol [~'x])) - (extend-protocol !str|gen__Protocol - ...) - (defn !str|gen ([ ] (.invoke !str|gen|__0)) - ([a0] (!str|gen__protocol a0)))) - :cljs `(do (defn !str|gen ([] (StringBuffer.)) - ([a0] (let [x a0] (StringBuffer. x))))))) - -;; =====|=====|=====|=====|===== ;; - -(macroexpand ' -(defnt #_:inline >|gen - #?(:clj ([a ? b ? ] (quantum.core.Numeric/gt a b)) - :cljs ([a t/double? b t/double?] (cljs.core/> a b)))) -) - -;; ----- expanded code ----- ;; - -`(do (swap! fn->spec assoc #'>|gen - (xp/casef c/count - 2 (xp/condpf-> t/<= (xp/get 0) - t/byte? (xp/condpf-> t/<= (xp/get 1) - t/byte? t/boolean? - t/char? t/boolean? - t/short? t/boolean? - t/int? t/boolean? - t/long? t/boolean? - t/float? t/boolean? - t/double? t/boolean?) - t/char? (xp/condpf-> t/<= (xp/get 1) - t/byte? t/boolean? - t/char? t/boolean? - t/short? t/boolean? - t/int? t/boolean? - t/long? t/boolean? - t/float? t/boolean? - t/double? t/boolean?) - t/short? (xp/condpf-> t/<= (xp/get 1) - t/byte? t/boolean? - t/char? t/boolean? - t/short? t/boolean? - t/int? t/boolean? - t/long? t/boolean? - t/float? t/boolean? - t/double? t/boolean?) - t/int? (xp/condpf-> t/<= (xp/get 1) - t/byte? t/boolean? - t/char? t/boolean? - t/short? t/boolean? - t/int? t/boolean? - t/long? t/boolean? - t/float? t/boolean? - t/double? t/boolean?) - t/long? (xp/condpf-> t/<= (xp/get 1) - t/byte? t/boolean? - t/char? t/boolean? - t/short? t/boolean? - t/int? t/boolean? - t/long? t/boolean? - t/float? t/boolean? - t/double? t/boolean?) - t/float? (xp/condpf-> t/<= (xp/get 1) - t/byte? t/boolean? - t/char? t/boolean? - t/short? t/boolean? - t/int? t/boolean? - t/long? t/boolean? - t/float? t/boolean? - t/double? t/boolean?) - t/double? (xp/condpf-> t/<= (xp/get 1) - t/byte? t/boolean? - t/char? t/boolean? - t/short? t/boolean? - t/int? t/boolean? - t/long? t/boolean? - t/float? t/boolean? - t/double? t/boolean?)))) - - - ~(case-env - :clj `(do (def >|gen|__0 - (reify byte+byte>boolean (^boolean invoke [_# ^byte a ^byte b] (Numeric/gt a b)) - byte+char>boolean (^boolean invoke [_# ^byte a ^char b] (Numeric/gt a b)) - byte+short>boolean (^boolean invoke [_# ^byte a ^short b] (Numeric/gt a b)) - byte+int>boolean (^boolean invoke [_# ^byte a ^int b] (Numeric/gt a b)) - byte+long>boolean (^boolean invoke [_# ^byte a ^long b] (Numeric/gt a b)) - byte+float>boolean (^boolean invoke [_# ^byte a ^float b] (Numeric/gt a b)) - byte+double>boolean (^boolean invoke [_# ^byte a ^double b] (Numeric/gt a b)) - char+byte>boolean (^boolean invoke [_# ^char a ^byte b] (Numeric/gt a b)) - char+char>boolean (^boolean invoke [_# ^char a ^char b] (Numeric/gt a b)) - char+short>boolean (^boolean invoke [_# ^char a ^short b] (Numeric/gt a b)) - char+int>boolean (^boolean invoke [_# ^char a ^int b] (Numeric/gt a b)) - char+long>boolean (^boolean invoke [_# ^char a ^long b] (Numeric/gt a b)) - char+float>boolean (^boolean invoke [_# ^char a ^float b] (Numeric/gt a b)) - char+double>boolean (^boolean invoke [_# ^char a ^double b] (Numeric/gt a b)) - short+byte>boolean (^boolean invoke [_# ^short a ^byte b] (Numeric/gt a b)) - short+char>boolean (^boolean invoke [_# ^short a ^char b] (Numeric/gt a b)) - short+short>boolean (^boolean invoke [_# ^short a ^short b] (Numeric/gt a b)) - short+int>boolean (^boolean invoke [_# ^short a ^int b] (Numeric/gt a b)) - short+long>boolean (^boolean invoke [_# ^short a ^long b] (Numeric/gt a b)) - short+float>boolean (^boolean invoke [_# ^short a ^float b] (Numeric/gt a b)) - short+double>boolean (^boolean invoke [_# ^short a ^double b] (Numeric/gt a b)) - int+byte>boolean (^boolean invoke [_# ^int a ^byte b] (Numeric/gt a b)) - int+char>boolean (^boolean invoke [_# ^int a ^char b] (Numeric/gt a b)) - int+short>boolean (^boolean invoke [_# ^int a ^short b] (Numeric/gt a b)) - int+int>boolean (^boolean invoke [_# ^int a ^int b] (Numeric/gt a b)) - int+long>boolean (^boolean invoke [_# ^int a ^long b] (Numeric/gt a b)) - int+float>boolean (^boolean invoke [_# ^int a ^float b] (Numeric/gt a b)) - int+double>boolean (^boolean invoke [_# ^int a ^double b] (Numeric/gt a b)) - long+byte>boolean (^boolean invoke [_# ^long a ^byte b] (Numeric/gt a b)) - long+char>boolean (^boolean invoke [_# ^long a ^char b] (Numeric/gt a b)) - long+short>boolean (^boolean invoke [_# ^long a ^short b] (Numeric/gt a b)) - long+int>boolean (^boolean invoke [_# ^long a ^int b] (Numeric/gt a b)) - long+long>boolean (^boolean invoke [_# ^long a ^long b] (Numeric/gt a b)) - long+float>boolean (^boolean invoke [_# ^long a ^float b] (Numeric/gt a b)) - long+double>boolean (^boolean invoke [_# ^long a ^double b] (Numeric/gt a b)) - float+byte>boolean (^boolean invoke [_# ^float a ^byte b] (Numeric/gt a b)) - float+char>boolean (^boolean invoke [_# ^float a ^char b] (Numeric/gt a b)) - float+short>boolean (^boolean invoke [_# ^float a ^short b] (Numeric/gt a b)) - float+int>boolean (^boolean invoke [_# ^float a ^int b] (Numeric/gt a b)) - float+long>boolean (^boolean invoke [_# ^float a ^long b] (Numeric/gt a b)) - float+float>boolean (^boolean invoke [_# ^float a ^float b] (Numeric/gt a b)) - float+double>boolean (^boolean invoke [_# ^float a ^double b] (Numeric/gt a b)) - double+byte>boolean (^boolean invoke [_# ^double a ^byte b] (Numeric/gt a b)) - double+char>boolean (^boolean invoke [_# ^double a ^char b] (Numeric/gt a b)) - double+short>boolean (^boolean invoke [_# ^double a ^short b] (Numeric/gt a b)) - double+int>boolean (^boolean invoke [_# ^double a ^int b] (Numeric/gt a b)) - double+long>boolean (^boolean invoke [_# ^double a ^long b] (Numeric/gt a b)) - double+float>boolean (^boolean invoke [_# ^double a ^float b] (Numeric/gt a b)) - double+double>boolean (^boolean invoke [_# ^double a ^double b] (Numeric/gt a b)))) - - (defprotocol >|gen__Protocol - (>|gen [~'a0 ~'a1])) - (extend-protocol >|gen__Protocol - ...)) - :cljs `(do (defn >|gen - ([a0 a1] - (cond* (double? a0) - (cond* (double? a1) - (let [a a0 b a1] (cljs.core/> a b)) - (unsupported! `>|gen [a0 a1])) - (unsupported! `>|gen [a0 a1]))))))) - -;; =====|=====|=====|=====|===== ;; - -(macroexpand ' -(defnt #_:inline str - ([] "") - ([x t/nil?] "") - ;; could have inferred but there may be other objects who have overridden .toString - #?(:clj ([x Object] (.toString x)) - ;; Can't infer that it returns a string (without a pre-constructed list of built-in functions) - ;; As such, must explicitly mark - :cljs ([x t/any? > (t/assume string?)] (.join #js [x] ""))) - ;; TODO only one variadic arity allowed currently; theoretically could dispatch on at least pre-variadic args, if not variadic - ([x ? & xs (s/seq ?) #?@(:clj [> (t/assume string?)])] ; TODO should have automatic currying? - (let [sb (!str (str x))] - (doseq [x' xs] (.append sb (str x'))) ; TODO is `doseq` the right approach? - (.toString sb)))) -) - -;; ----- expanded code ----- ;; - -`(do (swap! fn->spec assoc #'str|gen - (xp/casef c/count - 0 (t/value "") - 1 (xp/condpf-> t/<= (xp/get 0) - nil? (t/value "") - ~@(case-env :clj `[Object t/string?] - :cljs `[t/any? t/string?])) - (xp/condpf-> t/<= ...))) - - ~(case-env - :clj `(do (def str|gen|__0 - (reify >Object (^java.lang.Object invoke [_# ] ""))) - (def str|gen|__1 ; `nil?` - (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'x] ""))) - (def str|gen|__2 ; `Object` - (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'x] (.toString x)))) - - ;; No protocol needed because overloads of protocolizable arity (n>=1, not variadic) do not vary by class - (defn str|gen - ([ ] (.invoke !str|gen|__0)) - ([a0] (cond* (nil? x) (.invoke !str|gen|__1) - (.invoke !str|gen|__2 a0))) - ([x & xs] - (let [sb (!str (str x))] - (doseq [x' xs] (.append sb (str x'))) ; TODO is `doseq` the right approach? - (.toString sb))))) - :cljs `(do ;; No protocol needed because overloads of protocolizable arity (n>=1, not variadic) do not vary by class - (defn str|gen - ([ ] "") - ([a0] (cond* (nil? x) "" - (.join #js [x] ""))) - ([x & xs] - (let [sb (!str (str x))] - (doseq [x' xs] (.append sb (str x'))) ; TODO is `doseq` the right approach? - (.toString sb))))))) - -;; =====|=====|=====|=====|===== ;; - -(macroexpand ' -(defnt #_:inline count - ([xs #?(:clj ? :cljs array?) #?@(:cljs [> t/int?])] (#?(:clj Array/count :cljs .-length) xs)) - ([xs t/string? #?@(:cljs [> t/int?])] (#?(:clj .length :cljs .-length) xs)) - ([xs !+vector? #?@(:cljs [> t/int?])] (#?(:clj count :cljs (do (TODO) 0)) xs))) -) - -;; ----- expanded code ----- ;; - -`(do (swap! fn->spec assoc #'count|gen - (xp/casef c/count - 1 (xp/condpf-> t/<= (xp/get 0) - array? t/int? - string? t/int? - !+vector? t/int?))) - - ~(case-env - :clj `(do ;; `array?` - (def count|gen|__0__1 (reify Object>int (^int invoke [_# ^java.lang.Object ~'xs] (Array/count ^"[B" xs)))) - ... - - (defprotocol count|gen__Protocol ...)) - :cljs `(do ...))) - -;; =====|=====|=====|=====|===== ;; - -(defnt #_:inline get - ([xs t/array? , k (t/-> integer? ?)] (#?(:clj Array/get :cljs aget) xs k)) - ([xs t/string?, k (t/-> integer? ?)] (.charAt xs k)) - ([xs !+vector?, k t/any?] #?(:clj (.valAt xs k) :cljs (TODO)))) - -;; ----- expanded code ----- ;; - -;; =====|=====|=====|=====|===== ;; - -; TODO CLJS version will come after -#?(:clj -(macroexpand ' -(defnt seq|gen > (t/? ISeq) - "Taken from `clojure.lang.RT/seq`" - ([xs t/nil? ] nil) - ([xs t/array? ] (ArraySeq/createFromObject xs)) - ([xs ASeq ] xs) - ([xs (t/or LazySeq Seqable)] (.seq xs)) - ([xs Iterable ] (clojure.lang.RT/chunkIteratorSeq (.iterator xs))) - ([xs CharSequence ] (StringSeq/create xs)) - ([xs Map ] (seq|gen (.entrySet xs))))) -) - -;; ----- expanded code ----- ;; - -#?(:clj -`(do (swap! fn->spec assoc #'seq|gen - (xp/casef c/count - 1 (xp/condpf-> t/<= (xp/get 0) - nil? (t/value nil) - array? (t/>spec ISeq) - (t/>spec ASeq) t/>spec ; TODO fix - (t/or LazySeq Seqable) (t/>spec ISeq) - (t/>spec Iterable) (t/>spec ISeq) - (t/>spec CharSequence) (t/>spec ISeq) - (t/>spec Map) (t/>spec ISeq)))) - - ~(case-env - :clj `(do ;; `nil?` - (def seq|gen|__0 (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] nil))) - ;; `array?` - (def seq|gen|__1__0 (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] (ArraySeq/createFromObject xs)))) - ... - ;; `ASeq` - (def seq|gen|__2 (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] xs))) - ;; `LazySeq` - (def seq|gen|__3__0 (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] (.seq ^LazySeq xs)))) - ;; `Seqable` - (def seq|gen|__3__1 (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] (.seq ^Seqable xs)))) - ;; `Iterable` - (def seq|gen|__4 (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] - (clojure.lang.RT/chunkIteratorSeq (.iterator ^Iterator xs))))) - ;; `CharSequence` - (def seq|gen|__5 (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] (StringSeq/create ^CharSequence xs)))) - ;; `Map` - (def seq|gen|__6 (reify Object>Object (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] (seq|gen (.entrySet ^Map xs))))) - - (defprotocol seq|gen__Protocol - (seq|gen [a0])) - (extend-protocol seq|gen__Protocol - ;; `array?` - ... - ASeq (seq|gen [^ASeq a0] (.invoke seq|gen|__2 a0)) - LazySeq (seq|gen [^LazySeq a0] (.invoke seq|gen|__3__0 a0)) - Object (seq|gen [a0] - ;; these are sequential dispatch because none of these are concrete or abstract classes - ;; (most are interfaces etc.) - (cond* (nil? a0) (.invoke seq|gen|__0 a0) - (instance? ASeq a0) (.invoke seq|gen|__2 a0) - (instance? Seqable a0) (.invoke seq|gen|__3__1 a0) - (instance? Iterable a0) (.invoke seq|gen|__4 a0) - (instance? CharSequence a0) (.invoke seq|gen|__5 a0) - (instance? Map a0) (.invoke seq|gen|__6 a0) - (unsupported! `seq|gen a0))))) - :cljs `(do ...)))) - -;; =====|=====|=====|=====|===== ;; - -#?(:clj -(macroexpand ' -(defnt first|gen - ([xs t/nil? ] nil) - ([xs (t/and sequential? indexed?)] (get|gen xs 0)) - ([xs ISeq ] (.first xs)) - ([xs ? ] (first|gen (seq|gen xs))))) -) - -#?(:clj -`(do (swap! fn->spec assoc #'seq|gen - (xp/casef c/count - 1 (xp/condpf-> t/<= (xp/get 0) - nil? (t/value nil) - (t/and sequential? indexed?) ... - (t/>spec ISeq) Object - (t/or nil? - array? - ASeq - (t/or LazySeq Seqable) - Iterable - CharSequence - Map ) ...))) - - ~(case-env - :clj `(do ...) - :cljs `(do ...)))) - -;; ----- expanded code ----- ;; - -;; =====|=====|=====|=====|===== ;; - -(macroexpand ' -(defnt next|gen > (? ISeq) - "Taken from `clojure.lang.RT/next`" - ([xs t/nil?] nil) - ([xs ISeq ] (.next xs)) - ([xs ? ] (next|gen (seq|gen xs)))) -) - -;; ----- expanded code ----- ;; - -;; =====|=====|=====|=====|===== ;; - -(defnt reduce - "Much of this content taken from clojure.core.protocols for inlining and - type-checking purposes." - {:attribution "alexandergunnarson"} - ([f ? xs nil?] (f)) - ([f (fn-of 2), init ? xs nil?] init) - ([f ?, init ?, z fast_zip.core.ZipperLocation] - (loop [xs (zip/down z) v init] - (if (some? z) - (let [ret (f v z)] - (if (reduced? ret) - @ret - (recur (zip/right xs) ret))) - v))) - ; TODO look at CLJS `array-reduce` - ([f ?, init ?, xs (t/or array? string? !+vector?)] ; because transient vectors aren't reducible - (let [ct (count xs)] - (loop [i 0 v init] - (if (< i ct) - (let [ret (f v (get xs i))] - (if (reduced? ret) - @ret - (recur (inc* i) ret))) - v)))) -#?(:clj ([f ?, init ?, xs clojure.lang.StringSeq] - (let [s (.s xs)] - (loop [i (.i xs) v init] - (if (< i (count s)) - (let [ret (f v (get s i))] - (if (reduced? ret) - @ret - (recur (inc* i) ret))) - v))))) -#?(:clj ([f ? - xs (t/or clojure.lang.PersistentVector ; vector's chunked seq is faster than its iter - clojure.lang.LazySeq ; for range - clojure.lang.ASeq)] ; aseqs are iterable, masking internal-reducers - (if-let [s (seq xs)] - (clojure.core.protocols/internal-reduce (next s) f (first s)) - (f)))) -#?(:clj ([f ?, init ? - xs (t/or clojure.lang.PersistentVector ; vector's chunked seq is faster than its iter - clojure.lang.LazySeq ; for range - clojure.lang.ASeq)] ; aseqs are iterable, masking internal-reducers - (let [s (seq xs)] - (clojure.core.protocols/internal-reduce s f init)))) - ([x transformer?, f ?] - (let [rf ((.-xf x) f)] - (rf (reduce rf (rf) (.-prev x))))) - ([x transformer?, f ?, init ?] - (let [rf ((.-xf x) f)] - (rf (reduce rf init (.-prev x))))) - ([f ?, init ?, x chan?] (async/reduce f init x)) ; TODO spec `async/reduce` -#?(:cljs ([f ?, init ?, xs +map?] (#_(:clj clojure.core.protocols/kv-reduce - :cljs -kv-reduce) ; in order to use transducers... - -reduce-seq xs f init))) -#?(:cljs ([f ?, init ?, xs +set?] (-reduce-seq xs f init))) - ([f ?, init ?, n numerically-int?] - (loop [i 0 v init] - (if (< i n) - (let [ret (f v i)] - (if (reduced? ret) - @ret - (recur (inc* i) ret))) ; TODO should only be unchecked if `n` is within unchecked range - v))) - ;; `iter-reduce` -#?(:clj ([f ? - xs (t/or clojure.lang.APersistentMap$KeySeq - clojure.lang.APersistentMap$ValSeq - Iterable)] - (let [iter (.iterator xs)] - (if (.hasNext iter) - (loop [ret (.next iter)] - (if (.hasNext iter) - (let [ret (f ret (.next iter))] - (if (reduced? ret) - @ret - (recur ret))) - ret)) - (f))))) - ;; `iter-reduce` -#?(:clj ([f ?, init ? - xs (t/or clojure.lang.APersistentMap$KeySeq - clojure.lang.APersistentMap$ValSeq - Iterable)] - (let [iter (.iterator xs)] - (loop [ret init] - (if (.hasNext iter) - (let [ret (f ret (.next iter))] - (if (reduced? ret) - @ret - (recur ret))) - ret))))) -#?(:clj ([f ?, xs clojure.lang.IReduce ] (.reduce xs f))) -#?(:clj ([f ?, init, xs clojure.lang.IKVReduce ] (.kvreduce xs f init))) -#?(:clj ([f ?, init, xs clojure.lang.IReduceInit] (.reduce xs f init))) - ([f (fn-of 2), xs any?] - (#?(:clj clojure.core.protocols/coll-reduce - :cljs -reduce) xs f)) - ([f (fn-of 2), init ?, xs any?] - (#?(:clj clojure.core.protocols/coll-reduce - :cljs -reduce) xs f init))) - -;; ----- expanded code ----- ;; - -;; =====|=====|=====|=====|===== ;; - -(defnt transduce - ([ f ? xs ?] (transduce identity f xs)) - ([xf ? f ? xs ?] (transduce xf f (f) xs)) - ([xf ? f ? init ? xs ?] - (let [f' (xf f)] (f' (reduce f' init xs))))) - -;; ----- expanded code ----- ;; - -; ================================================ ; - -(do - -; (optional) function — only when the `defnt` has an arity with 0 arguments - -; (optional) inline macros — invoked only if in a typed context and not used as a function -(do #?(:clj (defmacro clj:name:java:lang:String [a0] `(let [~'x ~a0] ~'x))) - #?(:clj (defmacro cljs:name:string [a0] `(let [~'x ~a0] ~'x))) - #?(:clj (defmacro clj:name:clojure:lang:Named [a0] `(let [~'x ~a0] ~'(-name x)))) - #?(:clj (defmacro cljs:name:cljs:core:INamed [a0] `(let [~'x ~a0] ~'(.getName x))))) -) - -(extend-defnt abc/name ; for use outside of ns - ([a ?, b ?] (...))) - -(name (read )) - -(defn def-interfaces - [{:keys [::*interfaces]}] - *interfaces) - -(defn atom? [x] (instance? clojure.lang.IAtom x)) - -(s/def ::*interfaces (s/and atom? (fn-> deref map?))) -(s/def ::signatures (s/coll-of (s/tuple symbol? (s/+ symbol?)) :kind sequential?)) - -(s/fdef def-interfaces - :args (s/cat :a0 (s/keys :req [::signatures ::*interfaces])) - #_:ret #_int? - #_:fn #_(s/and #(>= (:ret %) (-> % :args :start)) - #(< (:ret %) (-> % :args :end)))) - -(s/def ::lang #{:clj :cljs}) - -(s/def ::expand-signatures:opts (s/keys :opt-un [::lang])) - -(s/fdef expand-signatures - :args (s/cat :signatures ::signatures - :opts (s/? ::expand-signatures:opts)) - :ret ::signatures) - -(defn expand-signatures [signatures & [opts]] - signatures) - -(instrument) -(def-interfaces {::signatures [['boolean ['nil?]] - ['boolean ['boolean]] - ['boolean ['any?]]] - ::*interfaces (atom {})}) - -(expand-signatures - [['boolean ['nil?]] - ['boolean ['boolean]] - ['boolean ['any?]]] - {:lang :clj}) - -(do -; (optional) function — only when the `defnt` has an arity with 0 arguments - -; (optional) inline macros — invoked only if in a typed context and not used as a function -(do #?(:clj (defmacro clj:name:java:lang:String [a0] `(let [~'x ~a0] ~'x))) - #?(:clj (defmacro cljs:name:string [a0] `(let [~'x ~a0] ~'x))) - #?(:clj (defmacro clj:name:clojure:lang:Named [a0] `(let [~'x ~a0] ~'(-name x)))) - #?(:clj (defmacro cljs:name:cljs:core:INamed [a0] `(let [~'x ~a0] ~'(.getName x))))) -) - -; ================================================ ; - -(defnt ^:inline custom - [x (s/if double? - (t/or (s/fnt [x ?] (> x 3)) ; uses the above-defined `>` - (s/fnt [x ?] (< x 0.1))) - (t/or string? !string?)) - y ?] (str x (name y))) ; uses the above-defined `name` - - -;; ===== CLOJURESCRIPT ===== ;; - -;; In order for specs to be enforceable at compile time, they must be able to be executed by the compilation -;; language. The case of one language compiled in a different one (e.g. ClojureScript in Clojure/Java) is -;; thus problematic. - -;; For instance, this is only able to be checked in CLJS, because `js-object?` is not implemented in CLJ: -(defnt abcde1 - [x #?(:clj string? :cljs js-object?)] ...) - -;; This could be checked in CLJ, but it would be an error to do so: -(defn my-spec [x] #?(:clj (check-this) :cljs (check-that))) - -(defnt abcde2 - [x my-spec] ...) - -;; So what is the solution? The solution is to forgo some functionality in ClojureScript and instead rely -;; fundamentally on the aggregative relationships among predicates created using the `defnt` spec system. - -;; For instance: - -(defnt abcde1 [x (t/pc :clj string? :cljs js-object?)] ...) - -;; Or: - -(t/def abcde1|x? :clj string? :cljs js-object?) - -(defnt abcde1 [x abcde1|x?] ...) - -;; Because the spec was registered using the `defnt` spec system, the quoted forms can be analyzed and -;; at least some things can be deduced. - -;; In this case, the spec of `x` is deducible: `abcde1|x?` (`js-object?` deeper down). The return spec -;; is also deducible as being the return spec of `abcde1`: - -(defnt abcde2 [x ?] (abcde1 x)) diff --git a/subprojects/quantum-java/src/java/quantum/core/Collections.java b/src-java/quantum/core/Collections.java similarity index 100% rename from subprojects/quantum-java/src/java/quantum/core/Collections.java rename to src-java/quantum/core/Collections.java diff --git a/subprojects/quantum-java/src/java/quantum/core/Core.java b/src-java/quantum/core/Core.java similarity index 100% rename from subprojects/quantum-java/src/java/quantum/core/Core.java rename to src-java/quantum/core/Core.java diff --git a/subprojects/quantum-java/src/java/quantum/core/error/Error.java b/src-java/quantum/core/Error.java similarity index 97% rename from subprojects/quantum-java/src/java/quantum/core/error/Error.java rename to src-java/quantum/core/Error.java index cb2775eb..b913e809 100644 --- a/subprojects/quantum-java/src/java/quantum/core/error/Error.java +++ b/src-java/quantum/core/Error.java @@ -1,4 +1,4 @@ -package quantum.core.error; +package quantum.core; import java.util.Collection; import java.util.Iterator; @@ -26,8 +26,11 @@ import static quantum.core.Core.keyword; import static quantum.core.Core.throw_; -// Like `clojure.lang.ExceptionInfo`, but a record -// This is expanded from `(macroexpand-all '(defrecord Error [ident message data trace cause]))`, while extending `RuntimeException` +// - Like `clojure.lang.ExceptionInfo`, but a record +// - This is expanded from `(macroexpand-all '(defrecord Error [ident message data trace cause]))`, +// while extending `RuntimeException` +// - The reason this is in Java code is in order to extend `RuntimeException` directly without using +// Clojure's `proxy` public class Error extends RuntimeException diff --git a/subprojects/quantum-java/src/java/quantum/core/Fn.java b/src-java/quantum/core/Fn.java similarity index 100% rename from subprojects/quantum-java/src/java/quantum/core/Fn.java rename to src-java/quantum/core/Fn.java diff --git a/subprojects/quantum-java/src/java/quantum/core/Numeric.java b/src-java/quantum/core/Numeric.java similarity index 54% rename from subprojects/quantum-java/src/java/quantum/core/Numeric.java rename to src-java/quantum/core/Numeric.java index 65f089bd..b629849a 100644 --- a/subprojects/quantum-java/src/java/quantum/core/Numeric.java +++ b/src-java/quantum/core/Numeric.java @@ -1,5 +1,5 @@ package quantum.core; -// TAKEN FROM ztellman/primitive-math AND EXPANDED +// Parts of `ztellman/primitive-math` were adapted for this // Note from java.lang.Math: // Code generators are encouraged to use platform-specific native libraries or @@ -10,90 +10,597 @@ public class Numeric { public static final byte byte0 = (byte) 0; - public static final char char0 = (char) 0; public static final short short0 = (short)0; + public static final char char0 = (char) 0; public static final int int0 = 0; + public static final float float0 = 0.0f; public static final byte byte1 = (byte) 1; - public static final char char1 = (char) 1; public static final short short1 = (short)1; + public static final char char1 = (char) 1; public static final int int1 = 1; + public static final float float1 = 1.0f; + + // ================================= Boolean Operations ===================================== // + + public static boolean identical (final Object a, final Object b) { return a == b; } + public static boolean nonIdentical(final Object a, final Object b) { return a != b; } + public static boolean isTrue (final boolean a ) { return a; } + public static boolean isFalse (final boolean a ) { return !a; } + public static boolean isNil (final Object a ) { return a == null; } + public static boolean not (final boolean a ) { return !a; } + public static boolean and (final boolean a, final boolean b) { return a && b; } + public static boolean or (final boolean a, final boolean b) { return a || b; } + + // =================================== Bit Operations ======================================= // + + // ---------------------------- bitNot : ! (implicitly checked) ---------------------------- // + + public static boolean bitNot (final boolean x) { return !x; } + public static byte bitNot (final byte x) { return (byte) ~x; } + public static short bitNot (final short x) { return (short)~x; } + public static char bitNot (final char x) { return (char) ~x; } + public static int bitNot (final int x) { return ~x; } + public static long bitNot (final long x) { return ~x; } + public static float bitNot (final float x) { + return Float.intBitsToFloat(~Float.floatToIntBits(x)); + } + public static double bitNot (final double x) { + return Double.longBitsToDouble(~Double.doubleToLongBits(x)); + } + + // ---------------------------- bitAnd : & (implicitly checked) ---------------------------- // + // Returns the smallest safe type; decimals are "infectious" + + public static boolean bitAnd (final boolean a, final boolean b) { return a & b ; } + public static byte bitAnd (final byte a, final byte b) { return (byte) (a & b); } + public static short bitAnd (final byte a, final short b) { return (short)(a & b); } + public static int bitAnd (final byte a, final char b) { return a & b ; } + public static int bitAnd (final byte a, final int b) { return a & b ; } + public static long bitAnd (final byte a, final long b) { return a & b ; } + public static float bitAnd (final byte a, final float b) { + return Float.intBitsToFloat(a & Float.floatToIntBits(b)); + } + public static double bitAnd (final byte a, final double b) { + return Double.longBitsToDouble(a & Double.doubleToLongBits(b)); + } + public static short bitAnd (final short a, final byte b) { return (short)(a & b); } + public static short bitAnd (final short a, final short b) { return (short)(a & b); } + public static int bitAnd (final short a, final char b) { return a & b ; } + public static int bitAnd (final short a, final int b) { return a & b ; } + public static long bitAnd (final short a, final long b) { return a & b ; } + public static float bitAnd (final short a, final float b) { + return Float.intBitsToFloat(a & Float.floatToIntBits(b)); + } + public static double bitAnd (final short a, final double b) { + return Double.longBitsToDouble(a & Double.doubleToLongBits(b)); + } + public static int bitAnd (final char a, final byte b) { return a & b ; } + public static int bitAnd (final char a, final short b) { return a & b ; } + public static char bitAnd (final char a, final char b) { return (char) (a & b); } + public static int bitAnd (final char a, final int b) { return a & b ; } + public static long bitAnd (final char a, final long b) { return a & b ; } + public static float bitAnd (final char a, final float b) { + return Float.intBitsToFloat(a & Float.floatToIntBits(b)); + } + public static double bitAnd (final char a, final double b) { + return Double.longBitsToDouble(a & Double.doubleToLongBits(b)); + } + public static int bitAnd (final int a, final byte b) { return a & b ; } + public static int bitAnd (final int a, final short b) { return a & b ; } + public static int bitAnd (final int a, final char b) { return a & b ; } + public static int bitAnd (final int a, final int b) { return a & b ; } + public static long bitAnd (final int a, final long b) { return a & b ; } + public static float bitAnd (final int a, final float b) { + return Float.intBitsToFloat(a & Float.floatToIntBits(b)); + } + public static double bitAnd (final int a, final double b) { + return Double.longBitsToDouble(a & Double.doubleToLongBits(b)); + } + public static long bitAnd (final long a, final byte b) { return a & b ; } + public static long bitAnd (final long a, final short b) { return a & b ; } + public static long bitAnd (final long a, final char b) { return a & b ; } + public static long bitAnd (final long a, final int b) { return a & b ; } + public static long bitAnd (final long a, final long b) { return a & b ; } + public static double bitAnd (final long a, final float b) { + return Double.longBitsToDouble(a & Float.floatToIntBits(b)); + } + public static double bitAnd (final long a, final double b) { + return Double.longBitsToDouble(a & Double.doubleToLongBits(b)); + } + public static float bitAnd (final float a, final byte b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) & b); + } + public static float bitAnd (final float a, final short b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) & b); + } + public static float bitAnd (final float a, final char b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) & b); + } + public static float bitAnd (final float a, final int b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) & b); + } + public static double bitAnd (final float a, final long b) { + return Double.longBitsToDouble(Float.floatToIntBits(a) & b); + } + public static float bitAnd (final float a, final float b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) & Float.floatToIntBits(b)); + } + public static double bitAnd (final float a, final double b) { + return Double.longBitsToDouble(Float.floatToIntBits(a) & Double.doubleToLongBits(b)); + } + public static double bitAnd (final double a, final byte b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) & b); + } + public static double bitAnd (final double a, final short b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) & b); + } + public static double bitAnd (final double a, final char b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) & b); + } + public static double bitAnd (final double a, final int b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) & b); + } + public static double bitAnd (final double a, final long b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) & b); + } + public static double bitAnd (final double a, final float b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) & Float.floatToIntBits(b)); + } + public static double bitAnd (final double a, final double b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) & Double.doubleToLongBits(b)); + } + + // ----------------------------- bitOr : | (implicitly checked) ----------------------------- // + // Returns the smallest safe type; decimals are "infectious" + + public static boolean bitOr (final boolean a, final boolean b) { return a | b ; } + public static byte bitOr (final byte a, final byte b) { return (byte) (a | b); } + public static short bitOr (final byte a, final short b) { return (short)(a | b); } + public static int bitOr (final byte a, final char b) { return a | b ; } + public static int bitOr (final byte a, final int b) { return a | b ; } + public static long bitOr (final byte a, final long b) { return a | b ; } + public static float bitOr (final byte a, final float b) { + return Float.intBitsToFloat(a | Float.floatToIntBits(b)); + } + public static double bitOr (final byte a, final double b) { + return Double.longBitsToDouble(a | Double.doubleToLongBits(b)); + } + public static short bitOr (final short a, final byte b) { return (short)(a | b); } + public static short bitOr (final short a, final short b) { return (short)(a | b); } + public static int bitOr (final short a, final char b) { return a | b ; } + public static int bitOr (final short a, final int b) { return a | b ; } + public static long bitOr (final short a, final long b) { return a | b ; } + public static float bitOr (final short a, final float b) { + return Float.intBitsToFloat(a | Float.floatToIntBits(b)); + } + public static double bitOr (final short a, final double b) { + return Double.longBitsToDouble(a | Double.doubleToLongBits(b)); + } + public static int bitOr (final char a, final byte b) { return a | b ; } + public static int bitOr (final char a, final short b) { return a | b ; } + public static char bitOr (final char a, final char b) { return (char) (a | b); } + public static int bitOr (final char a, final int b) { return a | b ; } + public static long bitOr (final char a, final long b) { return a | b ; } + public static float bitOr (final char a, final float b) { + return Float.intBitsToFloat(a | Float.floatToIntBits(b)); + } + public static double bitOr (final char a, final double b) { + return Double.longBitsToDouble(a | Double.doubleToLongBits(b)); + } + public static int bitOr (final int a, final byte b) { return a | b ; } + public static int bitOr (final int a, final short b) { return a | b ; } + public static int bitOr (final int a, final char b) { return a | b ; } + public static int bitOr (final int a, final int b) { return a | b ; } + public static long bitOr (final int a, final long b) { return a | b ; } + public static float bitOr (final int a, final float b) { + return Float.intBitsToFloat(a | Float.floatToIntBits(b)); + } + public static double bitOr (final int a, final double b) { + return Double.longBitsToDouble(a | Double.doubleToLongBits(b)); + } + public static long bitOr (final long a, final byte b) { return a | b ; } + public static long bitOr (final long a, final char b) { return a | b ; } + public static long bitOr (final long a, final short b) { return a | b ; } + public static long bitOr (final long a, final int b) { return a | b ; } + public static long bitOr (final long a, final long b) { return a | b ; } + public static double bitOr (final long a, final float b) { + return Double.longBitsToDouble(a | Float.floatToIntBits(b)); + } + public static double bitOr (final long a, final double b) { + return Double.longBitsToDouble(a | Double.doubleToLongBits(b)); + } + public static float bitOr (final float a, final byte b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) | b); + } + public static float bitOr (final float a, final short b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) | b); + } + public static float bitOr (final float a, final char b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) | b); + } + public static float bitOr (final float a, final int b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) | b); + } + public static double bitOr (final float a, final long b) { + return Double.longBitsToDouble(Float.floatToIntBits(a) | b); + } + public static float bitOr (final float a, final float b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) | Float.floatToIntBits(b)); + } + public static double bitOr (final float a, final double b) { + return Double.longBitsToDouble(Float.floatToIntBits(a) | Double.doubleToLongBits(b)); + } + public static double bitOr (final double a, final byte b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) | b); + } + public static double bitOr (final double a, final short b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) | b); + } + public static double bitOr (final double a, final char b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) | b); + } + public static double bitOr (final double a, final int b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) | b); + } + public static double bitOr (final double a, final long b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) | b); + } + public static double bitOr (final double a, final float b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) | Float.floatToIntBits(b)); + } + public static double bitOr (final double a, final double b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) | Double.doubleToLongBits(b)); + } - // ============================ BOOLEAN OPERATIONS ================================ // - - public static boolean isTrue (final boolean a ) { return a == true; } - public static boolean isFalse (final boolean a ) { return a == false; } - public static boolean isNil (final Object a ) { return a == null; } - public static boolean and (final boolean a, final boolean b) { return a && b; } - public static boolean or (final boolean a, final boolean b) { return a || b; } - public static boolean not (final boolean a ) { return !a; } - public static boolean xor (final boolean a, final boolean b) { return (a || b) && !(a && b); } - - // ============================ BIT OPERATIONS ================================ // - // Apparently '&' is fundamentally an int operation - - public static byte bitAnd (final byte a, final byte b) { return (byte) (a & b); } - public static char bitAnd (final byte a, final char b) { return (char) (a & b); } - public static short bitAnd (final byte a, final short b) { return (short)(a & b); } - public static int bitAnd (final byte a, final int b) { return a & b ; } - public static long bitAnd (final byte a, final long b) { return a & b ; } - public static char bitAnd (final char a, final byte b) { return (char) (a & b); } - public static char bitAnd (final char a, final char b) { return (char) (a & b); } - public static short bitAnd (final char a, final short b) { return (short)(a & b); } - public static int bitAnd (final char a, final int b) { return a & b ; } - public static long bitAnd (final char a, final long b) { return a & b ; } - public static short bitAnd (final short a, final byte b) { return (short)(a & b); } - public static short bitAnd (final short a, final char b) { return (short)(a & b); } - public static short bitAnd (final short a, final short b) { return (short)(a & b); } - public static int bitAnd (final short a, final int b) { return a & b ; } - public static long bitAnd (final short a, final long b) { return a & b ; } - public static int bitAnd (final int a, final byte b) { return a & b ; } - public static int bitAnd (final int a, final char b) { return a & b ; } - public static int bitAnd (final int a, final short b) { return a & b ; } - public static int bitAnd (final int a, final int b) { return a & b ; } - public static long bitAnd (final int a, final long b) { return a & b ; } - public static long bitAnd (final long a, final byte b) { return a & b ; } - public static long bitAnd (final long a, final char b) { return a & b ; } - public static long bitAnd (final long a, final short b) { return a & b ; } - public static long bitAnd (final long a, final int b) { return a & b ; } - public static long bitAnd (final long a, final long b) { return a & b ; } - - public static long bitOr (final long a, final long b) { return a | b; } // Implicitly checked - public static long bitXor (final long a, final long b) { return a ^ b; } // Implicitly checked - public static long bitNot (final long a ) { return ~a; } // Implicitly checked - public static long shiftLeft (final long a, final long b) { return a << b; } // Implicitly checked - public static long shiftRight (final long a, final long b) { return a >> b; } // Implicitly checked - public static long unsignedShiftRight (final long a, final long b) { return a >>> b; } - public static long unsignedShiftRight (final int a, final long b) { return a >>> b; } - - // TODO flipbit, testbit, setbit, clearbit - - // Because "more than one matching method" - public static short reverseShort(final short x) { - return (short) ((x << 8) - | ((char) x >>> 8)); - } - - public static int reverseInt (final int x) { - return ( (x << 24) - | ((x & 0x0000ff00) << 8) - | ((x & 0x00ff0000) >>> 8) - | (x >>> 24)); - } - - public static long reverseLong (final long x) { - return ( ((long) reverseInt((int)x) << 32) - | ((long) reverseInt((int)(x >>> 32)) & 0xffffffffL)); - } - - // ============================ LT : < ================================ // + // ------------------------------ bitXOr (implicitly checked) ------------------------------ // + // Returns the smallest safe type; decimals are "infectious" + + public static boolean bitXOr (final boolean a, final boolean b) { return a ^ b ; } + public static byte bitXOr (final byte a, final byte b) { return (byte) (a ^ b); } + public static short bitXOr (final byte a, final short b) { return (short)(a ^ b); } + public static int bitXOr (final byte a, final char b) { return a ^ b ; } + public static int bitXOr (final byte a, final int b) { return a ^ b ; } + public static long bitXOr (final byte a, final long b) { return a ^ b ; } + public static float bitXOr (final byte a, final float b) { + return Float.intBitsToFloat(a ^ Float.floatToIntBits(b)); + } + public static double bitXOr (final byte a, final double b) { + return Double.longBitsToDouble(a ^ Double.doubleToLongBits(b)); + } + public static short bitXOr (final short a, final byte b) { return (short)(a ^ b); } + public static short bitXOr (final short a, final short b) { return (short)(a ^ b); } + public static int bitXOr (final short a, final char b) { return a ^ b ; } + public static int bitXOr (final short a, final int b) { return a ^ b ; } + public static long bitXOr (final short a, final long b) { return a ^ b ; } + public static float bitXOr (final short a, final float b) { + return Float.intBitsToFloat(a ^ Float.floatToIntBits(b)); + } + public static double bitXOr (final short a, final double b) { + return Double.longBitsToDouble(a ^ Double.doubleToLongBits(b)); + } + public static int bitXOr (final char a, final byte b) { return a ^ b ; } + public static int bitXOr (final char a, final short b) { return a ^ b ; } + public static char bitXOr (final char a, final char b) { return (char) (a ^ b); } + public static int bitXOr (final char a, final int b) { return a ^ b ; } + public static long bitXOr (final char a, final long b) { return a ^ b ; } + public static float bitXOr (final char a, final float b) { + return Float.intBitsToFloat(a ^ Float.floatToIntBits(b)); + } + public static double bitXOr (final char a, final double b) { + return Double.longBitsToDouble(a ^ Double.doubleToLongBits(b)); + } + public static int bitXOr (final int a, final byte b) { return a ^ b ; } + public static int bitXOr (final int a, final short b) { return a ^ b ; } + public static int bitXOr (final int a, final char b) { return a ^ b ; } + public static int bitXOr (final int a, final int b) { return a ^ b ; } + public static long bitXOr (final int a, final long b) { return a ^ b ; } + public static float bitXOr (final int a, final float b) { + return Float.intBitsToFloat(a ^ Float.floatToIntBits(b)); + } + public static double bitXOr (final int a, final double b) { + return Double.longBitsToDouble(a ^ Double.doubleToLongBits(b)); + } + public static long bitXOr (final long a, final byte b) { return a ^ b ; } + public static long bitXOr (final long a, final char b) { return a ^ b ; } + public static long bitXOr (final long a, final short b) { return a ^ b ; } + public static long bitXOr (final long a, final int b) { return a ^ b ; } + public static long bitXOr (final long a, final long b) { return a ^ b ; } + public static double bitXOr (final long a, final float b) { + return Double.longBitsToDouble(a ^ Float.floatToIntBits(b)); + } + public static double bitXOr (final long a, final double b) { + return Double.longBitsToDouble(a ^ Double.doubleToLongBits(b)); + } + public static float bitXOr (final float a, final byte b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) ^ b); + } + public static float bitXOr (final float a, final short b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) ^ b); + } + public static float bitXOr (final float a, final char b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) ^ b); + } + public static float bitXOr (final float a, final int b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) ^ b); + } + public static double bitXOr (final float a, final long b) { + return Double.longBitsToDouble(Float.floatToIntBits(a) ^ b); + } + public static float bitXOr (final float a, final float b) { + return Float.intBitsToFloat(Float.floatToIntBits(a) ^ Float.floatToIntBits(b)); + } + public static double bitXOr (final float a, final double b) { + return Double.longBitsToDouble(Float.floatToIntBits(a) ^ Double.doubleToLongBits(b)); + } + public static double bitXOr (final double a, final byte b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) ^ b); + } + public static double bitXOr (final double a, final short b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) ^ b); + } + public static double bitXOr (final double a, final char b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) ^ b); + } + public static double bitXOr (final double a, final int b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) ^ b); + } + public static double bitXOr (final double a, final long b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) ^ b); + } + public static double bitXOr (final double a, final float b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) ^ Float.floatToIntBits(b)); + } + public static double bitXOr (final double a, final double b) { + return Double.longBitsToDouble(Double.doubleToLongBits(a) ^ Double.doubleToLongBits(b)); + } + + // -------------------------- shiftLeft : << (implicitly checked) -------------------------- // + + public static byte shiftLeft (final byte x, final byte n) { return (byte) (x << n); } + public static byte shiftLeft (final byte x, final short n) { return (byte) (x << n); } + public static byte shiftLeft (final byte x, final char n) { return (byte) (x << n); } + public static byte shiftLeft (final byte x, final int n) { return (byte) (x << n); } + public static byte shiftLeft (final byte x, final long n) { return (byte) (x << n); } + public static short shiftLeft (final short x, final byte n) { return (short)(x << n); } + public static short shiftLeft (final short x, final short n) { return (short)(x << n); } + public static short shiftLeft (final short x, final char n) { return (short)(x << n); } + public static short shiftLeft (final short x, final int n) { return (short)(x << n); } + public static short shiftLeft (final short x, final long n) { return (short)(x << n); } + public static char shiftLeft (final char x, final byte n) { return (char) (x << n); } + public static char shiftLeft (final char x, final short n) { return (char) (x << n); } + public static char shiftLeft (final char x, final char n) { return (char) (x << n); } + public static char shiftLeft (final char x, final int n) { return (char) (x << n); } + public static char shiftLeft (final char x, final long n) { return (char) (x << n); } + public static int shiftLeft (final int x, final byte n) { return x << n ; } + public static int shiftLeft (final int x, final short n) { return x << n ; } + public static int shiftLeft (final int x, final char n) { return x << n ; } + public static int shiftLeft (final int x, final int n) { return x << n ; } + public static int shiftLeft (final int x, final long n) { return x << n ; } + public static long shiftLeft (final long x, final byte n) { return x << n ; } + public static long shiftLeft (final long x, final char n) { return x << n ; } + public static long shiftLeft (final long x, final short n) { return x << n ; } + public static long shiftLeft (final long x, final int n) { return x << n ; } + public static long shiftLeft (final long x, final long n) { return x << n ; } + public static float shiftLeft (final float x, final byte n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) << n); + } + public static float shiftLeft (final float x, final short n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) << n); + } + public static float shiftLeft (final float x, final char n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) << n); + } + public static float shiftLeft (final float x, final int n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) << n); + } + public static float shiftLeft (final float x, final long n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) << n); + } + public static double shiftLeft (final double x, final byte n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) << n); + } + public static double shiftLeft (final double x, final short n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) << n); + } + public static double shiftLeft (final double x, final char n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) << n); + } + public static double shiftLeft (final double x, final int n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) << n); + } + public static double shiftLeft (final double x, final long n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) << n); + } + + // -------------------------- shiftRight : >> (implicitly checked) -------------------------- // + + public static byte shiftRight (final byte x, final byte n) { return (byte) (x >> n); } + public static byte shiftRight (final byte x, final short n) { return (byte) (x >> n); } + public static byte shiftRight (final byte x, final char n) { return (byte) (x >> n); } + public static byte shiftRight (final byte x, final int n) { return (byte) (x >> n); } + public static byte shiftRight (final byte x, final long n) { return (byte) (x >> n); } + public static short shiftRight (final short x, final byte n) { return (short)(x >> n); } + public static short shiftRight (final short x, final short n) { return (short)(x >> n); } + public static short shiftRight (final short x, final char n) { return (short)(x >> n); } + public static short shiftRight (final short x, final int n) { return (short)(x >> n); } + public static short shiftRight (final short x, final long n) { return (short)(x >> n); } + public static char shiftRight (final char x, final byte n) { return (char) (x >> n); } + public static char shiftRight (final char x, final short n) { return (char) (x >> n); } + public static char shiftRight (final char x, final char n) { return (char) (x >> n); } + public static char shiftRight (final char x, final int n) { return (char) (x >> n); } + public static char shiftRight (final char x, final long n) { return (char) (x >> n); } + public static int shiftRight (final int x, final byte n) { return x >> n ; } + public static int shiftRight (final int x, final short n) { return x >> n ; } + public static int shiftRight (final int x, final char n) { return x >> n ; } + public static int shiftRight (final int x, final int n) { return x >> n ; } + public static int shiftRight (final int x, final long n) { return x >> n ; } + public static long shiftRight (final long x, final byte n) { return x >> n ; } + public static long shiftRight (final long x, final char n) { return x >> n ; } + public static long shiftRight (final long x, final short n) { return x >> n ; } + public static long shiftRight (final long x, final int n) { return x >> n ; } + public static long shiftRight (final long x, final long n) { return x >> n ; } + public static float shiftRight (final float x, final byte n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) >> n); + } + public static float shiftRight (final float x, final short n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) >> n); + } + public static float shiftRight (final float x, final char n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) >> n); + } + public static float shiftRight (final float x, final int n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) >> n); + } + public static float shiftRight (final float x, final long n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) >> n); + } + public static double shiftRight (final double x, final byte n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) >> n); + } + public static double shiftRight (final double x, final short n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) >> n); + } + public static double shiftRight (final double x, final char n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) >> n); + } + public static double shiftRight (final double x, final int n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) >> n); + } + public static double shiftRight (final double x, final long n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) >> n); + } + + // --------------------- unsignedShiftRight : >>> (implicitly checked) --------------------- // + + public static byte uShiftRight (final byte x, final byte n) { return (byte) (x >>> n);} + public static byte uShiftRight (final byte x, final short n) { return (byte) (x >>> n);} + public static byte uShiftRight (final byte x, final char n) { return (byte) (x >>> n);} + public static byte uShiftRight (final byte x, final int n) { return (byte) (x >>> n);} + public static byte uShiftRight (final byte x, final long n) { return (byte) (x >>> n);} + public static short uShiftRight (final short x, final byte n) { return (short)(x >>> n);} + public static short uShiftRight (final short x, final short n) { return (short)(x >>> n);} + public static short uShiftRight (final short x, final char n) { return (short)(x >>> n);} + public static short uShiftRight (final short x, final int n) { return (short)(x >>> n);} + public static short uShiftRight (final short x, final long n) { return (short)(x >>> n);} + public static char uShiftRight (final char x, final byte n) { return (char) (x >>> n);} + public static char uShiftRight (final char x, final short n) { return (char) (x >>> n);} + public static char uShiftRight (final char x, final char n) { return (char) (x >>> n);} + public static char uShiftRight (final char x, final int n) { return (char) (x >>> n);} + public static char uShiftRight (final char x, final long n) { return (char) (x >>> n);} + public static int uShiftRight (final int x, final byte n) { return x >>> n ;} + public static int uShiftRight (final int x, final short n) { return x >>> n ;} + public static int uShiftRight (final int x, final char n) { return x >>> n ;} + public static int uShiftRight (final int x, final int n) { return x >>> n ;} + public static int uShiftRight (final int x, final long n) { return x >>> n ;} + public static long uShiftRight (final long x, final byte n) { return x >>> n ;} + public static long uShiftRight (final long x, final char n) { return x >>> n ;} + public static long uShiftRight (final long x, final short n) { return x >>> n ;} + public static long uShiftRight (final long x, final int n) { return x >>> n ;} + public static long uShiftRight (final long x, final long n) { return x >>> n ;} + public static float uShiftRight (final float x, final byte n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) >>> n); + } + public static float uShiftRight (final float x, final short n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) >>> n); + } + public static float uShiftRight (final float x, final char n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) >>> n); + } + public static float uShiftRight (final float x, final int n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) >>> n); + } + public static float uShiftRight (final float x, final long n) { + return Float.intBitsToFloat(Float.floatToIntBits(x) >>> n); + } + public static double uShiftRight (final double x, final byte n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) >>> n); + } + public static double uShiftRight (final double x, final short n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) >>> n); + } + public static double uShiftRight (final double x, final char n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) >>> n); + } + public static double uShiftRight (final double x, final int n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) >>> n); + } + public static double uShiftRight (final double x, final long n) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) >>> n); + } + + // ---------------------------------- bitClear (unchecked) ---------------------------------- // + + public static byte bitClear (final byte x, final long i) { return (byte) (x & ~(1L << i)); } + public static short bitClear (final short x, final long i) { return (short)(x & ~(1L << i)); } + public static char bitClear (final char x, final long i) { return (char) (x & ~(1L << i)); } + public static int bitClear (final int x, final long i) { return (int) (x & ~(1L << i)); } + public static long bitClear (final long x, final long i) { return x & ~(1L << i) ; } + public static float bitClear (final float x, final long i) { + return Float.intBitsToFloat((int)(Float.floatToIntBits(x) & ~(1L << i))); + } + public static double bitClear (final double x, final long i) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) & ~(1L << i)); + } + + // ---------------------------------- bitFlip (unchecked) ---------------------------------- // + + public static byte bitFlip (final byte x, final long i) { return (byte) (x ^ (1L << i)); } + public static short bitFlip (final short x, final long i) { return (short)(x ^ (1L << i)); } + public static char bitFlip (final char x, final long i) { return (char) (x ^ (1L << i)); } + public static int bitFlip (final int x, final long i) { return (int) (x ^ (1L << i)); } + public static long bitFlip (final long x, final long i) { return x ^ (1L << i) ; } + public static float bitFlip (final float x, final long i) { + return Float.intBitsToFloat((int)(Float.floatToIntBits(x) ^ (1L << i))); + } + public static double bitFlip (final double x, final long i) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) ^ (1L << i)); + } + + // ----------------------------------- bitSet (unchecked) ----------------------------------- // + // Returns the smallest safe type + + public static byte bitSet (final byte x, final long i) { return (byte) (x | (1L << i)); } + public static short bitSet (final short x, final long i) { return (short)(x | (1L << i)); } + public static char bitSet (final char x, final long i) { return (char) (x | (1L << i)); } + public static int bitSet (final int x, final long i) { return (int) (x | (1L << i)); } + public static long bitSet (final long x, final long i) { return x | (1L << i) ; } + public static float bitSet (final float x, final long i) { + return Float.intBitsToFloat((int)(Float.floatToIntBits(x) | (1L << i))); + } + public static double bitSet (final double x, final long i) { + return Double.longBitsToDouble(Double.doubleToLongBits(x) | (1L << i)); + } + + // ---------------------------------- bitTest (unchecked) ---------------------------------- // + + public static boolean bitTest (final byte x, final long i) { return (x & (1L << i)) != 0L; } + public static boolean bitTest (final short x, final long i) { return (x & (1L << i)) != 0L; } + public static boolean bitTest (final char x, final long i) { return (x & (1L << i)) != 0L; } + public static boolean bitTest (final int x, final long i) { return (x & (1L << i)) != 0L; } + public static boolean bitTest (final long x, final long i) { return (x & (1L << i)) != 0L; } + public static boolean bitTest (final float x, final long i) { + return (Float.floatToIntBits(x) & (1L << i)) != 0L; + } + public static boolean bitTest (final double x, final long i) { + return (Double.doubleToLongBits(x) & (1L << i)) != 0L; + } + + // ======================================= lt : < =========================================== // public static boolean lt (final byte a, final byte b) { return a < b; } - public static boolean lt (final byte a, final char b) { return a < b; } public static boolean lt (final byte a, final short b) { return a < b; } + public static boolean lt (final byte a, final char b) { return a < b; } public static boolean lt (final byte a, final int b) { return a < b; } public static boolean lt (final byte a, final long b) { return a < b; } public static boolean lt (final byte a, final float b) { return a < b; } public static boolean lt (final byte a, final double b) { return a < b; } + public static boolean lt (final short a, final byte b) { return a < b; } + public static boolean lt (final short a, final short b) { return a < b; } + public static boolean lt (final short a, final char b) { return a < b; } + public static boolean lt (final short a, final int b) { return a < b; } + public static boolean lt (final short a, final long b) { return a < b; } + public static boolean lt (final short a, final float b) { return a < b; } + public static boolean lt (final short a, final double b) { return a < b; } public static boolean lt (final char a, final byte b) { return a < b; } public static boolean lt (final char a, final char b) { return a < b; } public static boolean lt (final char a, final short b) { return a < b; } @@ -101,688 +608,736 @@ public static long reverseLong (final long x) { public static boolean lt (final char a, final long b) { return a < b; } public static boolean lt (final char a, final float b) { return a < b; } public static boolean lt (final char a, final double b) { return a < b; } - public static boolean lt (final short a, final byte b) { return a < b; } - public static boolean lt (final short a, final char b) { return a < b; } - public static boolean lt (final short a, final short b) { return a < b; } - public static boolean lt (final short a, final int b) { return a < b; } - public static boolean lt (final short a, final long b) { return a < b; } - public static boolean lt (final short a, final float b) { return a < b; } - public static boolean lt (final short a, final double b) { return a < b; } public static boolean lt (final int a, final byte b) { return a < b; } - public static boolean lt (final int a, final char b) { return a < b; } public static boolean lt (final int a, final short b) { return a < b; } + public static boolean lt (final int a, final char b) { return a < b; } public static boolean lt (final int a, final int b) { return a < b; } public static boolean lt (final int a, final long b) { return a < b; } public static boolean lt (final int a, final float b) { return a < b; } public static boolean lt (final int a, final double b) { return a < b; } public static boolean lt (final long a, final byte b) { return a < b; } - public static boolean lt (final long a, final char b) { return a < b; } public static boolean lt (final long a, final short b) { return a < b; } + public static boolean lt (final long a, final char b) { return a < b; } public static boolean lt (final long a, final int b) { return a < b; } public static boolean lt (final long a, final long b) { return a < b; } public static boolean lt (final long a, final float b) { return a < b; } public static boolean lt (final long a, final double b) { return a < b; } public static boolean lt (final float a, final byte b) { return a < b; } - public static boolean lt (final float a, final char b) { return a < b; } public static boolean lt (final float a, final short b) { return a < b; } + public static boolean lt (final float a, final char b) { return a < b; } public static boolean lt (final float a, final int b) { return a < b; } public static boolean lt (final float a, final long b) { return a < b; } public static boolean lt (final float a, final float b) { return a < b; } public static boolean lt (final float a, final double b) { return a < b; } public static boolean lt (final double a, final byte b) { return a < b; } - public static boolean lt (final double a, final char b) { return a < b; } public static boolean lt (final double a, final short b) { return a < b; } + public static boolean lt (final double a, final char b) { return a < b; } public static boolean lt (final double a, final int b) { return a < b; } public static boolean lt (final double a, final long b) { return a < b; } public static boolean lt (final double a, final float b) { return a < b; } public static boolean lt (final double a, final double b) { return a < b; } - // ============================ LTE : <= ================================ // + // ====================================== lte : <= ========================================== // public static boolean lte (final byte a, final byte b) { return a <= b; } - public static boolean lte (final byte a, final char b) { return a <= b; } public static boolean lte (final byte a, final short b) { return a <= b; } + public static boolean lte (final byte a, final char b) { return a <= b; } public static boolean lte (final byte a, final int b) { return a <= b; } public static boolean lte (final byte a, final long b) { return a <= b; } public static boolean lte (final byte a, final float b) { return a <= b; } public static boolean lte (final byte a, final double b) { return a <= b; } - public static boolean lte (final char a, final byte b) { return a <= b; } - public static boolean lte (final char a, final char b) { return a <= b; } - public static boolean lte (final char a, final short b) { return a <= b; } - public static boolean lte (final char a, final int b) { return a <= b; } - public static boolean lte (final char a, final long b) { return a <= b; } - public static boolean lte (final char a, final float b) { return a <= b; } - public static boolean lte (final char a, final double b) { return a <= b; } public static boolean lte (final short a, final byte b) { return a <= b; } - public static boolean lte (final short a, final char b) { return a <= b; } public static boolean lte (final short a, final short b) { return a <= b; } + public static boolean lte (final short a, final char b) { return a <= b; } public static boolean lte (final short a, final int b) { return a <= b; } public static boolean lte (final short a, final long b) { return a <= b; } public static boolean lte (final short a, final float b) { return a <= b; } public static boolean lte (final short a, final double b) { return a <= b; } + public static boolean lte (final char a, final byte b) { return a <= b; } + public static boolean lte (final char a, final short b) { return a <= b; } + public static boolean lte (final char a, final char b) { return a <= b; } + public static boolean lte (final char a, final int b) { return a <= b; } + public static boolean lte (final char a, final long b) { return a <= b; } + public static boolean lte (final char a, final float b) { return a <= b; } + public static boolean lte (final char a, final double b) { return a <= b; } public static boolean lte (final int a, final byte b) { return a <= b; } - public static boolean lte (final int a, final char b) { return a <= b; } public static boolean lte (final int a, final short b) { return a <= b; } + public static boolean lte (final int a, final char b) { return a <= b; } public static boolean lte (final int a, final int b) { return a <= b; } public static boolean lte (final int a, final long b) { return a <= b; } public static boolean lte (final int a, final float b) { return a <= b; } public static boolean lte (final int a, final double b) { return a <= b; } public static boolean lte (final long a, final byte b) { return a <= b; } - public static boolean lte (final long a, final char b) { return a <= b; } public static boolean lte (final long a, final short b) { return a <= b; } + public static boolean lte (final long a, final char b) { return a <= b; } public static boolean lte (final long a, final int b) { return a <= b; } public static boolean lte (final long a, final long b) { return a <= b; } public static boolean lte (final long a, final float b) { return a <= b; } public static boolean lte (final long a, final double b) { return a <= b; } public static boolean lte (final float a, final byte b) { return a <= b; } - public static boolean lte (final float a, final char b) { return a <= b; } public static boolean lte (final float a, final short b) { return a <= b; } + public static boolean lte (final float a, final char b) { return a <= b; } public static boolean lte (final float a, final int b) { return a <= b; } public static boolean lte (final float a, final long b) { return a <= b; } public static boolean lte (final float a, final float b) { return a <= b; } public static boolean lte (final float a, final double b) { return a <= b; } public static boolean lte (final double a, final byte b) { return a <= b; } - public static boolean lte (final double a, final char b) { return a <= b; } public static boolean lte (final double a, final short b) { return a <= b; } + public static boolean lte (final double a, final char b) { return a <= b; } public static boolean lte (final double a, final int b) { return a <= b; } public static boolean lte (final double a, final long b) { return a <= b; } public static boolean lte (final double a, final float b) { return a <= b; } public static boolean lte (final double a, final double b) { return a <= b; } - // ============================ GT : > ================================ // + // ======================================= gt : > =========================================== // public static boolean gt (final byte a, final byte b) { return a > b; } - public static boolean gt (final byte a, final char b) { return a > b; } public static boolean gt (final byte a, final short b) { return a > b; } + public static boolean gt (final byte a, final char b) { return a > b; } public static boolean gt (final byte a, final int b) { return a > b; } public static boolean gt (final byte a, final long b) { return a > b; } public static boolean gt (final byte a, final float b) { return a > b; } public static boolean gt (final byte a, final double b) { return a > b; } - public static boolean gt (final char a, final byte b) { return a > b; } - public static boolean gt (final char a, final char b) { return a > b; } - public static boolean gt (final char a, final short b) { return a > b; } - public static boolean gt (final char a, final int b) { return a > b; } - public static boolean gt (final char a, final long b) { return a > b; } - public static boolean gt (final char a, final float b) { return a > b; } - public static boolean gt (final char a, final double b) { return a > b; } public static boolean gt (final short a, final byte b) { return a > b; } - public static boolean gt (final short a, final char b) { return a > b; } public static boolean gt (final short a, final short b) { return a > b; } + public static boolean gt (final short a, final char b) { return a > b; } public static boolean gt (final short a, final int b) { return a > b; } public static boolean gt (final short a, final long b) { return a > b; } public static boolean gt (final short a, final float b) { return a > b; } public static boolean gt (final short a, final double b) { return a > b; } + public static boolean gt (final char a, final byte b) { return a > b; } + public static boolean gt (final char a, final short b) { return a > b; } + public static boolean gt (final char a, final char b) { return a > b; } + public static boolean gt (final char a, final int b) { return a > b; } + public static boolean gt (final char a, final long b) { return a > b; } + public static boolean gt (final char a, final float b) { return a > b; } + public static boolean gt (final char a, final double b) { return a > b; } public static boolean gt (final int a, final byte b) { return a > b; } - public static boolean gt (final int a, final char b) { return a > b; } public static boolean gt (final int a, final short b) { return a > b; } + public static boolean gt (final int a, final char b) { return a > b; } public static boolean gt (final int a, final int b) { return a > b; } public static boolean gt (final int a, final long b) { return a > b; } public static boolean gt (final int a, final float b) { return a > b; } public static boolean gt (final int a, final double b) { return a > b; } public static boolean gt (final long a, final byte b) { return a > b; } - public static boolean gt (final long a, final char b) { return a > b; } public static boolean gt (final long a, final short b) { return a > b; } + public static boolean gt (final long a, final char b) { return a > b; } public static boolean gt (final long a, final int b) { return a > b; } public static boolean gt (final long a, final long b) { return a > b; } public static boolean gt (final long a, final float b) { return a > b; } public static boolean gt (final long a, final double b) { return a > b; } public static boolean gt (final float a, final byte b) { return a > b; } - public static boolean gt (final float a, final char b) { return a > b; } public static boolean gt (final float a, final short b) { return a > b; } + public static boolean gt (final float a, final char b) { return a > b; } public static boolean gt (final float a, final int b) { return a > b; } public static boolean gt (final float a, final long b) { return a > b; } public static boolean gt (final float a, final float b) { return a > b; } public static boolean gt (final float a, final double b) { return a > b; } public static boolean gt (final double a, final byte b) { return a > b; } - public static boolean gt (final double a, final char b) { return a > b; } public static boolean gt (final double a, final short b) { return a > b; } + public static boolean gt (final double a, final char b) { return a > b; } public static boolean gt (final double a, final int b) { return a > b; } public static boolean gt (final double a, final long b) { return a > b; } public static boolean gt (final double a, final float b) { return a > b; } public static boolean gt (final double a, final double b) { return a > b; } - // ============================ GTE : >= ================================ // + // ====================================== gte : >= ========================================== // public static boolean gte (final byte a, final byte b) { return a >= b; } - public static boolean gte (final byte a, final char b) { return a >= b; } public static boolean gte (final byte a, final short b) { return a >= b; } + public static boolean gte (final byte a, final char b) { return a >= b; } public static boolean gte (final byte a, final int b) { return a >= b; } public static boolean gte (final byte a, final long b) { return a >= b; } public static boolean gte (final byte a, final float b) { return a >= b; } public static boolean gte (final byte a, final double b) { return a >= b; } - public static boolean gte (final char a, final byte b) { return a >= b; } - public static boolean gte (final char a, final char b) { return a >= b; } - public static boolean gte (final char a, final short b) { return a >= b; } - public static boolean gte (final char a, final int b) { return a >= b; } - public static boolean gte (final char a, final long b) { return a >= b; } - public static boolean gte (final char a, final float b) { return a >= b; } - public static boolean gte (final char a, final double b) { return a >= b; } public static boolean gte (final short a, final byte b) { return a >= b; } - public static boolean gte (final short a, final char b) { return a >= b; } public static boolean gte (final short a, final short b) { return a >= b; } + public static boolean gte (final short a, final char b) { return a >= b; } public static boolean gte (final short a, final int b) { return a >= b; } public static boolean gte (final short a, final long b) { return a >= b; } public static boolean gte (final short a, final float b) { return a >= b; } public static boolean gte (final short a, final double b) { return a >= b; } + public static boolean gte (final char a, final byte b) { return a >= b; } + public static boolean gte (final char a, final short b) { return a >= b; } + public static boolean gte (final char a, final char b) { return a >= b; } + public static boolean gte (final char a, final int b) { return a >= b; } + public static boolean gte (final char a, final long b) { return a >= b; } + public static boolean gte (final char a, final float b) { return a >= b; } + public static boolean gte (final char a, final double b) { return a >= b; } public static boolean gte (final int a, final byte b) { return a >= b; } - public static boolean gte (final int a, final char b) { return a >= b; } public static boolean gte (final int a, final short b) { return a >= b; } + public static boolean gte (final int a, final char b) { return a >= b; } public static boolean gte (final int a, final int b) { return a >= b; } public static boolean gte (final int a, final long b) { return a >= b; } public static boolean gte (final int a, final float b) { return a >= b; } public static boolean gte (final int a, final double b) { return a >= b; } public static boolean gte (final long a, final byte b) { return a >= b; } - public static boolean gte (final long a, final char b) { return a >= b; } public static boolean gte (final long a, final short b) { return a >= b; } + public static boolean gte (final long a, final char b) { return a >= b; } public static boolean gte (final long a, final int b) { return a >= b; } public static boolean gte (final long a, final long b) { return a >= b; } public static boolean gte (final long a, final float b) { return a >= b; } public static boolean gte (final long a, final double b) { return a >= b; } public static boolean gte (final float a, final byte b) { return a >= b; } - public static boolean gte (final float a, final char b) { return a >= b; } public static boolean gte (final float a, final short b) { return a >= b; } + public static boolean gte (final float a, final char b) { return a >= b; } public static boolean gte (final float a, final int b) { return a >= b; } public static boolean gte (final float a, final long b) { return a >= b; } public static boolean gte (final float a, final float b) { return a >= b; } public static boolean gte (final float a, final double b) { return a >= b; } public static boolean gte (final double a, final byte b) { return a >= b; } - public static boolean gte (final double a, final char b) { return a >= b; } public static boolean gte (final double a, final short b) { return a >= b; } + public static boolean gte (final double a, final char b) { return a >= b; } public static boolean gte (final double a, final int b) { return a >= b; } public static boolean gte (final double a, final long b) { return a >= b; } public static boolean gte (final double a, final float b) { return a >= b; } public static boolean gte (final double a, final double b) { return a >= b; } - // ============================ EQ : == ================================ // + // ====================================== eq : == ========================================== // public static boolean eq (final boolean a, final boolean b) { return a == b; } public static boolean eq (final byte a, final byte b) { return a == b; } - public static boolean eq (final byte a, final char b) { return a == b; } public static boolean eq (final byte a, final short b) { return a == b; } + public static boolean eq (final byte a, final char b) { return a == b; } public static boolean eq (final byte a, final int b) { return a == b; } public static boolean eq (final byte a, final long b) { return a == b; } public static boolean eq (final byte a, final float b) { return a == b; } public static boolean eq (final byte a, final double b) { return a == b; } - public static boolean eq (final char a, final byte b) { return a == b; } - public static boolean eq (final char a, final char b) { return a == b; } - public static boolean eq (final char a, final short b) { return a == b; } - public static boolean eq (final char a, final int b) { return a == b; } - public static boolean eq (final char a, final long b) { return a == b; } - public static boolean eq (final char a, final float b) { return a == b; } - public static boolean eq (final char a, final double b) { return a == b; } public static boolean eq (final short a, final byte b) { return a == b; } - public static boolean eq (final short a, final char b) { return a == b; } public static boolean eq (final short a, final short b) { return a == b; } + public static boolean eq (final short a, final char b) { return a == b; } public static boolean eq (final short a, final int b) { return a == b; } public static boolean eq (final short a, final long b) { return a == b; } public static boolean eq (final short a, final float b) { return a == b; } public static boolean eq (final short a, final double b) { return a == b; } + public static boolean eq (final char a, final byte b) { return a == b; } + public static boolean eq (final char a, final short b) { return a == b; } + public static boolean eq (final char a, final char b) { return a == b; } + public static boolean eq (final char a, final int b) { return a == b; } + public static boolean eq (final char a, final long b) { return a == b; } + public static boolean eq (final char a, final float b) { return a == b; } + public static boolean eq (final char a, final double b) { return a == b; } public static boolean eq (final int a, final byte b) { return a == b; } - public static boolean eq (final int a, final char b) { return a == b; } public static boolean eq (final int a, final short b) { return a == b; } + public static boolean eq (final int a, final char b) { return a == b; } public static boolean eq (final int a, final int b) { return a == b; } public static boolean eq (final int a, final long b) { return a == b; } public static boolean eq (final int a, final float b) { return a == b; } public static boolean eq (final int a, final double b) { return a == b; } public static boolean eq (final long a, final byte b) { return a == b; } - public static boolean eq (final long a, final char b) { return a == b; } public static boolean eq (final long a, final short b) { return a == b; } + public static boolean eq (final long a, final char b) { return a == b; } public static boolean eq (final long a, final int b) { return a == b; } public static boolean eq (final long a, final long b) { return a == b; } public static boolean eq (final long a, final float b) { return a == b; } public static boolean eq (final long a, final double b) { return a == b; } public static boolean eq (final float a, final byte b) { return a == b; } - public static boolean eq (final float a, final char b) { return a == b; } public static boolean eq (final float a, final short b) { return a == b; } + public static boolean eq (final float a, final char b) { return a == b; } public static boolean eq (final float a, final int b) { return a == b; } public static boolean eq (final float a, final long b) { return a == b; } public static boolean eq (final float a, final float b) { return a == b; } public static boolean eq (final float a, final double b) { return a == b; } public static boolean eq (final double a, final byte b) { return a == b; } - public static boolean eq (final double a, final char b) { return a == b; } public static boolean eq (final double a, final short b) { return a == b; } + public static boolean eq (final double a, final char b) { return a == b; } public static boolean eq (final double a, final int b) { return a == b; } public static boolean eq (final double a, final long b) { return a == b; } public static boolean eq (final double a, final float b) { return a == b; } public static boolean eq (final double a, final double b) { return a == b; } - // ============================ NEQ : != ================================ // + // =========================== neq : != (implicitly checked) =============================== // public static boolean neq (final boolean a, final boolean b) { return a != b; } public static boolean neq (final byte a, final byte b) { return a != b; } - public static boolean neq (final byte a, final char b) { return a != b; } public static boolean neq (final byte a, final short b) { return a != b; } + public static boolean neq (final byte a, final char b) { return a != b; } public static boolean neq (final byte a, final int b) { return a != b; } public static boolean neq (final byte a, final long b) { return a != b; } public static boolean neq (final byte a, final float b) { return a != b; } public static boolean neq (final byte a, final double b) { return a != b; } - public static boolean neq (final char a, final byte b) { return a != b; } - public static boolean neq (final char a, final char b) { return a != b; } - public static boolean neq (final char a, final short b) { return a != b; } - public static boolean neq (final char a, final int b) { return a != b; } - public static boolean neq (final char a, final long b) { return a != b; } - public static boolean neq (final char a, final float b) { return a != b; } - public static boolean neq (final char a, final double b) { return a != b; } public static boolean neq (final short a, final byte b) { return a != b; } - public static boolean neq (final short a, final char b) { return a != b; } public static boolean neq (final short a, final short b) { return a != b; } + public static boolean neq (final short a, final char b) { return a != b; } public static boolean neq (final short a, final int b) { return a != b; } public static boolean neq (final short a, final long b) { return a != b; } public static boolean neq (final short a, final float b) { return a != b; } public static boolean neq (final short a, final double b) { return a != b; } + public static boolean neq (final char a, final byte b) { return a != b; } + public static boolean neq (final char a, final short b) { return a != b; } + public static boolean neq (final char a, final char b) { return a != b; } + public static boolean neq (final char a, final int b) { return a != b; } + public static boolean neq (final char a, final long b) { return a != b; } + public static boolean neq (final char a, final float b) { return a != b; } + public static boolean neq (final char a, final double b) { return a != b; } public static boolean neq (final int a, final byte b) { return a != b; } - public static boolean neq (final int a, final char b) { return a != b; } public static boolean neq (final int a, final short b) { return a != b; } + public static boolean neq (final int a, final char b) { return a != b; } public static boolean neq (final int a, final int b) { return a != b; } public static boolean neq (final int a, final long b) { return a != b; } public static boolean neq (final int a, final float b) { return a != b; } public static boolean neq (final int a, final double b) { return a != b; } public static boolean neq (final long a, final byte b) { return a != b; } - public static boolean neq (final long a, final char b) { return a != b; } public static boolean neq (final long a, final short b) { return a != b; } + public static boolean neq (final long a, final char b) { return a != b; } public static boolean neq (final long a, final int b) { return a != b; } public static boolean neq (final long a, final long b) { return a != b; } public static boolean neq (final long a, final float b) { return a != b; } public static boolean neq (final long a, final double b) { return a != b; } public static boolean neq (final float a, final byte b) { return a != b; } - public static boolean neq (final float a, final char b) { return a != b; } public static boolean neq (final float a, final short b) { return a != b; } + public static boolean neq (final float a, final char b) { return a != b; } public static boolean neq (final float a, final int b) { return a != b; } public static boolean neq (final float a, final long b) { return a != b; } public static boolean neq (final float a, final float b) { return a != b; } public static boolean neq (final float a, final double b) { return a != b; } public static boolean neq (final double a, final byte b) { return a != b; } - public static boolean neq (final double a, final char b) { return a != b; } public static boolean neq (final double a, final short b) { return a != b; } + public static boolean neq (final double a, final char b) { return a != b; } public static boolean neq (final double a, final int b) { return a != b; } public static boolean neq (final double a, final long b) { return a != b; } public static boolean neq (final double a, final float b) { return a != b; } public static boolean neq (final double a, final double b) { return a != b; } - // ============================ INC / DEC ================================ // + // =============================== inc / dec (unchecked) =================================== // public static byte inc (final byte a) { return (byte )(a + byte1 ); } - public static char inc (final char a) { return (char )(a + char1 ); } public static short inc (final short a) { return (short)(a + short1); } + public static char inc (final char a) { return (char )(a + char1 ); } public static int inc (final int a) { return a + 1; } public static long inc (final long a) { return a + 1L; } public static float inc (final float a) { return a + 1.0f; } public static double inc (final double a) { return a + 1.0d; } public static byte dec (final byte a) { return (byte )(a - byte1 ); } - public static char dec (final char a) { return (char )(a - char1 ); } public static short dec (final short a) { return (short)(a - short1); } + public static char dec (final char a) { return (char )(a - char1 ); } public static int dec (final int a) { return a - 1; } public static long dec (final long a) { return a - 1L; } public static float dec (final float a) { return a - 1.0f; } public static double dec (final double a) { return a - 1.0d; } - // ============================ ISZERO ================================ // + // ============================ isZero (implicitly checked) ================================ // public static boolean isZero (final byte a) { return a == byte0; } - public static boolean isZero (final char a) { return a == char0; } public static boolean isZero (final short a) { return a == short0; } + public static boolean isZero (final char a) { return a == char0; } public static boolean isZero (final int a) { return a == int0; } public static boolean isZero (final long a) { return a == 0L; } public static boolean isZero (final float a) { return a == 0.0f; } public static boolean isZero (final double a) { return a == 0.0d; } - // ============================ ISNEG ================================ // + // ============================ isNeg (implicitly checked) ================================ // - public static boolean isNeg (final byte a) { return a < byte0; } // Implicitly checked - public static boolean isNeg (final char a) { return a < char0; } // Implicitly checked - public static boolean isNeg (final short a) { return a < short0; } // Implicitly checked - public static boolean isNeg (final int a) { return a < int0; } // Implicitly checked - public static boolean isNeg (final long a) { return a < 0L; } // Implicitly checked - public static boolean isNeg (final float a) { return a < 0.0f; } // Implicitly checked - public static boolean isNeg (final double a) { return a < 0.0d; } // Implicitly checked + public static boolean isNeg (final byte a) { return a < byte0; } + public static boolean isNeg (final short a) { return a < short0; } + public static boolean isNeg (final char a) { return a < char0; } + public static boolean isNeg (final int a) { return a < int0; } + public static boolean isNeg (final long a) { return a < 0L; } + public static boolean isNeg (final float a) { return a < 0.0f; } + public static boolean isNeg (final double a) { return a < 0.0d; } - // ============================ ISPOS ================================ // + // ============================ isPos (implicitly checked) ================================ // - public static boolean isPos (final byte a) { return a > byte0; } // Implicitly checked - public static boolean isPos (final char a) { return a > char0; } // Implicitly checked - public static boolean isPos (final short a) { return a > short0; } // Implicitly checked - public static boolean isPos (final int a) { return a > int0; } // Implicitly checked - public static boolean isPos (final long a) { return a > 0L; } // Implicitly checked - public static boolean isPos (final float a) { return a > 0.0f; } // Implicitly checked - public static boolean isPos (final double a) { return a > 0.0d; } // Implicitly checked + public static boolean isPos (final byte a) { return a > byte0; } + public static boolean isPos (final short a) { return a > short0; } + public static boolean isPos (final char a) { return a > char0; } + public static boolean isPos (final int a) { return a > int0; } + public static boolean isPos (final long a) { return a > 0L; } + public static boolean isPos (final float a) { return a > 0.0f; } + public static boolean isPos (final double a) { return a > 0.0d; } - // ============================ ADD : + ================================ // + // ===================== add : + (unchecked unless otherwise noted) ========================= // // "Infectious": uses a promotion of the largest data type passed - public static short add (final byte a, final byte b) { return (short)(a + b); } // Implicitly checked - public static int add (final byte a, final char b) { return a + b; } // Implicitly checked - public static int add (final byte a, final short b) { return a + b; } // Implicitly checked - public static long add (final byte a, final int b) { return a + b; } // Implicitly checked + + // Implicitly checked + public static short add (final byte a, final byte b) { return (short)(a + b); } + // Implicitly checked + public static int add (final byte a, final short b) { return a + b; } + // Implicitly checked + public static int add (final byte a, final char b) { return a + b; } + // Implicitly checked + public static long add (final byte a, final int b) { return a + b; } public static long add (final byte a, final long b) { return a + b; } - public static double add (final byte a, final float b) { return a + b; } // Implicitly checked + // Implicitly checked + public static double add (final byte a, final float b) { return a + b; } public static double add (final byte a, final double b) { return a + b; } - public static int add (final char a, final byte b) { return a + b; } // Implicitly checked - public static int add (final char a, final char b) { return a + b; } // Implicitly checked - public static int add (final char a, final short b) { return a + b; } // Implicitly checked - public static long add (final char a, final int b) { return a + b; } // Implicitly checked - public static long add (final char a, final long b) { return a + b; } - public static double add (final char a, final float b) { return a + b; } // Implicitly checked - public static double add (final char a, final double b) { return a + b; } - public static int add (final short a, final byte b) { return a + b; } // Implicitly checked - public static int add (final short a, final char b) { return a + b; } // Implicitly checked - public static int add (final short a, final short b) { return a + b; } // Implicitly checked - public static long add (final short a, final int b) { return a + b; } // Implicitly checked + // Implicitly checked + public static int add (final short a, final byte b) { return a + b; } + // Implicitly checked + public static int add (final short a, final short b) { return a + b; } + // Implicitly checked + public static int add (final short a, final char b) { return a + b; } + // Implicitly checked + public static long add (final short a, final int b) { return a + b; } public static long add (final short a, final long b) { return a + b; } - public static double add (final short a, final float b) { return a + b; } // Implicitly checked + // Implicitly checked + public static double add (final short a, final float b) { return a + b; } public static double add (final short a, final double b) { return a + b; } - public static long add (final int a, final byte b) { return a + b; } // Implicitly checked - public static long add (final int a, final char b) { return a + b; } // Implicitly checked - public static long add (final int a, final short b) { return a + b; } // Implicitly checked - public static long add (final int a, final int b) { return a + b; } // Implicitly checked + // Implicitly checked + public static int add (final char a, final byte b) { return a + b; } + // Implicitly checked + public static int add (final char a, final short b) { return a + b; } + // Implicitly checked + public static int add (final char a, final char b) { return a + b; } + // Implicitly checked + public static long add (final char a, final int b) { return a + b; } + public static long add (final char a, final long b) { return a + b; } + // Implicitly checked + public static double add (final char a, final float b) { return a + b; } + public static double add (final char a, final double b) { return a + b; } + // Implicitly checked + public static long add (final int a, final byte b) { return a + b; } + // Implicitly checked + public static long add (final int a, final short b) { return a + b; } + // Implicitly checked + public static long add (final int a, final char b) { return a + b; } + // Implicitly checked + public static long add (final int a, final int b) { return a + b; } public static long add (final int a, final long b) { return a + b; } - public static double add (final int a, final float b) { return a + b; } // Implicitly checked + // Implicitly checked + public static double add (final int a, final float b) { return a + b; } public static double add (final int a, final double b) { return a + b; } public static long add (final long a, final byte b) { return a + b; } - public static long add (final long a, final char b) { return a + b; } public static long add (final long a, final short b) { return a + b; } + public static long add (final long a, final char b) { return a + b; } public static long add (final long a, final int b) { return a + b; } public static long add (final long a, final long b) { return a + b; } public static double add (final long a, final float b) { return a + b; } public static double add (final long a, final double b) { return a + b; } - public static double add (final float a, final byte b) { return a + b; } // Implicitly checked - public static double add (final float a, final char b) { return a + b; } // Implicitly checked - public static double add (final float a, final short b) { return a + b; } // Implicitly checked - public static double add (final float a, final int b) { return a + b; } // Implicitly checked + // Implicitly checked + public static double add (final float a, final byte b) { return a + b; } + // Implicitly checked + public static double add (final float a, final short b) { return a + b; } + // Implicitly checked + public static double add (final float a, final char b) { return a + b; } + // Implicitly checked + public static double add (final float a, final int b) { return a + b; } public static double add (final float a, final long b) { return a + b; } - public static double add (final float a, final float b) { return a + b; } // Implicitly checked + // Implicitly checked + public static double add (final float a, final float b) { return a + b; } public static double add (final float a, final double b) { return a + b; } public static double add (final double a, final byte b) { return a + b; } - public static double add (final double a, final char b) { return a + b; } public static double add (final double a, final short b) { return a + b; } + public static double add (final double a, final char b) { return a + b; } public static double add (final double a, final int b) { return a + b; } public static double add (final double a, final long b) { return a + b; } public static double add (final double a, final float b) { return a + b; } public static double add (final double a, final double b) { return a + b; } - // ============================ SUBTRACT : - ================================ // + // ================== subtract : - (unchecked unless otherwise noted) ====================== // // "Infectious": uses the largest data type passed - public static short subtract (final byte a, final byte b) { return (short)(a - b); } // Implicitly checked - public static int subtract (final byte a, final char b) { return a - b; } // Implicitly checked - public static int subtract (final byte a, final short b) { return a - b; } // Implicitly checked - public static long subtract (final byte a, final int b) { return a - b; } // Implicitly checked + // Implicitly checked + public static short subtract (final byte a, final byte b) { return (short)(a - b); } + // Implicitly checked + public static int subtract (final byte a, final short b) { return a - b; } + // Implicitly checked + public static int subtract (final byte a, final char b) { return a - b; } + // Implicitly checked + public static long subtract (final byte a, final int b) { return a - b; } public static long subtract (final byte a, final long b) { return a - b; } - public static double subtract (final byte a, final float b) { return a - b; } // Implicitly checked + // Implicitly checked + public static double subtract (final byte a, final float b) { return a - b; } public static double subtract (final byte a, final double b) { return a - b; } - public static int subtract (final char a, final byte b) { return a - b; } // Implicitly checked - public static int subtract (final char a, final char b) { return a - b; } // Implicitly checked - public static int subtract (final char a, final short b) { return a - b; } // Implicitly checked - public static long subtract (final char a, final int b) { return a - b; } // Implicitly checked - public static long subtract (final char a, final long b) { return a - b; } - public static double subtract (final char a, final float b) { return a - b; } // Implicitly checked - public static double subtract (final char a, final double b) { return a - b; } - public static int subtract (final short a, final byte b) { return a - b; } // Implicitly checked - public static int subtract (final short a, final char b) { return a - b; } // Implicitly checked - public static int subtract (final short a, final short b) { return a - b; } // Implicitly checked - public static long subtract (final short a, final int b) { return a - b; } // Implicitly checked + // Implicitly checked + public static int subtract (final short a, final byte b) { return a - b; } + // Implicitly checked + public static int subtract (final short a, final short b) { return a - b; } + // Implicitly checked + public static int subtract (final short a, final char b) { return a - b; } + // Implicitly checked + public static long subtract (final short a, final int b) { return a - b; } public static long subtract (final short a, final long b) { return a - b; } - public static double subtract (final short a, final float b) { return a - b; } // Implicitly checked + // Implicitly checked + public static double subtract (final short a, final float b) { return a - b; } public static double subtract (final short a, final double b) { return a - b; } - public static long subtract (final int a, final byte b) { return a - b; } // Implicitly checked - public static long subtract (final int a, final char b) { return a - b; } // Implicitly checked - public static long subtract (final int a, final short b) { return a - b; } // Implicitly checked - public static long subtract (final int a, final int b) { return a - b; } // Implicitly checked + // Implicitly checked + public static int subtract (final char a, final byte b) { return a - b; } + // Implicitly checked + public static int subtract (final char a, final short b) { return a - b; } + // Implicitly checked + public static int subtract (final char a, final char b) { return a - b; } + // Implicitly checked + public static long subtract (final char a, final int b) { return a - b; } + public static long subtract (final char a, final long b) { return a - b; } + // Implicitly checked + public static double subtract (final char a, final float b) { return a - b; } + public static double subtract (final char a, final double b) { return a - b; } + // Implicitly checked + public static long subtract (final int a, final byte b) { return a - b; } + // Implicitly checked + public static long subtract (final int a, final short b) { return a - b; } + // Implicitly checked + public static long subtract (final int a, final char b) { return a - b; } + // Implicitly checked + public static long subtract (final int a, final int b) { return a - b; } public static long subtract (final int a, final long b) { return a - b; } - public static double subtract (final int a, final float b) { return a - b; } // Implicitly checked + // Implicitly checked + public static double subtract (final int a, final float b) { return a - b; } public static double subtract (final int a, final double b) { return a - b; } public static long subtract (final long a, final byte b) { return a - b; } - public static long subtract (final long a, final char b) { return a - b; } public static long subtract (final long a, final short b) { return a - b; } + public static long subtract (final long a, final char b) { return a - b; } public static long subtract (final long a, final int b) { return a - b; } public static long subtract (final long a, final long b) { return a - b; } public static double subtract (final long a, final float b) { return a - b; } public static double subtract (final long a, final double b) { return a - b; } - public static double subtract (final float a, final byte b) { return a - b; } // Implicitly checked - public static double subtract (final float a, final char b) { return a - b; } // Implicitly checked - public static double subtract (final float a, final short b) { return a - b; } // Implicitly checked - public static double subtract (final float a, final int b) { return a - b; } // Implicitly checked + // Implicitly checked + public static double subtract (final float a, final byte b) { return a - b; } + // Implicitly checked + public static double subtract (final float a, final short b) { return a - b; } + // Implicitly checked + public static double subtract (final float a, final char b) { return a - b; } + // Implicitly checked + public static double subtract (final float a, final int b) { return a - b; } public static double subtract (final float a, final long b) { return a - b; } - public static double subtract (final float a, final float b) { return a - b; } // Implicitly checked + // Implicitly checked + public static double subtract (final float a, final float b) { return a - b; } public static double subtract (final float a, final double b) { return a - b; } public static double subtract (final double a, final byte b) { return a - b; } - public static double subtract (final double a, final char b) { return a - b; } public static double subtract (final double a, final short b) { return a - b; } + public static double subtract (final double a, final char b) { return a - b; } public static double subtract (final double a, final int b) { return a - b; } public static double subtract (final double a, final long b) { return a - b; } public static double subtract (final double a, final float b) { return a - b; } public static double subtract (final double a, final double b) { return a - b; } - // ============================ NEGATE : - ================================ // + // =============================== negate : - (unchecked) =================================== // public static byte negate (final byte a) { return (byte )-a; } - public static char negate (final char a) { return (char )-a; } public static short negate (final short a) { return (short)-a; } + public static char negate (final char a) { return (char )-a; } public static int negate (final int a) { return -a; } public static long negate (final long a) { return -a; } public static float negate (final float a) { return -a; } public static double negate (final double a) { return -a; } - // ============================ MULTIPLY : * ================================ // + // ================== multiply : * (unchecked unless otherwise noted) ====================== // // "Infectious": uses the largest data type passed - public static short multiply (final byte a, final byte b) { return (short)(a * b); } // Implicitly checked - public static int multiply (final byte a, final char b) { return a * b; } // Implicitly checked - public static int multiply (final byte a, final short b) { return a * b; } // Implicitly checked - public static long multiply (final byte a, final int b) { return a * b; } // Implicitly checked + // Implicitly checked + public static short multiply (final byte a, final byte b) { return (short)(a * b); } + // Implicitly checked + public static int multiply (final byte a, final short b) { return a * b; } + // Implicitly checked + public static int multiply (final byte a, final char b) { return a * b; } + // Implicitly checked + public static long multiply (final byte a, final int b) { return a * b; } public static long multiply (final byte a, final long b) { return a * b; } // ->BigInteger - public static double multiply (final byte a, final float b) { return a * b; } // + public static double multiply (final byte a, final float b) { return a * b; } public static double multiply (final byte a, final double b) { return a * b; } - public static long multiply (final char a, final byte b) { return a * b; } - public static long multiply (final char a, final char b) { return a * b; } - public static long multiply (final char a, final short b) { return a * b; } - public static long multiply (final char a, final int b) { return a * b; } - public static long multiply (final char a, final long b) { return a * b; } - public static double multiply (final char a, final float b) { return a * b; } - public static double multiply (final char a, final double b) { return a * b; } public static long multiply (final short a, final byte b) { return a * b; } - public static long multiply (final short a, final char b) { return a * b; } public static long multiply (final short a, final short b) { return a * b; } + public static long multiply (final short a, final char b) { return a * b; } public static long multiply (final short a, final int b) { return a * b; } public static long multiply (final short a, final long b) { return a * b; } public static double multiply (final short a, final float b) { return a * b; } public static double multiply (final short a, final double b) { return a * b; } + public static long multiply (final char a, final byte b) { return a * b; } + public static long multiply (final char a, final short b) { return a * b; } + public static long multiply (final char a, final char b) { return a * b; } + public static long multiply (final char a, final int b) { return a * b; } + public static long multiply (final char a, final long b) { return a * b; } + public static double multiply (final char a, final float b) { return a * b; } + public static double multiply (final char a, final double b) { return a * b; } public static long multiply (final int a, final byte b) { return a * b; } - public static long multiply (final int a, final char b) { return a * b; } public static long multiply (final int a, final short b) { return a * b; } + public static long multiply (final int a, final char b) { return a * b; } public static long multiply (final int a, final int b) { return a * b; } public static long multiply (final int a, final long b) { return a * b; } public static double multiply (final int a, final float b) { return a * b; } public static double multiply (final int a, final double b) { return a * b; } public static long multiply (final long a, final byte b) { return a * b; } - public static long multiply (final long a, final char b) { return a * b; } public static long multiply (final long a, final short b) { return a * b; } + public static long multiply (final long a, final char b) { return a * b; } public static long multiply (final long a, final int b) { return a * b; } public static long multiply (final long a, final long b) { return a * b; } public static double multiply (final long a, final float b) { return a * b; } public static double multiply (final long a, final double b) { return a * b; } public static double multiply (final float a, final byte b) { return a * b; } - public static double multiply (final float a, final char b) { return a * b; } public static double multiply (final float a, final short b) { return a * b; } + public static double multiply (final float a, final char b) { return a * b; } public static double multiply (final float a, final int b) { return a * b; } public static double multiply (final float a, final long b) { return a * b; } public static double multiply (final float a, final float b) { return a * b; } public static double multiply (final float a, final double b) { return a * b; } public static double multiply (final double a, final byte b) { return a * b; } - public static double multiply (final double a, final char b) { return a * b; } public static double multiply (final double a, final short b) { return a * b; } + public static double multiply (final double a, final char b) { return a * b; } public static double multiply (final double a, final int b) { return a * b; } public static double multiply (final double a, final long b) { return a * b; } public static double multiply (final double a, final float b) { return a * b; } public static double multiply (final double a, final double b) { return a * b; } - // ============================ DIVIDE : / ================================ // + // =============================== divde : / (unchecked) =================================== // // "Infectious": uses the largest data type passed // TODO need to deal with int truncation here... sometimes it's intentional... public static double divide (final byte a, final byte b) { return a / b; } - public static double divide (final byte a, final char b) { return a / b; } public static double divide (final byte a, final short b) { return a / b; } + public static double divide (final byte a, final char b) { return a / b; } public static double divide (final byte a, final int b) { return a / b; } public static double divide (final byte a, final long b) { return a / b; } public static double divide (final byte a, final float b) { return a / b; } public static double divide (final byte a, final double b) { return a / b; } - public static double divide (final char a, final byte b) { return a / b; } - public static double divide (final char a, final char b) { return a / b; } - public static double divide (final char a, final short b) { return a / b; } - public static double divide (final char a, final int b) { return a / b; } - public static double divide (final char a, final long b) { return a / b; } - public static double divide (final char a, final float b) { return a / b; } - public static double divide (final char a, final double b) { return a / b; } public static double divide (final short a, final byte b) { return a / b; } - public static double divide (final short a, final char b) { return a / b; } public static double divide (final short a, final short b) { return a / b; } + public static double divide (final short a, final char b) { return a / b; } public static double divide (final short a, final int b) { return a / b; } public static double divide (final short a, final long b) { return a / b; } public static double divide (final short a, final float b) { return a / b; } public static double divide (final short a, final double b) { return a / b; } + public static double divide (final char a, final byte b) { return a / b; } + public static double divide (final char a, final short b) { return a / b; } + public static double divide (final char a, final char b) { return a / b; } + public static double divide (final char a, final int b) { return a / b; } + public static double divide (final char a, final long b) { return a / b; } + public static double divide (final char a, final float b) { return a / b; } + public static double divide (final char a, final double b) { return a / b; } public static double divide (final int a, final byte b) { return a / b; } - public static double divide (final int a, final char b) { return a / b; } public static double divide (final int a, final short b) { return a / b; } + public static double divide (final int a, final char b) { return a / b; } public static double divide (final int a, final int b) { return a / b; } public static double divide (final int a, final long b) { return a / b; } public static double divide (final int a, final float b) { return a / b; } public static double divide (final int a, final double b) { return a / b; } public static double divide (final long a, final byte b) { return a / b; } - public static double divide (final long a, final char b) { return a / b; } public static double divide (final long a, final short b) { return a / b; } + public static double divide (final long a, final char b) { return a / b; } public static double divide (final long a, final int b) { return a / b; } public static double divide (final long a, final long b) { return a / b; } public static double divide (final long a, final float b) { return a / b; } public static double divide (final long a, final double b) { return a / b; } public static double divide (final float a, final byte b) { return a / b; } - public static double divide (final float a, final char b) { return a / b; } public static double divide (final float a, final short b) { return a / b; } + public static double divide (final float a, final char b) { return a / b; } public static double divide (final float a, final int b) { return a / b; } public static double divide (final float a, final long b) { return a / b; } public static double divide (final float a, final float b) { return a / b; } public static double divide (final float a, final double b) { return a / b; } public static double divide (final double a, final byte b) { return a / b; } - public static double divide (final double a, final char b) { return a / b; } public static double divide (final double a, final short b) { return a / b; } + public static double divide (final double a, final char b) { return a / b; } public static double divide (final double a, final int b) { return a / b; } public static double divide (final double a, final long b) { return a / b; } public static double divide (final double a, final float b) { return a / b; } public static double divide (final double a, final double b) { return a / b; } - // ============================ MAX ================================ // + // ============================== max (implicitly checked) ================================== // // "Infectious": uses the largest data type passed public static byte max (final byte a, final byte b) { return (a < b) ? b : a; } - public static char max (final byte a, final char b) { return (char)((a < b) ? b : a); } public static short max (final byte a, final short b) { return (a < b) ? b : a; } + public static int max (final byte a, final char b) { return (a < b) ? b : a; } public static int max (final byte a, final int b) { return (a < b) ? b : a; } public static long max (final byte a, final long b) { return (a < b) ? b : a; } public static float max (final byte a, final float b) { return (a < b) ? b : a; } public static double max (final byte a, final double b) { return (a < b) ? b : a; } - public static char max (final char a, final byte b) { return (char)((a < b) ? b : a); } - public static char max (final char a, final char b) { return (a < b) ? b : a; } - public static short max (final char a, final short b) { return (short)((a < b) ? b : a); } - public static int max (final char a, final int b) { return (a < b) ? b : a; } - public static long max (final char a, final long b) { return (a < b) ? b : a; } - public static float max (final char a, final float b) { return (a < b) ? b : a; } - public static double max (final char a, final double b) { return (a < b) ? b : a; } public static short max (final short a, final byte b) { return (a < b) ? b : a; } - public static short max (final short a, final char b) { return (short)((a < b) ? b : a); } public static short max (final short a, final short b) { return (a < b) ? b : a; } + public static int max (final short a, final char b) { return (a < b) ? b : a; } public static int max (final short a, final int b) { return (a < b) ? b : a; } public static long max (final short a, final long b) { return (a < b) ? b : a; } public static float max (final short a, final float b) { return (a < b) ? b : a; } public static double max (final short a, final double b) { return (a < b) ? b : a; } + public static int max (final char a, final byte b) { return (a < b) ? b : a; } + public static int max (final char a, final short b) { return (a < b) ? b : a; } + public static char max (final char a, final char b) { return (a < b) ? b : a; } + public static int max (final char a, final int b) { return (a < b) ? b : a; } + public static long max (final char a, final long b) { return (a < b) ? b : a; } + public static float max (final char a, final float b) { return (a < b) ? b : a; } + public static double max (final char a, final double b) { return (a < b) ? b : a; } public static int max (final int a, final byte b) { return (a < b) ? b : a; } - public static int max (final int a, final char b) { return (a < b) ? b : a; } public static int max (final int a, final short b) { return (a < b) ? b : a; } + public static int max (final int a, final char b) { return (a < b) ? b : a; } public static int max (final int a, final int b) { return Math.max(a, b); } public static long max (final int a, final long b) { return (a < b) ? b : a; } - public static float max (final int a, final float b) { return (a < b) ? b : a; } + public static double max (final int a, final float b) { return (a < b) ? b : a; } public static double max (final int a, final double b) { return (a < b) ? b : a; } public static long max (final long a, final byte b) { return (a < b) ? b : a; } - public static long max (final long a, final char b) { return (a < b) ? b : a; } public static long max (final long a, final short b) { return (a < b) ? b : a; } + public static long max (final long a, final char b) { return (a < b) ? b : a; } public static long max (final long a, final int b) { return (a < b) ? b : a; } - public static long max (final long a, final long b) { return Math.max(a, b); } - public static float max (final long a, final float b) { return (a < b) ? b : a; } - public static double max (final long a, final double b) { return (a < b) ? b : a; } + public static long max (final long a, final long b) { return (a < b) ? b : a; } + public static Object max (final long a, final float b) { return (a < b) ? b : a; } + public static Object max (final long a, final double b) { return (a < b) ? b : a; } public static float max (final float a, final byte b) { return (a < b) ? b : a; } - public static float max (final float a, final char b) { return (a < b) ? b : a; } public static float max (final float a, final short b) { return (a < b) ? b : a; } - public static float max (final float a, final int b) { return (a < b) ? b : a; } - public static float max (final float a, final long b) { return (a < b) ? b : a; } - public static float max (final float a, final float b) { return Math.max(a, b); } + public static float max (final float a, final char b) { return (a < b) ? b : a; } + public static double max (final float a, final int b) { return (a < b) ? b : a; } + public static Object max (final float a, final long b) { return (a < b) ? b : a; } + public static float max (final float a, final float b) { return (a < b) ? b : a; } public static double max (final float a, final double b) { return (a < b) ? b : a; } public static double max (final double a, final byte b) { return (a < b) ? b : a; } - public static double max (final double a, final char b) { return (a < b) ? b : a; } public static double max (final double a, final short b) { return (a < b) ? b : a; } + public static double max (final double a, final char b) { return (a < b) ? b : a; } public static double max (final double a, final int b) { return (a < b) ? b : a; } - public static double max (final double a, final long b) { return (a < b) ? b : a; } + public static Object max (final double a, final long b) { return (a < b) ? b : a; } public static double max (final double a, final float b) { return (a < b) ? b : a; } - public static double max (final double a, final double b) { return Math.max(a, b); } + public static double max (final double a, final double b) { return (a < b) ? b : a; } - // ============================ MIN ================================ // + // ============================== min (implicitly checked) ================================== // // "Infectious": uses the largest data type passed public static byte min (final byte a, final byte b) { return (a > b) ? b : a; } - public static char min (final byte a, final char b) { return (char)((a > b) ? b : a); } public static short min (final byte a, final short b) { return (a > b) ? b : a; } + public static int min (final byte a, final char b) { return (a > b) ? b : a; } public static int min (final byte a, final int b) { return (a > b) ? b : a; } public static long min (final byte a, final long b) { return (a > b) ? b : a; } public static float min (final byte a, final float b) { return (a > b) ? b : a; } public static double min (final byte a, final double b) { return (a > b) ? b : a; } - public static char min (final char a, final byte b) { return (char)((a > b) ? b : a); } - public static char min (final char a, final char b) { return (a > b) ? b : a; } - public static short min (final char a, final short b) { return (short)((a > b) ? b : a); } - public static int min (final char a, final int b) { return (a > b) ? b : a; } - public static long min (final char a, final long b) { return (a > b) ? b : a; } - public static float min (final char a, final float b) { return (a > b) ? b : a; } - public static double min (final char a, final double b) { return (a > b) ? b : a; } public static short min (final short a, final byte b) { return (a > b) ? b : a; } - public static short min (final short a, final char b) { return (short)((a > b) ? b : a); } public static short min (final short a, final short b) { return (a > b) ? b : a; } + public static int min (final short a, final char b) { return (a > b) ? b : a; } public static int min (final short a, final int b) { return (a > b) ? b : a; } public static long min (final short a, final long b) { return (a > b) ? b : a; } public static float min (final short a, final float b) { return (a > b) ? b : a; } public static double min (final short a, final double b) { return (a > b) ? b : a; } + public static int min (final char a, final byte b) { return (a > b) ? b : a; } + public static int min (final char a, final short b) { return (a > b) ? b : a; } + public static char min (final char a, final char b) { return (a > b) ? b : a; } + public static int min (final char a, final int b) { return (a > b) ? b : a; } + public static long min (final char a, final long b) { return (a > b) ? b : a; } + public static float min (final char a, final float b) { return (a > b) ? b : a; } + public static double min (final char a, final double b) { return (a > b) ? b : a; } public static int min (final int a, final byte b) { return (a > b) ? b : a; } - public static int min (final int a, final char b) { return (a > b) ? b : a; } public static int min (final int a, final short b) { return (a > b) ? b : a; } - // Intrinsic; maybe the others could be acclerated in the same way? - // TODO maybe use if-optimization? + public static int min (final int a, final char b) { return (a > b) ? b : a; } public static int min (final int a, final int b) { return Math.min(a, b); } public static long min (final int a, final long b) { return (a > b) ? b : a; } - public static float min (final int a, final float b) { return (a > b) ? b : a; } + public static double min (final int a, final float b) { return (a > b) ? b : a; } public static double min (final int a, final double b) { return (a > b) ? b : a; } public static long min (final long a, final byte b) { return (a > b) ? b : a; } - public static long min (final long a, final char b) { return (a > b) ? b : a; } public static long min (final long a, final short b) { return (a > b) ? b : a; } + public static long min (final long a, final char b) { return (a > b) ? b : a; } public static long min (final long a, final int b) { return (a > b) ? b : a; } - public static long min (final long a, final long b) { return Math.min(a, b); } - public static float min (final long a, final float b) { return (a > b) ? b : a; } - public static double min (final long a, final double b) { return (a > b) ? b : a; } + public static long min (final long a, final long b) { return (a > b) ? b : a; } + public static Object min (final long a, final float b) { return (a > b) ? b : a; } + public static Object min (final long a, final double b) { return (a > b) ? b : a; } public static float min (final float a, final byte b) { return (a > b) ? b : a; } - public static float min (final float a, final char b) { return (a > b) ? b : a; } public static float min (final float a, final short b) { return (a > b) ? b : a; } - public static float min (final float a, final int b) { return (a > b) ? b : a; } - public static float min (final float a, final long b) { return (a > b) ? b : a; } - public static float min (final float a, final float b) { return Math.min(a, b); } + public static float min (final float a, final char b) { return (a > b) ? b : a; } + public static double min (final float a, final int b) { return (a > b) ? b : a; } + public static Object min (final float a, final long b) { return (a > b) ? b : a; } + public static float min (final float a, final float b) { return (a > b) ? b : a; } public static double min (final float a, final double b) { return (a > b) ? b : a; } public static double min (final double a, final byte b) { return (a > b) ? b : a; } - public static double min (final double a, final char b) { return (a > b) ? b : a; } public static double min (final double a, final short b) { return (a > b) ? b : a; } + public static double min (final double a, final char b) { return (a > b) ? b : a; } public static double min (final double a, final int b) { return (a > b) ? b : a; } - public static double min (final double a, final long b) { return (a > b) ? b : a; } + public static Object min (final double a, final long b) { return (a > b) ? b : a; } public static double min (final double a, final float b) { return (a > b) ? b : a; } - public static double min (final double a, final double b) { return Math.min(a, b); } + public static double min (final double a, final double b) { return (a > b) ? b : a; } - // ============================ REM ================================ // + // ================================== rem (unchecked) ====================================== // + // TODO other overloads public static long rem (final long a, final long b) { return a % b; } - // ============================ EVEN? ================================ // + // ======================================= even? =========================================== // + // NOTE that this is here for the Java quantum.core.Collections public static boolean isEven (final long x) { return isZero(bitAnd(x, 1)); } diff --git a/subprojects/quantum-java/src/java/quantum/core/Primitive.java b/src-java/quantum/core/Primitive.java similarity index 100% rename from subprojects/quantum-java/src/java/quantum/core/Primitive.java rename to src-java/quantum/core/Primitive.java diff --git a/subprojects/quantum-java/src/java/quantum/core/data/Array.java b/src-java/quantum/core/data/Array.java similarity index 99% rename from subprojects/quantum-java/src/java/quantum/core/data/Array.java rename to src-java/quantum/core/data/Array.java index 0455cd0f..595855a6 100644 --- a/subprojects/quantum-java/src/java/quantum/core/data/Array.java +++ b/src-java/quantum/core/data/Array.java @@ -1151,6 +1151,8 @@ public class Array { // ================================ NEW 1D ARRAY ================================ // + public static Object [] new1dObjectArray() { return new Object [] {}; } + public static Object [] new1dObjectArray(final Object a0 ) { return new Object []{ a0 }; } public static Object [] new1dObjectArray(final Object a0, final Object a1 ) { return new Object []{ a0, a1 }; } public static Object [] new1dObjectArray(final Object a0, final Object a1, final Object a2 ) { return new Object []{ a0, a1, a2 }; } diff --git a/subprojects/quantum-java/src/java/quantum/core/data/queue/LinkedBlockingQueue.java b/src-java/quantum/core/data/queue/LinkedBlockingQueue.java similarity index 100% rename from subprojects/quantum-java/src/java/quantum/core/data/queue/LinkedBlockingQueue.java rename to src-java/quantum/core/data/queue/LinkedBlockingQueue.java diff --git a/subprojects/quantum-java/src/java/quantum/core/data/streams/ByteBufferInputStream.java b/src-java/quantum/core/data/streams/ByteBufferInputStream.java similarity index 100% rename from subprojects/quantum-java/src/java/quantum/core/data/streams/ByteBufferInputStream.java rename to src-java/quantum/core/data/streams/ByteBufferInputStream.java diff --git a/subprojects/quantum-java/src/java/quantum/core/data/streams/InputStream.java b/src-java/quantum/core/data/streams/InputStream.java similarity index 100% rename from subprojects/quantum-java/src/java/quantum/core/data/streams/InputStream.java rename to src-java/quantum/core/data/streams/InputStream.java diff --git a/subprojects/quantum-java/src/java/quanta/ClassIntrospector.java b/src-java/quantum/misc/ClassIntrospector.java similarity index 99% rename from subprojects/quantum-java/src/java/quanta/ClassIntrospector.java rename to src-java/quantum/misc/ClassIntrospector.java index e85356f4..e1857a93 100644 --- a/subprojects/quantum-java/src/java/quanta/ClassIntrospector.java +++ b/src-java/quantum/misc/ClassIntrospector.java @@ -1,12 +1,12 @@ -package quanta; +package quantum.misc; import sun.misc.Unsafe; - + import java.lang.reflect.Array; import java.lang.reflect.Field; import java.lang.reflect.Modifier; import java.math.BigDecimal; import java.util.*; - + /** * This class could be used for any object contents/memory layout printing. */ @@ -25,11 +25,11 @@ public static void main(String[] args) throws IllegalAccessException { //res = ci.introspect( new String[] { "str1", "str2" } ); //res = ci.introspect(ObjectInfo.class); //res = ci.introspect( new TestObj() ); - + System.out.println( res.getDeepSize() ); System.out.println( res ); } - + /** First test object - testing various arrays and complex objects */ private static class TestObj { @@ -37,7 +37,7 @@ private static class TestObj protected final int[] ints = { 14, 16 }; private final Integer i = 28; protected final BigDecimal bigDecimal = BigDecimal.ONE; - + @Override public String toString() { return "TestObj{" + @@ -48,13 +48,13 @@ public String toString() { '}'; } } - + /** Test class 2 - testing inheritance */ private static class TestObjChild extends TestObj { private final boolean[] flags = { true, true, false }; private final boolean flag = false; - + @Override public String toString() { return "TestObjChild{" + @@ -63,7 +63,7 @@ public String toString() { '}'; } } - + private static final Unsafe unsafe; /** Size of any Object reference */ private static final int objectRefSize; @@ -74,7 +74,7 @@ public String toString() { Field field = Unsafe.class.getDeclaredField("theUnsafe"); field.setAccessible(true); unsafe = (Unsafe)field.get(null); - + objectRefSize = unsafe.arrayIndexScale( Object[].class ); } catch (Exception e) @@ -82,10 +82,10 @@ public String toString() { throw new RuntimeException(e); } } - + /** Sizes of all primitive values */ private static final Map primitiveSizes; - + static { primitiveSizes = new HashMap( 10 ); @@ -97,7 +97,7 @@ public String toString() { primitiveSizes.put( double.class, 8 ); primitiveSizes.put( boolean.class, 1 ); } - + /** * Get object information for any Java object. Do not pass primitives to this method because they * will boxed and the information you will get will be related to a boxed version of your value. @@ -115,10 +115,10 @@ public ObjectInfo introspect( final Object obj ) throws IllegalAccessException m_visited.clear(); } } - + //we need to keep track of already visited objects in order to support cycles in the object graphs private IdentityHashMap m_visited = new IdentityHashMap( 100 ); - + private ObjectInfo introspect( final Object obj, final Field fld ) throws IllegalAccessException { //use Field type only if the field contains null. In this case we will at least know what's expected to be @@ -133,7 +133,7 @@ private ObjectInfo introspect( final Object obj, final Field fld ) throws Illega isRecursive = true; m_visited.put( obj, true ); } - + final Class type = ( fld == null || ( obj != null && !isPrimitive) ) ? obj.getClass() : fld.getType(); int arraySize = 0; @@ -145,7 +145,7 @@ private ObjectInfo introspect( final Object obj, final Field fld ) throws Illega indexScale = unsafe.arrayIndexScale( type ); arraySize = baseOffset + indexScale * Array.getLength( obj ); } - + final ObjectInfo root; if ( fld == null ) { @@ -158,7 +158,7 @@ private ObjectInfo introspect( final Object obj, final Field fld ) throws Illega root = new ObjectInfo( fld.getName(), type.getCanonicalName(), getContents( obj, type ), offset, getShallowSize( type ), arraySize, baseOffset, indexScale ); } - + if ( !isRecursive && obj != null ) { if ( isObjectArray( type ) ) @@ -182,11 +182,11 @@ private ObjectInfo introspect( final Object obj, final Field fld ) throws Illega } } } - + root.sort(); //sort by offset return root; } - + //get all fields for this class, including all superclasses fields private static List getAllFields( final Class type ) { @@ -203,7 +203,7 @@ private static List getAllFields( final Class type ) } return res; } - + //check if it is an array of objects. I suspect there must be a more API-friendly way to make this check. private static boolean isObjectArray( final Class type ) { @@ -214,7 +214,7 @@ private static boolean isObjectArray( final Class type ) return false; return true; } - + //advanced toString logic private static String getContents( final Object val, final Class type ) { @@ -243,7 +243,7 @@ else if ( type == double[].class ) } return val.toString(); } - + //obtain a shallow size of a field of given class (primitive or object reference size) private static int getShallowSize( final Class type ) { @@ -255,4 +255,4 @@ private static int getShallowSize( final Class type ) else return objectRefSize; } -} \ No newline at end of file +} diff --git a/subprojects/quantum-java/src/java/quanta/ObjectInfo.java b/src-java/quantum/misc/ObjectInfo.java similarity index 99% rename from subprojects/quantum-java/src/java/quanta/ObjectInfo.java rename to src-java/quantum/misc/ObjectInfo.java index 4b692201..821452cc 100644 --- a/subprojects/quantum-java/src/java/quanta/ObjectInfo.java +++ b/src-java/quantum/misc/ObjectInfo.java @@ -1,10 +1,10 @@ -package quanta; +package quantum.misc; import java.util.ArrayList; import java.util.Collections; import java.util.Comparator; import java.util.List; - + /** * This class contains object info generated by ClassIntrospector tool */ @@ -27,7 +27,7 @@ public class ObjectInfo { public final int arraySize; /** This object fields */ public final List children; - + public ObjectInfo(String name, String type, String contents, int offset, int length, int arraySize, int arrayBase, int arrayElementSize) { @@ -41,13 +41,13 @@ public ObjectInfo(String name, String type, String contents, int offset, int len this.arrayElementSize = arrayElementSize; children = new ArrayList( 1 ); } - + public void addChild( final ObjectInfo info ) { if ( info != null ) children.add( info ); } - + /** * Get the full amount of memory occupied by a given object. This value may be slightly less than * an actual value because we don't worry about memory alignment - possible padding after the last object field. @@ -59,7 +59,7 @@ public long getDeepSize() { return length + arraySize + getUnderlyingSize( arraySize != 0 ); } - + private long getUnderlyingSize( final boolean isArray ) { long size = 0; @@ -69,7 +69,7 @@ private long getUnderlyingSize( final boolean isArray ) size += children.get( children.size() - 1 ).offset + children.get( children.size() - 1 ).length; return size; } - + private static final class OffsetComparator implements Comparator { @Override @@ -78,20 +78,20 @@ public int compare( final ObjectInfo o1, final ObjectInfo o2 ) return o1.offset - o2.offset; //safe because offsets are small non-negative numbers } } - + //sort all children by their offset public void sort() { Collections.sort( children, new OffsetComparator() ); } - + @Override public String toString() { final StringBuilder sb = new StringBuilder(); toStringHelper( sb, 0 ); return sb.toString(); } - + private void toStringHelper( final StringBuilder sb, final int depth ) { depth( sb, depth ).append("name=").append( name ).append(", type=").append( type ) @@ -109,11 +109,11 @@ private void toStringHelper( final StringBuilder sb, final int depth ) child.toStringHelper(sb, depth + 1); } } - + private StringBuilder depth( final StringBuilder sb, final int depth ) { for ( int i = 0; i < depth; ++i ) sb.append( '\t' ); return sb; } -} \ No newline at end of file +} diff --git a/subprojects/quantum-java/src/java/quanta/Packed12.java b/src-java/quantum/misc/Packed12.java similarity index 98% rename from subprojects/quantum-java/src/java/quanta/Packed12.java rename to src-java/quantum/misc/Packed12.java index 7a7eb176..68448a9c 100644 --- a/subprojects/quantum-java/src/java/quanta/Packed12.java +++ b/src-java/quantum/misc/Packed12.java @@ -1,4 +1,4 @@ -package quanta; +package quantum.misc; import java.nio.ByteBuffer; import java.nio.charset.Charset; @@ -10,14 +10,14 @@ public class Packed12 extends PackedBase private final int f1; private final int f2; private final int f3; - + public Packed12( final byte[] ar ) { // should be the same logic as in java.util.Bits.getInt, because ByteBuffer.putInt use it f1 = get( ar, 3 ) | get( ar, 2 ) << 8 | get( ar, 1 ) << 16 | get( ar, 0 ) << 24; f2 = get( ar, 7 ) | get( ar, 6 ) << 8 | get( ar, 5 ) << 16 | get( ar, 4 ) << 24; f3 = get( ar, 11 ) | get( ar, 10 ) << 8 | get( ar, 9 ) << 16 | get( ar, 8 ) << 24; } - + protected ByteBuffer toByteBuffer() { final ByteBuffer bbuf = ByteBuffer.allocate( 12 ); bbuf.putInt( f1 ); @@ -25,7 +25,7 @@ protected ByteBuffer toByteBuffer() { bbuf.putInt( f3 ); return bbuf; } - + @Override public boolean equals(Object o) { if ( this == o ) return true; @@ -33,7 +33,7 @@ public boolean equals(Object o) { Packed12 packed12 = ( Packed12 ) o; return f1 == packed12.f1 && f2 == packed12.f2 && f3 == packed12.f3; } - + @Override public int hashCode() { int result = f1; @@ -41,4 +41,4 @@ public int hashCode() { result = 31 * result + f3; return result; } -} \ No newline at end of file +} diff --git a/subprojects/quantum-java/src/java/quanta/PackedBase.java b/src-java/quantum/misc/PackedBase.java similarity index 98% rename from subprojects/quantum-java/src/java/quanta/PackedBase.java rename to src-java/quantum/misc/PackedBase.java index 73202be7..74ca47dd 100644 --- a/subprojects/quantum-java/src/java/quanta/PackedBase.java +++ b/src-java/quantum/misc/PackedBase.java @@ -1,4 +1,4 @@ -package quanta; +package quantum.misc; import java.nio.ByteBuffer; import java.nio.charset.Charset; @@ -10,9 +10,9 @@ protected static int get( final byte[] ar, final int index ) { return index < ar.length ? ar[ index ] : 0; } - + protected abstract ByteBuffer toByteBuffer(); - + protected String toString( final ByteBuffer bbuf ) { final byte[] ar = bbuf.array(); @@ -22,7 +22,7 @@ protected String toString( final ByteBuffer bbuf ) --last; return new String( ar, 0, last + 1, US_ASCII ); } - + @Override public String toString() { @@ -34,14 +34,14 @@ private class Packed12 extends PackedBase private final int f1; private final int f2; private final int f3; - + public Packed12( final byte[] ar ) { // should be the same logic as in java.util.Bits.getInt, because ByteBuffer.putInt use it f1 = get( ar, 3 ) | get( ar, 2 ) << 8 | get( ar, 1 ) << 16 | get( ar, 0 ) << 24; f2 = get( ar, 7 ) | get( ar, 6 ) << 8 | get( ar, 5 ) << 16 | get( ar, 4 ) << 24; f3 = get( ar, 11 ) | get( ar, 10 ) << 8 | get( ar, 9 ) << 16 | get( ar, 8 ) << 24; } - + protected ByteBuffer toByteBuffer() { final ByteBuffer bbuf = ByteBuffer.allocate( 12 ); bbuf.putInt( f1 ); @@ -49,7 +49,7 @@ protected ByteBuffer toByteBuffer() { bbuf.putInt( f3 ); return bbuf; } - + @Override public boolean equals(Object o) { if ( this == o ) return true; @@ -57,7 +57,7 @@ public boolean equals(Object o) { Packed12 packed12 = ( Packed12 ) o; return f1 == packed12.f1 && f2 == packed12.f2 && f3 == packed12.f3; } - + @Override public int hashCode() { int result = f1; @@ -66,4 +66,4 @@ public int hashCode() { return result; } } -} \ No newline at end of file +} diff --git a/src-untyped/quantum/untyped/core/analyze.cljc b/src-untyped/quantum/untyped/core/analyze.cljc new file mode 100644 index 00000000..a6fcdcb7 --- /dev/null +++ b/src-untyped/quantum/untyped/core/analyze.cljc @@ -0,0 +1,1273 @@ +(ns quantum.untyped.core.analyze + (:require + ;; TODO excise this reference + [quantum.core.type.core :as tcore] + [quantum.untyped.core.analyze.ast :as uast] + [quantum.untyped.core.analyze.expr :as uxp] + [quantum.untyped.core.collections :as uc + :refer [>vec]] + [quantum.untyped.core.collections.logic :as clogic] + [quantum.untyped.core.compare :as ucomp] + [quantum.untyped.core.core + :refer [istr]] + [quantum.untyped.core.data + :refer [kw-map]] + [quantum.untyped.core.data.reactive :as urx] + [quantum.untyped.core.data.set :as uset] + [quantum.untyped.core.defnt + :refer [defns defns- fns]] + [quantum.untyped.core.error :as uerr + :refer [TODO err!]] + [quantum.untyped.core.fn + :refer [<- fn-> fn->> fn1]] + [quantum.untyped.core.form :as uform] + [quantum.untyped.core.form.evaluate :as ufeval] + [quantum.untyped.core.form.type-hint :as ufth] + [quantum.untyped.core.identifiers :as uid] + [quantum.untyped.core.log :as ulog + :refer [prl!]] + [quantum.untyped.core.logic :as l + :refer [if-not-let ifs]] + [quantum.untyped.core.print + :refer [ppr]] + [quantum.untyped.core.reducers :as ur + :refer [educe join reducei]] + [quantum.untyped.core.refs :as uref + :refer [>!thread-local]] + [quantum.untyped.core.spec :as us] + [quantum.untyped.core.type :as t + :refer [?]] + [quantum.untyped.core.type.compare :as utcomp] + [quantum.untyped.core.type.reifications :as utr + #?@(:cljs [:refer [TypedFn]])] + [quantum.untyped.core.vars :as uvar + :refer [update-meta]]) +#?(:clj (:import + [quantum.untyped.core.type.reifications TypedFn]))) + +(def special-metadata-keys #{:val}) + +;; TODO move? +(defns class>type + "For converting a class in a reflective method, constructor, or field declaration to a type. + Unlike `t/isa?`, takes into account that non-primitive classes in Java aren't guaranteed to be + non-null." + [x class? > t/type?] + (let [matching-boxed-class (t/unboxed-class->boxed-class x)] + (-> (or matching-boxed-class x) + t/maybe-look-up-type-from-class + (cond-> (not matching-boxed-class) t/?)))) + +(defn- assume-val-for-form? [form] (-> form meta :val true?)) + +(defns- maybe-with-assume-val [c class?, form _ > t/type?] + (let [matching-boxed-class (t/unboxed-class->boxed-class c)] + (-> (or matching-boxed-class c) + t/maybe-look-up-type-from-class + (cond-> (and (not matching-boxed-class) (not (assume-val-for-form? form))) t/?)))) + +;; TODO move? +(defns- compare-class-specificity [c0 class?, c1 class?] + (case (utcomp/compare|class+class* + (or (t/unboxed-class->boxed-class c0) c0) + (or (t/unboxed-class->boxed-class c1) c1)) + -1 -1 + (0 2 3) 0 + 1 1)) + +;; ----- Reflection support ----- ;; + +#?(:clj +(defrecord Method + [^String name ^Class out-class ^"[Ljava.lang.Class;" arg-classes ^clojure.lang.Keyword kind] + fipp.ednize/IOverride + fipp.ednize/IEdn (-edn [this] (tagged-literal (symbol "M") (into (array-map) this))))) + +#?(:clj (defns method? [x _] (instance? Method x))) + +#?(:clj +(defns class>methods + "Returns all the public methods associated with a class, as a map from: + method-name -> arg-count -> kind=static|instance -> methods" + [^Class c class? > map?] + (let [with-most-specific-out-class + (fn->> (ucomp/comp-min-of + (fn [m0 m1] (compare-class-specificity (:out-class m0) (:out-class m1))))) + ;; We have to use `with-distinct-arg-class-seqs` Because even though it's not supposed to + ;; be the case that there is ever more than one method with the same combination of name, + ;; kind (static/instance), and arg classes, only differing by return type, it *has* + ;; happened on Java version "1.8.0_162", Mac OS X, JVM version "25.162-b12", with the + ;; `ByteBuffer.array()` public instance method which maps to two overloads, one which + ;; returns `Object` and one which returns `byte[]`. + ;; See also this link for the claim that this is impossible according to the Java 1.8 spec + ;; (http://docs.oracle.com/javase/specs/jls/se8/html/jls-8.html#jls-8.4.2) and that the bug + ;; only exists in Java 6 or 7 on Oracle's JDK, OpenJDK, and IBM's JDK: https://stackoverflow.com/questions/5561436/can-two-java-methods-have-same-name-with-different-return-types + with-distinct-arg-class-seqs + (fn->> (uc/group-by (fn-> :arg-classes vec)) + vals + (uc/map with-most-specific-out-class))] + (->> (.getMethods c) + (uc/map+ (fn [^java.lang.reflect.Method x] + (Method. (.getName x) (.getReturnType x) (.getParameterTypes x) + (if (java.lang.reflect.Modifier/isStatic (.getModifiers x)) + :static + :instance)))) + (uc/group-by (fn [^Method x] (:name x))) ; TODO all of these need to be into !vector and !hash-map + (uc/map-vals+ + (fn->> (uc/group-by (fn [^Method x] (count (:arg-classes x)))) + (uc/map-vals+ + (fn->> (uc/group-by (fn [^Method x] (:kind x))) + (uc/map-vals+ with-distinct-arg-class-seqs) + (ur/join {}))) + (ur/join {}))) + (ur/join {}))))) + + +(defonce class>methods|with-cache + (memoize (fn [c] (class>methods c)))) + +#?(:clj +(defrecord Constructor [^"[Ljava.lang.Class;" arg-classes] + fipp.ednize/IOverride + fipp.ednize/IEdn (-edn [this] (tagged-literal (symbol "C") {:arg-classes (vec arg-classes)})))) + +#?(:clj (defns constructor? [x _] (instance? Constructor x))) + +#?(:clj +(defns class>constructors + "Returns all the public constructors associated with a class, as a vector." + [^Class c class? > vector?] + (->> (.getConstructors c) + (uc/map (fn [^java.lang.reflect.Constructor x] (Constructor. (.getParameterTypes x))))))) + +(defonce class>constructors|with-cache + (memoize (fn [c] (class>constructors c)))) + +#?(:clj +(defrecord Field [^String name ^Class class ^clojure.lang.Keyword kind] + fipp.ednize/IOverride + fipp.ednize/IEdn (-edn [this] (tagged-literal (symbol "F") (into (array-map) this))))) + +#?(:clj +(defns class>fields + "Returns all the public fields associated with a class, as a map from field name to field." + [^Class c class? > map?] + (->> (.getFields c) + (uc/map+ (fn [^java.lang.reflect.Field x] + [(.getName x) + (Field. (.getName x) (.getType x) + (if (java.lang.reflect.Modifier/isStatic (.getModifiers x)) + :static + :instance))])) + (ur/join {})))) ; TODO !hash-map + +#?(:clj +(def class>fields|with-cache + (memoize (fn [c] (class>fields c))))) + +;; ----- End reflection support ----- ;; + +(def ^:dynamic *analyzing?* false) + +;; Will define later in `quantum.untyped.core.type.defnt` +(defonce !!analyze-fnt + (atom (fn [env form] (throw (ex-info "`analyze-fnt` has not been defined yet" {}))))) + +(defonce !!analyze-defnt + (atom (fn [env form] (throw (ex-info "`analyze-defnt` has not been defined yet" {}))))) + +(defonce !!analyze-extend-defnt + (atom (fn [env form] (throw (ex-info "`analyze-extend-defnt!` has not been defined yet" {}))))) + +(defonce !!analyze-arg-syms|iter (>!thread-local 0)) ; `nneg-fixint?` + +(defonce !!analyze-depth (>!thread-local 0)) + +(uvar/defonce !!dependent? + "Denotes whether a dependent type was found to be used in the current arglist context." + (>!thread-local false)) + +(defn add-file-context-from [to from] + (let [{:keys [line column]} (meta from)] + (update-meta to + #(cond-> % line (assoc :line line) + column (assoc :column column))))) + +;; TODO move +(deftype WatchableMutable + [^:unsynchronized-mutable v ^:unsynchronized-mutable ^clojure.lang.IFn watch] + clojure.lang.IDeref (deref [this] v) + clojure.lang.IRef (addWatch [this _ f] (set! watch f ) this) + (removeWatch [this _] (set! watch nil) this) + clojure.lang.IAtom (reset [this newv] (set! v newv) v) + (swap [this f] + (let [oldv v] + (set! v (f v)) + (when (some? watch) (watch nil this oldv v)) + v)) + Object (equals [this that] + (and (instance? WatchableMutable that) + (= v (.-v ^WatchableMutable that)))) + fipp.ednize/IOverride + fipp.ednize/IEdn (-edn [this] (tagged-literal (symbol "!@") v))) + +;; TODO move +(defn !ref + ([v] (->WatchableMutable v nil)) + ([v watch] (->WatchableMutable v watch))) + +(us/def ::opts (us/map-of keyword? t/any?)) + +(us/def ::env + (us/map-of (us/or* symbol? #(= % :opts)) + ;; Technically this should change based on the key spec + (us/or* uast/node? map?))) + +(declare analyze* analyze-arg-syms*) + +(defns- select-fields-for-print [node uast/node?] (select-keys node [:form :unanalyzed-form :type])) + +;; TODO maybe just roll this into `analyze-seq|do`? Not sure yet +(defns- analyze-non-map-seqable + "Analyzes a non-map seqable." + {:params-doc + '{merge-types-fn "2-arity fn that merges two types (or sets of types). + The first argument is the current deduced type of the + overall AST node; the second is the deduced type of + the current sub-AST-node."}} + [env ::env, form _, empty-form _, rf _] + (-> (reducei + (fn [accum form' i] (rf accum (analyze* (:env accum) form') i)) + {:env env :form (transient empty-form) :body (transient [])} + form) + (update :form (fn-> persistent! (add-file-context-from form))) + (update :body persistent!))) + +;; TODO abstract `analyze-unkeyed` and `analyze-map` +(defns- analyze-unkeyed + [env ::env, form _, empty-v _, built-in-type t/type?, ordered-or-unordered fn?, >ast fn? + > uast/node?] + (let [{:keys [all-values? nodes]} + (->> form + (uc/map+ (fn [form-v] (analyze* env form-v))) + (educe (fn ([ret] ret) + ([{:as ret :keys [all-values?]} v] + (let [all-values?' (and all-values? (-> v :type utr/value-type?))] + (-> ret (assoc :all-values? all-values?') + (update :nodes conj v))))) + {:all-values? true :nodes []})) + t (if all-values? + (->> nodes + (uc/map+ (fn-> :type t/unvalue)) + (join empty-v) + t/value) + (t/and built-in-type (->> nodes (uc/map :type) ordered-or-unordered)))] + (>ast {:env env + :unanalyzed-form form + :form (->> nodes (uc/map+ :form) (join empty-v) + (<- (add-file-context-from form))) + :nodes nodes + :type t}))) + +(defns- analyze-vector [env ::env, form _ > uast/vector-node?] + (analyze-unkeyed env form [] t/+vector|built-in? t/ordered uast/vector-node)) + +(defns- analyze-set [env ::env, form _ > uast/set-node?] + (analyze-unkeyed env form #{} t/+unordered-set|built-in? t/unordered uast/set-node)) + +(defns- analyze-map + {:todo #{"Should we differentiate between array map and hash map here depen. on ct of inputs?"}} + [env ::env, form _] + (let [{:keys [all-values? nodes]} + (->> form + (uc/map+ (fn [[form-k form-v]] [(analyze* env form-k) (analyze* env form-v)])) + (educe (fn ([ret] ret) + ([{:as ret :keys [all-values?]} [k v :as kv]] + (let [all-values?' (and all-values? + (-> k :type utr/value-type?) + (-> v :type utr/value-type?))] + (-> ret (assoc :all-values? all-values?') + (update :nodes conj kv))))) + {:all-values? true :nodes []})) + t (if all-values? + (->> nodes + (uc/map+ (fn [[k v]] + [(-> k :type t/unvalue) (-> v :type t/unvalue)])) + (join {}) + t/value) + (t/and t/+map|built-in? + (->> nodes + (uc/map (fn [[k v]] (t/ordered (:type k) (:type v)))) + t/unordered)))] + (uast/map-node + {:env env + :unanalyzed-form form + :form (->> nodes + (uc/map+ (fn [[k v]] [(:form k) (:form v)])) + (join {}) + (<- (add-file-context-from form))) + :nodes nodes + :type t}))) + +(defns- analyze-seq|do [env ::env, [_ _ & body|form _ :as form] _ > uast/do?] + (if (empty? body|form) + (uast/do {:env env + :unanalyzed-form form + :form form + :body [] + :type t/nil?}) + (let [{analyzed-form :form body :body} + (analyze-non-map-seqable env body|form [] + (fn [accum ast-data _] + ;; The env should be the same as whatever it was originally because no new scopes + ;; are created + (-> accum + (update :form conj! (:form ast-data)) + (update :body conj! ast-data))))] + (uast/do {:env env + :unanalyzed-form form + :form (with-meta (list* 'do analyzed-form) (meta analyzed-form)) + :body body + ;; To types, only the last sub-AST-node ever matters, as each is independent from + ;; the others + :type (-> body uc/last :type)})))) + +(defns- analyze-seq|let*|bindings [env ::env, bindings|form _] + (->> bindings|form + (uc/partition-all+ 2) + (reduce (fn [{env' :env !bindings :form :keys [bindings-map]} [sym form :as binding|form]] + (let [node (analyze* env' form)] ; environment is additive with each binding + {:env (assoc env' sym node) + :form (conj! (conj! !bindings sym) (:form node)) + :bindings-map (assoc bindings-map sym node)})) + {:env env :form (transient []) :bindings-map {}}) + (<- (update :form (fn-> persistent! (add-file-context-from bindings|form)))))) + +(defns- analyze-seq|let* + [env ::env, [_ _, bindings|form _ & body|form _ :as form] _ > uast/let*?] + (let [{env' :env bindings|form' :form :keys [bindings-map]} + (analyze-seq|let*|bindings env bindings|form) + {body|form' :form body|type :type body :body} + (analyze-seq|do env' (list* 'do body|form))] + (uast/let* {:env env + :unanalyzed-form form + :form (list* 'let* bindings|form' (rest body|form')) + :bindings bindings-map + :body body + :type body|type}))) + +#?(:clj +(defns ?cast-call->type + "Given a cast call like `clojure.lang.RT/uncheckedBooleanCast`, returns the + corresponding type. + + Unchecked fns could be assumed to actually *want* to shift the range over if the + range hits a certain point, but we do not make that assumption here." + [c class?, method symbol? > (? t/type?)] + (when (identical? c clojure.lang.RT) + (case method + (uncheckedBooleanCast booleanCast) t/boolean? + (uncheckedByteCast byteCast) t/byte? + (uncheckedCharCast charCast) t/char? + (uncheckedShortCast shortCast) t/char? + (uncheckedIntCast intCast) t/int? + (uncheckedLongCast longCast) t/long? + (uncheckedFloatCast floatCast) t/float? + (uncheckedDoubleCast doubleCast) t/double? + nil)))) + +(defns- call-sites>most-specific + "Time complexity = O(m•n) where m = # of call sites and n = # of args per call site." + [call-sites (us/vec-of t/any? #_(us/array-of class?)) > (us/vec-of t/any? #_(us/array-of class?))] + (let [^"[Ljava.lang.Object;" sample-arg-classes (-> call-sites first :arg-classes) + args-ct (alength sample-arg-classes)] + (->> (range args-ct) + (reduce + (fn [call-sites' ^long i] + (->> call-sites' + (ucomp/comp-mins-of + (fn [x0 x1] + (let [^"[Ljava.lang.Object;" cs0 (:arg-classes x0) + ^"[Ljava.lang.Object;" cs1 (:arg-classes x1)] + (compare-class-specificity (aget cs0 i) (aget cs1 i))))))) + call-sites)))) + +(defns- analyze-seq|method-or-constructor-call|incrementally-analyze + [env ::env, form _, target-class class?, args|form _, call-sites-for-ct _ + kinds-str string? > (us/kv {:args|analyzed vector?})] + (let [{:as ret :keys [call-sites args|analyzed]} + (->> args|form + (reducei + (fn [{:as ret :keys [args|analyzed call-sites]} arg|form i|arg] + (let [arg|analyzed (analyze* env arg|form) + arg|analyzed|type (:type arg|analyzed) + call-sites' + (->> call-sites + (uc/filter + (fn [{:keys [^"[Ljava.lang.Object;" arg-classes]}] + (t/<= arg|analyzed|type + (class>type (aget arg-classes i|arg))))))] + (if (empty? call-sites') + (err! (str "No " kinds-str " for class match the arg type at index") + {:class target-class + :form form + :arg|type arg|analyzed|type + :arg|analyzed-form (:form arg|analyzed) + :i|arg i|arg + :arg-types + (vec (concat (mapv :type args|analyzed) + [arg|analyzed|type] + (repeat (- (count args|form) + (inc (count args|analyzed))) + :unanalyzed))) + (keyword kinds-str) call-sites-for-ct}) + (-> ret + (assoc :call-sites call-sites') + (update :args|analyzed conj arg|analyzed))))) + {:call-sites call-sites-for-ct :args|analyzed []})) + call-sites (cond-> call-sites (-> call-sites count (> 1)) call-sites>most-specific)] + (if (-> call-sites count (> 1)) + (err! (str "Multiple, equally specific " kinds-str " for class match the arg types") + {:class target-class + :form form + (keyword kinds-str) (->> call-sites (uc/map #(update % :arg-classes vec))) + :arg-types (mapv :type args|analyzed)}) + ret))) + +(defns- analyze-seq|dot|method-call|incrementally-analyze + [env ::env, form _, target uast/node?, target-class class?, method-form _ + args|form _ methods-for-ct-and-kind (us/seq-of t/any?) > uast/method-call?] + (let [{:keys [args|analyzed call-sites]} + (analyze-seq|method-or-constructor-call|incrementally-analyze env form target-class + args|form methods-for-ct-and-kind "methods") + ?cast-type (?cast-call->type target-class method-form) + ;; TODO enable the below: + ;; (us/validate (-> with-ret-type :args first :type) #(t/>= % (t/numerically ?cast-type))) + ;; _ (when ?cast-type + ;; TODO fix this: + ;; (ulog/ppr :warn + ;; "Not yet able to statically validate whether primitive cast will succeed at runtime" + ;; {:form form})) + ] + (uast/method-call + {:env env + :unanalyzed-form form + :form (list* '. (:form target) method-form (map :form args|analyzed)) + :target target + :method method-form + :args args|analyzed + :type (-> call-sites first :out-class (maybe-with-assume-val form))}))) + +(defns- analyze-seq|dot|method-call + "A note will be made of what methods match the argument types. + If only one method is found, that is noted too. If no matching method is found, an + exception is thrown." + [env ::env, form _, target uast/node?, target-class class?, static? t/boolean? + method-form simple-symbol?, args|form _ #_(seq-of form?) > uast/method-call?] + ;; TODO cache type by method + (if-not-let [methods-for-name (-> target-class class>methods|with-cache + (uc/get (name method-form)))] + (if (empty? args|form) + (err! "No such method or field in class" {:class target-class :method-or-field method-form}) + (err! "No such method in class" {:class target-class :methods method-form})) + (if-not-let [methods-for-ct (uc/get methods-for-name (uc/count args|form))] + (err! "Incorrect number of arguments for method" + {:class target-class + :method method-form + :possible-counts (->> methods-for-name keys (apply sorted-set))}) + (let [[kind non-kind] (if static? [:static :instance] [:instance :static])] + (if-not-let [methods-for-ct-and-kind (uc/get methods-for-ct kind)] + (err! (istr "Method found for arg-count, but was ~non-kind, not ~kind") + {:class target-class :method method-form :args args|form}) + (analyze-seq|dot|method-call|incrementally-analyze env form target target-class + method-form args|form methods-for-ct-and-kind)))))) + +(defns- analyze-seq|dot|field-access + [env ::env, form _, target _, field-form simple-symbol?, field (t/isa? Field) + > uast/field-access?] + (uast/field-access + {:env env + :unanalyzed-form form + :form (list '. (:form target) field-form) + :target target + :field field-form + :type (-> field :class (maybe-with-assume-val form))})) + +(defns classes>class + "Ensure that given a set of classes, that set consists of at most a class C and nil. + If so, returns C. Otherwise, throws." + [cs (us/set-of (us/nilable class?)) > class?] + (let [cs' (disj cs nil)] + (if (-> cs' count (= 1)) + (first cs') + (err! "Found more than one class" cs)))) + +(defns- analyze-seq|dot + [env ::env, [_ _, target-form _, ?method-or-field _ & ?args _ :as form] _] + (let [target (analyze* env target-form) + method-or-field (if (symbol? ?method-or-field) ?method-or-field (first ?method-or-field)) + ;; To get around a weird behavior in `ufeval/macroexpand` in which e.g. `uncheckedLongCast` + ;; becomes `clojure.core/uncheckedLongCast` + method-or-field (-> method-or-field name symbol) + args-forms (if (symbol? ?method-or-field) ?args (rest ?method-or-field))] + (if (t/= (:type target) t/nil?) + (err! "Cannot use the dot operator on a target of nil type." {:form form}) + (let [;; `nilable?` because technically any non-primitive in Java is nilable and we can't + ;; necessarily rely on all e.g. "@nonNull" annotations + {:as ?target-static-class-map + target-static-class :class + target-static-class-nilable? :nilable?} + (-> target :type t/type>?class-value) + target-classes + (if ?target-static-class-map + (cond-> #{target-static-class} target-static-class-nilable? (conj nil)) + (-> target :type t/type>classes)) + target-class (classes>class target-classes)] + (if-let [target-class-nilable? (contains? target-classes nil)] + (err! "Cannot use the dot operator on a target that might be nil." + {:form form :target-type (:type target)}) + (if-let [field (and (empty? args-forms) + (-> target-class class>fields|with-cache + (uc/get (name method-or-field))))] + (analyze-seq|dot|field-access env form target method-or-field field) + (analyze-seq|dot|method-call env form target target-class + (boolean ?target-static-class-map) method-or-field args-forms))))))) + +;; TODO this is not the right approach for CLJS +(defns- analyze-seq|new + [env ::env, [_ _ & [c|form _ & args|form _ :as body] _ :as form] _ > uast/new-node?] + (let [c|analyzed (analyze* env c|form)] + (if-not (and (-> c|analyzed :type t/value-type?) + (-> c|analyzed :type utr/value-type>value class?)) + (err! "Supplied non-class to `new` form" {:form form}) + (let [c (-> c|analyzed :type utr/value-type>value) + constructors (-> c class>constructors|with-cache) + args-ct (count args|form) + constructors-for-ct (->> constructors + (uc/filter (fn [{:keys [^"[Ljava.lang.Object;" arg-classes]}] + (= (alength arg-classes) args-ct))))] + (if (empty? constructors-for-ct) + (err! "No constructors for class match the arg ct" {:class c :args|form args|form}) + (let [{:keys [args|analyzed call-sites]} + (analyze-seq|method-or-constructor-call|incrementally-analyze env form c + args|form constructors-for-ct "constructors")] + (uast/new-node + {:env env + :unanalyzed-form form + :form (list* 'new c|form (map :form args|analyzed)) + :class c + :args args|analyzed + :type (t/maybe-look-up-type-from-class c)}))))))) + +;; TODO move this +(defns truthy-node? [{:as ast t [:type _]} _ > (t/? t/boolean?)] + (ifs (or (t/= t t/nil?) (t/= t t/false?)) false + (or (t/> t t/nil?) (t/> t t/false?)) nil ; representing "unknown" + true)) + +;; TODO this should be adding analysis information on every predicate it finds to be true or not true +(defns- analyze-seq|if + "Performs conditional branch pruning." + [env ::env, [_ _ & [pred-form _, true-form _, false-form _ :as body] _ :as form] _ + > uast/node?] + (if-not (<= 2 (count body) 3) + (err! "`if` accepts exactly 3 arguments: one predicate test and two branches; received" + {:body body}) + (let [pred-node (analyze* env pred-form) + true-node (delay (analyze* env true-form)) + false-node (delay (analyze* env false-form)) + whole-node + (delay + (uast/if-node + {:env env + :unanalyzed-form form + :form (list 'if (:form pred-node) (:form @true-node) (:form @false-node)) + :pred-node pred-node + :true-node @true-node + :false-node @false-node + :type (apply t/or (->> [(:type @true-node) (:type @false-node)] + (remove nil?)))}))] + (case (truthy-node? pred-node) + true (do (ulog/ppr :warn "Predicate in `if` node is always true" {:pred pred-form}) + (assoc @true-node :env env)) + false (do (ulog/ppr :warn "Predicate in `if` node is always false" {:pred pred-form}) + (assoc @false-node :env env)) + nil @whole-node)))) + +(defns- analyze-seq|quote [env ::env, [_ _, arg-form _ :as form] _ > uast/quoted?] + (if (-> form count (not= 2)) + (err! "Must supply exactly one input to `quote`" {:form form}) + (uast/quoted env form (t/value arg-form)))) + +(defns- analyze-seq|throw [env ::env, [_ _, arg-form _ :as form] _ > uast/throw-node?] + (if (-> form count (not= 2)) + (err! "Must supply exactly one input to `throw`" {:form form}) + (let [arg|analyzed (analyze* env arg-form)] + ;; TODO this is not quite true for CLJS but it's good practice at least + (if-not (-> arg|analyzed :type (t/<= t/throwable?)) + (err! "`throw` requires a throwable; received" + {:arg-form arg-form :type (:type arg|analyzed)}) + (uast/throw-node + {:env env + :unanalyzed-form form + :form (list 'throw (:form arg|analyzed)) + :arg arg|analyzed + ;; `t/none?` because nothing is actually returned + :type t/none?}))))) + +(defns- analyze-seq|var + [env ::env, [_ _, arg-form _ :as form] _ > uast/var?] + (ifs (-> form count (not= 2)) + (err! "Must supply exactly one input to `var`" {:form form}) + (not (symbol? arg-form)) + (err! "`var` accepts a symbol argument" {:form form}) + (let [resolved (uvar/resolve (or (-> env :opts :ns) *ns*) arg-form)] + (ifs (nil? resolved) + (err! "Could not resolve var from symbol" {:symbol arg-form}) + (not (var? resolved)) + (err! "Expected var, but found" {:form form :resolved resolved}) + (uast/var* env (list 'var (uid/>symbol resolved)) resolved (t/value resolved)))))) + +(defn- filter-dynamic-dispatchable-overload-types + "An example of dynamic dispatch: + - When we call `seq` on an input of type `(t/? (t/isa? java.util.Set))`, direct dispatch will + fail as it is not `t/<=` to any overload (including `t/iterable?` which is the only one under + which `(t/isa? java.util.Set)` falls). + However since all branches of the `t/or` are guaranteed to result in a successful dispatch + (i.e. `t/nil?` and `t/iterable?`) then dynamic dispatch will go forward without an error." + [{:as ret :keys [dispatchable-overload-types-seq]} input|analyzed i caller|node body] + (if-not (-> input|analyzed :type utr/or-type?) + (err! "Cannot currently do a dynamic dispatch on a non-`t/or` input type" + {:input|analyzed input|analyzed}) + (let [or-types (-> input|analyzed :type utr/or-type>args) + {:keys [dispatchable-overload-types-seq' non-dispatchable-or-types]} + (->> dispatchable-overload-types-seq + (reduce + (fn [ret {:as overload :keys [arg-types]}] + (if-let [or-types-that-match + (->> or-types (uc/lfilter #(t/<= % (get arg-types i))) seq)] + (-> ret + (update :dispatchable-overload-types-seq' conj overload) + (update :non-dispatchable-or-types + #(apply disj % or-types-that-match))) + ret)) + {:dispatchable-overload-types-seq' [] + :non-dispatchable-or-types (set or-types)}))] + (if (or (empty? dispatchable-overload-types-seq') + (uc/contains? non-dispatchable-or-types)) + (err! "No overloads satisfy the inputs, whether direct or dynamic" + {:caller caller|node + :inputs body + :failing-input-form (:form input|analyzed) + :failing-input-type (:type input|analyzed)}) + (assoc ret :dispatchable-overload-types-seq dispatchable-overload-types-seq' + :dispatch-type :dynamic))))) + +(defn- filter-direct-dispatchable-overload-types + [{:as ret :keys [dispatchable-overload-types-seq]} input|analyzed i caller|node args-form] + (if-let [dispatchable-overload-types-seq' + (->> dispatchable-overload-types-seq + (uc/lfilter + (fn [{:keys [arg-types]}] + (t/<= (:type input|analyzed) (get arg-types i)))) + seq)] + (assoc ret :dispatchable-overload-types-seq dispatchable-overload-types-seq' + :dispatch-type :direct) + (if (-> caller|node :unanalyzed-form meta :dyn) + (filter-dynamic-dispatchable-overload-types ret input|analyzed i caller|node args-form) + (err! (str "No overloads satisfy the inputs via direct dispatch; " + "dynamic dispatch not requested") + {:caller (select-keys caller|node [:unanalyzed-form :form :type]) + :inputs args-form + :failing-input-form (:form input|analyzed) + :failing-input-type (:type input|analyzed)})))) + +(defn- >dispatch|output-type [dispatch-type dispatchable-overload-types-seq] + (case dispatch-type + :direct (-> dispatchable-overload-types-seq first :output-type) + :dynamic (->> dispatchable-overload-types-seq + (uc/lmap :output-type) + ;; Technically we could do a complex conditional instead of a simple `t/or` but + ;; no need + (apply t/or)))) + +(defns- caller>overload-type-data-for-arity + [env ::env, caller|node uast/node?, caller|type _, inputs-ct _] + ;; FIXME pull name from local binding if not present on type + (if-not-let [fn|name (utr/fn-type>fn-name caller|type)] + (err! "No name found for typed fn corresponding to caller" + (assoc (select-keys caller|node [:unanalyzed-form :form]) :type caller|type)) + (let [overload-types-name (symbol (namespace fn|name) (str (name fn|name) "|__types"))] + (if-let [fn|types-node (get env overload-types-name)] + (->> fn|types-node :value (uc/filter #(-> % :arg-types count (= inputs-ct)))) + (if-not-let [fn|types-var (uvar/resolve (or (-> env :opts :ns) *ns*) overload-types-name)] + (err! "Overload-types not found for typed fn" + {:fn|name fn|name + :caller (assoc (select-keys caller|node [:unanalyzed-form :form]) + :type caller|type)}) + (->> fn|types-var var-get urx/norx-deref :overload-types + (uc/filter #(-> % :arg-types count (= inputs-ct))))))))) + +(def direct-dispatch-method-sym 'invoke) + +(defns- overload-type-datum>reify-name [type-datum _, fn|name symbol? > qualified-symbol?] + (symbol (-> type-datum :ns-name name) (str (name fn|name) "|__" (:id type-datum)))) + +(defn aget* [x i] + #?(:clj (list '. 'clojure.lang.RT 'aget x i) + :cljs (list 'cljs.core/aget x i))) + +(defn aset* [x i v] + #?(:clj (list '. 'clojure.lang.RT 'aset x i v) + :cljs (list 'cljs.core/aset x i v))) + +(defns- >direct-dispatch|reify-call + [caller|node uast/node?, caller|type _, type-datum _, args-codelist (us/seq-of t/any?)] + (if-let [fn|name (utr/fn-type>fn-name caller|type)] + `(. ~(ufth/with-type-hint + (aget* `(. ~(-> fn|name name symbol + (ufth/with-type-hint (ufth/>body-embeddable-tag TypedFn))) + ~'getFs) + (:id type-datum)) + (-> type-datum :interface ufth/>body-embeddable-tag)) + ~direct-dispatch-method-sym ~@args-codelist) + (err! "No name found for typed fn corresponding to caller; cannot create direct dispatch call" + (assoc (select-keys caller|node [:unanalyzed-form :form]) :type caller|type)))) + +(defns- >direct-dispatch + [env ::env, {:as overload-type-datum :keys [arglist-code|hinted _, body-codelist _, inline? _]} _ + caller|node uast/node?, caller|type _, input-nodes (us/vec-of uast/node?)] + (if inline? + ;; TODO abstract this with the `let*` code + (let [bindings-map (reducei (fn [bindings sym i|arg] + (assoc bindings sym (get input-nodes i|arg))) + {} arglist-code|hinted) + ns-val (the-ns (:ns-name overload-type-datum)) + body-node + (analyze* (-> env (merge bindings-map) (update :opts assoc :ns ns-val)) + (list* 'do body-codelist)) + bindings|form + (reducei (fn [bindings to i|arg] + (let [from-node (get input-nodes i|arg) + ;; To avoid "Can't hint a primitive local" errors + to' (cond-> to (-> from-node :type t/primitive-type?) + ufth/un-type-hint)] + (conj bindings to' (:form from-node)))) + [] arglist-code|hinted) + node (uast/let* {:env env + :unanalyzed-form (list* 'let* bindings|form body-codelist) + :form (list* 'let* bindings|form + (->> body-node :body (uc/lmap :form))) + :bindings bindings-map + :body body-node + :type (:type body-node)})] + ;; TODO fix this; apparently it's not enough or maybe `assume` isn't being propagated + (cond-> node (-> overload-type-datum :output-type t/assume?) + (update :type #(t/and % (:output-type overload-type-datum))))) + {:input-nodes input-nodes + :form (>direct-dispatch|reify-call + caller|node caller|type overload-type-datum (uc/map :form input-nodes)) + :type (:output-type overload-type-datum)})) + +(defns- >call-data-with-fnt-dispatch|empty-args + [env ::env, caller|node uast/node?, caller|type _, caller-kind _] + (if (= :fnt caller-kind) + (if-not-let [overload-type-datum + (first (caller>overload-type-data-for-arity env caller|node caller|type 0))] + (err! (str "No overloads satisfy the inputs via direct dispatch; " + "dynamic dispatch not requested") + {:caller (assoc (select-keys caller|node [:unanalyzed-form :form]) :type caller|type) + :inputs []}) + (>direct-dispatch env overload-type-datum caller|node caller|type [])) + ;; We could do a little smarter analysis here but we'll keep it simple for now + {:form (list (:form caller|node)) :input-nodes [] :type t/any?})) + +(defns- >call-data-with-fnt-dispatch + [env ::env, caller|node uast/node?, caller|type _, caller-kind _, inputs-ct _, args-form _] + (if (zero? inputs-ct) + (>call-data-with-fnt-dispatch|empty-args env caller|node caller|type caller-kind) + (->> args-form + (uc/map+ #(analyze* env %)) + (reducei + (fn [{:as ret :keys [dispatch-type]} input|analyzed i] + (let [last-input? (= i (dec inputs-ct))] + (if (= :fnt caller-kind) + (let [{:as ret' + :keys [dispatchable-overload-types-seq dispatch-type input-nodes]} + (-> (case dispatch-type + :direct (filter-direct-dispatchable-overload-types + ret input|analyzed i caller|node args-form) + :dynamic (filter-dynamic-dispatchable-overload-types + ret input|analyzed i caller|node args-form)) + (update :input-nodes conj input|analyzed))] + (if last-input? + (if (= dispatch-type :direct) + (>direct-dispatch env (first dispatchable-overload-types-seq) + caller|node caller|type input-nodes) + (-> ret' + (assoc :form (list* (:form caller|node) + (uc/lmap :form input-nodes)) + :type (>dispatch|output-type dispatch-type + dispatchable-overload-types-seq)) + (dissoc :caller|node :dispatch-type + :dispatchable-overload-types-seq))) + ret')) + (let [{:as ret' :keys [input-nodes]} + (update ret :input-nodes conj input|analyzed)] + (cond-> ret' last-input? + (assoc :form (list* (:form caller|node) (uc/lmap :form input-nodes)))))))) + {:input-nodes [] + ;; We could do a little smarter analysis here but we'll keep it simple for now + :type (when-not (= :fnt caller-kind) t/any?) + :caller|node caller|node + :dispatch-type :direct + :dispatchable-overload-types-seq + (when (= :fnt caller-kind) + (caller>overload-type-data-for-arity env caller|node caller|type inputs-ct))})))) + +(defns- analyze-seq|dependent-type-call + [env ::env, [caller|form _, & args-form _ :as form] _ > uast/node?] + (if (and (-> caller|form name (= "type")) + (-> args-form count (not= 1))) + (err! "Incorrect number of args passed to dependent type call" + {:form form :args-ct (count args-form)}) + (let [arg-nodes (->> args-form (mapv #(analyze* env %))) + caller|node (analyze* env caller|form) + caller|t (-> arg-nodes first :type) + unvalued-arg-types (->> arg-nodes rest (map :type) (map t/unvalue)) + _ (uref/set! !!dependent? true) + t (case (name caller|form) + "input-type" (if (-> env :opts :split-types?) + (t/input|meta-or caller|t unvalued-arg-types) + (t/input|or caller|t unvalued-arg-types)) + "output-type" (if (-> env :opts :split-types?) + (t/output|meta-or caller|t unvalued-arg-types) + (t/output|or caller|t unvalued-arg-types)) + "type" caller|t)] + (uast/call-node + {:env env + :unanalyzed-form form + :form (if (utr/rx-type? t) form (uform/>form t)) + :caller caller|node + :args arg-nodes + :type (t/value t)})))) + +(defns- apply-arg-type-combine [combinef fn?, input-nodes _ > t/value-type?] + (->> input-nodes + (uc/map+ :type) + (uc/map+ t/unvalue) + ur/join + (apply combinef) + t/value)) + +;; TODO this is probably not a great way to do this; rethink this +;; Maybe it would work more cleanly if we added the `::t/type` metadata to each `t/` operator after +;; the fact? +(defns- handle-type-combinators + [caller|node uast/node?, input-nodes _, output-type t/type? > t/type?] + (condp = (:type caller|node) + ;; TODO this relies on spec instrumentation not happening for these fns + (t/value t/isa?) (apply-arg-type-combine t/isa? input-nodes) + (t/value t/value) (apply-arg-type-combine t/value input-nodes) + (t/value t/or) (apply-arg-type-combine t/or input-nodes) + (t/value t/and) (apply-arg-type-combine t/and input-nodes) + (t/value t/-) (apply-arg-type-combine t/- input-nodes) + (t/value t/?) (apply-arg-type-combine t/? input-nodes) + (t/value t/ftype) (apply-arg-type-combine t/ftype input-nodes) + (t/value t/run) (apply-arg-type-combine t/run input-nodes) + (t/value t/ref) (apply-arg-type-combine t/ref input-nodes) + (t/value t/unref) (apply-arg-type-combine t/unref input-nodes) + (t/value t/assume) (apply-arg-type-combine t/assume input-nodes) + (t/value t/unassume) (apply-arg-type-combine t/unassume input-nodes) + output-type)) + +(defns- analyze-seq|call + [env ::env, [caller|form _ & args-form _ :as form] _ > uast/node?] + (let [caller|node (analyze* env caller|form) + caller|type (:type caller|node) + ;; We just `norx-deref` the `caller|type` primarily for `t/defn`s but it could be unsafe + ;; TODO assess what will happen if we reactively derefed. It's currently being derefed in an + ;; interceptor on `!overload-types`. If it were reactively derefed then I believe it + ;; would make it so every time any `t/defn` function was even mentioned in a body, if + ;; any of those `t/defn`s changed whatsoever, the body would be re-analyzed and + ;; overloads would be re-created (though currently it only checks whether the input + ;; or output types have changed... not things in the body). + caller|type (cond-> caller|type (utr/rx-type? caller|type) urx/norx-deref) + inputs-ct (count args-form)] + ;; TODO fix this line of code and extend t/compare so the comparison checks below will + ;; work with t/fn + (case (if (utr/fn-type? caller|type) + -1 + (t/compare caller|type t/callable?)) + (1 2) (err! "It is not known whether form can be called" + {:node (select-fields-for-print caller|node)}) + 3 (err! "Form cannot be called" {:node (select-fields-for-print caller|node)}) + (-1 0) (let [caller-kind + (ifs (utr/fn-type? caller|type) :fnt + (t/<= caller|type t/keyword?) :keyword + (t/<= caller|type t/+map|built-in?) :map + (t/<= caller|type t/+vector|built-in?) :vector + (t/<= caller|type t/+set|built-in?) :set + (t/<= caller|type t/fn?) :fn + (t/<= caller|type t/type?) :type + ;; If it's callable but not fn, we might have missed something in + ;; this dispatch so for now we throw + (err! "Don't know how how to handle non-fn callable" + {:caller (select-fields-for-print caller|node)})) + _ (when (= caller-kind :type) (ulog/pr :warn "need to handle type call better")) + assert-valid-inputs-ct + (case caller-kind + (:keyword :map) + (when-not (or (= inputs-ct 1) (= inputs-ct 2)) + (err! (str "Keywords and `clojure.core` persistent maps must be " + "provided with exactly one or two inputs when calling " + "them") + {:inputs-ct inputs-ct + :caller (select-fields-for-print caller|node)})) + (:vector :set) + (when-not (= inputs-ct 1) + (err! (str "`clojure.core` persistent vectors and `clojure.core` " + "persistent sets must be provided with exactly one " + "input when calling them") + {:inputs-ct inputs-ct + :caller (select-fields-for-print caller|node)})) + :type + (when-not (= inputs-ct 1) + (err! "Types must be provided with exactly one input when calling them" + {:inputs-ct inputs-ct + :caller (select-fields-for-print caller|node)})) + :fnt + (when-not (-> caller|type utr/fn-type>arities (contains? inputs-ct)) + (err! "Unhandled number of inputs for fnt" + {:inputs-ct inputs-ct + :caller (select-fields-for-print caller|node)})) + ;; TODO use the `reflect/reflect` and `js/Object.getOwnPropertyNames` trick + :fn nil) + {:as call-data :keys [input-nodes] analyzed-form :form} + (>call-data-with-fnt-dispatch + env caller|node caller|type caller-kind inputs-ct args-form)] + (if (uast/node? call-data) ; in the case of an inline expansion + call-data + (uast/call-node + {:env env + :unanalyzed-form form + :form analyzed-form + :caller caller|node + :args input-nodes + :type (if (-> env :opts :arglist-context?) + (handle-type-combinators + caller|node input-nodes (:type call-data)) + (:type call-data))})))))) + +(defns- analyze-seq* + "Analyze a seq after it has been macro-expanded. + The ->`form` is post- incremental macroexpansion." + [env ::env, [caller|form _ & body _ :as form] _, expanded-caller-sym symbol? > uast/node?] + (case expanded-caller-sym + . (analyze-seq|dot env form) + (quantum.core.type/def quantum.untyped.core.type.defnt/def) + (TODO "t/def" {:form form}) + def (TODO "def" {:form form}) + deftype* (TODO "deftype*" {:form form}) + do (analyze-seq|do env form) + ;; To avoid having to re-analyze + (quantum.core.type/dotyped quantum.untyped.core.type.defnt/dotyped) + (analyze-seq|do env (list* 'do (rest form))) + fn* (TODO "fn*" {:form form}) + (quantum.core.type.defnt/fn quantum.untyped.core.type.defnt/fn) + (@!!analyze-fnt env form) + (quantum.core.type.defnt/defn quantum.untyped.core.type.defnt/defn) + (@!!analyze-defnt env form) + if (analyze-seq|if env form) + let* (analyze-seq|let* env form) + new (analyze-seq|new env form) + quote (analyze-seq|quote env form) + reify* (TODO "reify" {:form form}) ; NOTE only for CLJ + set! (TODO "set!" {:form form}) + throw (analyze-seq|throw env form) + try (TODO "try" {:form form}) + var (analyze-seq|var env form) + (if (-> env :opts :arglist-context?) + (if-let [caller-form-dependent-type-call? + (case expanded-caller-sym + (quantum.core.type/type + quantum.untyped.core.type/type + quantum.core.type/input-type + quantum.untyped.core.type/input-type + quantum.core.type/output-type + quantum.untyped.core.type/output-type) true + false)] + (analyze-seq|dependent-type-call env form) + (analyze-seq|call env form)) + (analyze-seq|call env form)))) + +(defns- analyze-seq [env ::env, form _] + (let [ns-val (or (-> env :opts :ns) *ns*) + caller|form (first form) + expanded-caller-sym (if (symbol? caller|form) + (or (some->> caller|form (uvar/resolve ns-val) uid/>symbol) + caller|form) + caller|form) + expanded-form (case expanded-caller-sym + (quantum.core.type.defnt/dotyped + quantum.untyped.core.type.defnt/dotyped + quantum.core.type.defnt/fn + quantum.untyped.core.type.defnt/fn + quantum.core.type.defnt/defn + quantum.untyped.core.type.defnt/defn) + form ; will be analyzed in `analyze-seq*` + (binding [*ns* ns-val] + (ufeval/macroexpand form)))] + (if-let [no-expansion? (ucomp/== form expanded-form)] + (analyze-seq* env expanded-form expanded-caller-sym) + (let [expanded-form' (cond-> expanded-form + (uvar/with-metable? expanded-form) (update-meta merge (meta form))) + expanded (analyze* env expanded-form')] + (uast/macro-call + {:env env + :unexpanded-form form + :unanalyzed-form expanded-form' + :form (:form expanded) + :expanded expanded + :type (:type expanded)}))))) + +(defns- ?resolve + [env ::env, sym symbol? > (us/nilable (us/kv {:resolved some? :resolved-via keyword?}))] + (if-let [[_ local] (or (find env sym) + (and (-> env :opts :arglist-context?) + (-> env :opts :arg-env deref (find sym))))] + {:resolved local :resolved-via :env} + (if-let [resolved (uvar/resolve (or (-> env :opts :ns) *ns*) sym)] + {:resolved resolved :resolved-via :resolve} + (when (some->> sym namespace symbol (uvar/resolve (or (-> env :opts :ns) *ns*)) class?) + {:resolved (analyze-seq|dot + env (list '. (-> sym namespace symbol) (-> sym name symbol))) + :resolved-via :dot})))) + +(defns- analyze-symbol|arglist-context + "Handles forward dependent-type dependencies e.g. `[a (type b) b t/any?]`" + [env ::env form symbol?] + (l/if-let [_ (-> env :opts :arglist-context?) + arg-type-form (-> env :opts :arg-sym->arg-type-form (get form))] + (let [env' {:opts (update (:opts env) :arglist-syms|queue + (fn [q] + (if (contains? q form) + (err! "Cyclic dependency between two input types" + {:dependent-sym (uc/last q) + :dependent-type-form + (-> env :opts :arg-sym->arg-type-form (get (uc/last q))) + :dependee-sym form + :dependee-type-form arg-type-form}) + (conj q form))))} + result (analyze-arg-syms* env')] + ;; We need to propagate the result upward and this is arguably the cleanest control flow + ;; mechanism to do it, sadly + (err! ::arg-syms-analyzed "All arg syms analyzed" {:result result})) + (err! "Could not resolve symbol" {:sym form}))) + +(defns- analyze-symbol + "Analyzes vars as if their value is constant, unless they're marked as dynamic." + [env ::env, form symbol? > uast/symbol?] + (if-not-let [{:keys [resolved resolved-via]} (?resolve env form)] + (analyze-symbol|arglist-context env form) + (let [node (case resolved-via + (:env :dot) resolved + :resolve + (if (var? resolved) + (let [form (list 'var (uid/>symbol resolved))] + (if (uvar/dynamic? resolved) + (uast/var* env form resolved (t/value resolved)) + (let [v (var-get resolved)] + (uast/var-value env form v + (or (-> resolved meta :quantum.core.type/type) (t/value v)))))) + (uast/class-value env (uid/>symbol resolved) resolved)))] + (ifs (uast/symbol? node) + (assoc node :env env) + (uast/class-value? node) + ;; To avoid unnecessary type hint + (quantum.untyped.core.analyze.ast.Symbol. env form node (:type node)) + (uast/symbol env form node (:type node)))))) + +(defns- analyze* [env ::env, form _ > uast/node?] + (when (> (uref/get (uref/update! !!analyze-depth inc)) 500) + (throw (ex-info "Stack too deep" {:form form}))) + (ifs (symbol? form) (analyze-symbol env form) + (t/literal? form) (uast/literal env form (t/value form)) + (vector? form) (analyze-vector env form) + (set? form) (analyze-set env form) + (map? form) (analyze-map env form) + (seq? form) (analyze-seq env form) + (throw (ex-info "Unrecognized form" {:form form})))) + +(defns analyze + "`env` consists of a map from simple symbol to `uast/node?`, with one exception: `env` admits one + optional key that is not a symbol: `:opts`. The reason `:opts` exists on the `env` map is that + analyzer functions may need to return updated opts or metadata and it is cleaner to put it on the + env map rather than on the AST nodes themselves. + + The `:opts` map may include: + - :arglist-context? : p/boolean? + : If you use `analyze-arg-syms` you won't have to set this yourself. + : When this is enabled, each AST node is tagged with additional + : information about dependent type analysis, namely: + : - :arglist-syms|queue : (dc/set-of id/simple-symbol?) + : - :arglist-syms|unanalyzed : (dc/set-of id/simple-symbol?) + - :arg-sym->arg-type-form : (dc/map-of id/simple-symbol? t/any?) + : If you use `analyze-arg-syms` you won't have to set this yourself. + - :arglist-syms|queue : (dc/set-of id/simple-symbol?) + : If you use `analyze-arg-syms` you won't have to set this yourself. + - :arglist-syms|unanalyzed : (dc/set-of id/simple-symbol?) + : If you use `analyze-arg-syms` you won't have to set this yourself. + + Special metadata directives are defined in `special-metadata-keys`. They include: + - `:val` : Causes the analyzer to assume that the return value of the dot-form satisfies + `t/val?`. Useful for doing method/dot-chaining in which the methods return + non-primitives." + > uast/node? + ([form _] (analyze {} form)) + ([env ::env, form _] + (uref/set! !!analyze-depth 0) + (binding [*analyzing?* true] (analyze* env form)))) + +;; ===== Arglist analysis ===== ;; + +(us/def ::arg-sym->arg-type-form (us/map-of simple-symbol? t/any?)) + +(def analyze-arg-syms|max-iter 10000) + +;; TODO excise +(defn pr! [x] + (binding [quantum.untyped.core.analyze.ast/*print-env?* false + quantum.untyped.core.print/*collapse-symbols?* true + *print-meta* true + *print-level* 20] + (quantum.untyped.core.print/ppr x))) + +(defn pr-no-meta! [x] + (binding [quantum.untyped.core.analyze.ast/*print-env?* false + quantum.untyped.core.print/*collapse-symbols?* true + *print-meta* false + *print-level* 20] + (quantum.untyped.core.print/ppr x))) + +#?(:clj +(uvar/def sort-guide "for use in arglist sorting, in increasing conceptual (and bit) size" + {t/nil? 0 + t/boolean? 1 + t/byte? 2 + t/short? 3 + t/char? 4 + t/int? 5 + t/long? 6 + t/float? 7 + t/double? 8 + t/object? 9})) + +;; TODO move? +(defns type>split + "Only `t/or`s and `t/meta-or`s are splittable for now. + Reactive types are non-reactively derefed in order to make splitting possible." + [t t/type? > (us/vec-of t/type?)] + (let [t' (cond-> t (utr/rx-type? t) urx/norx-deref)] + (ifs (utr/or-type? t') (utr/or-type>args t') + ;; TODO determine if this is the appropriate place to deal with `t/none?` + (utr/meta-or-type? t') (->> t' utr/meta-or-type>types (uc/remove (fn1 t/= t/none?))) + [t']))) + +(defns type>split+primitivized [t t/type? > (us/vec-of t/type?)] + (let [t|norx (cond-> t (utr/rx-type? t) urx/norx-deref) + t|split (type>split t|norx) + primitive-subtypes + (->> t|split + (uc/map+ #(t/type>primitive-subtypes % false)) + (ur/educe uset/union) + (sort-by sort-guide))] ; For cleanliness and reproducibility in tests + (uc/distinct (concat primitive-subtypes t|split)))) + +(defn- enqueue-first-unanalyzed-if-queue-empty [env #_::env #_> #_::env] + (cond-> env + (-> env :opts :arglist-syms|queue empty?) + (update-in [:opts :arglist-syms|queue] conj + (-> env :opts :arglist-syms|unanalyzed first)))) + +(defn- analyze-arg-syms* [env #_::env] + (uref/update! !!analyze-arg-syms|iter inc) + (let [{:keys [arg-sym->arg-type-form arglist-syms|queue arglist-syms|unanalyzed + output-type-or-form split-types?]} (:opts env)] + (ifs (empty? arglist-syms|unanalyzed) + [{:env env + :output-type-node (if (t/type? output-type-or-form) + (uast/literal env nil output-type-or-form) ; a simulated AST node + (-> (analyze env output-type-or-form) + (update :type (fn-> t/unvalue urx/?norx-deref)))) + :dependent? (uref/get !!dependent?)}] + (>= (uref/get !!analyze-arg-syms|iter) analyze-arg-syms|max-iter) + (err! "Max number of iterations reached for `analyze-arg-syms`" + {:n (uref/get !!analyze-arg-syms|iter)}) + (let [_ (assert (not (empty? arglist-syms|queue))) + arg-sym (uc/last arglist-syms|queue) + arg-type-form (arg-sym->arg-type-form arg-sym) + analyzed (-> (analyze env arg-type-form) (update :type t/unvalue)) + env-analyzed (-> analyzed :env + (update-in [:opts :arglist-syms|queue] disj arg-sym) + (update-in [:opts :arglist-syms|unanalyzed] disj arg-sym)) + t-split (if split-types? + (-> analyzed :type type>split+primitivized) + [(:type analyzed)])] + (if (-> t-split count (= 1)) + (recur (-> env-analyzed + (update-in [:opts :arg-env] + #(doto % (swap! assoc arg-sym (assoc analyzed :type (first t-split))))) + enqueue-first-unanalyzed-if-queue-empty)) + (->> t-split + (uc/mapcat+ + (fn [t] + (analyze-arg-syms* + (-> env-analyzed + enqueue-first-unanalyzed-if-queue-empty + (update-in [:opts :arg-env] + ;; `(atom (deref %))` in order to create a new env for a new split + #(-> % deref atom + (doto (swap! assoc arg-sym (assoc analyzed :type t))))))))) + ur/join)))))) + +(defns- >analyze-arg-syms|opts + [env ::env, arg-sym->arg-type-form ::arg-sym->arg-type-form, output-type-or-form _ + split-types? boolean?] + {:arglist-context? true + :arglist-syms|queue (uset/ordered-set (-> arg-sym->arg-type-form keys first)) + :arglist-syms|unanalyzed (-> arg-sym->arg-type-form keys set) + :arg-env (atom env) ; Mutable so it can cache + :arg-sym->arg-type-form arg-sym->arg-type-form + :output-type-or-form output-type-or-form + :split-types? split-types?}) + +(defns analyze-arg-syms + "`dependent?` denotes whether any of of the arg-types or output-type use dependent types. + + Performance characteristics: + - While an internally recursive function, the maximum stack depth is the number of arguments in + the provided arglist. + - The maximum number of generated arglists is equal to the product of the cardinalities of the + deduced types of the inputs. In other words, in the worst case scenario each of the arg types + might be a 'splittable' type like `t/or` (whose cardinality is the number of arguments to it + when simplified) which would require a Cartesian product of the splits of the arg types." + > vector? #_(us/vec-of (us/kv {:env ::env :output-type-node uast/node? :dependent? boolean?})) + ([arg-sym->arg-type-form ::arg-sym->arg-type-form, output-type-or-form _] + (analyze-arg-syms {} arg-sym->arg-type-form output-type-or-form true)) + ([arg-sym->arg-type-form ::arg-sym->arg-type-form, output-type-or-form _, split-types? boolean?] + (analyze-arg-syms {} arg-sym->arg-type-form output-type-or-form split-types?)) + ([env ::env, arg-sym->arg-type-form ::arg-sym->arg-type-form, output-type-or-form _ + split-types? boolean? + > (us/vec-of (us/kv {:env ::env :output-type-node uast/node?}))] + (uref/set! !!analyze-arg-syms|iter 0) + (uref/set! !!dependent? false) + (try (binding [*analyzing?* true] + (analyze-arg-syms* + {:opts (merge (:opts env) + (>analyze-arg-syms|opts env arg-sym->arg-type-form output-type-or-form + split-types?))})) + (catch Throwable t + (if (and (uerr/error-map? t) (-> t :ident (= ::arg-syms-analyzed))) + (-> t :data :result) + (throw t)))))) diff --git a/src-untyped/quantum/untyped/core/analyze/ast.cljc b/src-untyped/quantum/untyped/core/analyze/ast.cljc index 48956e8b..fe5cdfc2 100644 --- a/src-untyped/quantum/untyped/core/analyze/ast.cljc +++ b/src-untyped/quantum/untyped/core/analyze/ast.cljc @@ -2,144 +2,433 @@ "Facilities for creating AST nodes (for now, just for Clojure). No actual analysis is done here." (:refer-clojure :exclude - [symbol Symbol #?(:cljs ->Symbol) symbol? - == - unbound?]) + [== symbol Symbol #?(:cljs ->Symbol) symbol? unbound? var var?]) (:require - [quantum.untyped.core.compare :as comp + [quantum.untyped.core.analyze.expr :as uxp] + [quantum.untyped.core.compare :as comp :refer [==]] - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.type :as t])) + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.form + :refer [>form]] + [quantum.untyped.core.form.type-hint :as ufth] + [quantum.untyped.core.type :as t] + [quantum.untyped.core.type.reifications :as utr])) (ucore/log-this-ns) -(do +(def ^:dynamic ^{:doc "Controls whether `:env` is printed on AST nodes."} *print-env?* true) -;; ===== CONSTITUENT SPECS ===== ;; +(defn std-print-structure [record] + (cond-> (into (array-map) record) (not *print-env?*) (dissoc :env))) + +(defn >type-hint + "Applied on every `form` of every AST node created in order to avoid reflection wherever + possible." + [form t] + (if (or (not (t/with-metable? form)) + (utr/fn-type? t) + (utr/rx-type? t) + ;; TODO for now + (uxp/iexpr? t)) + nil + (let [cs (cond-> (t/type>classes t) (t/type-ref? t) (conj nil))] + (case (count cs) + 1 (let [c (first cs)] + (when-let [not-primitive? (not (contains? t/boxed-class->unboxed-symbol c))] + (ufth/>body-embeddable-tag c))) + 2 (when (contains? cs nil) + (-> cs (disj nil) first ufth/>body-embeddable-tag)) + nil)))) + +(defn with-type-hint [node] + (if-let [type-hint (>type-hint (:form node) (:type node))] + (-> node + (update :form ufth/with-type-hint type-hint) + (cond-> (contains? node :unexpanded-form) + (update :unexpanded-form ufth/with-type-hint type-hint))) + node)) + +;; ===== Constituent types ===== ;; (#?(:clj definterface :cljs defprotocol) INode (getForm [#?(:cljs this)]) - (getSpec [#?(:cljs this)])) + (getType [#?(:cljs this)])) (defn node? [x] (instance? INode x)) #_(t/def ::node (t/isa? INode)) -#_(t/def ::env (t/map-of t/symbol? ::node)) +#_(t/def ::env (t/map-of symbol? ::node)) -;; ===== NODES ===== ;; +;; ===== Nodes ===== ;; -(defrecord Unbound [env #_::env, form #_t/symbol?, minimum-spec #_t/spec?, spec #_t/spec?] ;; TODO `spec` should be `t/deducible-spec?` +;; Does not include unbound vars; this is specifically for arguments +(defrecord Unbound + [env #_::env + form #_symbol? + minimum-type #_t/type? + type #_t/type?] ;; TODO should be `t/deducible-type?` INode fipp.ednize/IOverride fipp.ednize/IEdn - (-edn [this] (list `unbound form {:minimum minimum-spec :deduced spec}))) + (-edn [this] (list `unbound (std-print-structure this)))) (defn unbound - ([form spec] (unbound nil form spec)) - ([env form spec] (Unbound. env form spec spec))) ; TODO should wrap second `spec` in `t/deducible` + ([form t] (unbound nil form t)) + ;; TODO should wrap second `t` in `t/deducible` + ([env form t] (Unbound. env (ufth/with-type-hint form (>type-hint form t)) t t))) (defn unbound? [x] (instance? Unbound x)) -(defrecord Literal [env #_::env, form #_::t/literal, spec #_::t/spec] +(defrecord + ^{:doc "AST node whose `type` is `(t/value form)`."} + Literal [env #_::env, unanalyzed-form #_t/literal?, form #_form?, type #_t/type?] INode fipp.ednize/IOverride fipp.ednize/IEdn - (-edn [this] (list `literal form spec))) + (-edn [this] (list `literal (std-print-structure this)))) (defn literal - ([form spec] (literal nil form spec)) - ([env form spec] (Literal. env form spec))) + ([form t] (literal nil form t)) + ([env form t] + (let [form' (>form form)] + (Literal. env form (ufth/with-type-hint form' (>type-hint form' t)) t)))) + +(defn literal? [x] (instance? Literal x)) + +(defrecord VectorNode + [env #_::env + unanalyzed-form #_::t/form + form #_::t/form + nodes #_(s/seq-of node?) + type #_t/type?] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `vector-node (std-print-structure this)))) + +(defn vector-node [m] (map->VectorNode m)) + +(defn vector-node? [x] (instance? VectorNode x)) + +(defrecord MapNode + [env #_::env + unanalyzed-form #_::t/form + form #_::t/form + nodes #_(s/seq-of (s/tuple node? node?)) + type #_t/type?] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `map-node (std-print-structure this)))) + +(defn map-node [m] (map->MapNode m)) + +(defn map-node? [x] (instance? MapNode x)) + +(defrecord SetNode + [env #_::env + unanalyzed-form #_::t/form + form #_::t/form + nodes #_(s/seq-of node?) + type #_t/type?] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `set-node (std-print-structure this)))) + +(defn set-node [m] (map->SetNode m)) + +(defn set-node? [x] (instance? SetNode x)) + +(defrecord ClassValue [env #_::env, form #_simple-symbol?, value #_t/class?, type #_(t/value value)] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `class-value (std-print-structure this)))) + +(defn class-value + ([form v] (class-value nil form v)) + ([env form v] (ClassValue. env form v (t/value v)))) + +(defn class-value? [x] (instance? ClassValue x)) + +(defrecord + ^{:doc "AST node generated from the value of a non-dynamic var. + The `type` may not always be `(t/value value)` because in the case of e.g. `t/defn`s, + their corresponding var value may just be a `core/defn`, but the type of the `t/defn` is + annotated in the var's metadata."} + VarValue + [env #_::env + form #_qualified-symbol? + value #_t/any? + type #_t/type?] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `var-value (std-print-structure this)))) + +(defn var-value + ([form v t] (var-value nil form v t)) + ([env form v t] (VarValue. env (ufth/with-type-hint form (>type-hint form t)) v t))) + +(defn var-value? [x] (instance? VarValue x)) + +(defrecord + ^{:doc "AST node reserved only for dynamic vars."} + Var + [env #_::env + form ; (list 'var ) + value #_core/var? + type #_t/type?] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `var* (std-print-structure this)))) + +(defn var* + ([form value t] (var* nil form value t)) + ([env form value t] (Var. env form value t))) + +(defn var? [x] (instance? Var x)) (defrecord Symbol [env #_::env - form #_t/symbol? - spec #_::t/spec] + form #_id/symbol? + node #_t/any? + type #_t/type?] INode fipp.ednize/IOverride fipp.ednize/IEdn - (-edn [this] (list `symbol (into (array-map) this)))) + (-edn [this] (list `symbol (std-print-structure this)))) (defn symbol - ([form spec] (symbol nil form spec)) - ([env form spec] (Symbol. env form spec))) + ([form node t] (symbol nil form node t)) + ([env form node t] (Symbol. env (ufth/with-type-hint form (>type-hint form t)) node t))) (defn symbol? [x] (instance? Symbol x)) -;; ===== SPECIAL CALLS ===== ;; +;; ===== Special calls ===== ;; (defrecord Quoted - [env #_::env, form #_::t/form, spec #_::t/spec] + [env #_::env, form #_::t/form, type #_t/type?] INode fipp.ednize/IOverride fipp.ednize/IEdn - (-edn [this] (list `quoted form spec))) + (-edn [this] (list `quoted (std-print-structure this)))) + +(defn quoted + ([form t] (quoted nil form t)) + ([env form t] (Quoted. nil (ufth/with-type-hint form (>type-hint form t)) t))) -(defn quoted [form spec] (Quoted. nil form spec)) +(defn quoted? [x] (instance? Quoted x)) (defrecord Let* - [env #_::env - form #_::t/body - bindings #_::env - body #_(t/and t/sequential? t/indexed? (t/every? ::node)) - spec #_::t/spec] + [env #_::env + unanalyzed-form #_::t/form + form #_::t/body + bindings #_::env + body #_(t/and t/sequential? t/indexed? (t/every? ::node)) + type #_t/type?] INode fipp.ednize/IOverride fipp.ednize/IEdn - (-edn [this] (list `let* (into (array-map) this)))) + (-edn [this] (list `let* (std-print-structure this)))) + +(defn let* [m] (-> m map->Let* with-type-hint)) -(defn let* [m] (map->Let* m)) +(defn let*? [x] (instance? Let* x)) (defrecord Do - [env #_::env - form #_::t/form - body #_(t/and t/sequential? t/indexed? (t/every? ::node)) - spec #_::t/spec] + [env #_::env + unanalyzed-form #_::t/form + form #_::t/form + body #_(t/and t/sequential? t/indexed? (t/every? ::node)) + type #_t/type?] INode fipp.ednize/IOverride fipp.ednize/IEdn - (-edn [this] (list `do (into (array-map) this)))) + (-edn [this] (list `do (std-print-structure this)))) + +(defn do [m] (-> m map->Do with-type-hint)) -(defn do [m] (map->Let* m)) +(defn do? [x] (instance? Do x)) (defrecord MacroCall - [env #_::env - form #_::t/form - expanded #_::node - spec #_::t/spec] + [env #_::env + unexpanded-form #_::t/form ; the original form + unanalyzed-form #_::t/form ; the expanded-once form, pre-analysis + form #_::t/form ; the *fully* expanded form, post-analysis + expanded #_::node + type #_t/type?] INode fipp.ednize/IOverride fipp.ednize/IEdn - (-edn [this] (list `macro-call (into (array-map) this)))) + (-edn [this] (list `macro-call (std-print-structure this)))) -(defn macro-call [m] (-> m map->MacroCall (assoc :spec (-> m :expanded :spec)))) +(defn macro-call [m] (-> m map->MacroCall with-type-hint)) + +(defn macro-call? [x] (instance? MacroCall x)) + +(defrecord IfNode + [env #_::env + unanalyzed-form #_::t/form + form #_::t/form + pred-node #_::node + true-node #_::node + false-node #_::node + type #_t/type?] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `if-node (std-print-structure this)))) + +(defn if-node [m] (-> m map->IfNode with-type-hint)) + +(defn if-node? [x] (instance? IfNode x)) ;; ===== RUNTIME CALLS ===== ;; (defrecord FieldAccess - [env #_::env - form #_::t/form - target #_::node - field #_t/unqualified-symbol? - spec #_::t/spec] + [env #_::env + unanalyzed-form #_::t/form + form #_::t/form + target #_::node + field #_unqualified-symbol? + type #_t/type?] INode fipp.ednize/IOverride fipp.ednize/IEdn - (-edn [this] (list `field-access (into (array-map) this)))) + (-edn [this] (list `field-access (std-print-structure this)))) +;; Not type hinted because it's inferred (defn field-access [m] (map->FieldAccess m)) +(defn field-access? [x] (instance? FieldAccess x)) + (defrecord MethodCall - [env #_::env - form #_::t/form - target #_::node - method #_::t/unqualified-symbol? - args #_(t/and t/sequential? t/indexed? (t/every? ::node)) - spec #_::t/spec] + [env #_::env + unanalyzed-form #_::t/form + form #_::t/form + target #_::node + method #_::unqualified-symbol? + args #_(t/and t/sequential? t/indexed? (t/seq-and ::node)) + type #_t/type?] INode fipp.ednize/IOverride fipp.ednize/IEdn - (-edn [this] (list `method-call (into (array-map) this)))) + (-edn [this] (list `method-call (std-print-structure this)))) +;; Not type hinted because it's inferred (defn method-call [m] (map->MethodCall m)) -) +(defn method-call? [x] (instance? MethodCall x)) + +(defrecord CallNode ; by a `t/callable?` + [env #_::env + unanalyzed-form #_::t/form + form #_::t/form + caller #_::node + args #_(t/and t/sequential? t/indexed? (t/seq-and ::node)) + type #_t/type?] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `call-node (std-print-structure this)))) + +(defn call-node [m] (-> m map->CallNode with-type-hint)) + +(defn call-node? [x] (instance? CallNode x)) + +(defrecord NewNode + [env #_::env + unanalyzed-form #_::t/form + form #_::t/form + class #_t/class? + args #_(t/and t/sequential? t/indexed? (t/seq-and ::node)) + type #_t/type?] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `new-node (std-print-structure this)))) + +;; Not type hinted because it's inferred +(defn new-node [m] (map->NewNode m)) + +(defn new-node? [x] (instance? NewNode x)) + +(defrecord ThrowNode + [env #_::env + unanalyzed-form #_::t/form + form #_::t/form + arg #_::node + type #_(t/value t/none?)] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `throw-node (std-print-structure this)))) + +;; Not type hinted because there's no point +(defn throw-node [m] (map->ThrowNode m)) + +(defn throw-node? [x] (instance? ThrowNode x)) + +(defrecord TypedFnNode + [env #_::env + unanalyzed-form #_::t/form + name #_simple-symbol? + meta #_meta? + overloads #_(t/vec-of (t/kv {:arg-types (t/vec-of t/type?) + :type t/type? + :body node?})) + form #_::t/form + type #_t/type?] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `fnt-node (std-print-structure this)))) + +;; Not type hinted because it's inferred +(defn fnt-node [m] (map->TypedFnNode m)) + +(defn fnt-node? [x] (instance? TypedFnNode x)) + +(defrecord TypedDefnNode + [env #_::env + unanalyzed-form #_::t/form + name #_simple-symbol? + meta #_meta? + overloads #_(t/vec-of (t/kv {:arg-types (t/vec-of t/type?) + :type t/type? + :body node?})) + form #_::t/form + type #_t/type?] + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `defnt-node (std-print-structure this)))) + +;; Not type hinted because it's inferred +(defn defnt-node [m] (map->TypedDefnNode m)) + +(defn defnt-node? [x] (instance? TypedDefnNode x)) + +(defrecord ExtendTypedDefnNode + [env #_::env + unanalyzed-form #_::t/form + name #_simple-symbol? + meta #_meta? + ;; The extensions, not the original overloads (which data will have been lost) + overloads #_(t/vec-of (t/kv {:arg-types (t/vec-of t/type?) + :type t/type? + :body node?})) + form #_::t/form + type #_t/type?] ; of the extended fn + INode + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (list `defnt-node (std-print-structure this)))) + +;; Not type hinted because it's inferred +(defn extend-defnt-node [m] (map->ExtendTypedDefnNode m)) + +(defn extend-defnt-node? [x] (instance? ExtendTypedDefnNode x)) diff --git a/src-untyped/quantum/untyped/core/analyze/expr.cljc b/src-untyped/quantum/untyped/core/analyze/expr.cljc index 06fc6422..fe96e510 100644 --- a/src-untyped/quantum/untyped/core/analyze/expr.cljc +++ b/src-untyped/quantum/untyped/core/analyze/expr.cljc @@ -1,6 +1,7 @@ (ns quantum.untyped.core.analyze.expr + "An expression is an object whose form is retained and editable to form new objects." (:refer-clojure :exclude - [flatten get ==]) + [flatten ==]) (:require [clojure.core :as core] [quantum.untyped.core.form.generate.deftype :as udt #?@(:cljs [:include-macros true])] ; should be obvious but oh well @@ -10,13 +11,14 @@ :refer [seq-or]] [quantum.untyped.core.compare :refer [== not==]] - [quantum.untyped.core.convert :as uconv - :refer [>symbol]] [quantum.untyped.core.core :as ucore] [quantum.untyped.core.error :as uerr :refer [err! TODO]] + [quantum.untyped.core.form :as uform + :refer [>form]] + [quantum.untyped.core.identifiers :as uident + :refer [>symbol]] [quantum.untyped.core.print :as upr] - [quantum.untyped.core.qualify :as uqual] [quantum.untyped.core.reducers :as ur :refer [join]] [quantum.untyped.core.vars @@ -24,171 +26,87 @@ (ucore/log-this-ns) -(do - -(defn expr>code [x] (cond-> x (fn? x) >symbol)) +(defn expr>form [x] (cond-> x (fn? x) >symbol)) (#?(:clj definterface :cljs defprotocol) IExpr) +(defn iexpr? [x] (#?(:clj instance? :cljs satisfies?) IExpr x)) + (defprotocol PExpr - (>code [this]) - (with-code [this code']) - (update-code [this f]) + (with-form [this form']) + (update-form [this f]) (>evaled [this])) (#?(:clj definterface :cljs defprotocol) ICall) -(defn icall? [x] (instance? ICall x)) +(defn call? [x] (#?(:clj instance? :cljs satisfies?) ICall x)) #?(:clj (defmacro def [sym x] - `(def ~sym (NamedExpr. '~(uqual/qualify sym) ~x)))) + `(def ~sym (NamedExpr. '~(uident/qualify sym) ~x)))) #?(:clj (defalias -def def)) -(defrecord NamedExpr - [sym #_symbol? x #__] +(defrecord NamedExpr [sym #_symbol? x #__] IExpr fipp.ednize/IOverride fipp.ednize/IEdn (-edn [this] sym)) -;; ===== LOGIC ===== ;; - -(defrecord Expr|casef - [f #_t/fn?, cases #_t/+map?] - IExpr ICall - #?(:clj clojure.lang.IFn :cljs cljs.core/IFn) - (#?(:clj invoke :cljs -invoke) [_ x] - (let [dispatch (f x)] - (if-let [[_ then] (find cases dispatch)] - (if (icall? then) (then x) then) - (err! "No matching clause found" {:dispatch dispatch})))) - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] - (if upr/*print-as-code?* - (list* `casef (expr>code f) (map upr/>group cases)) - (list* `casef f cases)))) - -(defn casef [f & cases] - (new Expr|casef f (->> cases (partition-all+ 2) (join {})))) - -(defrecord Expr|condpf-> - [pred #_t/fn?, f #_t/fn?, clauses #_(t/and* t/sequential? t/indexed?)] - IExpr ICall - #?(:clj clojure.lang.IFn :cljs cljs.core/IFn) - (#?(:clj invoke :cljs -invoke) [_ x] - (let [v (f x)] - (if-let [[_ then :as matching-clause] - (seq-or (fn [clause] - (if (-> clause count (= 1)) - clause - (let [[condition then] clause] - (when (pred v condition) - clause)))) clauses)] - (if (icall? then) (then x) then) - (err! "No matching clause found" {:v v})))) - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] - (if upr/*print-as-code?* - (list* `condpf-> - (expr>code pred) - (expr>code f) - (map upr/>group clauses)) - (list* `condpf-> pred f clauses)))) - -(defn condpf-> [pred f & clauses] - (new Expr|condpf-> pred f (->> clauses (partition-all+ 2) join))) - -(defrecord Expr|get [k] - IExpr - #?(:clj clojure.lang.IFn :cljs cljs.core/IFn) - (#?(:clj invoke :cljs -invoke) [this m] (core/get m k)) - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (list `get k))) - -(defn get [k] (new Expr|get k)) - -(defrecord Expr|fn [name arities] - IExpr - #?(:clj clojure.lang.IFn :cljs cljs.core/IFn) - (#?(:clj invoke :cljs -invoke) [this] ((core/get arities 0))) - (#?(:clj invoke :cljs -invoke) [this a0] ((core/get arities 1) a0)) - (#?(:clj invoke :cljs -invoke) [this a0 a1] ((core/get arities 2) a0 a1)) - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (concat [`fn] (when name [name]) arities))) - (udt/deftype - ^{:doc "All possible behaviors of `code` are inherited except function-callability, which - is used for calling the evaled code itself. - A code form may consist of any of the following, recursively: - - nil - - number - - double - - long - - bigdec (`M`) - - bigint (`N`) - - string - - symbol - - keyword - - seq - - vector - - map + ^{:doc "All possible behaviors of `form` (e.g. `get`/`update`/`conj`) are inherited except + function-callability, which is used for calling the evaled form itself. Modification of a tagged literal is only supported to the extent the quoted form of the literal may be modified."} - Expression [code evaled] + Expression [form evaled] {;; expression-like - IExpr nil - PExpr {>code ([this] code) - with-code ([this code'] (Expression. code' (#?(:clj eval :cljs (TODO "eval not supported")) code'))) - update-code ([this f] (with-code this (f code))) - >evaled ([this] evaled)} - ;; `code`-like - ?Associative {assoc ([this k v] (with-code this (assoc code k v))) - dissoc ([this k] (with-code this (dissoc code k))) - keys ([this] (with-code this (keys code))) - vals ([this] (with-code this (vals code))) - contains? ([this] (contains? code)) - find (([this k] (with-code this (find code))) - ([this k else] (with-code this (find code else))))} - ?Collection {empty ([this] (with-code this (empty code))) - conj ([this x] (with-code this (conj code x))) - empty? ([this] (empty? code)) - equals ([this that] (or (== this that) - (and (instance? Expression that) - (let [^Expression that that] - (= evaled (.-evaled that)) - (= code (.-code that))))))} - ?Counted {count ([this] (count code))} - ?Indexed {nth ([this i] (with-code this (nth code i)))} - ?Lookup {get (([this k] (with-code this (core/get code k))) - #_([this k else] (with-code this (core/get code k else))))} ; TODO make it work - ?Meta {meta ([this] (meta code)) - with-meta ([this meta'] (Expression. (with-meta code meta') evaled))} - ?Reversible {rseq ([this] (with-code this (rseq code)))} - ?Seq {first ([this] (with-code this (first code))) - rest ([this] (with-code this (rest code))) - next ([this] (with-code this (next code)))} - ?Seqable {seq ([this] (with-code this (seq code)))} - ?Stack {peek ([this] (with-code this (peek code))) - pop ([this] (with-code this (pop code)))} + IExpr nil + uform/PGenForm {>form ([this] form)} + PExpr {with-form ([this form'] + (Expression. form' + (#?(:clj eval :cljs (TODO "eval not supported")) form'))) + update-form ([this f] (with-form this (f form))) + >evaled ([this] evaled)} + ?Equals {= ([this that] + (or (== this that) + (and (instance? Expression that) + (let [^Expression that that] + (= evaled (.-evaled that)) + (= form (.-form that))))))} + ;; `form`-like + ?Associative {assoc ([this k v] (with-form this (assoc form k v))) + dissoc ([this k] (with-form this (dissoc form k))) + keys ([this] (with-form this (keys form))) + vals ([this] (with-form this (vals form))) + contains? ([this] (contains? form)) + find (([this k] (with-form this (find form))) + ([this k else] (with-form this (find form else))))} + ?Collection {empty ([this] (with-form this (empty form))) + conj ([this x] (with-form this (conj form x))) + empty? ([this] (empty? form))} + ?Counted {count ([this] (count form))} + ?Indexed {nth ([this i] (with-form this (nth form i)))} + ?Lookup {get (([this k] (with-form this (get form k))) + #_([this k else] (with-form this (get form k else))))} ; TODO make it work + ?Meta {meta ([this] (meta form)) + with-meta ([this meta'] (Expression. (with-meta form meta') evaled))} + ?Reversible {rseq ([this] (with-form this (rseq form)))} + ?Seq {first ([this] (with-form this (first form))) + rest ([this] (with-form this (rest form))) + next ([this] (with-form this (next form)))} + ?Seqable {seq ([this] (with-form this (seq form)))} + ?Stack {peek ([this] (with-form this (peek form))) + pop ([this] (with-form this (pop form)))} ;; `evaled`-like - ?Fn {invoke (([this] (evaled)) - ([this a0] (evaled a0)) - ([this a0 a1] (evaled a0 a1)))} + ?Fn {invoke (([this] (evaled)) + ([this a0] (evaled a0)) + ([this a0 a1] (evaled a0 a1)))} ;; printing fipp.ednize/IOverride nil - fipp.ednize/IEdn - {-edn ([this] (tagged-literal 'expr code))}}) + fipp.ednize/IEdn {-edn ([this] (tagged-literal 'expr form))}}) #?(:clj (defmacro >expr [expr-] `(quantum.untyped.core.analyze.expr.Expression. '~expr- ~expr-))) #?(:clj (defn expr? [x] (instance? Expression x))) - -) diff --git a/src-untyped/quantum/untyped/core/async.cljc b/src-untyped/quantum/untyped/core/async.cljc new file mode 100644 index 00000000..df83a49d --- /dev/null +++ b/src-untyped/quantum/untyped/core/async.cljc @@ -0,0 +1,16 @@ +(ns quantum.untyped.core.async + (:require + [quantum.untyped.core.system :as usys])) + +#?(:cljs +(def at-next-tick + (or (.-requestAnimationFrame usys/global) + (.-webkitRequestAnimationFrame usys/global) + (.-mozRequestAnimationFrame usys/global) + (.-msRequestAnimationFrame usys/global) + (.-oRequestAnimationFrame usys/global) + (let [t0 (.getTime (js/Date.))] + (fn [f] + (js/setTimeout + #(f (- (.getTime (js/Date.)) t0)) + 16.66666)))))) diff --git a/src-untyped/quantum/untyped/core/cache.cljc b/src-untyped/quantum/untyped/core/cache.cljc index 377326f4..c6867be6 100644 --- a/src-untyped/quantum/untyped/core/cache.cljc +++ b/src-untyped/quantum/untyped/core/cache.cljc @@ -2,20 +2,20 @@ (:refer-clojure :exclude [memoize]) (:require - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.error :as uerr + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.error :as uerr :refer [err!]] - [quantum.untyped.core.fn :as ufn + [quantum.untyped.core.fn :as ufn :refer [fn1]] [quantum.untyped.core.logic :refer [whenc1]] - [quantum.untyped.core.type.predicates :as utpred + [quantum.untyped.core.refs :refer [derefable?]] [quantum.untyped.core.vars :refer [defmacro-]]) #?(:cljs (:require-macros - [quantum.untyped.core.cache :as self + [quantum.untyped.core.cache :as self :refer [memoize-form]])) #?(:clj (:import diff --git a/src-untyped/quantum/untyped/core/classes.cljc b/src-untyped/quantum/untyped/core/classes.cljc new file mode 100644 index 00000000..c9f343e8 --- /dev/null +++ b/src-untyped/quantum/untyped/core/classes.cljc @@ -0,0 +1,18 @@ +(ns quantum.untyped.core.classes + (:require + [quantum.untyped.core.core :as ucore]) +#?(:clj (:import + [java.lang.reflect Modifier]))) + +#?(:clj (defn final? [x] (and (class? x) (Modifier/isFinal (.getModifiers ^Class x))))) +#?(:clj (defn interface? [x] (and (class? x) (.isInterface ^Class x)))) +#?(:clj (defn static? [x] (and (class? x) (Modifier/isStatic (.getModifiers ^Class x))))) +#?(:clj (defn primitive? [x] (and (class? x) (.isPrimitive ^Class x)))) +#?(:clj (defn array? [x] (and (class? x) (.isArray ^Class x)))) + +(defn protocol? [x] + #?(:clj (and (ucore/lookup? x) (-> x (get :on-interface) class?)) + ;; Unfortunately there's no better check in CLJS, at least as of 03/18/2018 + :cljs (and (fn? x) (= (str x) "function (){}")))) + +#?(:clj (defn protocol>class [x] (:on-interface x))) diff --git a/src-untyped/quantum/untyped/core/collections.cljc b/src-untyped/quantum/untyped/core/collections.cljc index 7d468f64..db8a2f12 100644 --- a/src-untyped/quantum/untyped/core/collections.cljc +++ b/src-untyped/quantum/untyped/core/collections.cljc @@ -1,24 +1,74 @@ (ns quantum.untyped.core.collections - (:refer-clojure :exclude - [#?(:cljs array?) assoc-in contains? distinct? get filter flatten last map map-indexed - mapcat pmap remove vec]) - (:require - [clojure.core :as core] - [fast-zip.core :as zip] - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.error :as uerr - :refer [err!]] - [quantum.untyped.core.fn :as ufn - :refer [fn']] - [quantum.untyped.core.logic - #?(:clj :refer :cljs :refer-macros) [condf1 fn-not]] ; no idea why this is required currently :/ - [quantum.untyped.core.reducers :as ur - :refer [defeager transducer->transformer]] - [quantum.untyped.core.type.predicates - :refer [val?]])) + "Operations on collections." + (:refer-clojure :exclude + [#?(:cljs array?) assoc-in cat conj! contains? count dedupe distinct distinct? drop first + get group-by filter flatten frequencies key last map map-indexed mapcat partition-all pmap + remove reverse run! take val zipmap]) + (:require + [clojure.core :as core] + [fast-zip.core :as zip] +#?(:cljs [goog.array :as garray]) + [quantum.untyped.core.core :as ucore + :refer [sentinel]] + [quantum.untyped.core.data + :refer [transient?]] + [quantum.untyped.core.data + :refer [val?]] + [quantum.untyped.core.data.array :as uarr + :refer [array?]] + [quantum.untyped.core.data.map :as umap] + [quantum.untyped.core.data.vector :as uvec] + [quantum.untyped.core.error :as uerr + :refer [err!]] + [quantum.untyped.core.fn :as ufn + :refer [<- ntha fn' aritoid]] + [quantum.untyped.core.logic + #?(:clj :refer :cljs :refer-macros) [ifs condf1 fn-not]] ; no idea why this is required currently :/ + [quantum.untyped.core.loops + :refer [reduce-2]] + [quantum.untyped.core.reducers :as ur + :refer [defeager def-transducer>eager transducer->transformer educe]])) (ucore/log-this-ns) +(def count core/count) +(def lrange core/range) + +(defn ?persistent! [x] + (if (transient? x) (persistent! x) x)) + +(def conj!|rf + (fn ([] (transient [])) + ([x] (persistent! x)) + ([xs x] (core/conj! xs x)))) + +(defn conj! + ([] (transient [])) + ([xs] xs) + ([xs x0] (core/conj! xs x0)) + ([xs x0 x1] (-> xs (conj! x0) (conj! x1)))) + +(def first|rf (aritoid ufn/fn-nil identity (fn [_ x] (reduced x)))) + +(defn first [xs] + (if (ur/transformer? xs) + (educe first|rf xs) + (core/first xs))) + +(defn reverse [xs] (if (reversible? xs) (rseq xs) (core/reverse xs))) + +(defn key [x] + #?(:clj (if (instance? java.util.Map$Entry x) + (.getKey ^java.util.Map$Entry x) + (first x)) + :cljs (first x))) + +(defn val [x] + #?(:clj (if (instance? java.util.Map$Entry x) + (.getValue ^java.util.Map$Entry x) + (second x)) + :cljs (second x))) + ;; ===== SOCIATIVE ===== ;; (defn get @@ -32,6 +82,13 @@ (defn update-val [[k v] f] [k (f v)]) +(defn updates + "For each key-function pair in @kfs, + updates value in an associative data structure @coll associated with key + by applying the function @f to the existing value." + ([coll & kfs] + (ur/reduce-pair update coll kfs))) ; TODO This is inefficient + ;; ----- *SOC ----- ;; (defn dissoc* @@ -48,14 +105,18 @@ ;; ----- *SOC-IN ----- ;; +(declare partition-all+) + (defn assoc-in "Like `assoc-in`, but allows multiple k-v pair arguments like `assoc`." ([ ks v] (fn [x] (core/assoc-in x ks v))) ([x ks v] (core/assoc-in x ks v)) ([x ks v & ks-vs] - (reduce (fn [x' [ks' v']] (assoc-in x' ks' v')) - (assoc-in x ks v) - (partition-all 2 ks-vs)))) + (->> ks-vs + (partition-all+ 2) + (educe + (aritoid nil identity (fn [x' [ks' v']] (assoc-in x' ks' v'))) + (assoc-in x ks v))))) (defn dissoc-in "Dissociate a value in a nested assocative structure, identified by a sequence @@ -74,6 +135,20 @@ (assoc m k new-n)))) m)) +(defn select + ([x k] {k (get x k)}) + ([x k & ks] + (reduce + (fn [ret k'] (assoc ret k' (get x k'))) + (select x k) ks))) + +(defn select-in + ([x ks] (assoc-in {} ks (get-in x ks))) + ([x ks & kss] + (reduce + (fn [ret ks'] (assoc-in ret ks' (get-in x ks'))) + (select-in x ks) kss))) + (defn merge-deep-with "Like `merge-with` but merges maps recursively, applying the given fn only when there's a non-map at a particular level. @@ -96,13 +171,37 @@ ([x y] y)))) (defn merge-at [k m & ms] - (reduce (fn [m' m-next] (update m k merge (get m-next k))) m ms)) - - -;; TODO move to type predicates -(defn array? [x] - #?(:clj (-> x class .isArray) ; must be reflective - :cljs (core/array? x))) + (educe (aritoid nil identity (fn [m' m-next] (update m k merge (get m-next k)))) m ms)) + +(defn mergev-with + "Like `merge-with`, but merges elements of successive vectors at the same indices, + `conj`ing when the element is not present. + `f`: takes three inputs, `i`, `v0`, `v1`" + [f & xss] + (reduce + (fn [xs' xs] + (ifs (empty? xs') xs + (empty? xs ) xs' + (reduce + (fn [xs'' ^long i|xs] + (if (>= i|xs (count xs'')) + (conj xs'' (get xs i|xs)) + (let [v|xs'' (get xs'' i|xs) + v|xs (get xs i|xs)] + (if (not= v|xs'' v|xs) + (assoc xs'' i|xs (f i|xs v|xs'' v|xs)) + xs'')))) + xs' + (lrange (count xs))))) + [] + xss)) + +(def mergev (partial mergev-with (fn [i v0 v1] v1))) + +(defn zipmap-into [x ks vs] + (reduce-2 assoc (fn [_ _ _] (throw (ex-info "Seqs' count is not the same"))) x ks vs)) + +(defn zipmap [ks vs] (zipmap-into {} ks vs)) ;; ===== Sequential ==== ;; @@ -111,17 +210,23 @@ [xs] (dec (count xs))) -(defn last [xs] - (if (or (and (counted? xs) (indexed? xs)) - (string? xs) - (array? xs)) - (get xs (lasti xs)) - (core/last xs))) +(defn last + "Gets the last element of ->`xs` in as short a time as possible. + In the case of collections that are both counted and indexed, this is sublinear (often `O(1)`). + Otherwise, resorts to a linear traversal." + [xs] + (ifs (or (and (counted? xs) (indexed? xs)) + (string? xs) + (array? xs)) + (get xs (lasti xs)) + (reversible? xs) + (-> xs rseq first) + (core/last xs))) ;; ===== Keyed ==== ;; (defn contains? - ([xs] (boolean (seq xs))) + ([xs] (not (empty? xs))) ([xs k] (core/contains? xs k))) ;; ===== ... ==== ;; @@ -138,6 +243,53 @@ (and (val? elem) (index-of x elem)) :else (uerr/not-supported! `containsv? x)))) +;; NOTE: The below functions, built on transducers, inasmuch as they require a 0- or 1-arity +;; reducing function to behave correctly (e.g. `partition-all+`), are unsafe for use with +;; core/reduce. Prefer `educe` instead. + +(def-transducer>eager map core/map 1) +(def-transducer>eager map-indexed core/map-indexed 1) +(def-transducer>eager mapcat core/mapcat 1) + +(defn- map-keys* [f-xs] (fn [f xs] (->> xs (f-xs (juxt (comp f key) val))))) +(def map-keys+ (map-keys* map+)) +(def map-keys' (map-keys* map')) +(def map-keys (map-keys* map )) +(def lmap-keys (map-keys* lmap)) + +(defn- map-vals* [f-xs] (fn [f xs] (->> xs (f-xs (juxt key (comp f val)))))) +(def map-vals+ (map-vals* map+)) +(def map-vals' (map-vals* map')) +(def map-vals (map-vals* map )) +(def lmap-vals (map-vals* lmap)) + +(def-transducer>eager filter core/filter 1) +(def-transducer>eager remove core/remove 1) + +(defn- pred-keys [f-xs] (fn [pred xs] (->> xs (f-xs (comp pred key))))) +(def filter-keys+ (pred-keys filter+)) +(defeager filter-keys filter-keys+ 1) +(def remove-keys+ (pred-keys remove+)) +(defeager remove-keys remove-keys+ 1) + +(defn- pred-vals [f-xs] (fn [pred xs] (->> xs (f-xs (comp pred val))))) +(def filter-vals+ (pred-vals filter+)) +(defeager filter-vals filter-vals+ 1) +(def remove-vals+ (pred-vals remove+)) +(defeager remove-vals remove-vals+ 1) + +(defn keys+ [xs] (->> xs (map+ key))) +(defn vals+ [xs] (->> xs (map+ val))) + +(defn indexed+ [xs] (map-indexed+ vector xs)) +(defn lindexed [xs] (lmap-indexed vector xs)) +(defeager indexed indexed+ 0) + +(def-transducer>eager partition-all core/partition-all 1) +(def-transducer>eager distinct core/distinct 0) +(def-transducer>eager take core/take 1) +(def-transducer>eager drop core/drop 1) + (defn subview "Returns a subview of ->`xs`, [->`a` to ->`b`), in O(1) time." ([xs ^long a] (subview xs a (count xs))) @@ -163,55 +315,23 @@ (subview xs a b) (slice a b)))) -(def mapcat+ (transducer->transformer 1 core/mapcat)) -(defeager mapcat mapcat+) - -(def map+ (transducer->transformer 1 core/map)) -(defeager map map+) - -(def map-indexed+ (transducer->transformer 1 core/map-indexed)) -(defeager map-indexed map-indexed+) - -(def indexed+ #(->> % (map-indexed+ vector))) -(defn lindexed [xs] (lmap-indexed vector xs)) - -(defn- map-keys* [f-xs] (fn [f xs] (->> xs (f-xs (juxt (comp f key) val))))) -(def map-keys+ (map-keys* map+)) -(def map-keys' (map-keys* map')) -(def map-keys (map-keys* map )) -(def lmap-keys (map-keys* lmap)) - -(defn- map-vals* [f-xs] (fn [f xs] (->> xs (f-xs (juxt key (comp f val)))))) -(def map-vals+ (map-vals* map+)) -(def map-vals' (map-vals* map')) -(def map-vals (map-vals* map )) -(def lmap-vals (map-vals* lmap)) - -(def filter+ (transducer->transformer 1 core/filter)) -(defeager filter filter+) - -(def remove+ (transducer->transformer 1 core/remove)) -(defeager remove remove+) - -(defn- pred-keys [f-xs] (fn [pred xs] (->> xs (f-xs (comp pred key))))) -(def filter-keys+ (pred-keys filter+)) -(defeager filter-keys filter-keys+) -(def remove-keys+ (pred-keys remove+)) -(defeager remove-keys remove-keys+) - -(defn- pred-vals [f-xs] (fn [pred xs] (->> xs (f-xs (comp pred val))))) -(def filter-vals+ (pred-vals filter+)) -(defeager filter-vals filter-vals+) -(def remove-vals+ (pred-vals remove+)) -(defeager remove-vals remove-vals+) +;; ===== COERCIVE ===== ;; -(def partition-all+ (transducer->transformer 1 core/partition-all)) +(defn >vec [xs] (ur/join xs)) -(def distinct+ (transducer->transformer 0 core/distinct)) +(defn >set [xs] (if (set? xs) xs (ur/join #{} xs))) -;; ===== COERCIVE ===== ;; +(def >array|rf + (aritoid uvec/alist + (fn [!xs] #?(:clj (.toArray ^java.util.ArrayList !xs) :cljs !xs)) + uvec/alist-conj!)) -(defn vec [xs] (ur/join xs)) +(defn >array [xs] + (ifs (nil? xs) (uarr/*<>) + (instance? java.util.Collection xs) (.toArray ^java.util.Collection xs) + (ur/transformer? xs) (educe >array|rf xs) + (array? xs) xs + (uerr/not-supported! `>array xs))) (def ensure-set (condf1 @@ -221,47 +341,161 @@ ;; ===== GENERAL ===== ;; +(defn cat|transducer + "Like `clojure.core/cat` but uses `educe` internally." + [] + (fn [rf] + (let [rrf (ur/preserving-reduced rf)] + (fn ([] (rf)) + ([result] (rf result)) + ([result input] (educe rrf result input)))))) + +(defn lcat [xs] (apply concat xs)) + +(def-transducer>eager cat cat|transducer 0 lcat) + (defn flatten ([] core/flatten) ([xs] (core/flatten xs)) ([n xs] (if (<= n 0) xs - (recur (dec n) (apply concat xs))))) + (recur (dec n) (lcat xs))))) + +(defn frequencies + "Like `frequencies` but uses `educe` internally" + [f xs] + (educe (fn ([] (transient {})) + ([cts] (persistent! cts)) + ([cts x] (assoc! cts x (inc (get cts x 0))))) + xs)) (defn frequencies-by - "Like |frequencies| crossed with |group-by|." + "Like `frequencies` crossed with `group-by`." {:in '[second [[1 2 3] [4 2 6] [5 2 7]]] :out '{[1 2 3] 3, [4 2 6] 3, [5 2 7] 3}} [f coll] (let [frequencies-0 - (persistent! - (reduce + (educe + (aritoid (fn' (transient {})) persistent! (fn [counts x] (let [gotten (f x) freq (inc (get counts gotten 0))] - (assoc! counts gotten freq))) - (transient {}) coll)) + (assoc! counts gotten freq)))) + coll) frequencies-f - (persistent! - (reduce - (fn [ret elem] (assoc! ret elem (get frequencies-0 (f elem)))) - (transient {}) coll))] + (educe + (aritoid (fn' (transient {})) persistent! + (fn [ret elem] (assoc! ret elem (get frequencies-0 (f elem))))) + coll)] frequencies-f)) - -(defn lflatten-1 [xs] (apply concat xs)) +(def group-by|rf (aritoid (fn [] (transient {})) persistent! nil assoc!)) +(def group-by|sub-rf (aritoid vector nil conj)) + +(def group-by|!rf + (aritoid umap/>!hash-map identity nil + #?(:clj (fn [^java.util.HashMap ret k v] (doto ret (.put k v))) :cljs assoc!))) + +(def group-by|!sub-rf uvec/alist-conj!) + +(defn group-by-into + "Like `group-by`, but uses `educe` internally, and you can choose what collection and + subcollection to group into." + ([kf rf xs] (group-by-into kf rf group-by|sub-rf xs)) + ([kf rf sub-rf xs] + (educe + (aritoid rf rf + (fn [ret x] + (let [k (kf x), v (get ret k sentinel)] + (rf ret k (sub-rf (if (identical? v sentinel) (sub-rf) v) x))))) + xs))) + +(defn group-by [kf xs] (group-by-into kf group-by|rf xs)) + +(defn group-into + ([rf xs] (group-by-into identity rf group-by|rf xs)) + ([rf sub-rf xs] (group-by-into identity rf sub-rf xs))) + +(defn group [xs] (group-by-into identity group-by|rf xs)) + +(defn- group-deep-by-into* [i n kf rf sub-rf xs] + (if (>= i n) + xs + (->> xs + (group-by-into (fn [x] (kf i x)) group-by|!rf group-by|!sub-rf) + (map-vals+ (fn [sub-xs] (group-deep-by-into* (inc i) n kf rf sub-rf sub-xs))) + (educe (aritoid rf rf (fn [ret [k v]] (rf ret k v))))))) + +(defn group-deep-by-into + "Like `group-by-into` but: + - Expects a reducible of reducibles + - Performs up to N groupings, defaulting to the max size of the inner reducibles + - `kf` takes two inputs: `depth` and `x`. + + E.g. `(group-deep-by (fn [i x] (get x i)) [[1 4] [3 2] [1 2] [3 2 5]])` + -> `{1 {2 {nil [[1 2]]} + 4 {nil [[1 4]]}} + 3 {2 {nil [[3 2]] + 5 [[3 2 5]]}}}`" + ([ kf rf xs] (group-deep-by-into kf rf group-by|sub-rf xs)) + ([ kf rf sub-rf xs] + (group-deep-by-into (->> xs (map+ count) (educe max 0)) kf rf sub-rf xs)) + ([n #_(> 0) kf rf sub-rf xs] (group-deep-by-into* 0 n kf rf sub-rf xs))) + +(defn group-deep-by + ([ kf xs] (group-deep-by-into kf group-by|rf group-by|sub-rf xs)) + ([n kf xs] (group-deep-by-into n kf group-by|rf group-by|sub-rf xs))) + +(defn group-deep-into + ([ rf xs] (group-deep-by-into (fn [i x] x) rf group-by|sub-rf xs)) + ([ rf sub-rf xs] (group-deep-by-into (fn [i x] x) rf sub-rf xs)) + ([n rf sub-rf xs] (group-deep-by-into n (fn [i x] x) rf sub-rf xs))) + +(defn group-deep + ([ xs] (group-deep-by-into (fn [i x] x) group-by|rf group-by|sub-rf xs)) + ([n xs] (group-deep-by-into n (fn [i x] x) group-by|rf group-by|sub-rf xs))) + +(defn lcat [xs] (apply concat xs)) + +(defn run! + "Like `core/run!` but uses `educe` internally." + [f xs] (->> xs (educe (fn ([] nil) ([ret] ret) ([ret x] (f x)))))) (defn distinct? "Like `clojure.core/distinct?` except operates on reducibles." [xs] - (boolean - (reduce (fn [distincts x] - (if (contains? distincts x) - (reduced false) - (conj distincts x))) - #{} - xs))) + (->> xs + (educe (aritoid (fn' (transient #{})) ?persistent! + (fn [distincts x] + (if (contains? distincts x) + (reduced false) + (conj! distincts x))))) + boolean)) + +(defn dedupe-by|tf + "Like `dedupe`'s transducer but is able to dedupe by comparing two inputs by `eq-f` rather than + only `=`." + [eq-f] + (fn [rf] + (let [pv (volatile! ::none)] + (fn ([] (rf)) + ([result] (rf result)) + ([result input] + (let [prior @pv] + (vreset! pv input) + (if (and (not (identical? prior ::none)) + (eq-f prior input)) + result + (rf result input)))))))) + +(def-transducer>eager dedupe-by dedupe-by|tf 1) + +(def dedupe|tf + (let [gen-rf (dedupe-by|tf =)] + (fn [] gen-rf))) + +(def-transducer>eager dedupe dedupe|tf 0) ;; ===== ZIPPER ===== ;; @@ -277,8 +511,9 @@ (merge-call #(assoc % :a 1)) (merge-call my-associng-fn) (merge-call fn-that-uses-the-previous-results))} + ([m] m) ([m f] (merge m (f m))) - ([m f & fs] (reduce merge-call (merge-call m f) fs))) + ([m f & fs] (educe merge-call (merge-call m f) fs))) (defn unchunk "Given a sequence that may have chunks, return a sequence that is 1-at-a-time @@ -293,3 +528,96 @@ (lazy-seq (when (seq s) (cons (first s) (unchunk (rest s)))))) + +(defn seq= + ([a b] (seq= a b =)) + ([a b eq-f] + (boolean + (loop [a (seq a) b (seq b)] + (let [a-nil? (nil? a)] + (and (identical? a-nil? (nil? b)) + (or a-nil? + (and (eq-f (first a) (first b)) + (recur (next a) (next b)))))))))) + +(defn >combinatoric-tree + "See tests for examples. + + Assumes all are sorted, grouped, and of the same count." + {:todo #{"Generalize to handle uneven input lengths and unsorted combination"}} + ([n #_pos-int?, xs #_(t/of (t/tuple (t/spec t/any? "identifier") (t/of)))] + (>combinatoric-tree + n = conj conj (fn ([] []) ([ret] ret) ([ret [k [x*]]] (conj ret [x* k]))) xs)) + ([n #_pos-int?, eq-f groupsf groupf terminalf xs] + (if (<= n 1) + (educe terminalf xs) + (let [terminate-group + (fn [grouped curr-group curr-x*] + (groupsf grouped + [curr-x* + (>combinatoric-tree + (dec n) eq-f groupsf groupf terminalf (groupf curr-group))]))] + (educe + (fn ([] [(groupsf) (groupf) sentinel]) + ([[grouped curr-group curr-x*]] + (groupsf (terminate-group grouped curr-group curr-x*))) + ([[grouped curr-group curr-x*] [k [x* & xs*]]] + (ifs (identical? curr-x* sentinel) [grouped (groupf curr-group [k xs*]) x*] + (eq-f curr-x* x*) [grouped (groupf curr-group [k xs*]) curr-x*] + [(terminate-group grouped curr-group curr-x*) + (groupf (groupf) [k xs*]) + x*]))) + xs))))) + +(defn aswap! + [#?(:clj ^"[Ljava.lang.Object;" !xs :cljs !xs) + #?(:clj ^long i :cljs ^number i) + #?(:clj ^long j :cljs ^number j)] + (let [tmp (aget !xs i)] + (doto !xs (aset i (aget !xs j)) + (aset j tmp)))) + +(defn shuffle! + "Uses the Fisher–Yates shuffle as enhanced by Durstenfeld." + [#?(:clj ^"[Ljava.lang.Object;" !xs :cljs !xs)] + (let [r #?(:clj (java.util.concurrent.ThreadLocalRandom/current) :cljs nil)] + (loop [i (-> !xs alength unchecked-dec)] + (if (> i 0) + (do (aswap! !xs i (#?@(:clj [.nextInt r] :cljs rand-int) (unchecked-inc i))) + (recur (unchecked-dec i))) + !xs)))) + +(defn sort|insertion! + {:adapted-from "https://en.wikipedia.org/wiki/Insertion_sort"} + ([#?(:clj ^"[Ljava.lang.Object;" !xs :cljs !xs)] (sort|insertion! compare !xs)) + ([compf #?(:clj ^"[Ljava.lang.Object;" !xs :cljs !xs)] + (let [ct (alength !xs)] + (loop [i 1] + (if (< i ct) + (let [x (aget !xs i)] + (loop [j (unchecked-dec i)] + (if (and (>= j 0) (pos? (int (compf (aget !xs j) x)))) + (do (aset !xs (unchecked-inc j) (aget !xs j)) + (recur (unchecked-dec j))) + (aset !xs (unchecked-inc j) x))) + (recur (unchecked-inc i))) + !xs))))) + +(defn sort-by|insertion! + ([kf !xs] (sort-by|insertion! kf compare !xs)) + ([kf compf !xs] (sort|insertion! (fn [a b] (compf (kf a) (kf b))) !xs))) + +(defn sort! + "Like `sort` but coerces `xs` to an array and then sorts it in place, returning the coerced array + instead of a seq on top of it. If `xs` is already an array, modifies `xs`." + ([xs] (sort! compare xs)) + ([compf xs] + (let [#?(:clj ^objects !xs :cljs !xs) (if (array? xs) xs (to-array xs))] + (doto !xs #?(:clj (java.util.Arrays/sort ^Comparator compf) + :cljs (garray/stableSort !xs (@#'fn->comparator compf))))))) + +(defn sort-by! + "Like `sort-by` but coerces `xs` to an array and then sorts it in place, returning the coerced + array instead of a seq on top of it. If `xs` is already an array, modifies `xs`." + ([kf xs] (sort-by! kf compare xs)) + ([kf compf xs] (sort! (fn [a b] (compf (kf a) (kf b))) xs))) diff --git a/src-untyped/quantum/untyped/core/collections/diff.cljc b/src-untyped/quantum/untyped/core/collections/diff.cljc index f46eb401..048f4027 100644 --- a/src-untyped/quantum/untyped/core/collections/diff.cljc +++ b/src-untyped/quantum/untyped/core/collections/diff.cljc @@ -8,11 +8,9 @@ [quantum.untyped.core.core :as ucore :refer [istr]] [quantum.untyped.core.data - :refer [kw-map]] + :refer [kw-map seqable?]] [quantum.untyped.core.error - :refer [err!]] - [quantum.untyped.core.type.predicates - :refer [seqable?]])) + :refer [err!]])) (ucore/log-this-ns) @@ -43,5 +41,3 @@ :- (istr "At position ~{position}, remove this number of items:")) x])) []))})) - - diff --git a/src-untyped/quantum/untyped/core/collections/logic.cljc b/src-untyped/quantum/untyped/core/collections/logic.cljc index e5d23df1..b8511810 100644 --- a/src-untyped/quantum/untyped/core/collections/logic.cljc +++ b/src-untyped/quantum/untyped/core/collections/logic.cljc @@ -9,6 +9,8 @@ :refer [>sentinel]] [quantum.untyped.core.fn :refer [rcomp]] + [quantum.untyped.core.loops + :refer [reduce-2]] [quantum.untyped.core.reducers :refer [educe]] [quantum.untyped.core.vars @@ -16,74 +18,80 @@ (ucore/log-this-ns) -;; `seq-or` +;; ----- `seq-or` ----- ;; -(defn seq-or:rf - ([] (seq-or:rf identity)) +(defn seq-or|rf + ([] (seq-or|rf identity)) ([pred] - (fn ([] true) ; vacuously + (fn ([] false) ([ret] ret) - ([_ x] (and (pred x) (reduced x))) - ([_ k v] (and (pred k v) (reduced [k v])))))) + ([_ x] (and (pred x) (reduced true))) + ([_ k v] (and (pred k v) (reduced true)))))) -(defn seq-or - "∃: A faster version of `some` using `reduce` instead of `seq`." - ([xs] (educe (seq-or:rf) xs)) - ([pred xs] (educe (seq-or:rf pred) xs))) +(defn seq-or #_> #_boolean? + "∃: A faster version of `some` using `educe` instead of `seq`." + ([xs] (educe (seq-or|rf) xs)) + ([pred xs] (educe (seq-or|rf pred) xs))) -(defalias some:rf seq-or:rf) +(defalias some|rf seq-or|rf) (defalias some seq-or) -(defn apply-or [xs] (seq-or xs)) +(defn seq-or-2 + "Like `seq-or` but for 2 seqables." + [pred xs0 xs1] + (reduce-2 (fn [_ x0 x1] (and (pred x0 x1) (reduced true))) + (fn [_ _ _] false) false xs0 xs1)) -;; `seq-nor` +;; ----- `seq-nor` ----- ;; -#_(def seq-nor:rf ...) +#_(def seq-nor|rf ...) -#_(defalias not-any?:rf seq-nor:rf) +#_(defalias not-any?|rf seq-nor|rf) (def seq-nor (rcomp seq-or not)) (defalias not-any? seq-nor) -;; `seq-and` +;; ----- `seq-and` ----- ;; -(defn seq-and:rf - ([] (seq-and:rf identity)) +(defn seq-and|rf + ([] (seq-and|rf identity)) ([pred] (fn ([] true) ; vacuously ([ret] ret) ([_ x] (or (pred x) (reduced false))) - ([_ k v] (or (pred k v) (reduced [k v])))))) + ([_ k v] (or (pred k v) (reduced false)))))) -(defn seq-and - "∀: A faster version of `every?` using `reduce` instead of `seq`." - ([xs] (educe (seq-and:rf) xs)) - ([pred xs] (educe (seq-and:rf pred) xs))) +(defn seq-and #_> #_boolean? + "∀: A faster version of `every?` using `educe` instead of `seq`." + ([xs] (educe (seq-and|rf) xs)) + ([pred xs] (educe (seq-and|rf pred) xs))) -(defalias every?:rf seq-and:rf) +(defalias every?|rf seq-and|rf) (defalias every? seq-and) -(defn apply-and [xs] (seq-and xs)) - -;; `seq-and-2` - (defn seq-and-2 + "Like `seq-and` but for 2 seqables." + [pred xs0 xs1] + (reduce-2 (fn [_ x0 x1] (or (pred x0 x1) (reduced false))) + (fn [_ _ _] false) true xs0 xs1)) + +(defn seq-and-pair "`seq-and` for pairwise comparisons." - ([pred xs] + ([pred xs #_seqable?] (reduce (fn [a b] (or (pred a b) (reduced false))) (first xs) (rest xs)))) -(defalias every?-2 seq-and-2) +(defalias every?-pair seq-and-pair) -;; `seq-nand` +;; ----- `seq-nand` ----- ;; -#_(def seq-nand:rf ...) +#_(def seq-nand|rf ...) (def seq-nand (rcomp seq-and not)) -#_(defalias not-every?:rf seq-nand:rf) +#_(defalias not-every?|rf seq-nand|rf) (defalias not-every? seq-nand) @@ -106,7 +114,7 @@ (not== ret failed-sentinel))) (defn every-val - "Yields what every value in `xs` is equivalent to (via `=`), or the provided + "Computes what every value in `xs` is equivalent to (via `=`), or the provided `not-equivalent` value if they are not all equivalent." [not-equivalent xs] (reduce (fn [ret x] diff --git a/src-untyped/quantum/untyped/core/collections/tree.cljc b/src-untyped/quantum/untyped/core/collections/tree.cljc index 66f28e9d..23f0e376 100644 --- a/src-untyped/quantum/untyped/core/collections/tree.cljc +++ b/src-untyped/quantum/untyped/core/collections/tree.cljc @@ -35,7 +35,7 @@ {:attribution 'alexandergunnarson} [branch?f childrenf root] (postwalk-fold (fn ([] (transient [])) ([x] (persistent! x)) ([xs x] (conj! xs x))) - (fn ([] (transient [])) ([x] (persistent! x)) ([a b] (ur/into! a b))) + (fn ([] (transient [])) ([x] (persistent! x)) ([a b] (ur/join! a b))) branch?f childrenf root)) (defn prewalk-find diff --git a/src-untyped/quantum/untyped/core/compare.cljc b/src-untyped/quantum/untyped/core/compare.cljc index 98991441..fbf311fb 100644 --- a/src-untyped/quantum/untyped/core/compare.cljc +++ b/src-untyped/quantum/untyped/core/compare.cljc @@ -1,21 +1,123 @@ (ns quantum.untyped.core.compare + "General comparison operators and constants" (:refer-clojure :exclude [==]) (:require - [quantum.untyped.core.core :as ucore])) + [quantum.untyped.core.core :as ucore + :refer [defaliases]] + [quantum.untyped.core.fn + :refer [fn']] + [quantum.untyped.core.logic + :refer [fn-or ifs]])) (ucore/log-this-ns) (def == identical?) (def not== (comp not identical?)) +(def comparison= zero?) +(def comparison-not= (comp not comparison=)) +(def comparison< neg?) +(def comparison<= (fn-or comparison< comparison=)) +(def comparison> pos?) +(def comparison>= (fn-or comparison> comparison=)) + +(defn comp< ([ x0 x1] (comp< compare x0 x1)) + ([compf x0 x1] (comparison< (compf x0 x1)))) +(defn comp<= ([ x0 x1] (comp<= compare x0 x1)) + ([compf x0 x1] (comparison<= (compf x0 x1)))) +(defn comp= ([ x0 x1] (comp= compare x0 x1)) + ([compf x0 x1] (comparison= (compf x0 x1)))) +(defn comp-not= ([ x0 x1] (comp-not= compare x0 x1)) + ([compf x0 x1] (comparison-not= (compf x0 x1)))) +(defn comp>= ([ x0 x1] (comp>= compare x0 x1)) + ([compf x0 x1] (comparison>= (compf x0 x1)))) +(defn comp> ([ x0 x1] (comp> compare x0 x1)) + ([compf x0 x1] (comparison> (compf x0 x1)))) + +;; TODO deprecate (def class->comparator {#?@(:clj [Class (fn [^Class a ^Class b] (.compareTo (.getName a) (.getName b)))])}) -(defn invert [c] - (case c - nil c - 0 c - -1 1 - 1 -1)) +(defn rcompare + "Reverse comparator." + {:adapted-from "taoensso.encore, possibly via weavejester.medley"} + [a b] (compare b a)) + +(defn comp-extrema-of + "Returns the extreme elements of `xs` according to comparator `compf` and `comparisonf` in O(n) + time." + ([comparisonf xs] (comp-extrema-of comparisonf compare xs)) + ([comparisonf compf xs] + (->> xs + (reduce + (fn ([[extremum extrema :as ret] x] + (if (identical? extremum ucore/sentinel) + [x [x]] + (let [c (int (compf x extremum))] + (ifs (comparison= c) + [x (conj extrema x)] + (comparisonf c) + [x [x]] + ret))))) + [ucore/sentinel []]) + second))) + +(defn comp-mins-of + "Returns the equally 'min' elements of `xs` according to comparator `compf` in O(n) time." + ([xs] (comp-mins-of compare xs)) + ([compf xs] (comp-extrema-of comparison< compf xs))) + +(defn comp-maxes-of + "Returns the equally 'max' elements of `xs` according to comparator `compf` in O(n) time." + ([xs] (comp-mins-of compare xs)) + ([compf xs] (comp-extrema-of comparison> compf xs))) + +(defn gen-comp-extremum|rf [compf comparisonf] + (fn ([] nil) ([prev x] (if (comparisonf (compf x prev)) x prev)))) + +(defn gen-comp-min|rf [compf] (gen-comp-extremum|rf compf comparison<)) + +(defn comp-min-of + "Returns the 'min' element of `xs` according to comparator `compf` in O(n) time." + ([xs] (comp-min-of compare xs)) + ([compf xs] (->> xs (reduce (gen-comp-min|rf compf))))) + +(defn gen-comp-max|rf [compf] (gen-comp-extremum|rf compf comparison>)) + +(defn comp-max-of + "Returns the 'max' element of `xs` according to comparator `compf` in O(n) time." + ([xs] (comp-max-of compare xs)) + ([compf xs] (->> xs (reduce (gen-comp-max|rf compf))))) + +(defn check-comparator + "To ensure the comparator maintains its contract and that `IllegalArgumentException Comparison + method violates its general contract!` is not thrown. + + Checks symmetry, reflexivity and transitivity." + {:complexity "O(n^3) time" + :adapted-from + "http://code.nomad-labs.com/2015/06/02/finding-the-error-in-your-comparators-compare-method-aka-comparison-method-violates-its-general-contract/"} + [compf xs] + (if (< (int (bounded-count 3 xs)) 3) + (throw (ex-info "`xs` must have at least 3 items")) + (let [^objects xs' (to-array xs) ct (count xs')] + (doseq [i0 (range 0 ct)] + (doseq [i1 (range 0 ct)] + (doseq [i2 (range 0 ct)] + (let [x0 (aget xs' i0) + x1 (aget xs' i1) + x2 (aget xs' i2) + x0+x1 (int (compf x0 x1)) + x0+x2 (int (compf x0 x2)) + x1+x2 (int (compf x1 x2))] + (when (and (neg? x0+x1) (neg? x1+x2) (not (neg? x0+x2))) + (throw (ex-info "x0 comp< x1, x1 comp< x2, but x0 not comp< x2" + {:x0 x0 :x1 x1 :x2 x2}))) + (when (and (zero? x0+x1) (zero? x1+x2) (not (zero? x0+x2))) + (throw (ex-info "x0 comp= x1, x1 comp= x2, but x0 not comp= x2" + {:x0 x0 :x1 x1 :x2 x2}))) + (when (and (pos? x0+x1) (pos? x1+x2) (not (pos? x0+x2))) + (throw (ex-info "x0 comp> x1, x1 comp> x2, but x0 not comp> x2" + {:x0 x0 :x1 x1 :x2 x2})))))))))) diff --git a/src-untyped/quantum/untyped/core/core.cljc b/src-untyped/quantum/untyped/core/core.cljc index 2c749f8f..fa4543b0 100644 --- a/src-untyped/quantum/untyped/core/core.cljc +++ b/src-untyped/quantum/untyped/core/core.cljc @@ -1,10 +1,14 @@ (ns quantum.untyped.core.core - (:require -#?@(:clj - [[environ.core :as env]]) - [cuerdas.core :as str+] - [quantum.untyped.core.type.predicates :as utpred - :refer [with-metable? metable?]])) + (:refer-clojure :exclude + [any?]) + (:require + [clojure.core :as core] + #?(:clj [clojure.future :as fcore]) + [clojure.string :as str] + [cuerdas.core :as str+] + #?@(:clj [[environ.core :as env]])) +#?(:cljs (:require-macros + [quantum.untyped.core.core :as self]))) ;; ===== Environment ===== ;; @@ -34,34 +38,55 @@ (defn >sentinel [] #?(:clj (Object.) :cljs #js {})) (def >object >sentinel) -; ===== COLLECTIONS ===== - -(defn seq= - ([a b] (seq= a b =)) - ([a b eq-f] - (boolean - (when (or (sequential? b) #?(:clj (instance? java.util.List b) - :cljs (list? b))) - (loop [a (seq a) b (seq b)] - (when (= (nil? a) (nil? b)) - (or (nil? a) - (when (eq-f (first a) (first b)) - (recur (next a) (next b)))))))))) - -(defn code= - "Ensures that two pieces of code are equivalent. - This means ensuring that seqs, vectors, and maps are only allowed to be compared with - each other, and that metadata is equivalent." - [code0 code1] - (if (metable? code0) - (and (metable? code1) - (= (meta code0) (meta code1)) - (cond (seq? code0) (and (seq? code1) (seq= code0 code1 code=)) - (vector? code0) (and (vector? code1) (seq= (seq code0) (seq code1) code=)) - (map? code0) (and (map? code1) (seq= (seq code0) (seq code1) code=)) - :else (= code0 code1))) - (and (not (metable? code1)) - (= code0 code1)))) +(defonce sentinel (>sentinel)) + +(defn- js-call [f args] + (let [argstr (->> (repeat (count args) "~{}") + (str/join ","))] + (list* 'js* (str "~{}(" argstr ")") f args))) + +(defn- dot-args [object member] + (assert (symbol? member) + (str "Symbol expected, not " (pr-str member))) + (assert (not (re-find #"\." (name object))) + (str "Dot not allowed in " object)) + (let [n (name member) + field? (= (subs n 0 1) "-") + names (-> (str/replace n #"^-" "") + (str/split #"\."))] + [field? names])) + +#?(:clj +(defmacro dot + "Access member in a JavaScript object, in a Closure-safe way. + `member` is assumed to be a field if it is a keyword or if the name starts with '-', otherwise + the named function is called with the optional args. + 'member' may contain '.', to allow access in nested objects. + If 'object' is a symbol it is not allowed contain '.'. + `(dot o :foo)` is equivalent to `(.-foo o)`, except that it gives the same result under advanced + compilation. + `(dot o foo arg1 arg2)` is the same as `(.foo o arg1 arg2)`." + {:adapted-from 'reagent.interop/$!} + [object member & args] + (let [[field names] (dot-args object member)] + (if field + (do (assert (empty? args) (str "Passing args to field doesn't make sense: " member)) + `(cljs.core/aget ~object ~@names)) + (js-call (list* `cljs.core/aget object names) args))))) + +#?(:clj +(defmacro dot! + "Set field in a JavaScript object, in a Closure-safe way. + `field` should be a keyword or a symbol starting with '-'. + `field` may contain '.', to allow access in nested objects. + If `object` is a symbol it is not allowed contain '.'. + `(dot! o :foo 1)` is equivalent to `(set! (.-foo o) 1)`, except that it gives the same result + under advanced compilation." + {:adapted-from 'reagent.interop/dot!} + [object field value] + (let [[field names] (dot-args object field)] + (assert field (str "Field name must start with - in " field)) + `(cljs.core/aset ~object ~@names ~value)))) ;; From `quantum.untyped.core.form.evaluate` — used below in `defalias` @@ -107,7 +132,8 @@ (defn merge-meta-from [to from] (update-meta to merge (meta from))) (defn replace-meta-from [to from] (with-meta to (meta from))) -#?(:clj (defn defalias* [^clojure.lang.Var orig-var ns-name- var-name] +#?(:clj +(defn defalias* [^clojure.lang.Var orig-var ns-name- var-name] (let [;; to avoid warnings var-name' (with-meta var-name (-> orig-var meta (select-keys [:dynamic]))) ^clojure.lang.Var var- @@ -152,6 +178,19 @@ alias-)] `(defaliases' ~ns-sym ~@names)))) +;; ===== Fundamental type predicates ===== ;; +;; TODO maybe move to `quantum.untyped.core.data`? + +#?(:clj (eval `(defalias ~(if (resolve `fcore/any?) + `fcore/any? + `core/any?))) + :cljs (defalias core/any?)) + +;; This is in here only because `uclass/protocol?` needs it; it's aliased later +(defn lookup? [x] + #?(:clj (instance? clojure.lang.ILookup x) + :cljs (satisfies? cljs.core/ILookup x))) + ;; From `quantum.untyped.core.collections.tree` — used in `quantum.untyped.core.macros` (defn walk @@ -184,15 +223,17 @@ (zipmap #{:always :error :warn :ns} (repeat true))))) (defonce *outs - (atom #?(:clj (if-let [out-path (or (System/getProperty "quantum.core.log:out-file") - (System/getProperty "quantum.core.log|out-file"))] - (let [_ (binding [*out* *err*] (println "Logging to" out-path)) - fos (-> out-path - (java.io.FileOutputStream. ) - (java.io.OutputStreamWriter.) - (java.io.BufferedWriter. ))] - (fn [] [*err* fos])) - (fn [] [*err*])) ; in order to not print to file + (atom #?(:clj (let [file-stream (when-let [path (System/getProperty "quantum.core.log|out-file")] + (binding [*out* *err*] (println "Logging to" path)) + (-> path + (java.io.FileOutputStream.) + (java.io.OutputStreamWriter.) + (java.io.BufferedWriter.))) + print-to-stderror (System/getProperty "quantum.core.log|print-to-stderror") + out-stream + (when (not= "false" print-to-stderror) *err*) + outs (->> [out-stream file-stream] (filterv some?))] + (fn [] outs)) :cljs (fn [] [*out*])))) (defn print-ns-name-to-outs! [ns-name-] diff --git a/src-untyped/quantum/untyped/core/data.cljc b/src-untyped/quantum/untyped/core/data.cljc index 7e820239..8e83a632 100644 --- a/src-untyped/quantum/untyped/core/data.cljc +++ b/src-untyped/quantum/untyped/core/data.cljc @@ -1,11 +1,18 @@ (ns quantum.untyped.core.data + (:refer-clojure :exclude + [seqable?]) (:require - [quantum.untyped.core.convert :as uconv + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.data.array :as uarr] + [quantum.untyped.core.identifiers :refer [>keyword]] - [quantum.untyped.core.core :as ucore])) + [quantum.untyped.core.vars + :refer [defalias]])) (ucore/log-this-ns) +(def val? some?) + (defn quote-map-base [kw-modifier ks & [no-quote?]] (->> ks (map #(vector (cond->> (kw-modifier %) (not no-quote?) (list 'quote)) %)) @@ -13,3 +20,26 @@ #?(:clj (defmacro kw-map [& ks] (list* `hash-map (quote-map-base >keyword ks)))) #?(:clj (defmacro quote-map [& ks] (list* `hash-map (quote-map-base identity ks)))) + +#?(:clj (defn seqable? + "Returns true if (seq x) will succeed, false otherwise." + {:from "clojure.contrib.core"} + [x] + (or (seq? x) + (instance? clojure.lang.Seqable x) + (nil? x) + (instance? Iterable x) + (uarr/array? x) + (string? x) + (instance? java.util.Map x))) + :cljs (def seqable? core/seqable?)) + +(defalias ucore/lookup?) + +(defn editable? [x] + #?(:clj (instance? clojure.lang.IEditableCollection x) + :cljs (satisfies? cljs.core/IEditableCollection x))) + +(defn transient? [x] + #?(:clj (instance? clojure.lang.ITransientCollection x) + :cljs (satisfies? cljs.core/ITransientCollection x))) diff --git a/src-untyped/quantum/untyped/core/data/array.cljc b/src-untyped/quantum/untyped/core/data/array.cljc new file mode 100644 index 00000000..64c770b0 --- /dev/null +++ b/src-untyped/quantum/untyped/core/data/array.cljc @@ -0,0 +1,101 @@ +(ns quantum.untyped.core.data.array + (:refer-clojure :exclude + [array array?]) + (:require + [clojure.core :as core] + [quantum.untyped.core.core + :refer [case-env]] + [quantum.untyped.core.loops :as uloop]) + #?(:clj (:import + [quantum.core Primitive] + [quantum.core.data Array]))) + +(defn array? [x] + #?(:clj (-> x class .isArray) ; must be reflective + :cljs (core/array? x))) + +#?(:clj +(defmacro *<>|sized [n] + (case-env :clj `(Array/newUninitialized1dObjectArray ~n) + :cljs `(let [arr# (cljs.core/array)] + (set! (.-length arr#) ~n) + arr#)))) + +(defn *<>|sized|fn [#?(:clj ^long n :cljs ^number n)] (*<>|sized n)) + +(defn *<>|code + ([] + #?(:clj `(Array/newUninitialized1dObjectArray 0) + :cljs `(core/array))) + ([x0] + #?(:clj `(Array/new1dObjectArray ~x0) + :cljs `(core/array ~x0))) + ([x0 x1] + #?(:clj `(Array/new1dObjectArray ~x0 ~x1) + :cljs `(core/array ~x0 ~x1))) + ([x0 x1 x2] + #?(:clj `(Array/new1dObjectArray ~x0 ~x1 ~x2) + :cljs `(core/array ~x0 ~x1 ~x2))) + ([x0 x1 x2 x3] + #?(:clj `(Array/new1dObjectArray ~x0 ~x1 ~x2 ~x3) + :cljs `(core/array ~x0 ~x1 ~x2 ~x3))) + ([x0 x1 x2 x3 x4] + #?(:clj `(Array/new1dObjectArray ~x0 ~x1 ~x2 ~x3 ~x4) + :cljs `(core/array ~x0 ~x1 ~x2 ~x3 ~x4))) + ([x0 x1 x2 x3 x4 x5] + #?(:clj `(Array/new1dObjectArray ~x0 ~x1 ~x2 ~x3 ~x4 ~x5) + :cljs `(core/array ~x0 ~x1 ~x2 ~x3 ~x4 ~x5))) + ([x0 x1 x2 x3 x4 x5 x6] + #?(:clj `(Array/new1dObjectArray ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6) + :cljs `(core/array ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6))) + ([x0 x1 x2 x3 x4 x5 x6 x7] + #?(:clj `(Array/new1dObjectArray ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6 ~x7) + :cljs `(core/array ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6 ~x7))) + ([x0 x1 x2 x3 x4 x5 x6 x7 x8] + #?(:clj `(Array/new1dObjectArray ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6 ~x7 ~x8) + :cljs `(core/array ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6 ~x7 ~x8))) + ([x0 x1 x2 x3 x4 x5 x6 x7 x8 x9] + #?(:clj `(Array/new1dObjectArray ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6 ~x7 ~x8 ~x9) + :cljs `(core/array ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6 ~x7 ~x8 ~x9))) + ([x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10] + #?(:clj `(Array/new1dObjectArray ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6 ~x7 ~x8 ~x9 ~x10) + :cljs `(core/array ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6 ~x7 ~x8 ~x9 ~x10))) + ([x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 & xs] + #?(:clj (let [arr-sym (gensym "arr")] + `(let [~arr-sym (Array/newUninitialized1dObjectArray ~(+ 11 (count xs)))] + ~@(for [[i x] (->> (concat [x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10] xs) + (map-indexed vector))] + `(Array/set ~arr-sym (Primitive/box ~x) ~i)))) + :cljs `(core/array ~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6 ~x7 ~x8 ~x9 ~x10 ~@xs)))) + +#?(:clj (defmacro *<> [& xs] (apply *<>|code xs))) + +(defn ^"[Ljava.lang.Object;" *<>|fn + ([] (*<>)) + ([x0] (*<> x0)) + ([x0 x1] (*<> x0 x1)) + ([x0 x1 x2] (*<> x0 x1 x2)) + ([x0 x1 x2 x3] (*<> x0 x1 x2 x3)) + ([x0 x1 x2 x3 x4] (*<> x0 x1 x2 x3 x4)) + ([x0 x1 x2 x3 x4 x5] (*<> x0 x1 x2 x3 x4 x5)) + ([x0 x1 x2 x3 x4 x5 x6] (*<> x0 x1 x2 x3 x4 x5 x6)) + ([x0 x1 x2 x3 x4 x5 x6 x7] (*<> x0 x1 x2 x3 x4 x5 x6 x7)) + ([x0 x1 x2 x3 x4 x5 x6 x7 x8] (*<> x0 x1 x2 x3 x4 x5 x6 x7 x8)) + ([x0 x1 x2 x3 x4 x5 x6 x7 x8 x9] (*<> x0 x1 x2 x3 x4 x5 x6 x7 x8 x9)) + ([x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10] (*<> x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10)) + ([x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 & xs] + #?(:clj (let [arr (Array/newUninitialized1dObjectArray (+ 11 (count xs)))] + (Array/set arr x0 0) + (Array/set arr x1 1) + (Array/set arr x2 2) + (Array/set arr x3 3) + (Array/set arr x4 4) + (Array/set arr x5 5) + (Array/set arr x6 6) + (Array/set arr x7 7) + (Array/set arr x8 8) + (Array/set arr x9 9) + (Array/set arr x10 10) + (uloop/doseqi [x xs i] (doto arr (Array/set x (+ 11 i))))) + :cljs (let [arr #js [x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10]] + (uloop/doseq [x xs] (doto arr (.push x))))))) diff --git a/src-untyped/quantum/untyped/core/data/bits.cljc b/src-untyped/quantum/untyped/core/data/bits.cljc index 4ecc0035..628a5247 100644 --- a/src-untyped/quantum/untyped/core/data/bits.cljc +++ b/src-untyped/quantum/untyped/core/data/bits.cljc @@ -1,34 +1,50 @@ (ns - ^{:doc "Useful bit/binary operations." + ^{:doc "Useful bit/binary operations, at the primitive (boolean, byte, long, etc.) and + pre-primitive level." :attribution "alexandergunnarson"} quantum.untyped.core.data.bits - (:refer-clojure :exclude [not and or reverse contains? empty conj disj]) - (:require - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.vars - :refer [defalias]]) - #?(:clj (:import quantum.core.Numeric))) + (:refer-clojure :exclude + [and not or, conj contains? disj empty reverse]) + (:require + [clojure.core :as core] + #?(:clj [clojure.future :as fcore]) + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.vars + :refer [defalias]]) +#?(:clj (:import quantum.core.Numeric))) (ucore/log-this-ns) -(defalias not bit-not) -(defalias and bit-and) -(defalias and-not bit-and-not) -(defalias or bit-or) -(defalias xor bit-xor) -(defalias not! bit-flip) -(defalias disj bit-clear) -(defalias conj bit-set) -(defalias contains? bit-test) +;; ===== Bit logic ===== ;; + +(defalias not bit-not) +(defalias and bit-and) +(defalias and-not bit-and-not) +(defalias or bit-or) +(defalias xor bit-xor) +(defalias not! bit-flip) + +;; ===== Bit set operations ===== ;; + +(defalias disj bit-clear) + (def ^:const empty 0) -;; ===== SHIFTS ===== ;; +(defn conj + ([] empty) + ([xs] xs) + ([xs v] (bit-set xs v)) + ([xs v0 v1] (-> xs (conj v0) (conj v1)))) + +(defalias contains? bit-test) + +;; ===== Shifts ===== ;; (defalias << bit-shift-left) (defalias >> bit-shift-right) (defalias >>> unsigned-bit-shift-right) -;; ===== ROTATIONS ===== ;; +;; ===== Rotations ===== ;; (defn rotate-left|long {:adapted-from "http://hg.openjdk.java.net/jdk7u/jdk7u6/jdk/file/8c2c5d63a17e/src/share/classes/java/lang/Integer.java"} @@ -56,7 +72,7 @@ (declare bits) -; ===== BULK BIT OPERATIONS ===== ; +;; ===== Bulk bit operations ===== ;; (defn ?-coll "Returns true or false for the bit at the given index of the collection." @@ -76,8 +92,14 @@ #?(:clj ^long n :cljs n)] (and x (unchecked-dec (<< 1 n)))) -; ====== ENDIANNESS REVERSAL ======= +;; ===== Primitives ===== ;; + +#?(:clj (eval `(defalias ~(if (resolve `fcore/boolean?) + `fcore/boolean? + `core/boolean?))) + :cljs (defalias core/boolean?)) -#?(:clj (defn reverse|short [x] (Numeric/reverseShort (short x)))) -#?(:clj (defn reverse|int [x] (Numeric/reverseInt (int x)))) -#?(:clj (defn reverse|long [^long x] (Numeric/reverseLong x))) +#?(:clj (eval `(defalias ~(if (resolve `fcore/double?) + `fcore/double? + `core/double?))) + :cljs (defalias core/double?)) diff --git a/src-untyped/quantum/untyped/core/data/hash.cljc b/src-untyped/quantum/untyped/core/data/hash.cljc new file mode 100644 index 00000000..07aa1345 --- /dev/null +++ b/src-untyped/quantum/untyped/core/data/hash.cljc @@ -0,0 +1,71 @@ +(ns quantum.untyped.core.data.hash + (:refer-clojure :exclude + [hash]) + (:require + [clojure.core :as core]) +#?(:cljs (:require-macros + [quantum.untyped.core.data.hash :as self]))) + +(def ^:const default -1) + +(def hash core/hash) + +(defn code [x] + #?(:clj (clojure.lang.Util/hash x) + :cljs (hash x))) + +(def unordered hash-unordered-coll) +(def ordered hash-ordered-coll) +(def mix mix-collection-hash) + +#?(:clj +;; Macro for efficiency; we will demacro in the typed version +(defmacro unordered-args [& args] + `(-> 0 ~@(->> args (map (fn [arg] `(unchecked-add-int (hash ~arg))))) + (mix-collection-hash ~(count args)) + int))) + +#?(:clj +(defmacro caching-set-unordered! + "Tries to retrive an cached unordered hash value at the provided field. If not found, sets the + field with an unordered hash value computed using the provided args. + + See also https://clojure.org/reference/data_structures." + [field #_simple-symbol? & args] + `(if (identical? ~field (unchecked-int default)) + (set! ~field (unordered-args ~@args)) + ~field))) + +#?(:clj +;; Macro for efficiency; we will demacro in the typed version +(defmacro ordered-args [& args] + `(-> 1 ~@(->> args (map (fn [arg] + `(-> (unchecked-multiply-int 31) + (unchecked-add-int (hash ~arg)))))) + (mix-collection-hash ~(count args)) + int))) + +#?(:clj +(defmacro caching-set-ordered! + "Tries to retrive an cached ordered hash value at the provided field. If not found, sets the + field with an ordered hash value computed using the provided args. + + See also https://clojure.org/reference/data_structures." + [field #_simple-symbol? & args] + `(if (identical? ~field (unchecked-int default)) + (set! ~field (ordered-args ~@args)) + ~field))) + +#?(:clj +;; Macro for efficiency; we will demacro in the typed version +(defmacro code-args [& args] + `(-> 0 ~@(->> args (map (fn [arg] `(unchecked-add-int (code ~arg)))))))) + +#?(:clj +(defmacro caching-set-code! + "Tries to retrive a cached hash-code value at the provided field. If not found, sets the field + with a computed hash-code using the sum of the hash-codes of the provided args." + [field #_simple-symbol? & args] + `(if (identical? ~field (unchecked-int default)) + (set! ~field (code-args ~@args)) + ~field))) diff --git a/src-untyped/quantum/untyped/core/data/map.cljc b/src-untyped/quantum/untyped/core/data/map.cljc index 7cde4d0f..ddd43c0b 100644 --- a/src-untyped/quantum/untyped/core/data/map.cljc +++ b/src-untyped/quantum/untyped/core/data/map.cljc @@ -1,110 +1,252 @@ -(ns - ^{:doc "Useful map functions. |map-entry|, a better merge, sorted-maps, etc." - :attribution "alexandergunnarson"} - quantum.untyped.core.data.map +(ns quantum.untyped.core.data.map + "Map functions. |map-entry|, a better merge, sorted-maps, etc." (:refer-clojure :exclude [split-at, merge, sorted-map sorted-map-by, array-map, hash-map]) (:require [clojure.core :as core] [clojure.data.avl :as avl ] +#?(:clj [flatland.ordered.map :as ordered-map] + :cljs [linked.core :as linked]) #?@(:clj [[clojure.data.int-map :as imap] - [flatland.ordered.map :as omap] [seqspert.hash-map]]) - [quantum.untyped.core.convert :as uconv] [quantum.untyped.core.data :as udata] + [quantum.untyped.core.identifiers + :refer [>keyword]] [quantum.untyped.core.reducers :as ur :refer [reduce-pair]] [quantum.untyped.core.vars - :refer [defalias]]) + :refer [defalias def-]]) (:import -#?@(:clj - [java.util.HashMap - [it.unimi.dsi.fastutil.ints Int2ReferenceOpenHashMap] - [it.unimi.dsi.fastutil.longs Long2LongOpenHashMap - Long2ReferenceOpenHashMap] - [it.unimi.dsi.fastutil.doubles Double2ReferenceOpenHashMap] - [it.unimi.dsi.fastutil.objects Reference2LongOpenHashMap]]))) - -;; TO EXPLORE -;; - Optimizing Hash-Array Mapped Tries for Fast and Lean Immutable JVM Collections -;; - http://michael.steindorfer.name/publications/oopsla15.pdf -;; - Overall significantly faster on what they've chosen to measure. -;; - Alex Miller: "We have seen it and will probably investigate some of these ideas after 1.8." -;; ======================= - -#?(:clj (def int-map imap/int-map )) -#?(:clj (defalias hash-map:long->ref int-map)) -(defalias array-map core/array-map) -(defalias hash-map core/hash-map ) - -(defalias ordered-map #?(:clj omap/ordered-map :cljs array-map)) -(defalias om ordered-map) +#?@(:clj [[java.util HashMap IdentityHashMap LinkedHashMap TreeMap] + [it.unimi.dsi.fastutil.ints Int2ReferenceOpenHashMap] + [it.unimi.dsi.fastutil.longs Long2LongOpenHashMap + Long2ReferenceOpenHashMap] + [it.unimi.dsi.fastutil.doubles Double2ReferenceOpenHashMap] + [it.unimi.dsi.fastutil.objects Reference2LongOpenHashMap]] + :cljs [[goog.structs AvlTree LinkedMap]]))) + +(defn +map-entry? [x] (instance? #?(:clj clojure.lang.MapEntry :cljs cljs.core.MapEntry) x)) + +;; ----- Hash maps ----- ;; + +;; TODO TYPED — use `deftypet` and also typed internals +#?(:cljs +(deftype MutableHashMap ; There can be no `undefined` values + [meta ^:mutable ct ^js/Map m #_"Keys are int hashes; vals are map entries from k to v" + ^:mutable ^boolean has-nil? ^:mutable nil-val ^:mutable __hash] + Object + (toString [this] (str (into {} (es6-iterator-seq (.values m))))) + (equiv [this other] (-equiv this other)) + (keys [this] (es6-iterator (cljs.core/keys this))) + (entries [this] (es6-entries-iterator (seq this))) + (values [this] (es6-iterator (vals this))) + (has [this k] (contains? this k)) + (get [this k not-found] (-lookup this k not-found)) + (forEach [this f] (doseq [[k v] this] (f v k))) + ICloneable + (-clone [_] (MutableHashMap. meta ct m has-nil? nil-val __hash)) + IIterable + (-iterator [this] (-iterator (vals this))) + IWithMeta + (-with-meta [this meta-] (MutableHashMap. meta- ct m has-nil? nil-val __hash)) + IMeta + (-meta [this] meta) + IEmptyableCollection + (-empty [this] (MutableHashMap. meta 0 (js/Map.) false nil 0)) + IEquiv + (-equiv [this that] (equiv-map this that)) + IHash + (-hash [this] (caching-hash this hash-unordered-coll __hash)) + ISeqable + (-seq [this] + (when (pos? ct) + (let [s (es6-iterator-seq (.values m))] + (if has-nil? + (cons (>map-entry nil nil-val) s) + s)))) + ICounted + (-count [this] ct) + ILookup + (-lookup [this k] (-lookup this k nil)) + (-lookup [this k not-found] + (if (nil? k) + (if has-nil? nil-val not-found) + (let [kv (.get m (hash k))] + (if (undefined? kv) not-found (-val kv))))) + IAssociative + (-contains-key? [this k] + (if (nil? k) + has-nil? + (.has m (hash k)))) + IFind + (-find [this k] + (if (nil? k) + (when has-nil? (>map-entry nil nil-val)) + (let [kv (.get m (hash k))] + (if (undefined? kv) nil kv)))) + ITransientCollection + (-conj! [this entry] + (if (vector? entry) + (-assoc! this (-nth entry 0) (-nth entry 1)) + (loop [ret this es (seq entry)] + (if (nil? es) + ret + (let [e (first es)] + (if (vector? e) + (recur (-assoc! ret (-nth e 0) (-nth e 1)) + (next es)) + (throw (ex-info "conj on a map takes map entries or seqables of map entries" {})))))))) + ITransientAssociative + (-assoc! [this k v] + (cond + (undefined? v) + (throw (ex-info "Cannot `assoc` undefined value to `MutableHashMap`" {})) + (nil? k) + (if (and has-nil? (identical? v nil-val)) + this + (do (when-not has-nil? (set! ct (inc ct))) + (set! has-nil? true) + (set! nil-val v) + (set! __hash nil) ; TODO recalculate incrementally? + this)) + :else + (let [hash-k (hash k)] + (if (.has m hash-k) + this + (do (.set m (hash k) (map-entry k v)) + (set! ct (inc ct)) + (set! __hash nil) ; TODO recalculate incrementally? + this))))) + ITransientMap + (-dissoc! [this k] + (if (nil? k) + (if has-nil? + (do (set! ct (dec ct)) + (set! has-nil? false) + (set! nil-val nil) + (set! __hash nil) ; TODO recalculate incrementally? + this) + this) + (if (.delete m (hash k)) + (do (set! ct (dec ct)) + (set! __hash nil) ; TODO recalculate incrementally? + this) + this))) + IKVReduce + (-kv-reduce [this f init] + (let [init (if has-nil? (f init nil nil-val) init)] + (if (reduced? init) + @init + (unreduced (reduce (fn [ret kv] (f ret (-key kv) (-val kv))) init m))))) + IFn + (-invoke [this k] (-lookup this k)) + (-invoke [this k not-found] (-lookup this k not-found)))) -#?(:clj (defn ^java.util.LinkedHashMap !ordered-map [] (java.util.LinkedHashMap.))) +#?(:clj (def hash-map? (partial instance? clojure.lang.PersistentHashMap))) -#?(:clj -(defmacro kw-omap - "Like `kw-map`, but preserves insertion order." - [& ks] - (list* `om (udata/quote-map-base uconv/>keyword ks)))) + (defalias hash-map core/hash-map) -(defalias core/sorted-map ) -(defalias core/sorted-map-by) +#?(:clj (defalias hash-map|long->ref imap/int-map)) +#?(:clj (defalias int-map hash-map|long->ref)) -(defn sorted-map-by-val [m-0] - (sorted-map-by (fn [k1 k2] - (compare [(get m-0 k2) k2] - [(get m-0 k1) k1])))) +(defn >!hash-map + "Creates a single-threaded, mutable hash map. + On the JVM, this is a `java.util.HashMap`. + On JS, this is a `quantum.untyped.core.data.map.HashMap`." + ([] #?(:clj (HashMap.) :cljs (MutableHashMap. nil 0 (js/Map.) false nil nil)))) -(defalias sorted-rank-map avl/sorted-map ) -(defalias sorted-rank-map-by avl/sorted-map-by ) -(defalias avl/nearest ) -(defalias avl/rank-of ) -(defalias avl/subrange ) -(defalias avl/split-key) -(defalias avl/split-at ) +;; ===== Ordered value-semantic maps ===== ;; -; TODO look at imap/merge +;; ---- Insertion-ordered ----- ;; -; `(apply hash-map pairs)` <~> `lodash/fromPairs` +(defalias ordered-map #?(:clj ordered-map/ordered-map :cljs linked/map)) +(defalias om ordered-map) -(defn map-entry - "A performant replacement for creating 2-tuples (vectors), e.g., as return values - in a |kv-reduce| function. +#?(:clj +(defmacro kw-omap + "Like `kw-map`, but preserves insertion order." + [& ks] + (list* `om (udata/quote-map-base >keyword ks)))) - Now overshadowed by ztellman's unrolled vectors in 1.8.0. +;; ----- Comparison-ordered (sorted) ----- ;; - Time to create 100000000 2-tuples: - new tuple-vector 55.816415 ms - map-entry 37.542442 ms +(defalias core/sorted-map) +(defalias core/sorted-map-by) - However, insertion into maps is faster with map-entry: +(defn gen-compare-by-val [m] (fn [k0 k1] (compare [(get m k1) k1] [(get m k0) k0]))) - (def vs [[1 2] [3 4]]) - (def ms [(map-entry 1 2) (map-entry 3 4)]) - (def m0 {}) - 508.122831 ms (dotimes [n 1000000] (into m0 vs)) - 310.335998 ms (dotimes [n 1000000] (into m0 ms))" - {:attribution "alexandergunnarson"} - [k v] - #?(:clj (clojure.lang.MapEntry. k v) - :cljs [k v])) +(defn sorted-map-by-val [m & kvs] (apply sorted-map-by (gen-compare-by-val m) kvs)) -(defn map-entry-seq [args] - (loop [[k v :as args-n] args - accum []] - (if (empty? args-n) - accum - (recur (-> args-n rest rest) - (conj accum (map-entry k v)))))) +;; TODO `goog.structs.AvlTree` has similar to this; implement with `defnt` +(defalias sorted-rank-map avl/sorted-map) +(defalias sorted-rank-map-by avl/sorted-map-by) +(defalias avl/nearest) +(defalias avl/rank-of) +(defalias avl/subrange) +(defalias avl/split-key) +(defalias avl/split-at) + +(defn >!sorted-map-by + "Creates a single-threaded, mutable sorted map with the specified comparator. + On the JVM, this is a `java.util.TreeMap`. + On JS, this is a `goog.structs.AvlTree`." + ([compf] #?(:clj (TreeMap. ^java.util.Comparator compf) :cljs (AvlTree. compf)))) + +(defn >!sorted-map [] (>!sorted-map-by compare)) + +;; ===== Interval Tree / Map ===== ;; + +;; TODO this is just a placeholder until we can use `com.dean.clojure-interval-tree` +;; (Adapted from http://clj-me.cgrand.net/2012/03/16/a-poor-mans-interval-tree/) + +(defn- interval< [[a b] [c d]] + (boolean (and b c + (if (= a b) + (neg? (compare b c)) + (<= (compare b c) 0))))) + +(def- interval-map|empty (sorted-map-by interval< [nil nil] #{})) + +(defn- interval-map|split-at [m x] + (if x + (let [[[a b :as k] vs] (find m [x x])] + (if (or (= a x) (= b x)) + m + (-> m (dissoc k) (assoc [a x] vs [x b] vs)))) + m)) + +(defn- interval-map|alter [m from to f & args] + (let [m (-> m (interval-map|split-at from) (interval-map|split-at to)) + kvs (for [[r vs] + (cond + (and from to) (subseq m >= [from from] < [to to]) + from (subseq m >= [from from]) + to (subseq m < [to to]) + :else m)] + [r (apply f vs args)])] + (into m kvs))) + +(defn interval|assoc [m from to v] (interval-map|alter m from to conj v)) +(defn interval|dissoc [m from to v] (interval-map|alter m from to disj v)) +(defn interval|get [m x] (get m [x x])) + +(defn interval-map [] interval-map|empty) + +(-> (interval-map) + (interval|assoc 0 5 :a) + (interval|assoc 1 6 :b) + (interval|assoc 2 7 :c) + (interval|get 2)) + +;; ===== General ===== ;; -#?(:clj (def hash-map? (partial instance? clojure.lang.PersistentHashMap))) +; TODO look at imap/merge ; TODO use |clojure.data.int-map/merge and merge-with|, |update|, |update!| for int maps. ; Benchmark these. (defn merge - "A performant drop-in replacement for |clojure.core/merge|. + "A performant drop-in replacement for `clojure.core/merge`. 398.815137 msecs (core/merge m1 m2) 188.270844 msecs (seqspert.hash-map/sequential-splice-hash-maps m1 m2) @@ -139,76 +281,6 @@ (reduce pmerge (pmerge m0 m1) ms)))) -; TODO generate these functions via macros -(defn #?(:clj ^HashMap !hash-map :cljs !hash-map) - "Creates a single-threaded, mutable hash map. - On the JVM, this is a java.util.HashMap. - - On JS, this is a `js/Map` (ECMAScript 6 Map)." - ([] #?(:clj (HashMap.) :cljs (js/Map.))) - ([k0 v0] - (doto #?(:clj (HashMap.) :cljs (js/Map.)) - (#?(:clj .put :cljs .set) k0 v0))) - ([k0 v0 k1 v1] - (doto #?(:clj (HashMap.) :cljs (js/Map.)) - (#?(:clj .put :cljs .set) k0 v0) - (#?(:clj .put :cljs .set) k1 v1))) - ([k0 v0 k1 v1 k2 v2] - (doto #?(:clj (HashMap.) :cljs (js/Map.)) - (#?(:clj .put :cljs .set) k0 v0) - (#?(:clj .put :cljs .set) k1 v1) - (#?(:clj .put :cljs .set) k2 v2))) - ([k0 v0 k1 v1 k2 v2 k3 v3] - (doto #?(:clj (HashMap.) :cljs (js/Map.)) - (#?(:clj .put :cljs .set) k0 v0) - (#?(:clj .put :cljs .set) k1 v1) - (#?(:clj .put :cljs .set) k2 v2) - (#?(:clj .put :cljs .set) k3 v3))) - ([k0 v0 k1 v1 k2 v2 k3 v3 k4 v4] - (doto #?(:clj (HashMap.) :cljs (js/Map.)) - (#?(:clj .put :cljs .set) k0 v0) - (#?(:clj .put :cljs .set) k1 v1) - (#?(:clj .put :cljs .set) k2 v2) - (#?(:clj .put :cljs .set) k3 v3) - (#?(:clj .put :cljs .set) k4 v4))) - ([k0 v0 k1 v1 k2 v2 k3 v3 k4 v4 k5 v5] - (doto #?(:clj (HashMap.) :cljs (js/Map.)) - (#?(:clj .put :cljs .set) k0 v0) - (#?(:clj .put :cljs .set) k1 v1) - (#?(:clj .put :cljs .set) k2 v2) - (#?(:clj .put :cljs .set) k3 v3) - (#?(:clj .put :cljs .set) k4 v4) - (#?(:clj .put :cljs .set) k5 v5))) - ([k0 v0 k1 v1 k2 v2 k3 v3 k4 v4 k5 v5 k6 v6 & kvs] - (reduce-pair - (fn [#?(:clj ^HashMap m :cljs m) k v] (doto m (#?(:clj .put :cljs .set) k v))) - (doto #?(:clj (HashMap.) :cljs (js/Map.)) - (#?(:clj .put :cljs .set) k0 v0) - (#?(:clj .put :cljs .set) k1 v1) - (#?(:clj .put :cljs .set) k2 v2) - (#?(:clj .put :cljs .set) k3 v3) - (#?(:clj .put :cljs .set) k4 v4) - (#?(:clj .put :cljs .set) k5 v5) - (#?(:clj .put :cljs .set) k6 v6)) - kvs))) - -; TODO generate these functions via macros -#?(:clj (defn ^Int2ReferenceOpenHashMap !hash-map:int->ref [] (Int2ReferenceOpenHashMap.))) -#?(:clj (defalias !hash-map:int->object !hash-map:int->ref)) - -#?(:clj (defn ^Long2LongOpenHashMap !hash-map:long->long [] (Long2LongOpenHashMap.))) -#?(:clj (defalias !hash-map:long !hash-map:long->long)) - -#?(:clj (defn ^Long2ReferenceOpenHashMap !hash-map:long->ref [] (Long2ReferenceOpenHashMap.))) -#?(:clj (defalias !hash-map:long->object !hash-map:long->ref)) - -#?(:clj (defn ^Double2ReferenceOpenHashMap !hash-map:double->ref [] (Double2ReferenceOpenHashMap.))) -#?(:clj (defalias !hash-map:double->object !hash-map:double->ref)) - -#?(:clj (defn ^Reference2LongOpenHashMap !hash-map:ref->long [] (Reference2LongOpenHashMap.))) -#?(:clj (defalias !hash-map:object->long !hash-map:ref->long)) - - (defn bubble-max-key [k coll] ; TODO move "Move a maximal element of coll according to fn k (which returns a number) to the front of coll." @@ -246,4 +318,3 @@ ([m0 m1 & ms] (let [bubbled-ms (bubble-max-key #(- (count %)) (conj ms m1 m0))] (reduce intersection-by-key (first bubbled-ms) (rest bubbled-ms))))) - diff --git a/src-untyped/quantum/untyped/core/data/reactive.cljc b/src-untyped/quantum/untyped/core/data/reactive.cljc new file mode 100644 index 00000000..4403a247 --- /dev/null +++ b/src-untyped/quantum/untyped/core/data/reactive.cljc @@ -0,0 +1,411 @@ +(ns quantum.untyped.core.data.reactive + "Most of the content adapted from `reagent.ratom` 2018-10-20. Note that `lynaghk/reflex` was the + source of the Reagent Atom and Reaction (and before that https://knockoutjs.com/documentation/computedObservables.html, and before that probably + something else), and it makes do with 78 LOC (!) whereas we grapple with nearly 400 for + presumably very similar functionality. Perhaps someday this code can be compressed. + + Includes `Reference` and `Reaction`; may include `Subscription` at some point. + + Currently only safe for single-threaded use; needs a rethink to accommodate concurrent + modification/access and customizable queueing strategies. + - We could either introduce concurrency-safe versions of `Reaction` and `Reference`, or we + could introduce a global single thread on which `Reaction`s and `Reference`s are modified, + but from which any number of threads can read, in a clojure.async sort of way." + (:require + [clojure.core :as core] + [clojure.set :as set] + [quantum.untyped.core.async :as uasync] + [quantum.untyped.core.data.vector + :refer [alist alist== alist-conj! alist-count alist-empty! alist-get]] + [quantum.untyped.core.error :as uerr] + [quantum.untyped.core.form.generate.deftype :as udt] + [quantum.untyped.core.log :as ulog] + [quantum.untyped.core.logic + :refer [ifs]] + [quantum.untyped.core.refs :as uref] + [quantum.untyped.core.vars + :refer [defonce-]]) +#?(:clj (:import [java.util ArrayList]))) + +;; ===== Internal functions for reactivity ===== ;; + +(def ^:dynamic *ref-context* nil) + +(def ^:dynamic #?(:clj *debug?* :cljs ^boolean *debug?*) false) + +(defonce- *running (core/atom 0)) + +(defonce global-queue (alist)) + +(defn- check-watches [old new] + (when (true? *debug?*) (swap! *running + (- (count new) (count old)))) + new) + +(defn norx-deref [rx] + (binding [*ref-context* nil] + #?(:clj (.deref ^clojure.lang.IDeref rx) + :cljs (-deref ^non-native rx)))) + +(defn ?norx-deref [x] (if (uref/derefable? x) (norx-deref x) x)) + +(defprotocol PWatchable + (getWatches [this]) + (setWatches [this v])) + +(defn- add-w! [^quantum.untyped.core.data.reactive.PWatchable x k f] + (let [w (.getWatches x)] + (.setWatches x (check-watches w (assoc w k f))) + x)) + +(defn- remove-w! [^quantum.untyped.core.data.reactive.PWatchable x k] + (let [w (.getWatches x)] + (.setWatches x (check-watches w (dissoc w k))) + x)) + +(defn- conj-kv! [#?(:clj ^ArrayList xs :cljs xs) k v] + (-> xs (alist-conj! k) (alist-conj! v))) + +(defn- notify-w! [^quantum.untyped.core.data.reactive.PWatchable x old new] + ;; Unlike Reagent, we do not copy to an array-list because in order to do so, we have to traverse + ;; the map anyway if the watches have changed. Plus we avoid garbage (except for the closure). + ;; Reagent optimizes for the case that watches will more rarely change than not. It would be nice + ;; to avoid that tradeoff by having a sufficiently fast reduction. + (when-some [w #?(:clj ^clojure.lang.IKVReduce (.getWatches x) :cljs ^non-native (.getWatches x))] + (#?(:clj .kvreduce :cljs -kv-reduce) w (fn [_ k f] (f k x old new)) nil)) + x) + +#?(:cljs +(defn- pr-ref! [a writer opts s] + (-write writer (str "#<" s " ")) + (pr-writer (binding [*ref-context* nil] (-deref ^non-native a)) writer opts) + (-write writer ">"))) + +;; ===== Reference ===== ;; + +(defprotocol PReactive) + +(defprotocol PHasCaptured + (getCaptured [this]) + (setCaptured [this v])) + +(defn- notify-deref-watcher! + "Add `derefed` to the `captured` field of `*ref-context*`. + + See also `in-context`" + [derefed] + (when-some [context *ref-context*] + (let [^quantum.untyped.core.data.reactive.PHasCaptured r context] + (if-some [c (.getCaptured r)] + (alist-conj! c derefed) + (.setCaptured r (alist derefed)))))) + +;; TODO use `loop` with array for interceptors rather than creating a closure every time +(defn- gen-call|rf [r oldv] + (fn ([newv'] newv') + ([newv' [k f]] (f r k oldv newv')) + ([newv' k f] (f r k oldv newv')))) + +;; Note that `interceptors` are all deref-capturing +(udt/deftype Reference [^:! state meta validator ^:! watches ^:! interceptors] + {;; IPrintWithWriter + ;; (-pr-writer [a w opts] (pr-ref a w opts "Reference:")) + PReactive nil + ?Equals {= ([this that] (identical? this that))} + ?Deref {deref ([this] + (notify-deref-watcher! this) + state)} + uref/PMutableReference + {get ([this] (norx-deref this)) + set! ([this newv] + (when-not (nil? validator) + (assert (validator newv) "Validator rejected reference state")) + (let [oldv state] + (if (identical? oldv newv) + newv + (let [oldv state] + (set! state (if (nil? interceptors) + newv + ;; TODO room for optimization here — e.g. use array for interceptors, with `loop` + (reduce-kv (gen-call|rf this oldv) newv interceptors))) + (when-not (nil? watches) (notify-w! this oldv newv)) + newv))))} + ?Watchable {add-watch! ([this k f] (add-w! this k f)) + remove-watch! ([this k] (remove-w! this k))} + PWatchable {getWatches ([this] watches) + setWatches ([this v] (set! watches v))} + uref/PInterceptable + {add-interceptor! ([this k f] (set! interceptors (assoc interceptors k f)))} + ?Meta {meta ([_] meta) + with-meta ([_ meta'] (Reference. state meta' validator watches interceptors))} +#?@(:cljs [?Hash {hash ([_] (goog/getUid this))}])}) + +(defn ! + "Reactive '!' (single-threaded mutable reference). Like `ref/!`, except that it keeps track of + derefs." + ([x] (Reference. x nil nil nil nil)) + ([x validator] (Reference. x nil validator nil nil))) + +;; ===== Reaction ("Computed Observable") ===== ;; + +;; Similar to java.io.Closeable +;; TODO move +(defprotocol PDisposable + (dispose [this]) + (addOnDispose [this f])) + +(defn dispose! [x] (dispose x)) +(defn add-on-dispose! [x f] (addOnDispose x f)) + +(declare flush! run-reaction! update-watching!) + +;; Note that `interceptors` are all deref-capturing +(udt/deftype Reaction + [^:! ^boolean ^:get alwaysRecompute + ^:! ^:get ^:set caught + ^:! captured + ^:! ^boolean ^:get ^:set computed + enqueue-fn + eq-fn + f + ^boolean no-cache? + ^:! on-dispose + ^:! on-dispose-arr + queue + ^:! ^:get ^:set state + ^:! ^:get ^:set watching ; i.e. 'dependents' + ^:! watches ; TODO consider a mutable map for `watches` + ^:! ^:get interceptors] ; TODO consider a mutable map for `interceptors` + {;; IPrintWithWriter + ;; (-pr-writer [a w opts] (pr-ref a w opts (str "Reaction " (hash a) ":"))) + ?Equals {= ([this that] (identical? this that))} +#?@(:cljs [?Hash {hash ([this] (goog/getUid this))}]) + PReactive nil + ?Deref {deref ([this] + (if-not (nil? caught) + (throw caught) + (let [non-reactive? (nil? *ref-context*)] + (when non-reactive? (flush! queue)) + (if (and non-reactive? alwaysRecompute) + (when-not computed + (let [old-state state] + (set! state + (if (nil? interceptors) + (f) + (reduce-kv (gen-call|rf this old-state) (f) interceptors))) + (when-not (or (nil? watches) (eq-fn old-state state)) + (notify-w! this old-state state)))) + (do (notify-deref-watcher! this) + (when-not computed (run-reaction! this false)))) + state)))} + uref/PMutableReference {get ([this] (norx-deref this))} + ?Watchable {add-watch! ([this k f] (add-w! this k f)) + remove-watch! ([this k] + (let [was-empty? (empty? watches)] + (remove-w! this k) + (when (and (not was-empty?) + (empty? watches) + (true? alwaysRecompute)) + (.dispose this))))} + PWatchable {getWatches ([this] watches) + setWatches ([this v] (set! watches v))} + uref/PInterceptable + {add-interceptor! ([this k f] (set! interceptors (assoc interceptors k f)))} + PHasCaptured + {getCaptured ([this] captured) + setCaptured ([this v] (set! captured v))} + PDisposable + {dispose + ([this] + (let [s state, wg watching] + (set! watching nil) + (set! state nil) + (set! alwaysRecompute #?(:clj (boolean true) :cljs true)) + (set! computed #?(:clj (boolean false) :cljs false)) + (doseq [w (set wg)] (#?(:clj remove-watch :cljs -remove-watch) w this)) + (set! interceptors nil) + (when (some? on-dispose) (on-dispose s)) + (when-some [a on-dispose-arr] + (dotimes [i (long (alist-count a))] ((alist-get a i) this))))) + addOnDispose + ([this f] + ;; f is called with the reaction as argument when it is no longer active + (if-some [a on-dispose-arr] + (alist-conj! a f) + (set! on-dispose-arr (alist f))))}}) + +(defn- deref-capture! + "When `f` is executed, if `(f)` and/or `interceptors` deref any reactive references, they are then + added to `(.-captured rx)` (i.e. `*ref-context*`). Then calls `update-watching!` on `rx` with any + `deref`ed reactive references captured, if any differ from the `watching` field of `rx`. Sets + the `computed` flag on `rx` to true. + + Inside `update-watching!` along with adding the references in `(-.watching rx)` of reaction, the + reaction is also added to the list of watches on each of the references that `f`+`interceptors` + deref. + + See `notify-deref-watcher!` to know how `*ref-context*` is updated." + [^Reaction rx] + (.setCaptured rx nil) + (let [oldv (.getState rx) + interceptors (.getInterceptors rx) + newv (binding [*ref-context* rx] + (if (nil? interceptors) + ((.-f rx)) + (reduce-kv (gen-call|rf rx oldv) ((.-f rx)) interceptors))) + c (.getCaptured rx)] + (.setComputed rx true) + ;; Optimize common case where derefs occur in same order + (when-not (alist== c (.getWatching rx)) (update-watching! rx c)) + newv)) + +(defn- try-capture! [^Reaction rx] + (uerr/catch-all + (do (.setCaught rx nil) + (deref-capture! rx)) + e + (do (.setState rx e) + (.setCaught rx e) + (.setComputed rx true)))) + +(defn- run-reaction! [^Reaction rx check?] + (let [old-state (.getState rx) + new-state (if check? + (try-capture! rx) + (deref-capture! rx))] + (when-not (.-no-cache? rx) + (.setState rx new-state) + (when-not (or (nil? (.getWatches rx)) + ((.-eq-fn rx) old-state new-state)) + (notify-w! rx old-state new-state))) + new-state)) + +(defn- handle-reaction-change! [^Reaction rx sender oldv newv] + (when-not (or (identical? oldv newv) (not (.getComputed rx))) + (if (.getAlwaysRecompute rx) + (do (.setComputed rx false) + ((.-enqueue-fn rx) (.-queue rx) rx)) + (run-reaction! rx false)))) + +(defn- update-watching! [^Reaction rx derefed] + (let [new (set derefed) ; TODO incrementally calculate `set` + old (set (.getWatching rx))] ; TODO incrementally calculate `set` + (.setWatching rx derefed) + (doseq [w (set/difference new old)] ; TODO optimize + (#?(:clj add-watch :cljs -add-watch) w rx handle-reaction-change!)) + (doseq [w (set/difference old new)] ; TODO optimize + (#?(:clj remove-watch :cljs -remove-watch) w rx)))) + +(defn- run-reaction-from-queue! [^Reaction rx] + (when-not (or (.getComputed rx) (nil? (.getWatching rx))) + (run-reaction! rx true))) + +(defn flush! [queue] + (loop [i 0] + (let [ct (-> queue alist-count long)] + ;; NOTE: We avoid `pop`-ing in order to reduce churn but in theory it presents a memory issue + ;; due to the possible unboundedness of the queue + ;; NOTE: In the Reagent version, every time a new "chunk" of the queue is worked on, that + ;; chunk is scheduled for re-render + ;; I.e. took care of all queue entries and reached a stable state + (if-let [reached-last-index? (>= i ct)] + (alist-empty! queue) + (let [remaining-ct (unchecked-subtract ct i)] + (dotimes [i* remaining-ct] + (run-reaction-from-queue! (alist-get queue (unchecked-add i i*)))) + ;; `recur`s because sometimes the queue gets added to in the process of running rx's + (recur (+ i remaining-ct))))))) + +(defn- default-enqueue! [queue rx] + ;; Immediate run without touching the queue + (run-reaction-from-queue! rx)) + +(def ^:dynamic *enqueue!* default-enqueue!) + +(def ^:dynamic *queue* global-queue) + +(defn ^Reaction >!rx + ([f] (>!rx f nil)) + ([f {:keys [always-recompute? enqueue-fn eq-fn no-cache? on-dispose queue]}] + (Reaction. (if (nil? always-recompute?) false always-recompute?) + nil + nil + false + (or enqueue-fn *enqueue!*) + (or eq-fn =) + f + (if (nil? no-cache?) false no-cache?) + on-dispose + nil + (or queue *queue*) + nil nil nil nil))) + +#?(:clj (defmacro !rx "Creates a single-threaded reaction." [& body] `(>!rx (fn [] ~@body)))) + +#?(:clj (defmacro !eager-rx [& body] `(>!rx (fn [] ~@body) {:always-recompute? true}))) + +#?(:clj +(defmacro !run-rx + "Runs body immediately, and runs again whenever reactive references deferenced in the body + change. Body should side effect." + [& body] `(doto (!rx ~@body) deref))) + +;; ===== Track ===== ;; + +(udt/deftype TrackableFn [f ^:! ^:get ^:set rxCache]) + +(declare cached-reaction) + +;; For perf test in `quantum.test.untyped.core.data.reactive`. TODO excise? +(udt/deftype Track + [^TrackableFn trackable-fn, args, ^:! ^:get ^:set ^quantum.untyped.core.data.reactive.Reaction rx] + {;; IPrintWithWriter + ;; (-pr-writer [a w opts] (pr-ref a w opts "Track:")) + PReactive nil + ?Deref {deref ([this] + (if (nil? rx) + (cached-reaction #(apply (.-f trackable-fn) args) + trackable-fn args this nil) + #?(:clj (.deref rx) :cljs (-deref ^non-native rx))))}} + ?Equals {= ([_ other] + (and (instance? Track other) + (-> ^Track other .-trackable-fn .-f (= (.-f trackable-fn))) + (-> ^Track other .-args (= args))))} + ?Hash {hash ([_] (hash [f args]))}) + +(defn- cached-reaction [f ^TrackableFn trackable-fn k ^Track t destroy-fn] + (let [ m (.getRxCache trackable-fn) + m (if (nil? m) {} m) + ^Reaction r (m k nil)] + (cond + (some? r) #?(:clj (.deref r) :cljs (-deref ^non-native r)) + (nil? *ref-context*) (f) + :else (let [r (>!rx f + {:on-dispose + (fn [x] + (when (true? *debug?*) (swap! *running dec)) + (as-> (.getRxCache trackable-fn) cache + (dissoc cache k) + (.setRxCache trackable-fn cache)) + (when (some? t) + (.setRx t nil)) + (when (some? destroy-fn) + (destroy-fn x))) + ;; Inherits the queue + :queue (some-> t .getRx .-queue)}) + v #?(:clj (.deref r) :cljs (-deref ^non-native r))] + (.setRxCache trackable-fn (assoc m k r)) + (when (true? *debug?*) (swap! *running inc)) + (when (some? t) + (.setRx t r)) + v)))) + +(defn ^Track >track [f args] (Track. (TrackableFn. f nil) args nil)) + +(defn >track! [f args opts] + (let [t (>track f args) + r (>!rx (fn [] #?(:clj (.deref t) :cljs (-deref ^non-native t))) + {:queue (or (:queue opts) global-queue)})] + @r + r)) + +(defn #?(:clj reactive? :cljs ^boolean reactive?) [x] (satisfies? PReactive x)) diff --git a/src-untyped/quantum/untyped/core/data/set.cljc b/src-untyped/quantum/untyped/core/data/set.cljc index 2759f9b2..7cf419f5 100644 --- a/src-untyped/quantum/untyped/core/data/set.cljc +++ b/src-untyped/quantum/untyped/core/data/set.cljc @@ -1,22 +1,30 @@ (ns quantum.untyped.core.data.set - (:refer-clojure :exclude [not]) + (:refer-clojure :exclude [- +, not, compare < <= >= >]) (:require #?@(:clj - [[flatland.ordered.set :as oset] - [seqspert.hash-set]]) - [clojure.core :as core] - [clojure.set :as set] - [quantum.untyped.core.core :as ucore])) + [[seqspert.hash-set]]) + [clojure.core :as core] + [clojure.set :as set] + [linked.core :as linked] + [quantum.untyped.core.compare :as ucomp] + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.vars + :refer [defalias]])) (ucore/log-this-ns) #?(:clj (def hash-set? (partial instance? clojure.lang.PersistentHashSet))) -#?(:clj (def ordered-set oset/ordered-set)) ; insertion-ordered set -#?(:clj (def oset ordered-set)) +(def ordered-set linked/set) ; insertion-ordered set +(def oset ordered-set) (def not complement) +; (and a (not b)) +(defalias differencel set/difference) +(defalias - differencel) +(defalias relative-complement differencel) + #?(:clj (defn union "337.050528 msecs (core/union s1 s2) @@ -34,3 +42,80 @@ ([s0 s1 & ss] (reduce union (union s0 s1) ss))) :cljs (def union set/union)) + +(defalias + union) + +;; ===== Set-specific comparison ===== ;; + +(def ^:const ident 1) ; superset +(def ^:const >ident 3) ; disjoint + +(def comparisons #{ident >ident}) +(def comparison? comparisons) + +(defn invert-comparison [^long c #_comparison? #_> #_comparison?] + (case c + -1 >ident + 1 ident + ;; TODO do fewer comparisons here + (let [diff0 (- s0 s1), diff1 (- s1 s0)] + (if (empty? diff0) + (if (empty? diff1) + =ident + ident + (if (some #(contains? s1 %) s0) + >ident))))))) + +(defn comparison< [c] (identical? c = [c] (or (identical? c >ident) (identical? c =ident))) +(defn comparison> [c] (identical? c >ident)) +(defn comparison>< [c] (identical? c > [c] (identical? c <>ident)) + +(defn comp< ([ x0 x1] (comp< compare x0 x1)) + ([compf x0 x1] (comparison< (compf x0 x1)))) +(defn comp<= ([ x0 x1] (comp<= compare x0 x1)) + ([compf x0 x1] (comparison<= (compf x0 x1)))) +(defn comp= ([ x0 x1] (comp= compare x0 x1)) + ([compf x0 x1] (comparison= (compf x0 x1)))) +(defn comp-not= ([ x0 x1] (comp-not= compare x0 x1)) + ([compf x0 x1] (comparison-not= (compf x0 x1)))) +(defn comp>= ([ x0 x1] (comp>= compare x0 x1)) + ([compf x0 x1] (comparison>= (compf x0 x1)))) +(defn comp> ([ x0 x1] (comp> compare x0 x1)) + ([compf x0 x1] (comparison> (compf x0 x1)))) +(defn comp>< ([ x0 x1] (comp>< compare x0 x1)) + ([compf x0 x1] (comparison>< (compf x0 x1)))) +(defn comp<> ([ x0 x1] (comp<> compare x0 x1)) + ([compf x0 x1] (comparison<> (compf x0 x1)))) + +(defn < [x0 x1] (comp< x0 x1)) +(defalias proper-subset? <) +(defn <= [x0 x1] (comp<= x0 x1)) +(defalias subset? <=) +(defn >= [x0 x1] (comp>= x0 x1)) +(defalias superset? >=) +(defn > [x0 x1] (comp> x0 x1)) +(defalias proper-superset? >) +(defn >< [x0 x1] (comp>< x0 x1)) +(defn <> [x0 x1] (comp<> x0 x1)) +(defalias disjoint? <>) diff --git a/src-untyped/quantum/untyped/core/data/vector.cljc b/src-untyped/quantum/untyped/core/data/vector.cljc new file mode 100644 index 00000000..dfced3e6 --- /dev/null +++ b/src-untyped/quantum/untyped/core/data/vector.cljc @@ -0,0 +1,42 @@ +(ns quantum.untyped.core.data.vector + #?(:clj (:import java.util.ArrayList))) + +(defn alist-get + #?(:clj [^ArrayList xs ^long i] + :cljs [ xs ^number i]) + (#?(:clj .get :cljs aget) xs i)) + +(defn alist-set! + #?(:clj [^ArrayList xs ^long i v] + :cljs [ xs ^number i v]) + (#?(:clj .set :cljs aset) xs i v)) + +(defn #?(:clj ^ArrayList alist :cljs alist) + ([] #?(:clj (ArrayList.) :cljs #js [])) + ([x] #?(:clj (doto (ArrayList.) (.add x)) :cljs #js [x]))) + +(defn alist-conj! + ([] (alist)) + ([#?(:clj ^ArrayList xs :cljs xs)] xs) + ([#?(:clj ^ArrayList xs :cljs xs) v] + (doto xs (#?(:clj .add :cljs .push) v)))) + +(defn #?(:clj alist-count :cljs ^number alist-count) [#?(:clj ^ArrayList xs :cljs xs)] + (#?(:clj .size :cljs alength) xs)) + +(defn #?(:clj alist-empty? :cljs ^boolean alist-empty?) [#?(:clj ^ArrayList xs :cljs xs)] + (== (#?(:clj .size :cljs alength) xs) 0)) + +(defn alist-empty! [#?(:clj ^ArrayList xs :cljs xs)] + #?(:clj (.clear xs) :cljs (set! (.-length xs) 0)) + xs) + +(defn #?(:clj alist== :cljs ^boolean alist==) + [#?(:clj ^ArrayList x :cljs x) #?(:clj ^ArrayList y :cljs y)] + (let [len (if (nil? x) 0 (long (alist-count x)))] + (and (== len (if (nil? y) 0 (long (alist-count y)))) + (loop [i 0] + (or (== i len) + (if (identical? (alist-get x i) (alist-get y i)) + (recur (inc i)) + false)))))) diff --git a/src-untyped/quantum/untyped/core/defnt.cljc b/src-untyped/quantum/untyped/core/defnt.cljc new file mode 100644 index 00000000..13714850 --- /dev/null +++ b/src-untyped/quantum/untyped/core/defnt.cljc @@ -0,0 +1,410 @@ +(ns quantum.untyped.core.defnt + "Primarily for `(de)fns`." + (:refer-clojure :exclude + [any? ident? qualified-keyword? seqable? simple-symbol?]) + (:require + [clojure.spec.alpha :as s] + [clojure.spec.gen.alpha :as gen] + [quantum.untyped.core.core + :refer [any?]] + [quantum.untyped.core.data + :refer [seqable?]] + [quantum.untyped.core.form.evaluate :as ufeval] + [quantum.untyped.core.identifiers + :refer [>keyword ident? qualified-keyword? simple-symbol?]] + [quantum.untyped.core.loops + :refer [reduce-2]] + [quantum.untyped.core.reducers :as ur] + [quantum.untyped.core.refs :as uref] + [quantum.untyped.core.spec :as us] + [quantum.untyped.core.specs :as uss]) +#?(:cljs + (:require-macros + [quantum.untyped.core.defnt :as self]))) + +;; ===== Specs ===== ;; + +(s/def :quantum.core.defnt/local-name + (s/and simple-symbol? (complement #{'& '| '>}))) + +(s/def :quantum.core.defnt/spec + (s/alt :any #{'_} + :spec any?)) + +;; ----- General destructuring ----- ;; + +(s/def :quantum.core.defnt/binding-form + (s/alt :sym :quantum.core.defnt/local-name + :seq :quantum.core.defnt/seq-binding-form + :map :quantum.core.defnt/map-binding-form)) + +(s/def :quantum.core.defnt/speced-binding + (s/cat :binding-form :quantum.core.defnt/binding-form + :spec :quantum.core.defnt/spec)) + +;; ----- Sequential destructuring ----- ;; + +(s/def :quantum.core.defnt/seq-binding-form + (s/and vector? + (s/cat :elems (s/* :quantum.core.defnt/speced-binding) + :rest (s/? (s/cat :amp #{'&} :form :quantum.core.defnt/speced-binding)) + :as (s/? (s/cat :as #{:as} :sym :quantum.core.defnt/local-name))))) + +;; ----- Map destructuring ----- ;; + +(defn- >keys|syms|strs [spec] + (s/and vector? + (s/spec (s/* (s/cat :binding-form spec + :spec :quantum.core.defnt/spec))))) + +(s/def :quantum.core.defnt/keys (>keys|syms|strs ident?)) +(s/def :quantum.core.defnt/syms (>keys|syms|strs symbol?)) +(s/def :quantum.core.defnt/strs (>keys|syms|strs simple-symbol?)) + +(s/def :quantum.core.defnt/or :quantum.core.specs/or) +(s/def :quantum.core.defnt/as :quantum.core.defnt/local-name) + +(s/def :quantum.core.defnt/map-special-binding + (s/keys :opt-un [:quantum.core.defnt/as :quantum.core.defnt/or + :quantum.core.defnt/keys :quantum.core.defnt/syms :quantum.core.defnt/strs])) + +(s/def :quantum.core.defnt/map-binding + (s/spec (s/cat :binding-form :quantum.core.defnt/binding-form + :key+spec (s/spec (s/cat :key any? :spec :quantum.core.defnt/spec))))) + +(s/def :quantum.core.defnt/ns-keys + (s/tuple + (s/and qualified-keyword? #(-> % name #{"keys" "syms"})) + (>keys|syms|strs simple-symbol?))) + +(s/def :quantum.core.defnt/map-binding-form + (s/and :quantum.core.defnt/map-special-binding + (s/coll-of (s/or :map-binding :quantum.core.defnt/map-binding + :ns-keys :quantum.core.defnt/ns-keys + :special (s/tuple #{:as :or :keys :syms :strs} any?)) :into {}))) + +;; ----- Args ----- ;; + +(s/def :quantum.core.defnt/output-spec + (s/? (s/cat :sym #(= % '>) :spec :quantum.core.defnt/spec))) + +(s/def :quantum.core.defnt/arglist + (let [!meta (uref/>!thread-local nil)] ; a dirty hack till clojure.spec preserves meta + (s/and vector? + (fn [arglist] (uref/set! !meta (meta arglist)) true) + (s/spec + (s/cat :args (s/* :quantum.core.defnt/speced-binding) + :varargs (s/? (s/cat :sym #(= % '&) + :speced-binding :quantum.core.defnt/speced-binding)) + :pre (s/? (s/cat :sym #(= % '|) + :spec (s/or :any-spec #{'_} :spec any?))) + :post :quantum.core.defnt/output-spec)) + (s/conformer + #(-> % + (with-meta (uref/get !meta)) + (cond-> (nil? (:args %)) (assoc :args []) + (contains? % :varargs) (update :varargs :speced-binding) + (contains? % :pre ) (update :pre :spec) + (contains? % :post ) (update :post :spec)))) + (fn [{:keys [args varargs]}] + ;; so `env` in `fnt` can work properly in the analysis + ;; TODO need to adjust for destructuring + (distinct? + (concat (map :binding-form args) + [(:binding-form varargs)])))))) + +(s/def :quantum.core.defnt/body (s/alt :body (s/* any?))) + +(s/def :quantum.core.defnt/arglist+body + (s/cat :arglist :quantum.core.defnt/arglist + :body :quantum.core.defnt/body)) + +(s/def :quantum.core.defnt/overloads + (s/alt :overload-1 :quantum.core.defnt/arglist+body + :overload-n (s/cat :overloads (s/+ (s/spec :quantum.core.defnt/arglist+body))))) + +(s/def :quantum.core.defnt/postchecks + (s/conformer + (fn [fn-form] + (-> fn-form + (update :quantum.core.defnt/overloads + #(mapv (fn [overload] (update overload :body :body)) %)) + (update :quantum.core.defnt/output-spec :spec))))) + +(s/def :quantum.core.defnt/fnt + (s/and (s/spec + (s/cat + :quantum.core.specs/fn|name (s/? :quantum.core.specs/fn|name) + :quantum.core.specs/docstring (s/? :quantum.core.specs/docstring) + :quantum.core.specs/pre-meta :quantum.core.specs/pre-meta + :quantum.core.defnt/output-spec :quantum.core.defnt/output-spec + :quantum.core.defnt/overloads :quantum.core.defnt/overloads)) + (uss/fn-like|postchecks|gen :quantum.core.defnt/overloads) + :quantum.core.defnt/postchecks)) + +(s/def :quantum.core.defnt/fns|code :quantum.core.defnt/fnt) + +(s/def :quantum.core.defnt/defnt + (s/and (s/spec + (s/cat + :quantum.core.specs/fn|name :quantum.core.specs/fn|name + :quantum.core.specs/docstring (s/? :quantum.core.specs/docstring) + :quantum.core.specs/pre-meta :quantum.core.specs/pre-meta + :quantum.core.defnt/output-spec :quantum.core.defnt/output-spec + :quantum.core.defnt/overloads (s/? :quantum.core.defnt/overloads))) + (uss/fn-like|postchecks|gen :quantum.core.defnt/overloads) + :quantum.core.defnt/postchecks)) + +(s/def :quantum.core.defnt/defns|code :quantum.core.defnt/defnt) + +(s/def :quantum.core.defnt/binding-form + (s/alt :sym :quantum.core.defnt/local-name + :seq :quantum.core.defnt/seq-binding-form + :map :quantum.core.defnt/map-binding-form)) + +;; ===== Implementation ===== ;; + +(defn >seq-destructuring-spec + "Creates a spec that performs seq destructuring, and provides a default generator for such based + on the generators of the destructured args." + [positional-destructurer most-complex-positional-destructurer kv-spec or|conformer seq-spec + {:as opts generate-from-seq-spec? :gen?}] + (let [or|unformer (s/conformer second) + most-complex-positional-destructurer|unformer + (s/conformer (fn [x] (s/unform most-complex-positional-destructurer x)))] + (cond-> + (s/and seq-spec + (s/conformer (fn [xs] {:xs xs :xs|destructured xs})) + (us/kv {:xs|destructured (s/and positional-destructurer + or|unformer + kv-spec)}) + (s/conformer (fn [m] (assoc m :xs|positionally-destructured|ct + (when-not (-> m :xs|destructured (contains? :varargs)) + (-> m :xs|destructured count))))) + (us/kv {:xs|destructured + (s/and or|conformer + (s/conformer (fn [x] (s/unform positional-destructurer x))))}) + (s/conformer (fn [{:keys [xs xs|destructured xs|positionally-destructured|ct]}] + (if xs|positionally-destructured|ct + (concat xs|destructured (drop xs|positionally-destructured|ct xs)) + xs|destructured)))) + (not generate-from-seq-spec?) + (s/with-gen + #(->> (s/gen kv-spec) + (gen/fmap (fn [x] (s/conform most-complex-positional-destructurer|unformer x)))))))) + +#?(:clj +(defmacro seq-destructure + "If `generate-from-seq-spec?` is true, generates from `seq-spec`'s generator instead of the + default generation strategy based on the generators of the destructured args." + [lang seq-spec #_any? args #_(s/* (s/cat :k keyword? :spec any?)) + & [varargs #_(s/nilable (s/cat :k keyword? :spec any?))]] + (let [opts (meta seq-spec) + args (us/assert-conform (s/* (s/cat :k keyword? :spec any?)) args) + varargs (us/assert-conform (s/nilable (s/cat :k keyword? :spec any?)) varargs) + args-ct>args-kw #(keyword (str "args-" %)) + arity>cat (fn [arg-i] + `(us/cat + ~@(->> args (take arg-i) + (map (fn [{:keys [k spec]}] [k `any?])) + (apply concat)))) + most-complex-positional-destructurer-sym (gensym "most-complex-positional-destructurer")] + `(let [~most-complex-positional-destructurer-sym + (us/cat + ~@(->> args + (map (fn [{:keys [k]}] [k `any?])) + (apply concat)) + ~@(when varargs [(:k varargs) + `(us/& (us/+ any?) (us/conformer seq identity))])) + positional-destructurer# + (us/or :args-0 (us/cat) + ~@(->> (range (count args)) + (map (fn [i] [(args-ct>args-kw (inc i)) (arity>cat (inc i))])) + (apply concat)) + ~@(when varargs [:varargs most-complex-positional-destructurer-sym])) + kv-spec# + (us/kv (hash-map ~@(apply concat + (cond-> (->> args (map (fn [{:keys [k spec]}] [k spec]))) + varargs (concat [[(:k varargs) (:spec varargs)]]))))) + or|conformer# + (us/conformer + (fn or|conformer# [m#] + [(case (count m#) + ~@(->> (range (inc (count args))) + (map (juxt identity args-ct>args-kw)) + (apply concat)) + ~@(when varargs [:varargs])) + m#]))] + (>seq-destructuring-spec positional-destructurer# ~most-complex-positional-destructurer-sym + kv-spec# or|conformer# ~seq-spec ~opts))))) + +#?(:clj +(defmacro map-destructure [lang map-spec #_any? kv-specs #_(s/map-of any? any?)] + (let [kv-spec-sym (gensym "kv-spec") + {:as opts generate-from-map-spec? :gen?} (meta map-spec)] + `(let [~kv-spec-sym (us/kv ~kv-specs)] + ~(if generate-from-map-spec? + `(us/and ~map-spec ~kv-spec-sym) + `(us/with-gen (us/and ~map-spec ~kv-spec-sym) + (fn [] (us/gen ~kv-spec-sym)))))))) + +(defn speced-binding>binding [{[kind binding-] :binding-form} #_:quantum.core.defnt/speced-binding] + (case kind + :sym binding- + :seq (let [{:keys [as elems] rest- :rest} binding-] + (cond-> (mapv speced-binding>binding elems) + rest- (conj '& (-> rest- :form speced-binding>binding)) + as (conj :as (:sym as)))) + :map (->> binding- + (map (fn [[k v]] + (case k + :as [k (second v)] + :or [k v] + (:keys :syms :strs) [k (->> v second (mapv :binding-form))] + [(speced-binding>binding v) + (get-in v [:key+spec :key])]))) + (into {})))) + +(defn speced-binding>arg-ident + [{[kind binding-] :binding-form} #_:quantum.core.defnt/speced-binding & [i|arg] #_(? nneg-integer?)] + (>keyword + (case kind + :sym binding- + (:seq :map) + (let [ks (if (= kind :seq) [:as :sym] [:as 1])] + (or (get-in binding- ks) + (gensym (if i|arg (str "arg-" i|arg "-") "varargs"))))))) + +(declare speced-binding>spec) + +(defn- speced-binding|seq>spec + [lang {:as speced-binding [kind binding-] :binding-form [spec-kind spec] :spec}] + `(seq-destructure ~lang ~(if (= spec-kind :spec) spec `seqable?) + ~(->> binding- :elems + (map-indexed + (fn [i|arg arg|speced-binding] + [(speced-binding>arg-ident arg|speced-binding i|arg) + (speced-binding>spec lang arg|speced-binding)])) + (apply concat) + vec) + ~@(when-let [varargs|speced-binding (get-in binding- [:rest :form])] + [[(speced-binding>arg-ident varargs|speced-binding) + (speced-binding>spec lang varargs|speced-binding)]]))) + +(defn- keys||strs||syms>key-specs [kind #_#{:keys :strs :syms} speced-bindings] + (let [binding-form>key + (case kind :keys >keyword :strs name :syms identity)] + (->> speced-bindings + (filter (fn [{[spec-kind _] :spec}] (= spec-kind :spec))) + (map (fn [{:keys [binding-form #_symbol?] [_ spec] :spec}] + [(binding-form>key binding-form) spec]))))) + +(defn- speced-binding|map>spec + [lang {:as speced-binding [kind binding-] :binding-form [spec-kind spec] :spec}] + `(map-destructure ~lang ~(if (= spec-kind :spec) spec `map?) + ~(->> (dissoc binding- :as :or) + (map (fn [[k v]] + (case k + (:keys :strs :syms) + (keys||strs||syms>key-specs k (second v)) + [[(get-in v [:key+spec :key]) + (speced-binding>spec lang + (assoc v :spec (get-in v [:key+spec :spec])))]]))) + (apply concat) + (into {})))) + +(defn speced-binding>spec + [lang {:as speced-binding [kind binding-] :binding-form [spec-kind spec] :spec}] + (case kind + :sym (if (= spec-kind :spec) spec `any?) + :seq (speced-binding|seq>spec lang speced-binding) + :map (speced-binding|map>spec lang speced-binding))) + +(defn arglist>spec-form|arglist + [lang args+varargs kw-args #_:quantum.core.specs/map-binding-form] + `(us/cat + ~@(reduce-2 + (fn [ret speced-binding [_ kw-arg]] + (conj ret kw-arg (speced-binding>spec lang speced-binding))) + [] + args+varargs kw-args))) + +;; TODO handle duplicate bindings (e.g. `_`) by `s/cat` using unique keys — e.g. :b|arg-2 +(defn fns|code [kind lang args] + (assert (= lang #?(:clj :clj :cljs :cljs)) lang) + (when (= kind :fn) (println "WARNING: `fn` will ignore spec validation")) + (let [{:as args' + :keys [:quantum.core.specs/fn|name + :quantum.core.defnt/overloads + :quantum.core.defnt/output-spec] + fn|meta :quantum.core.specs/meta} + (us/assert-conform (case kind (:defn :defn-) :quantum.core.defnt/defns|code + :fn :quantum.core.defnt/fns|code) args) + [_ output-spec] output-spec + ret-sym (gensym "ret") arity-kind-sym (gensym "arity-kind") args-sym (gensym "args") + {:keys [overload-forms spec-form|args spec-form|fn]} + (reduce + (fn [ret {{:keys [args varargs] [pre-kind pre] :pre [_ post] :post :as arglist} :arglist :keys [body]} #_:quantum.core.defnt/arglist+body] + (let [{:keys [fn-arglist kw-args]} + (ur/reducei + (fn [ret {:as speced-binding :keys [varargs?]} i|arg] + (let [arg-ident (speced-binding>arg-ident speced-binding i|arg) + binding- (speced-binding>binding speced-binding)] + (-> ret (cond-> varargs? (update :fn-arglist conj '&)) + (update :fn-arglist conj binding-) + (update :kw-args assoc binding- arg-ident)))) + {:fn-arglist [] :kw-args (hash-map)} + (cond-> args varargs (conj (assoc varargs :varargs? true)))) + overload-form (list* fn-arglist body) + arity-ident (keyword (str "arity-" (if varargs "varargs" (count args)))) + spec-form|arglist (arglist>spec-form|arglist lang + (cond-> args varargs (conj varargs)) kw-args) + spec-form|pre (when (and (contains? arglist :pre) (= pre-kind :spec)) + `(fn [~kw-args] ~pre)) + spec-form|args* (if spec-form|pre + `(us/and ~spec-form|arglist ~spec-form|pre) + spec-form|arglist) + spec-form|fn* (if (contains? arglist :post) + `(let [~kw-args ~args-sym] + (us/spec ~(if output-spec + `(us/and ~post ~output-spec) + post))) + (list `us/spec (or output-spec `any?)))] + (-> ret + (update :overload-forms conj overload-form) + (update :spec-form|args conj arity-ident spec-form|args*) + (update :spec-form|fn conj arity-ident spec-form|fn*)))) + {:overload-forms [] + :spec-form|args [] + :spec-form|fn []} + overloads) + spec-form (when (#{:defn :defn-} kind) + `(us/fdef ~fn|name :args + (us/or ~@spec-form|args) + :fn (us/with-gen-spec (fn [{~ret-sym :ret}] ~ret-sym) + (fn [{[~arity-kind-sym ~args-sym] :args}] + (case ~arity-kind-sym ~@spec-form|fn))))) + fn|name|with-meta (with-meta fn|name fn|meta) + fn-form (case kind + :fn (list* 'clojure.core/fn (concat (when (contains? args' :quantum.core.specs/fn|name) + [fn|name|with-meta]) + overload-forms)) + :defn (list* 'clojure.core/defn fn|name|with-meta overload-forms) + :defn- (list* 'clojure.core/defn- fn|name|with-meta overload-forms)) + code `(do ~spec-form ~fn-form)] + code)) + +#?(:clj +(defmacro fns + "Like `fnt`, but relies entirely on runtime spec checks." + [& args] (fns|code :fn (ufeval/env-lang) args))) + +#?(:clj +(defmacro defns + "Like `defnt`, but relies entirely on runtime spec checks." + [& args] (fns|code :defn (ufeval/env-lang) args))) + +#?(:clj +(defmacro defns- + "defns : defns- :: defn : defn-" + [& args] (fns|code :defn- (ufeval/env-lang) args))) diff --git a/src-untyped/quantum/untyped/core/error.cljc b/src-untyped/quantum/untyped/core/error.cljc index 30e6c213..4ca0650d 100644 --- a/src-untyped/quantum/untyped/core/error.cljc +++ b/src-untyped/quantum/untyped/core/error.cljc @@ -17,6 +17,31 @@ (ucore/log-this-ns) +;; ===== Types ===== ;; + +;; TODO move this? +;; TODO add to these types based on HTTP response types, Java(Script) built-in errors, etc.? +(def ^{:doc "Adapted from `com.cognitect/anomalies`"} types + {:quantum.core.error/unavailable + {:caller-can-retry? true :resolution-strategy "make sure callee healthy"} + :quantum.core.error/interrupted + {:caller-can-retry? true :resolution-strategy "stop interrupting"} + :quantum.core.error/incorrect + {:caller-can-retry? false :resolution-strategy "fix inputs from caller"} + :quantum.core.error/forbidden + {:caller-can-retry? false :resolution-strategy "fix authentication-inputs from caller"} + :quantum.core.error/unsupported + {:caller-can-retry? false + :resolution-strategy "function found, but it does not support what the input requests"} + :quantum.core.error/not-found + {:caller-can-retry? false :resolution-strategy "function not found"} + :quantum.core.error/conflict + {:caller-can-retry? false :resolution-strategy "coordinate with callee"} + :quantum.core.error/fault + {:caller-can-retry? false :resolution-strategy "fix callee bug"} + :quantum.core.error/busy + {:caller-can-retry? true :resolution-strategy "back off and retry"}}) + ;; ===== Config ===== ;; (uvar/defonce *print-blacklist "A set of classes not to print" (atom #{})) @@ -35,35 +60,20 @@ (error? x) (fipp/pprint (>err x)) (and (string? x) (> (count x) *print-length*)) - (println - (str "String is too long to print (" - (str (count x) " elements") - ").") - "`*print-length*` is set at" (str *print-length* ".")) ; TODO fix so ellipsize + (println (str "String is too long to print (" (str (count x) " elements") ").") + ;; TODO fix so ellipsize + "`*print-length*` is set at" (str *print-length* ".")) (contains? @*print-blacklist (type x)) - (println - "Object's class" - (str (type x) "(" ")") - "is blacklisted for printing.") + (println "Object's class" (str "(" (type x) ")") "is blacklisted for printing.") :else (fipp/pprint x)) nil))) - ([x & xs] - (doseq [x' (cons x xs)] (ppr x')))) + ([x & xs] (doseq [x' (cons x xs)] (ppr x')))) (defn ppr-str "Like `pr-str`, but pretty-prints." [x] (with-out-str (ppr x))) -(defonce *pr-data-to-str? - (atom #?(:clj false :cljs (boolean js/goog.DEBUG)))) - -(defn- msg+data>msg [msg data] - (if @*pr-data-to-str? - (str "Message: " msg "\n" - "Data:\n" (ppr-str data)) - msg)) - ;; ===== Error type: generic ===== ;; (def generic-error-type #?(:clj Throwable :cljs js/Error)) @@ -82,22 +92,23 @@ (defn >ex-info ([data] (>ex-info "Exception" data)) - ([msg data] (ex-info (msg+data>msg msg data) (or data {})))) + ([msg data] (ex-info msg (or data {})))) (def ex-info! (rcomp >ex-info (fn1 throw))) ;; ===== Error type: `defrecord`/map ===== ;; -#?(#_:clj #_(defrecord Error [ident message data trace cause]) ; defined in Java as `quantum.core.error.Error` + ;; Defined in Java as `quantum.core.Error` +#?(#_:clj #_(defrecord Error [ident message data trace cause]) :cljs (defrecord Error [ident message data trace cause])) -(def error-map-type #?(:clj quantum.core.error.Error :cljs quantum.untyped.core.error/Error)) +(def error-map-type #?(:clj quantum.core.Error :cljs quantum.untyped.core.error/Error)) (def error-map? (fnl instance? error-map-type)) #?(:clj (defmacro- err-constructor [& args] - `(~(case-env :clj 'quantum.core.error.Error. + `(~(case-env :clj 'quantum.core.Error. :cljs 'quantum.untyped.core.error.Error.) ~@args))) (declare ?ex-data) @@ -113,24 +124,24 @@ x (map? x) #?(:clj (err-constructor - (:ident x) (msg+data>msg (:message x) (:data x)) (:data x) (:trace x) (:cause x) + (:ident x) (:message x) (:data x) (:trace x) (:cause x) (meta x) (dissoc x :ident :message :data :trace :cause)) - :cljs (-> x map->Error (assoc :message (msg+data>msg (:message x) (:data x))))) + :cljs (-> x map->Error (assoc :message (:message x)))) (error? x) #?(:clj (let [^Throwable t x] (err-constructor - nil (msg+data>msg (.getLocalizedMessage t) (?ex-data t)) (?ex-data t) (.getStackTrace t) (some-> (.getCause t) >err) + nil (.getLocalizedMessage t) (?ex-data t) (.getStackTrace t) (some-> (.getCause t) >err) (meta t) {:type (class t)})) - :cljs (with-meta - (-> (err-constructor (.-name x) (msg+data>msg (.-message x) (?ex-data x)) (?ex-data x) (.-stack x) (.-cause x)) - ;; other non-standard fields - (cond-> (.-description x) (assoc :description (.-description x)) - (.-number x) (assoc :number (.-number x)) - (.-fileName x) (assoc :file-name (.-fileName x)) - (.-lineNumber x) (assoc :line-number (.-lineNumber x)) - (.-columnNumber x) (assoc :column-number (.-columnNumber x)))) - (meta x))) + :cljs (-> (err-constructor (.-name x) (.-message x) (?ex-data x) (.-stack x) + (.-cause x)) + ;; other non-standard fields + (cond-> (.-description x) (assoc :description (.-description x)) + (.-number x) (assoc :number (.-number x)) + (.-fileName x) (assoc :file-name (.-fileName x)) + (.-lineNumber x) (assoc :line-number (.-lineNumber x)) + (.-columnNumber x) (assoc :column-number (.-columnNumber x))) + (with-meta (meta x)))) (string? x) (>err nil x nil nil nil) :else @@ -141,12 +152,9 @@ (>err nil message data nil nil)) (let [ident a0 data a1] (>err ident nil data nil nil)))) - ([ident message data] - (>err ident message data nil nil)) - ([ident message data trace] - (>err ident message data trace nil)) - ([ident message data trace cause] - (err-constructor ident (msg+data>msg message data) data trace cause))) + ([ident message data] (>err ident message data nil nil)) + ([ident message data trace] (>err ident message data trace nil)) + ([ident message data trace cause] (err-constructor ident message data trace cause))) (def err! (rcomp >err (fn1 throw))) @@ -198,8 +206,9 @@ ;; ===== Specific error types ===== ;; (defn todo - ([] (err! :todo "This feature has not yet been implemented." nil)) - ([msg] (err! :todo (str "This feature has not yet been implemented: " msg) nil))) + ([] (err! :todo "This feature has not yet been implemented." nil)) + ([msg] (todo msg nil)) + ([msg data] (err! :todo (str "This feature has not yet been implemented: " msg) data))) (defalias TODO todo) (defn not-supported [name- x] (>err (str "`" name- "` not supported on") {:x (type x)})) diff --git a/src-untyped/quantum/untyped/core/fn.cljc b/src-untyped/quantum/untyped/core/fn.cljc index f4d14f56..b2732ad0 100644 --- a/src-untyped/quantum/untyped/core/fn.cljc +++ b/src-untyped/quantum/untyped/core/fn.cljc @@ -12,7 +12,7 @@ #?(:cljs (:require-macros [quantum.untyped.core.fn :as self - :refer [fn'|generate]]))) + :refer [fn'|generate gen-positional-nthas gen-ntha]]))) (ucore/log-this-ns) @@ -102,20 +102,12 @@ #?(:clj (defmacro <- - "Converts a ->> to a -> - Note: syntax modified from original." - {:attribution "thebusby.bagotricks" - :usage `(->> (range 10) (map inc) (<- doto println) (reduce +))} - ([x] `(~x)) - ([op & body] `(~op ~(last body) ~@(butlast body))))) + "Converts a ->> to a ->" + {:inspiration "thebusby.bagotricks" + :usage `(->> (range 10) (map inc) (<- (doto println) distinct) (reduce +))} + [& args] `(-> ~(last args) ~@(butlast args)))) -#?(:clj -(defmacro <<- - "Converts a -> to a ->>" - {:attribution "alexandergunnarson" - :usage `(-> 1 inc (/ 4) (<<- - 2))} - ([x] `(~x)) - ([x op & body] `(~op ~@body ~x)))) +#?(:clj (defalias <<- ->>)) #?(:clj (defmacro fn-> @@ -169,6 +161,45 @@ (def fn-false (fn' false)) (def fn-true (fn' true )) +;; ===== Argument-updating fns ===== ;; + +; ----- NTHA ----- ; + +(defn gen-positional-ntha [position] + `(~'defn ~(symbol (str "ntha-" position)) + ~(str "Accepts any number of arguments and returns the (n=" position ")th in O(1) time.") + ~@(arity-builder (fn [args] (nth args position)) + (fn [args vargs] (nth args position)) (inc position)))) + +#?(:clj +(defmacro gen-positional-nthas [] + `(do ~@(for [i (range 0 (:clj max-positional-arity))] (gen-positional-ntha i))))) + +(gen-positional-nthas) + +(defn ntha-& + "Accepts any number of arguments and returns the nth, variadically, in O(n) time." + [n] (fn [& args] (nth args n))) + +(defalias firsta ntha-0) +(defalias seconda ntha-1) +(defalias thirda ntha-2) + +#?(:clj +(defmacro gen-ntha [] + (let [n-sym (gensym "n")] + `(~'defn ~'ntha + "Accepts any number of arguments and returns the nth. + If n <= 18, returns in O(1) time; otherwise, in O(n) time via varargs." + [~(with-meta n-sym {:tag 'long})] + (case ~n-sym + ~@(apply concat + (for [i (range 0 (:clj max-positional-arity))] + [i (symbol (str "ntha-" i))])) + (ntha-& ~n-sym)))))) + +(gen-ntha) + ;; ===== Miscellaneous ===== ;; (defn ? [f] diff --git a/src-untyped/quantum/untyped/core/form.cljc b/src-untyped/quantum/untyped/core/form.cljc index 9fba33eb..0e4aaddb 100644 --- a/src-untyped/quantum/untyped/core/form.cljc +++ b/src-untyped/quantum/untyped/core/form.cljc @@ -1,12 +1,96 @@ (ns quantum.untyped.core.form (:require + [quantum.untyped.core.collections + :refer [seq=]] [quantum.untyped.core.core :as ucore :refer [defalias]] - [quantum.untyped.core.form.evaluate :as ueval - :refer [case-env*]])) + [quantum.untyped.core.form.evaluate + :refer [case-env*]] + [quantum.untyped.core.form.generate :as ufgen] + [quantum.untyped.core.vars :as uvar])) (ucore/log-this-ns) +;; TODO this semi-interacts with `print-dup` in the context of macros; unify them +(defprotocol PGenForm + (>form [this] "Returns the form associated with the object. + If evaluated, the form should evaluate to something exactly equivalent to the + value of the object (even stronger than a `=` guarantee — all properties up to + but not including identity). + Effectively the inverse of `eval`. + + A form may consist of any of the following, recursively: + - nil + - number + - double + - long + - bigdec (`M`) + - bigint (`N`) + - string + - symbol + - keyword + - seq + - vector + - map")) + +(extend-protocol PGenForm + nil (>form [x] nil) + #?(:clj java.lang.Boolean + :cljs boolean) (>form [x] x) + ;; If a byte etc. is emitted from a macro, then it emits + ;; `RT.readString("#=(java.lang.Byte. \"1\")")`. Below is a better way. + #?@(:clj [java.lang.Byte (>form [x] (list `unchecked-byte (long x))) + java.lang.Short (>form [x] (list `unchecked-short (long x))) + java.lang.Character (>form [x] (list `unchecked-char (long x))) + java.lang.Integer (>form [x] (list `unchecked-int (long x))) + java.lang.Long (>form [x] x) + java.lang.Float (>form [x] (list `unchecked-float (long x)))]) + #?(:clj java.lang.Double + :cljs number) (>form [x] x) + #?(:clj java.lang.String + :cljs string) (>form [x] x) + #?(:clj clojure.lang.Symbol + :cljs cljs.core/Symbol) (>form [x] (list 'quote x)) + #?(:clj clojure.lang.Keyword + :cljs cljs.core/Keyword) (>form [x] x) + + #?(:clj clojure.lang.PersistentArrayMap + :cljs cljs.core/PersistentArrayMap) + (>form [x] (->> x (map (fn [[k v]] [(>form k) (>form v)])) (into (array-map)))) + + #?(:clj clojure.lang.PersistentHashMap + :cljs cljs.core/PersistentHashMap) + (>form [x] (->> x (map (fn [[k v]] [(>form k) (>form v)])) (into (hash-map)))) + + #?(:clj clojure.lang.PersistentVector + :cljs cljs.core/PersistentVector) + (>form [x] (->> x (mapv >form))) + + #?(:clj clojure.lang.PersistentList + :cljs cljs.core/PersistentList) + (>form [x] (->> x (map >form) list*)) + + #?@(:clj [clojure.lang.PersistentList$EmptyList (>form [x] '())]) + #?@(:clj [clojure.lang.ASeq (>form [x] (->> x (map >form)))]) + #?@(:clj [clojure.lang.LazySeq (>form [x] (->> x (map >form)))]) + + #?(:clj clojure.lang.Var + :cljs cljs.core/Var) + (>form [x] #?(:clj (list 'var (symbol (-> x .-ns ns-name name) (-> x .-sym name))) + :cljs (.-sym x))) + + #?@(:clj [clojure.lang.Fn (>form [x] + ;; TODO can probably use uconv to good effect here + (or (when-let [ns- (-> x meta :ns)] + (symbol (ns-name ns-) (-> x meta :name name))) + (let [demunged (-> x class .getName + clojure.lang.Compiler/demunge)] + (if-let [anonymous-fn? (not= (.indexOf demunged "/") + (.lastIndexOf demunged "/"))] + (tagged-literal 'fn (symbol demunged)) + (symbol demunged)))))]) + #?@(:clj [Class (>form [x] (-> x #_uconv/>symbol .getName symbol))])) + (defn core-symbol [env sym] (symbol (str (case-env* env :cljs "cljs" "clojure") ".core") (name sym))) ;; TODO move this code generation code to a different namespace @@ -41,13 +125,39 @@ {:examples '{(let [a 1] (quote+ (for [b 2] (inc ~a)))) '(for [a 1] (inc 1))}} - [form] - `(unquote-replacement (locals) '~form))) + [form] `(unquote-replacement (locals) '~form))) #?(:clj (defmacro $ "Reproducibly, unifiedly syntax quote without messing up the format as a literal syntax quote might do." - [body] - `(binding [*reproducible-gensym* (reproducible-gensym|generator)] - (unify-gensyms (syntax-quote ~body) true)))) + [body] `(ufgen/unify-gensyms (syntax-quote ~body) true))) + +(defn code= + "Ensures that two pieces of code are equivalent. + This means ensuring that seqs, vectors, and maps are only allowed to be compared with + each other, and that metadata (minus line and column metadata) is equivalent." + ([c0 c1] + (if (uvar/metable? c0) + (and (uvar/metable? c1) + (= (-> c0 meta (or {}) (dissoc :line :column)) + (-> c1 meta (or {}) (dissoc :line :column))) + (let [similar-class? + (cond (seq? c0) (seq? c1) + (seq? c1) (seq? c0) + (vector? c0) (vector? c1) + (vector? c1) (vector? c0) + (map? c0) (map? c1) + (map? c1) (map? c0) + (set? c0) (set? c1) + (set? c1) (set? c0) + :else ::not-applicable)] + (if (= similar-class? ::not-applicable) + (= c0 c1) + (and similar-class? + (if (or (set? c0) (map? c0)) + (seq= (sort c0) (sort c1) code=) + (seq= (seq c0) (seq c1) code=)))))) + (and (not (uvar/metable? c1)) + (= c0 c1)))) + ([c0 c1 & cs] (and (code= c0 c1) (every? #(code= c0 %) cs)))) diff --git a/src-untyped/quantum/untyped/core/form/generate.cljc b/src-untyped/quantum/untyped/core/form/generate.cljc index 44fc145e..ba63429b 100644 --- a/src-untyped/quantum/untyped/core/form/generate.cljc +++ b/src-untyped/quantum/untyped/core/form/generate.cljc @@ -35,11 +35,12 @@ (defn gen-args ([max-n] (gen-args 0 max-n)) ([min-n max-n] (gen-args min-n max-n "x")) - ([min-n max-n s] (gen-args min-n max-n s false)) - ([min-n max-n s gensym?] - (->> (range min-n max-n) (mapv (fn [i] (symbol (str (if gensym? (gensym s) s) i))))))) + ([min-n max-n s] (gen-args min-n max-n s identity)) + ([min-n max-n s gen-gensym] + (->> (range min-n max-n) (mapv (fn [i] (gen-gensym (str s i))))))) -(defn arity-builder [positionalf variadicf & [min-positional-arity max-positional-arity sym-genf no-gensym?]] +(defn arity-builder + [positionalf variadicf & [min-positional-arity max-positional-arity sym-genf no-gensym?]] (let [mina (or min-positional-arity 0) maxa (or max-positional-arity 18) args (->> (range mina (+ mina maxa)) @@ -60,9 +61,9 @@ ;; ===== Gensym unification ===== ;; ;; Adapted from Potemkin for use with both CLJ and CLJS -(def unified-gensym-regex #"([a-zA-Z0-9\-\'\*]+)#__\d+__auto__$") +(def unified-gensym-regex #"([a-zA-Z0-9\-\_\'\*]+)#__\d+__auto__$") -(def gensym-regex #"(_|[a-zA-Z0-9\-\'\*]+)#?_+(\d+_*#?)+(auto__)?$") +(def gensym-regex #"(_|[a-zA-Z0-9\-\_\'\*]+)#?_+(\d+_*#?)+(auto__)?$") (defn unified-gensym? {:attribution 'potemkin.macros} @@ -81,11 +82,10 @@ [s] (second (re-find gensym-regex (str s)))) -(def ^:dynamic *reproducible-gensym* nil) - -(defn reproducible-gensym|generator [] - (let [*counter (atom -1)] - (memoize #(symbol (str % (swap! *counter inc)))))) +(defn >reproducible-gensym|generator [] + (let [inc-or-0 #(if (nil? %) 0 (inc %)) + str->counter (atom {})] + (fn [s] (symbol (str s (get (swap! str->counter update s inc-or-0) s)))))) (defn unify-gensyms "All gensyms defined using two hash symbols are unified to the same @@ -94,12 +94,10 @@ :contributors ["Alex Gunnarson"]} ([body] (unify-gensyms body false)) ([body reproducible-gensyms?] - (let [gensym* (or *reproducible-gensym* - (memoize (if reproducible-gensyms? - (reproducible-gensym|generator) - gensym)))] + (let [gensym* (if reproducible-gensyms? symbol (memoize gensym))] (ucore/postwalk #(if (unified-gensym? %) - (symbol (str (gensym* (str (un-gensym %) "__")) (when-not reproducible-gensyms? "__auto__"))) + (symbol (str (gensym* (str (un-gensym %) "__")) + (when-not reproducible-gensyms? "__auto__"))) %) body)))) diff --git a/src-untyped/quantum/untyped/core/form/generate/deftype.cljc b/src-untyped/quantum/untyped/core/form/generate/deftype.cljc index aa416379..5a2b8c53 100644 --- a/src-untyped/quantum/untyped/core/form/generate/deftype.cljc +++ b/src-untyped/quantum/untyped/core/form/generate/deftype.cljc @@ -2,41 +2,61 @@ (:refer-clojure :exclude [deftype]) (:require [cljs.analyzer] + [cljs.core] [clojure.core :as core] [quantum.untyped.core.data - :refer [kw-map]] + :refer [kw-map val?]] [quantum.untyped.core.form.evaluate :refer [case-env]] [quantum.untyped.core.form.generate :as ufgen] [quantum.untyped.core.form.generate.definterface] [quantum.untyped.core.form.type-hint :as uth :refer [type-hint with-type-hint un-type-hint]] - [quantum.untyped.core.qualify :as uqual] - [quantum.untyped.core.string :as ustr] - [quantum.untyped.core.type.predicates - :refer [val?]])) + [quantum.untyped.core.identifiers :as uident] + [quantum.untyped.core.string :as ustr])) -(defn ?Associative [lang] (case lang :clj 'clojure.lang.Associative :cljs 'cljs.core/IAssociative)) -(defn ?Collection [lang] (case lang :clj 'clojure.lang.IPersistentCollection :cljs 'cljs.core/ICollection )) -(defn ?Comparable [lang] (case lang :clj 'java.lang.Comparable :cljs 'cljs.core/IComparable )) -(defn ?Counted [lang] (case lang :clj 'clojure.lang.Counted :cljs 'cljs.core/ICounted )) -(defn ?Deref [lang] (case lang :clj 'clojure.lang.IDeref :cljs 'cljs.core/IDeref )) -(defn ?Fn [lang] (case lang :clj 'clojure.lang.IFn :cljs 'cljs.core/IFn )) -(defn ?HashEq [lang] (case lang :clj 'clojure.lang.IHashEq :cljs 'cljs.core/IHash )) -(defn ?Indexed [lang] (case lang :clj 'clojure.lang.Indexed :cljs 'cljs.core/IIndexed )) -(defn ?Iterable [lang] (case lang :clj 'java.lang.Iterable :cljs 'cljs.core/IIterable )) -(defn ?Lookup [lang] (case lang :clj 'clojure.lang.ILookup :cljs 'cljs.core/ILookup )) -(defn ?Map [lang] (case lang :clj 'clojure.lang.IPersistentMap :cljs 'cljs.core/IMap )) -(defn ?MutableMap [lang] (case lang :clj 'java.util.Map nil)) -(defn ?Object [lang] (case lang :clj 'java.lang.Object :cljs 'Object )) -(defn ?Record [lang] (case lang :clj 'clojure.lang.IRecord :cljs 'cljs.core/IRecord )) -(defn ?Reset [lang] (case lang :clj 'clojure.lang.IAtom :cljs 'cljs.core/IReset )) -(defn ?Reversible [lang] (case lang :clj 'clojure.lang.Reversible :cljs 'cljs.core/IReversible )) -(defn ?Seq [lang] (case lang :clj 'clojure.lang.ISeq :cljs 'cljs.core/ISeq )) -(defn ?Seqable [lang] (case lang :clj 'clojure.lang.Seqable :cljs 'cljs.core/ISeqable )) -(defn ?Sequential [lang] (case lang :clj 'clojure.lang.Sequential :cljs 'cljs.core/ISequential )) -(defn ?Stack [lang] (case lang :clj 'clojure.lang.IPersistentStack :cljs 'cljs.core/IStack )) -(defn ?Swap [lang] (case lang :clj 'clojure.lang.IAtom :cljs 'cljs.core/ISwap )) +(defn ?Associative [lang] + (case lang :clj 'clojure.lang.Associative :cljs 'cljs.core/IAssociative)) +(defn ?Collection [lang] + (case lang :clj 'clojure.lang.IPersistentCollection :cljs 'cljs.core/ICollection )) +(defn ?Comparable [lang] + (case lang :clj 'java.lang.Comparable :cljs 'cljs.core/IComparable )) +(defn ?Counted [lang] + (case lang :clj 'clojure.lang.Counted :cljs 'cljs.core/ICounted )) +(defn ?Deref [lang] + (case lang :clj 'clojure.lang.IDeref :cljs 'cljs.core/IDeref )) +(defn ?Fn [lang] + (case lang :clj 'clojure.lang.IFn :cljs 'cljs.core/IFn )) +(defn ?Hash [lang] + (case lang :clj 'clojure.lang.IHashEq :cljs 'cljs.core/IHash )) +(defn ?Indexed [lang] + (case lang :clj 'clojure.lang.Indexed :cljs 'cljs.core/IIndexed )) +(defn ?Iterable [lang] + (case lang :clj 'java.lang.Iterable :cljs 'cljs.core/IIterable )) +(defn ?Lookup [lang] + (case lang :clj 'clojure.lang.ILookup :cljs 'cljs.core/ILookup )) +(defn ?Map [lang] + (case lang :clj 'clojure.lang.IPersistentMap :cljs 'cljs.core/IMap )) +(defn ?MutableMap [lang] + (case lang :clj 'java.util.Map nil)) +(defn ?Object [lang] + (case lang :clj 'java.lang.Object :cljs 'Object )) +(defn ?Record [lang] + (case lang :clj 'clojure.lang.IRecord :cljs 'cljs.core/IRecord )) +(defn ?Reset [lang] + (case lang :clj 'clojure.lang.IAtom :cljs 'cljs.core/IReset )) +(defn ?Reversible [lang] + (case lang :clj 'clojure.lang.Reversible :cljs 'cljs.core/IReversible )) +(defn ?Seq [lang] + (case lang :clj 'clojure.lang.ISeq :cljs 'cljs.core/ISeq )) +(defn ?Seqable [lang] + (case lang :clj 'clojure.lang.Seqable :cljs 'cljs.core/ISeqable )) +(defn ?Sequential [lang] + (case lang :clj 'clojure.lang.Sequential :cljs 'cljs.core/ISequential )) +(defn ?Stack [lang] + (case lang :clj 'clojure.lang.IPersistentStack :cljs 'cljs.core/IStack )) +(defn ?Swap [lang] + (case lang :clj 'clojure.lang.IAtom :cljs 'cljs.core/ISwap )) (defn- pfn "Protocol fn" @@ -64,8 +84,7 @@ 'java.util.Map 'java.util.Collection)) -(defn- deftype-helper - [methods-spec lang] +(defn- deftype-helper [methods-spec lang] (for [[iname impls] methods-spec] (case iname ?Comparable @@ -85,21 +104,21 @@ :clj `[~(?Seq lang) ~@(p-arity 'first (get impls 'first)) - ~@(p-arity 'more (get impls 'rest )) - ~@(p-arity 'next (get impls 'next ))] + ~@(p-arity 'more (get impls 'rest)) + ~@(p-arity 'next (get impls 'next))] :cljs `[~(?Seq lang) ~@(p-arity '-first (get impls 'first)) - ~@(p-arity '-rest (get impls 'rest )) + ~@(p-arity '-rest (get impls 'rest)) cljs.core/INext - ~@(p-arity '-next (get impls 'next ))]) + ~@(p-arity '-next (get impls 'next))]) ?Stack `[~(?Stack lang) ~@(p-arity (pfn 'peek lang) (get impls 'peek)) - ~@(p-arity (pfn 'pop lang) (get impls 'pop ))] + ~@(p-arity (pfn 'pop lang) (get impls 'pop))] ?Reversible `[~(?Reversible lang) - ~@(p-arity (pfn 'rseq lang) (get impls 'rseq ))] + ~@(p-arity (pfn 'rseq lang) (get impls 'rseq))] ?Counted `[~(?Counted lang) ~@(p-arity (pfn 'count lang) (get impls 'count)) @@ -107,18 +126,23 @@ `[~(implement-map-or-collection methods-spec) ~@(p-arity 'size (get impls 'count))] nil)] - ?Object + ?Equals (case lang :clj `[~(?Object lang) - ~@(p-arity 'equals (get impls 'equals)) - ~@(p-arity 'hashCode (get impls 'hash ))] + ~@(p-arity 'equals (get impls '=))] :cljs `[~(?Object lang) - ~@(p-arity 'equiv (get impls 'equals))]) + ~@(p-arity 'equiv (get impls '=)) + cljs.core/IEquiv + ~@(p-arity '-equiv (get impls '=))]) ?Hash - `[~(?HashEq lang) - ~@(p-arity (case lang :clj 'hashEq :cljs '-hash) (get impls 'hash-eq))] + `[~(?Hash lang) + ~@(p-arity (case lang :clj 'hasheq :cljs '-hash) (get impls 'hash)) + ~@(case lang + :clj `[~(?Object lang) + ~@(p-arity 'hashCode (or (get impls 'hash-code) (get impls 'hash)))] + nil)] ?Meta (case lang :clj @@ -126,27 +150,25 @@ ~@(p-arity 'meta (get impls 'meta )) ~@(p-arity 'withMeta (get impls 'with-meta))] :cljs - `[cljs.core/IMeta + `[~@(when (get impls 'meta) ['cljs.core/IMeta]) ~@(p-arity '-meta (get impls 'meta )) - cljs.core/IWithMeta + ~@(when (get impls 'with-meta) ['cljs.core/IWithMeta]) ~@(p-arity '-with-meta (get impls 'with-meta))]) ?Collection (case lang :clj `[~(?Collection lang) - ~@(p-arity 'empty (get impls 'empty )) - ~@(p-arity 'equiv (get impls 'equals)) ; TBD - ~@(p-arity 'cons (get impls 'conj )) + ~@(p-arity 'empty (get impls 'empty)) + ~@(p-arity 'equiv (get-in methods-spec ['?Equals '=])) ; TBD + ~@(p-arity 'cons (get impls 'conj)) ~(implement-map-or-collection methods-spec) ~@(p-arity 'isEmpty (get impls 'empty?)) ~@(p-arity 'clear (get impls 'empty!))] :cljs - `[cljs.core/IEmptyableCollection - ~@(p-arity '-empty (get impls 'empty )) - cljs.core/IEquiv - ~@(p-arity '-equiv (get impls 'equals)) ; TBD - ~(?Collection lang) - ~@(p-arity '-conj (get impls 'conj ))]) + `[~@(when (get impls 'empty) ['cljs.core/IEmptyableCollection]) + ~@(p-arity '-empty (get impls 'empty)) + ~@(when (get impls 'conj) [(?Collection lang)]) + ~@(p-arity '-conj (get impls 'conj))]) ?Lookup `[~(?Lookup lang) ~@(p-arity (case lang :clj 'valAt :cljs '-lookup) (get impls 'get)) @@ -190,13 +212,22 @@ ?Deref `[~(?Deref lang) ~@(p-arity (pfn 'deref lang) (get impls 'deref))] + ?Watchable + (case lang + :clj `[clojure.lang.IRef + ~@(p-arity 'addWatch (get impls 'add-watch!)) + ~@(p-arity 'removeWatch (get impls 'remove-watch!))] + :cljs `[cljs.core/IWatchable + ~@(p-arity (pfn 'add-watch lang) (get impls 'add-watch!)) + ~@(p-arity (pfn 'remove-watch lang) (get impls 'remove-watch!))]) ?Atom (case lang :clj `[clojure.lang.IAtom ~@(p-arity (pfn 'swap lang) (get impls 'swap!)) ~@(p-arity (pfn 'compareAndSet lang) (get impls 'compare-and-set!)) ~@(p-arity (pfn 'reset lang) (get impls 'reset!))] - :cljs `[cljs.core/IReset + :cljs `[cljs.core/IAtom + cljs.core/IReset ~@(p-arity (pfn 'reset! lang) (get impls 'reset!)) cljs.core/ISwap ~@(p-arity (pfn 'swap! lang) (get impls 'swap!))]) @@ -231,11 +262,44 @@ (@#'cljs.core/build-positional-factory t r fields)) ~t)))) +(defn- parse-impls + "Exists because `clojure.core/parse-impls` overwrites when interface, impls, same interface, more + impls." + {:adapted-from 'clojure.core/parse-impls} + [specs] + (loop [ret {} s specs] + (if (seq s) + (recur (update ret (first s) #(concat % (take-while seq? (next s)))) + (drop-while seq? (next s))) + ret))) + +(defn- parse-opts+specs + "Exists because `clojure.core/parse-impls` overwrites when interface, impls, same interface, more + impls." + {:adapted-from 'clojure.core/parse-opts+specs} + [opts+specs] + (let [[opts specs] (@#'clojure.core/parse-opts opts+specs) + impls (parse-impls specs) + interfaces (-> (map #(if (var? (resolve %)) + (:on (deref (resolve %))) + %) + (keys impls)) + set + (disj 'Object 'java.lang.Object) + vec) + methods (->> impls vals (apply concat) + (map (fn [[name params & body]] + (cons name (@#'clojure.core/maybe-destructured params body)))))] + (when-let [bad-opts (seq (remove #{:no-print :load-ns} (keys opts)))] + (throw (IllegalArgumentException. + ^String (apply print-str "Unsupported option(s) -" bad-opts)))) + [interfaces methods opts])) + #?(:clj (defn- deftype|clj [env name fields & opts+specs] (@#'clojure.core/validate-fields fields name) (let [gname name - [interfaces methods opts] (@#'clojure.core/parse-opts+specs opts+specs) + [interfaces methods opts] (parse-opts+specs opts+specs) ns-part (namespace-munge *ns*) classname (symbol (str ns-part "." gname)) hinted-fields fields @@ -271,7 +335,8 @@ body)}) (defn- ?symbol->getter|setter - "Generates a getter or setter from a field symbol" + "Generates a getter or setter from a field symbol. + Useful for Clojure mutable `deftype` fields which are private." [qualified-interface-sym prefix field-sym] (when (-> field-sym meta (get prefix)) (let [type-sym (type-hint field-sym) @@ -308,7 +373,7 @@ {:methods-spec methods-spec} (let [interface-sym (symbol (str "I" (name type-sym) "__GEN")) - qualified-interface-sym (uqual/qualify|class interface-sym) + qualified-interface-sym (uident/qualify|class interface-sym) methods (->> fields (map (fn [field-sym] @@ -324,18 +389,27 @@ (merge methods-spec {interface-sym (->> methods (map :quantum.core.form.generate.deftype/deftype|method) (reduce merge))})})))) +;; WARNING: actually evals interface code when requested ; TODO fix this #?(:clj -(defmethod ufgen/generate :quantum.core.form.generate.deftype/deftype ; WARNING: actually evals interface code when requested ; TODO fix this +(defmethod ufgen/generate :quantum.core.form.generate.deftype/deftype [_ {:keys [&env lang type-sym fields methods-spec]}] - (let [{:keys [preamble methods-spec]} - (apply-getters+setters lang type-sym fields methods-spec) + (let [fields' (->> fields + (mapv #(vary-meta % + (fn [m] (let [m' (dissoc m :! :mutable :unsynchronized-mutable)] + (if (contains? m :!) + (case lang + :clj (assoc m' :unsynchronized-mutable (:! m)) + :cljs (assoc m' :mutable (:! m))) + m')))))) + {:keys [preamble methods-spec]} + (apply-getters+setters lang type-sym fields' methods-spec) _ (eval preamble) deftype-code (apply (case lang :clj deftype|clj :cljs deftype|cljs) - &env type-sym fields + &env type-sym fields' (apply concat (deftype-helper methods-spec lang)))] ; in order to help `deftype` recognize that there is an interface, when there is one `(do ~deftype-code - ~(when (= lang :clj) `(import (quote ~(uqual/qualify|class type-sym)))))))) ; TODO doesn't this already happen? + ~(when (= lang :clj) `(import (quote ~(uident/qualify|class type-sym)))))))) ; TODO doesn't this already happen? #?(:clj (defmacro deftype diff --git a/src-untyped/quantum/untyped/core/form/type_hint.cljc b/src-untyped/quantum/untyped/core/form/type_hint.cljc index b4a977b2..dafd6a13 100644 --- a/src-untyped/quantum/untyped/core/form/type_hint.cljc +++ b/src-untyped/quantum/untyped/core/form/type_hint.cljc @@ -1,8 +1,15 @@ (ns quantum.untyped.core.form.type-hint (:require + [quantum.untyped.core.collections :as uc] [quantum.untyped.core.error - :refer [ex-info!]] - [quantum.untyped.core.type.core :as utcore] + :refer [err!]] + [quantum.untyped.core.identifiers + :refer [>name]] + [quantum.untyped.core.logic + :refer [ifs]] + [quantum.untyped.core.loops + :refer [reduce-2]] + [quantum.untyped.core.type.core :as utcore] [quantum.untyped.core.vars :refer [update-meta]])) @@ -19,7 +26,7 @@ (defn sanitize-tag [lang tag] #?(:clj (or (get-in utcore/return-types-map [lang tag]) tag) - :cljs (ex-info! "`sanitize-tag` not supported in CLJS"))) + :cljs (err! "`sanitize-tag` not supported in CLJS"))) #?(:clj (defn with-sanitize-tag [lang sym] @@ -44,7 +51,7 @@ (if (nil? tag) nil (or (?tag->class tag) - (throw (ex-info "Cannot convert tag to class" {:tag tag})))))) + (err! "Cannot convert tag to class" {:tag tag}))))) #?(:clj (defn class->str [^Class c] (.getName c))) #?(:clj (defn class->symbol [^Class c] (-> c class->str symbol))) @@ -77,7 +84,7 @@ class->symbol))) #?(:clj -(defn ->fn-arglist-tag +(defn >fn-arglist-tag "`arglist-length` is count of positional (non-variadic) args" [tag lang arglist-length variadic?] (if (class? tag) @@ -105,7 +112,7 @@ (defn with-fn-arglist-type-hint "Ensures `sym` has a type hint appropriate for an `fn` arglist." [sym lang arglist-length variadic?] - (if-let [tag (->fn-arglist-tag (type-hint sym) lang arglist-length variadic?)] + (if-let [tag (>fn-arglist-tag (type-hint sym) lang arglist-length variadic?)] (with-type-hint sym tag) (un-type-hint sym)))) @@ -129,8 +136,54 @@ The compiler seems to ignore hints that are not strings or symbols, and does not allow primitive hints. This fn accommodates these requirements." - [tag #_(t/or string? class? symbol?)] - #?(:clj (if (class? tag) - (.getName ^Class tag) - tag) - :cljs tag)) + [tag #_(t/or string? symbol? class?)] + (ifs (or (string? tag) (symbol? tag)) tag + #?@(:clj [(class? tag) (.getName ^Class tag)]))) + +#?(:clj +(defn >interface-method-tag + "Outputs a tag usable as an interface method return type or arg type. + For primitive classes, the method must be tagged with the class itself (not a string etc.). + For all other classes, `>arglist-embeddable-tag` will suffice." + [tag #_(t/or string? symbol? class?)] + (if (and (class? tag) (.isPrimitive ^Class tag)) + tag + (>arglist-embeddable-tag tag)))) + +(defn static-cast|code + "`(with-meta (list 'do expr) {:tag class-sym})` isn't enough" + [class-sym expr] + (let [cast-sym (gensym "cast-sym")] + ; `let*` to preserve metadata even when macroexpanding + (tag class-sym `(let* [~(tag class-sym cast-sym) ~expr] ~cast-sym)))) + +#?(:clj +(defmacro static-cast + "Performs a static type cast" + [class-sym expr] + (static-cast|code class-sym expr))) + +(defn primitive-cast|code [form c #_t/class?] + (list (symbol "clojure.core" (>name c)) form)) + +(defn cast-bindings|code + "Given a map of bindings to class, casts those bindings to their associated classes via + a `let` statement." + [form binding->class #_(t/map-of binding-symbol? t/class?)] + (if (empty? binding->class) + form + (list 'let* + (->> binding->class + (uc/map+ (fn [[binding-sym c]] + [(with-type-hint binding-sym (>body-embeddable-tag c)) + (if #?(:clj (.isPrimitive ^Class c) :cljs false) + (primitive-cast|code binding-sym c) + binding-sym)])) + uc/cat) + form))) + +(defn hint-arglist-with + [arglist #_seqable? hints #_seqable?] + (reduce-2 (fn [arglist' arg hint] + (conj arglist' (with-type-hint arg hint))) + [] arglist hints)) diff --git a/src-untyped/quantum/untyped/core/convert.cljc b/src-untyped/quantum/untyped/core/identifiers.cljc similarity index 52% rename from src-untyped/quantum/untyped/core/convert.cljc rename to src-untyped/quantum/untyped/core/identifiers.cljc index 6d493915..f4865b1c 100644 --- a/src-untyped/quantum/untyped/core/convert.cljc +++ b/src-untyped/quantum/untyped/core/identifiers.cljc @@ -1,20 +1,38 @@ -(ns quantum.untyped.core.convert - (:require - [clojure.string :as str] - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.error :as uerr] - [quantum.untyped.core.fn :as ufn] - [quantum.untyped.core.qualify - :refer [#?(:cljs DelimitedIdent) delim-ident? named?]] - [quantum.untyped.core.type.predicates - :refer [namespace?]]) - #?(:clj (:import quantum.untyped.core.qualify.DelimitedIdent))) +(ns quantum.untyped.core.identifiers + "Functions related to variable identifiers/names (`name`, `namespace`, etc.) and + qualification/unqualification of nameables." + (:refer-clojure :exclude + [ident? qualified-keyword? simple-symbol?]) + (:require + [clojure.core :as core] +#?(:clj [clojure.future :as fcore]) + [clojure.string :as str] + [fipp.ednize] + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.error :as uerr] + [quantum.untyped.core.fn :as ufn] + [quantum.untyped.core.ns :as uns +#?@(:clj [:refer [namespace?]])] + [quantum.untyped.core.vars + :refer [defalias]])) (ucore/log-this-ns) +;; ===== Nameability ===== ;; + +(defn named? [x] + #?(:clj (instance? clojure.lang.Named x) + :cljs (implements? cljs.core/INamed x))) + (defn demunged>namespace [^String s] (subs s 0 (.lastIndexOf s "/"))) (defn demunged>name [^String s] (subs s (inc (.lastIndexOf s "/")))) +(defn ?ns->name [?ns] + (name #?(:clj (if (namespace? ?ns) + (ns-name ?ns) + ?ns) + :cljs ?ns))) + (defn >name "Computes the name (the unqualified string identifier) of `x`." [x] @@ -46,6 +64,90 @@ (-> x .-name demunge-str demunged>namespace))) :else (uerr/not-supported! `>?namespace x))) +;; ===== Qualification ===== ;; + +(defn qualify + #?(:clj ([sym] (qualify *ns* sym))) + ([ns-or-sym sym] + (let [qualifier (cond (symbol? ns-or-sym) (-> ns-or-sym name) + (namespace? ns-or-sym) (-> ns-or-sym ns-name name) + :else (uerr/not-supported! `qualify ns-or-sym))] + (symbol qualifier (name sym))))) + +(defn qualify|dot [sym ns-] + (symbol (str (?ns->name ns-) "." (name sym)))) + +#?(:clj (defn qualify|class [sym] (symbol (str (-> *ns* ns-name name munge) "." sym)))) + +(defn unqualify [sym] (-> sym name symbol)) + +#?(:clj +(defn collapse-symbol + ([sym] (collapse-symbol sym true)) + ([sym extra-slash?] + (symbol + (when-let [n (namespace sym)] + (when-not (= n (-> *ns* ns-name name)) + (if-let [alias- (do #?(:clj (uns/ns-name>alias *ns* (symbol n)) :cljs false))] + (str alias- (when extra-slash? "/")) + n))) (name sym))))) + +;; ===== Standard identifiers ===== ;; + +#?(:clj (eval `(defalias ~(if (resolve `fcore/qualified-keyword?) + `fcore/qualified-keyword? + `core/qualified-keyword?))) + :cljs (defalias core/qualified-keyword?)) + +(defn >keyword [x] + (cond (keyword? x) x + (symbol? x) (keyword (>?namespace x) (>name x)) + :else (-> x str keyword))) + +#?(:clj (eval `(defalias ~(if (resolve `fcore/simple-symbol?) + `fcore/simple-symbol? + `core/simple-symbol?))) + :cljs (defalias core/simple-symbol?)) + +(defn >symbol + "Converts `x` to a symbol (possibly qualified, meta-able identifier)." + [x] + (cond (symbol? x) x + (string? x) (symbol x) + (or (keyword? x) #?(:clj (var? x))) + (symbol (>?namespace x) (>name x)) +#?@(:clj [(class? x) (-> x >name symbol) + (namespace? x) (ns-name x)]) + (fn? x) #?(:clj (or (when-let [ns- (-> x meta :ns)] + (symbol (>name ns-) (-> x meta :name >name))) + (-> x class .getName clojure.lang.Compiler/demunge recur)) + :cljs (when-not (-> x .-name str/blank?) + (-> x .-name demunge-str recur))) + :else (-> x str >symbol))) + +#?(:clj (eval `(defalias ~(if (resolve `fcore/ident?) + `fcore/ident? + `core/ident?))) + :cljs (defalias core/ident?)) + +;; ===== UUIDs ===== ;; + +(defn >uuid [] + #?(:clj (java.util.UUID/randomUUID) + :cljs (cljs.core/random-uuid))) + +;; ===== Delimited identifiers ===== ;; + +(defrecord + ^{:doc "A delimited identifier. + Defaults to delimiting all qualifiers by the pipe symbol instead of slashes or dots."} + DelimitedIdent [qualifiers #_(t/seq (t/and string? (t/not (fn1 contains? \|))))] + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal '| (symbol (str/join "|" qualifiers))))) + +(defn delim-ident? [x] (instance? DelimitedIdent x)) + (defn >delim-ident "Computes the delimited identifier of `x`." [x] @@ -67,29 +169,3 @@ (-> x .-name demunge-str (str/split #"\.|\||/"))))) (nil? x) (uerr/not-supported! `>delim-ident x) :else (-> x str recur))) - -(defn >keyword [x] - (cond (keyword? x) x - (symbol? x) (keyword (>?namespace x) (>name x)) - :else (-> x str keyword))) - -(defn >symbol - "Converts `x` to a symbol (possibly qualified, meta-able identifier)." - [x] - (cond (symbol? x) x - (string? x) (symbol x) - (or (keyword? x) #?(:clj (var? x))) - (symbol (>?namespace x) (>name x)) -#?@(:clj [(namespace? x) (ns-name x)]) - (fn? x) #?(:clj (or (when-let [ns- (-> x meta :ns)] - (symbol (>name ns-) (-> x meta :name >name))) - (-> x class .getName clojure.lang.Compiler/demunge recur)) - :cljs (when-not (-> x .-name str/blank?) - (-> x .-name demunge-str recur))) - :else (-> x str recur))) - -(defn >integer [x] - (cond (integer? x) x - (string? x) #?(:clj (Long/parseLong ^String x) - :cljs (js/parseInt x)) - :else (uerr/not-supported! `>integer x))) diff --git a/src-untyped/quantum/untyped/core/log.cljc b/src-untyped/quantum/untyped/core/log.cljc index e93ed2ac..734a599f 100644 --- a/src-untyped/quantum/untyped/core/log.cljc +++ b/src-untyped/quantum/untyped/core/log.cljc @@ -2,24 +2,24 @@ (:refer-clojure :exclude [pr seqable?]) (:require - [com.stuartsierra.component :as component] - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.error :as uerr] + [com.stuartsierra.component :as component] + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.data + :refer [seqable?]] + [quantum.untyped.core.error :as uerr] [quantum.untyped.core.form :refer [$]] [quantum.untyped.core.form.evaluate :refer [compile-if]] - [quantum.untyped.core.form.generate :as ufgen] - [quantum.untyped.core.meta.debug :as udebug] - [quantum.untyped.core.print :as upr] - [quantum.untyped.core.qualify :as uqual] - [quantum.untyped.core.type.predicates - :refer [seqable?]] + [quantum.untyped.core.form.generate :as ufgen] + [quantum.untyped.core.identifiers :as uident] + [quantum.untyped.core.meta.debug :as udebug] + [quantum.untyped.core.print :as upr] [quantum.untyped.core.vars :refer [defalias]]) #?(:cljs (:require-macros - [quantum.untyped.core.log :as self + [quantum.untyped.core.log :as self :refer [-gen-from-levels with-log-errors]]))) (ucore/log-this-ns) @@ -42,13 +42,13 @@ ;; ===== Log levels ===== ;; (defn disable! - ([pr-type #_t/keyword?] (swap! *levels assoc pr-type false)) + ([pr-type #_keyword?] (swap! *levels assoc pr-type false)) ([pr-type & pr-types] (doseq [pr-type-n (conj pr-types pr-type)] (disable! pr-type-n)))) (defn enable! - ([pr-type #_t/keyword?] (swap! *levels assoc pr-type true)) + ([pr-type #_keyword?] (swap! *levels assoc pr-type true)) ([pr-type & pr-types] (doseq [pr-type-n (conj pr-types pr-type)] (enable! pr-type-n)))) @@ -123,8 +123,8 @@ #?(:clj (defmacro -def-with-always [sym & args] - (let [args-sym (gensym "args") - macro-sym (uqual/qualify sym)] + (let [args-sym (gensym "args") + macro-sym (uident/qualify sym)] `(do (defmacro ~sym ~@args) (defmacro ~(symbol (str (name sym) "!")) [& ~args-sym] `(~'~macro-sym :always ~@~args-sym)))))) @@ -156,7 +156,7 @@ ;; ===== Level-specific macros ===== ;; #?(:clj -(defmacro -gen-from-levels [& levels #_(t/seq-of t/keyword?)] +(defmacro -gen-from-levels [& levels #_(t/seq-of keyword?)] `(do ~@(for [level levels] `(defmacro ~(-> level name symbol) [& ~'args] `(ppr ~~level ~@'args)))))) diff --git a/src-untyped/quantum/untyped/core/logic.cljc b/src-untyped/quantum/untyped/core/logic.cljc index 13e83ef5..4bb1a222 100644 --- a/src-untyped/quantum/untyped/core/logic.cljc +++ b/src-untyped/quantum/untyped/core/logic.cljc @@ -16,13 +16,21 @@ ;; ===== Logical operators ===== ;; - ;; tests value-equivalence +;; ----- Unary operators ----- ;; + + (defalias not core/not) + +;; ----- Binary operators ----- ;; + + ;; Tests value-equivalence (defalias = core/=) - ;; tests identity-equivalence + ;; Tests identity-equivalence (defalias ref= identical?) - (defalias not core/not) +#?(:clj (defmacro implies? [a b] `(if ~a ~b true))) + +;; ----- Infinitary operators ----- ;; #?(:clj (defalias and core/and)) @@ -32,20 +40,24 @@ #?(:clj (defmacro nor [& args] `(not (or ~@args)))) +;; NOTE: n-ary `xor` is true when the number of 1-bits is odd. +;; The below implements "some but not all" as in `(and (some identity args) (not (every? identity args)))` #?(:clj (defmacro xor {:attribution 'alexandergunnarson} ([] nil) - ([x] false) - ([x y] (if x (not y) y)) - ([x y & next] - `(if ~x (when-not (and ~y ~@next) ~x) (xor ~y ~@next))))) + ([a] false) + ([a b] `(let [a# ~a b# ~b] (if a# (not b#) b#))) + ([a b & next] + `(let [a# ~a b# ~b] + (if a# + (when-not (and b# ~@next) a#) + (xor b# ~@next)))))) + ;; TODO `xnor` #?(:clj (declare xnor)) -#?(:clj (defmacro implies? [a b] `(if ~a ~b true))) - ;; ===== Function-logical operators ===== ;; (defn fn= [x] (fn [y] (= x y))) @@ -70,8 +82,40 @@ #?(:clj (defmacro fn-implies? [a b] `(fn-logic-base implies? ~a ~b))) +;; ===== `case-val` ===== ;; + +#?(:clj +(defmacro case-val + "Like `case` but the dispatch value forms are `eval`ed at compile time rather than needing to be + compile-time literals. The results of the evaluation of the forms must each be literals." + [v & args] + (let [[branches else has-else?] + (if (-> args count even?) + [args nil false] + [(butlast args) (last args) true])] + `(case ~v + ~@(->> branches + (partition-all 2) + (mapcat (fn [[dispatch then]] [(eval dispatch) then]))) + ~@(when has-else? [else]))))) + ;; ===== `cond(f|c|p)` ===== ;; +#?(:clj +(defmacro ifs + "Like `clojure.core/cond`, but accepts an uneven number of arguments, in which case + the last functions as the default branch. If no default branch is supplied, an + exception branch will be emitted." + ([then-expr] then-expr) + ([cond-expr then-expr] + `(if ~cond-expr + ~then-expr + (throw (ex-info "`ifs`: No matching clause" {})))) + ([cond-expr then-expr & clauses] + `(if ~cond-expr + ~then-expr + (ifs ~@clauses))))) + #?(:clj (defmacro condf "Like `cond`, with each expr as a function applied to the initial argument, ->`obj`." @@ -84,14 +128,14 @@ (let [[[a b c :as clause] more] (split-at 2 args) n (count clause)] - (cond + (ifs (= 0 n) `(throw (~illegal-argument (str "No matching clause for " ~obj))) (= 1 n) `(~a ~obj) (= 2 n) `(if (~a ~obj) (~b ~obj) ~(emit obj more)) - :else (emit obj more))))] + (emit obj more))))] `(let [~gobj ~obj] ~(emit gobj clauses))))) @@ -108,14 +152,14 @@ (let [[[a b c :as clause] more] (split-at 2 args) n (count clause)] - (cond + (ifs (= 0 n) `(throw (~illegal-argument (str "No matching clause for " ~obj))) (= 1 n) `(~a ~obj) (= 2 n) `(if (or ~(= a :else) (~a ~obj)) ~b ; As in, this expression is not used as a function taking @obj as an argument ~(emit obj more)) - :else (emit obj more))))] + (emit obj more))))] `(let [~gobj ~obj] ~(emit gobj clauses))))) @@ -132,7 +176,7 @@ (let [[[a b c :as clause] more] (split-at (if (= :>> (second args)) 3 2) args) n (count clause)] - (cond + (ifs (= 0 n) nil ; No matching clause `(throw (IllegalArgumentException. (str "No matching clause: " ~expr))) (= 1 n) a (= 2 n) `(if (if (fn? ~a) @@ -140,9 +184,9 @@ (~pred ~expr ~a)) ~b ~(emit pred expr more)) - :else `(clojure.core/if-let [p# (~pred ~a ~expr)] - (~c p#) - ~(emit pred expr more)))))] + `(clojure.core/if-let [p# (~pred ~a ~expr)] + (~c p#) + ~(emit pred expr more)))))] `(let [~gpred ~pred ~gexpr ~expr] ~(emit gpred gexpr clauses))))) @@ -198,6 +242,75 @@ #?(:clj (defmacro whenp->> "`whenf->>` + `ifp->>`" [x pred & texprs] `(let [x# ~x] (if ~pred (->> x# ~@texprs) x#)))) #?(:clj (defmacro whenp1 [x0 x1] `(fn [arg#] (whenp arg# ~x0 ~x1)))) +;; ===== Conditional `let` bindings ===== ;; + +#?(:clj +(defmacro if-let-base + {:attribution "alexandergunnarson"} + [cond-op #_symbol? [bind expr & more] then else] + `(let [temp# ~expr ~bind temp#] + (~cond-op temp# + ~(if (seq more) + `(if-let-base ~cond-op [~@more] ~then ~else) + then) + ~else)))) + +#?(:clj +(defmacro if-let + "Like `if-let`, but multiple bindings can be used." + [& args] `(if-let-base if ~@args))) + +#?(:clj +(defmacro if-not-let + "if : if-let :: if-not : if-not-let. All conditions must be false." + [& args] `(if-let-base if-not ~@args))) + +#?(:clj +(defmacro when-let-base + {:attribution "alexandergunnarson"} + [cond-op #_symbol? [bind expr & more] & body] + `(let [temp# ~expr ~bind temp#] + (~cond-op temp# + ~(if (seq more) + `(when-let-base ~cond-op [~@more] ~@body) + `(do ~@body)))))) + +#?(:clj +(defmacro when-let + "Like `when-let`, but multiple bindings can be used." + [& args] `(if-let-base when ~@args))) + +#?(:clj +(defmacro when-not-let + "when : when-let :: when-not : when-not-let. All conditions must be false." + [& args] `(when-let-base when-not ~@args))) + +#?(:clj +(defmacro ifs-let + "Transforms into a series of nested `if-let` statements." + {:attribution "alexandergunnarson"} + ([] `(throw (ex-info "`ifs-let`: No matching clause" {}))) ; no else + ([else] else) + ([bindings then & more] `(if-let ~bindings ~then (ifs-let ~@more))))) + +#?(:clj +(defmacro logical-let-base + {:attribution "alexandergunnarson"} + ([logical-op #_symbol? [bind expr & more]] + `(let [temp# ~expr ~bind temp#] + (~logical-op temp# + ~(if (seq more) + `(logical-let-base ~logical-op [~@more]) + `(~logical-op))))))) + +#?(:clj (defmacro and-let [bindings] `(logical-let-base and ~bindings))) +#?(:clj (defmacro or-let [bindings] `(logical-let-base or ~bindings))) +;; TODO These will require a different, non-incremental approach +#?(:clj (defmacro nand-let [bindings] (throw (ex-info "TODO" {})) #_`(logical-let-base nand ~bindings))) +#?(:clj (defmacro nor-let [bindings] (throw (ex-info "TODO" {})) #_`(logical-let-base nor ~bindings))) +#?(:clj (defmacro xor-let [bindings] (throw (ex-info "TODO" {})) #_`(logical-let-base xor ~bindings))) +#?(:clj (defmacro xnor-let [bindings] (throw (ex-info "TODO" {})) #_`(logical-let-base xnor ~bindings))) + ;; ===== `coll-(or|and)` ===== ;; #?(:clj diff --git a/src-untyped/quantum/untyped/core/loops.cljc b/src-untyped/quantum/untyped/core/loops.cljc index 0aa5aac4..8ee57fe4 100644 --- a/src-untyped/quantum/untyped/core/loops.cljc +++ b/src-untyped/quantum/untyped/core/loops.cljc @@ -1,25 +1,68 @@ (ns quantum.untyped.core.loops + (:refer-clojure :exclude + [doseq]) (:require - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.reducers :as r])) + [quantum.untyped.core.core :as ucore])) (ucore/log-this-ns) +(defn default-on-different-count [ret xs0 xs1] ret) + (defn reduce-2 "Reduces over two seqables at a time." - {:todo #{"`defnt` this and have it dispatch to e.g. reduce-2:indexed"}} ([f xs0 xs1] (reduce-2 f nil xs0 xs1)) - ([f init xs0 xs1] (reduce-2 f init xs0 xs1 false)) - ([f init xs0 xs1 assert-same-count?] + ([f init xs0 xs1] (reduce-2 f default-on-different-count init xs0 xs1)) + ([f on-different-count init xs0 xs1] (loop [ret init xs0' xs0 xs1' xs1] (cond (reduced? ret) @ret (or (empty? xs0') (empty? xs1')) - (do (when (and assert-same-count? - (or (and (empty? xs0') (seq xs1')) - (and (seq xs0') (empty? xs1')))) - (throw (ex-info "Seqables are not the same count" {}))) + (if (or (and (empty? xs0') (seq xs1')) + (and (seq xs0') (empty? xs1'))) + (unreduced (on-different-count ret xs0 xs1)) ret) :else (recur (f ret (first xs0') (first xs1')) (next xs0') (next xs1')))))) + +(defn reducei-2 + "Reduces over two seqables at a time, maintaining an index." + ([f xs0 xs1] (reducei-2 f nil xs0 xs1)) + ([f init xs0 xs1] (reducei-2 f init xs0 xs1 default-on-different-count)) + ([f init xs0 xs1 on-different-count] + (let [f' (let [*i (volatile! -1)] + (fn [ret x0 x1] (f ret x0 x1 (vreset! *i (unchecked-inc (long @*i))))))] + (reduce-2 f' on-different-count init xs0 xs1)))) + +;; TODO incorporate into `quantum.core.loops` +#?(:clj +(defmacro doseq + "Like `doseq` but: + - Indexed + - Returns the result + - Does not have `:let`, `:while` or `:when` semantics + - Much smaller code footprint" + [[x xs i] & body] + `(loop [xs# (seq ~xs) + ret# nil] + (if xs# + (let [~x (first xs#)] + (recur (next xs#) (do ~@body))) + ret#)))) + +;; TODO incorporate into `quantum.core.loops` +#?(:clj +(defmacro doseqi + "Like `doseq` but: + - Indexed + - Returns the result + - Does not have `:let`, `:while` or `:when` semantics + - Much smaller code footprint" + [[x xs i] & body] + `(loop [xs# (seq ~xs) + ~i 0 + ret# nil] + (if xs# + (let [~x (first xs#)] + (recur (next xs#) (inc ~i) (do ~@body))) + ret#)))) diff --git a/src-untyped/quantum/untyped/core/meta/debug.cljc b/src-untyped/quantum/untyped/core/meta/debug.cljc index 3feb1400..c1892b59 100644 --- a/src-untyped/quantum/untyped/core/meta/debug.cljc +++ b/src-untyped/quantum/untyped/core/meta/debug.cljc @@ -34,12 +34,13 @@ (reify java.lang.Thread$UncaughtExceptionHandler (^void uncaughtException [_ ^Thread t ^Throwable e] + ;; TODO (@clojure.core/atom|proto-repl|print-err-fn e) ? (println "Exception in thread" (str t ":")) (trace e))))) #?(:clj (defn print-pretty-exceptions! - ([] (Thread/setDefaultUncaughtExceptionHandler default-exception-handler)) + ([] (->> (Thread/getAllStackTraces) keys (map print-pretty-exceptions!) dorun)) ([^Thread t] (.setUncaughtExceptionHandler t default-exception-handler)))) (def stack-depth @@ -55,8 +56,8 @@ (let [st (identity #?(:clj (-> (Thread/currentThread) .getStackTrace) :cljs (-> (js/Error) .-stack - ; TODO Different browsers have different - ; implementations of stack traces + ;; TODO Different browsers have different + ;; implementations of stack traces (str/split "\n at ")))) #?(:clj ^StackTraceElement elem :cljs elem) diff --git a/src-untyped/quantum/untyped/core/nondeterministic.cljc b/src-untyped/quantum/untyped/core/nondeterministic.cljc new file mode 100644 index 00000000..a1f617f3 --- /dev/null +++ b/src-untyped/quantum/untyped/core/nondeterministic.cljc @@ -0,0 +1,27 @@ +(ns quantum.untyped.core.nondeterministic + (:require + [clojure.core :as core] + [quantum.untyped.core.error + :refer [TODO]]) +#?(:clj + (:import + java.security.SecureRandom))) + +#?(:clj (defonce ^SecureRandom secure-random-generator + (SecureRandom/getInstance "SHA1PRNG"))) + +(defn #?(:clj ^java.util.Random get-generator :cljs get-generator) [secure?] + #?(:clj (if secure? + secure-random-generator + (java.util.concurrent.ThreadLocalRandom/current)) + :cljs (TODO))) + +(defn double-between + "Yields a random double between a and b." + ([ a b] (double-between false a b)) + ([secure? a b] + #?(:clj (let [generator (get-generator secure?)] + (+ a (* (.nextDouble generator) (- b a)))) + :cljs (if secure? + (TODO "CLJS does not yet support secure random numbers") + (+ a (core/rand (inc (- b a)))))))) diff --git a/src-untyped/quantum/untyped/core/ns.cljc b/src-untyped/quantum/untyped/core/ns.cljc index a6f93818..6a1477ab 100644 --- a/src-untyped/quantum/untyped/core/ns.cljc +++ b/src-untyped/quantum/untyped/core/ns.cljc @@ -14,6 +14,8 @@ [quantum.untyped.core.vars :as uvar :refer [defalias defaliases]])) +#?(:clj (defn namespace? [x] (instance? clojure.lang.Namespace x))) + #?(:clj (do (defaliases core ns the-ns find-ns ns-name ns-map) (defalias core/ns-unmap ) diff --git a/src-untyped/quantum/untyped/core/numeric.cljc b/src-untyped/quantum/untyped/core/numeric.cljc index 5b07098a..7855c66f 100644 --- a/src-untyped/quantum/untyped/core/numeric.cljc +++ b/src-untyped/quantum/untyped/core/numeric.cljc @@ -1,14 +1,26 @@ (ns quantum.untyped.core.numeric - (:require - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.error :as err]) + (:refer-clojure :exclude + [pos-int?]) + (:require + [clojure.core :as core] + #?(:clj [clojure.future :as fcore]) + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.error :as uerr] + [quantum.untyped.core.vars + :refer [defalias]]) #?(:clj (:import java.lang.Math java.math.BigDecimal))) (ucore/log-this-ns) +#?(:clj (eval `(defalias ~(if (resolve `fcore/pos-int?) + `fcore/pos-int? + `core/pos-int?))) + :cljs (defalias core/pos-int?)) + (defn integer-value? - {:adapted-from '#{com.google.common.math.DoubleMath/isMathematicalInteger - "https://stackoverflow.com/questions/1078953/check-if-bigdecimal-is-integer-value"}} + {:adapted-from + '#{com.google.common.math.DoubleMath/isMathematicalInteger + "https://stackoverflow.com/questions/1078953/check-if-bigdecimal-is-integer-value"}} [x] (cond #?@(:clj [(or (double? x) (float? x)) (let [x (double x)] @@ -24,7 +36,13 @@ false] :cljs [(number? x) (js/Number.isInteger x)]) - :else (err/not-supported! `integer-value? x))) + :else (uerr/not-supported! `integer-value? x))) + +(defn >integer [x] + (cond (integer? x) x + (string? x) #?(:clj (Long/parseLong ^String x) + :cljs (js/parseInt x)) + :else (uerr/not-supported! `>integer x))) (defn signum|long [^long x] @@ -33,3 +51,5 @@ (bit-or 1 (bit-shift-right x 63)))) #?(:cljs (def abs js/Math.abs)) + +(defn inc-default [x] (if (nil? x) 1 (inc x))) diff --git a/src-untyped/quantum/untyped/core/print.cljc b/src-untyped/quantum/untyped/core/print.cljc index 34fac2b6..ea9d0be9 100644 --- a/src-untyped/quantum/untyped/core/print.cljc +++ b/src-untyped/quantum/untyped/core/print.cljc @@ -2,6 +2,7 @@ (:require #?@(:clj [[io.aviso.exception]]) + [fipp.ednize :as fedn] [quantum.untyped.core.collections :as uc] [quantum.untyped.core.core :as ucore] [quantum.untyped.core.error :as uerr @@ -39,7 +40,7 @@ (defn ppr-hints [x] (binding [*print-meta* true] (ppr x))) ; TODO this isn't right (defn ppr-error [x] - #?(:clj (do (println "EXCEPTION TRACE + MESSAGE:") + #?(:clj (do (println (str "EXCEPTION. TRACE + MESSAGE:")) (print (io.aviso.exception/format-exception x {:properties false})) (let [e (>err x) e (or (:cause e) e)] @@ -50,7 +51,6 @@ not-empty)] (println "EXCEPTION DATA:") (ppr e')))) ; TODO fix so it doesn't print "empty: false" - :cljs (ppr x))) (defalias uerr/ppr-str) @@ -64,3 +64,40 @@ ([x & args] (Group. (cons x args)))) (defn group? [x] (instance? Group x)) + +;; ===== fipp.edn ===== ;; + +(extend-protocol fedn/IEdn + nil (-edn [x] nil) + #?(:clj java.lang.Boolean + :cljs boolean) (-edn [x] x) + #?@(:clj [java.lang.Byte (-edn [x] x) + java.lang.Short (-edn [x] x) + java.lang.Character (-edn [x] x) + java.lang.Integer (-edn [x] x) + java.lang.Long (-edn [x] x) + java.lang.Float (-edn [x] x)]) + #?(:clj java.lang.Double + :cljs number) (-edn [x] x) + #?(:clj java.lang.String + :cljs string) (-edn [x] x) + #?(:clj clojure.lang.Symbol + :cljs cljs.core/Symbol) (-edn [x] x) + #?(:clj clojure.lang.Keyword + :cljs cljs.core/Keyword) (-edn [x] x) + #?(:clj clojure.lang.PersistentArrayMap + :cljs cljs.core/PersistentArrayMap) + (-edn [x] (->> x (map (fn [[k v]] [(fedn/-edn k) (fedn/-edn v)])) (into (array-map)))) + #?(:clj clojure.lang.PersistentHashMap + :cljs cljs.core/PersistentHashMap) + (-edn [x] (->> x (map (fn [[k v]] [(fedn/-edn k) (fedn/-edn v)])) (into (hash-map)))) + #?(:clj clojure.lang.PersistentVector + :cljs cljs.core/PersistentVector) + (-edn [x] (->> x (mapv fedn/-edn))) + #?(:clj clojure.lang.PersistentList + :cljs cljs.core/PersistentList) + (-edn [x] (->> x (map fedn/-edn) list*)) + #?@(:clj [clojure.lang.PersistentList$EmptyList (fedn/-edn [x] x)]) + #?@(:clj [clojure.lang.ASeq (-edn [x] (->> x (map fedn/-edn)))]) + #?@(:clj [clojure.lang.LazySeq (-edn [x] (->> x (map fedn/-edn)))]) + #?@(:clj [Class (-edn [x] (-> x .getName symbol))])) diff --git a/src-untyped/quantum/untyped/core/print/prettier.cljc b/src-untyped/quantum/untyped/core/print/prettier.cljc new file mode 100644 index 00000000..613dce8b --- /dev/null +++ b/src-untyped/quantum/untyped/core/print/prettier.cljc @@ -0,0 +1,180 @@ +(ns quantum.untyped.core.print.prettier + (:require + [fipp.edn] + [fipp.visit] + [fipp.ednize :as fedn] + [quantum.untyped.core.fn + :refer [rcomp]] + [quantum.untyped.core.ns] + [quantum.untyped.core.print] + [quantum.untyped.core.identifiers] + [quantum.untyped.core.vars])) + +#?(:clj +(defmethod print-method fipp.ednize.IEdn [v ^java.io.Writer w] + (print-method (fedn/-edn v) w))) + +#?(:clj (prefer-method print-method fipp.ednize.IEdn clojure.lang.IRecord)) +#?(:clj (prefer-method print-method fipp.ednize.IEdn clojure.lang.IPersistentMap)) +#?(:clj (prefer-method print-method fipp.ednize.IEdn java.util.Map)) +#?(:clj (prefer-method print-method fipp.ednize.IEdn clojure.lang.ISeq)) +#?(:clj (prefer-method print-method fipp.ednize.IEdn clojure.lang.IDeref)) +#?(:clj (prefer-method print-method clojure.lang.IRecord Throwable)) + +#?(:clj (in-ns 'fipp.visit)) + +#?(:clj +(defn- transient-vector? [x] + (instance? #?(:clj clojure.lang.ITransientVector + :cljs cljs.core/TransientVector) x))) + +;; TODO more efficient +;; TODO move? +#?(:clj +(deftype IntIndexedIterator + [^long ^:unsynchronized-mutable i ^long ct ^clojure.lang.Indexed xs] + java.util.Iterator + (hasNext [this] (< i ct)) + (next [this] + (if (< i ct) + (let [i-prev i] + (set! i (unchecked-inc i)) + (.nth xs i-prev)) + (throw (java.util.NoSuchElementException.)))) + (remove [this] (throw (UnsupportedOperationException.))))) + +#?(:clj +(deftype IntIndexedIterable [^clojure.lang.Indexed xs] + Iterable + (iterator [this] (IntIndexedIterator. 0 (count xs) xs)))) + +#?(:clj +(defn visit-symbol* [x] + [:text (cond-> x + quantum.untyped.core.print/*collapse-symbols?* + (quantum.untyped.core.identifiers/collapse-symbol + (not quantum.untyped.core.print/*print-as-code?*)))])) + +#?(:clj +(defn visit-fn [visitor x] + [:group "#" "fn" " " (-> x quantum.untyped.core.identifiers/>symbol visit-symbol*)])) + +#?(:clj +(defn visit* + "Visits objects, ignoring metadata." + [visitor x] + (cond + (nil? x) (visit-nil visitor) + (quantum.untyped.core.print/group? x) + (fipp.edn/pretty-coll visitor "" (.-xs ^quantum.untyped.core.print.Group x) :line "" visit) + (fipp.ednize/override? x) (visit-unknown visitor x) + (boolean? x) (visit-boolean visitor x) + (string? x) (visit-string visitor x) + (char? x) (visit-character visitor x) + (symbol? x) (visit-symbol* x) + (keyword? x) (visit-keyword visitor x) + (number? x) (visit-number visitor x) + (seq? x) (visit-seq visitor x) + (vector? x) (visit-vector visitor x) + (record? x) (visit-record visitor x) + (map? x) (visit-map visitor x) + (set? x) (visit-set visitor x) + (tagged-literal? x) (visit-tagged visitor x) + (var? x) (visit-var visitor x) + (regexp? x) (visit-pattern visitor x) + (fn? x) (visit-fn visitor x) + (transient-vector? x) + [:group "#" (pr-str '!+) + (when (and (:print-meta visitor) (meta (:form visitor))) " ") + (visit-vector visitor (IntIndexedIterable. x))] + :else (visit-unknown visitor x)))) + +#?(:clj +(defn visit [visitor x] + (let [m (meta x)] + (if (and m (not (var? x))) + (visit-meta visitor m x) + (visit* visitor x))))) + +#?(:clj (in-ns 'quantum.untyped.core.print.prettier)) + +(defn extend-pretty-printing! [] + #?(:clj + (do (extend-type java.util.ArrayList + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal '! (vec this)))) ; TODO faster + (extend-type it.unimi.dsi.fastutil.longs.LongArrayList + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal '!l (vec this)))) ; TODO faster + + (extend-type (Class/forName "[Z") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal '?<> (vec this)))) ; TODO faster + (extend-type (Class/forName "[B") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 'b<> (vec this)))) ; TODO faster + (extend-type (Class/forName "[C") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 'c<> (vec this)))) ; TODO faster + (extend-type (Class/forName "[[C") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 'c<><> (into [] this)))) ; TODO faster + (extend-type (Class/forName "[S") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 's<> (vec this)))) ; TODO faster + (extend-type (Class/forName "[I") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 'i<> (vec this)))) ; TODO faster + (extend-type (Class/forName "[J") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 'l<> (vec this)))) ; TODO ->vec for this + (extend-type (Class/forName "[F") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 'f<> (vec this)))) ; TODO faster + (extend-type (Class/forName "[D") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 'd<> (vec this)))) ; TODO ->vec for this + (extend-type (Class/forName "[[D") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 'd<><> (into [] this)))) ; TODO faster + (extend-type (Class/forName "[Ljava.lang.Object;") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal '*<> (vec this)))) ; TODO faster + (extend-type (Class/forName "[[Ljava.lang.Object;") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal '*<><> (into [] this)))) ; TODO faster + (extend-type (Class/forName "[Ljava.lang.Class;") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 'class<> (vec this)))) ; TODO faster + + (extend-type java.util.HashMap + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal '! (into {} this)))) + (extend-type java.util.concurrent.ConcurrentHashMap + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal '!! (into {} this)))) ; TODO ->map + (extend-type quantum.core.Error + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal 'err (into {} this)))) + (extend-type (Class/forName "[Ljava.lang.StackTraceElement;") + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (mapv (rcomp StackTraceElement->vec str symbol) this)))))) diff --git a/src-untyped/quantum/untyped/core/qualify.cljc b/src-untyped/quantum/untyped/core/qualify.cljc deleted file mode 100644 index 18fc88ce..00000000 --- a/src-untyped/quantum/untyped/core/qualify.cljc +++ /dev/null @@ -1,58 +0,0 @@ -(ns quantum.untyped.core.qualify - "Functions related to qualification (name, namespace, etc.) and unqualification - of nameables." - (:require - [clojure.string :as str] - [fipp.ednize] - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.ns :as uns] - [quantum.untyped.core.type.predicates - :refer [namespace?]])) - -(ucore/log-this-ns) - -(defn named? [x] - #?(:clj (instance? clojure.lang.Named x) - :cljs (implements? cljs.core/INamed x))) - -(defn ?ns->name [?ns] - (name #?(:clj (if (namespace? ?ns) - (ns-name ?ns) - ?ns) - :cljs ?ns))) - -;; ===== QUALIFICATION ===== ;; - -(defn qualify - #?(:clj ([sym] (qualify *ns* sym))) - ([?ns sym] (symbol (?ns->name ?ns) (name sym)))) - -(defn qualify|dot [sym ns-] - (symbol (str (?ns->name ns-) "." (name sym)))) - -#?(:clj (defn qualify|class [sym] (symbol (str (-> *ns* ns-name name munge) "." sym)))) - -(defn unqualify [sym] (-> sym name symbol)) - -#?(:clj -(defn collapse-symbol - ([sym] (collapse-symbol sym true)) - ([sym extra-slash?] - (symbol - (when-let [n (namespace sym)] - (when-not (= n (-> *ns* ns-name name)) - (if-let [alias- (do #?(:clj (uns/ns-name>alias *ns* (symbol n)) :cljs false))] - (str alias- (when extra-slash? "/")) - n))) (name sym))))) - -;; ===== IDENTS ===== ;; - -(defrecord - ^{:doc "A delimited identifier. - Defaults to delimiting all qualifiers by the pipe symbol instead of slashes or dots."} - DelimitedIdent [qualifiers #_(t/seq (t/and string? (t/not (fn1 contains? \|))))] - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal '| (symbol (str/join "|" qualifiers))))) - -(defn delim-ident? [x] (instance? DelimitedIdent x)) diff --git a/src-untyped/quantum/untyped/core/reducers.cljc b/src-untyped/quantum/untyped/core/reducers.cljc index ce15458f..f28fb2fd 100644 --- a/src-untyped/quantum/untyped/core/reducers.cljc +++ b/src-untyped/quantum/untyped/core/reducers.cljc @@ -1,20 +1,24 @@ (ns quantum.untyped.core.reducers - (:refer-clojure :exclude [apply every? vec == for seqable?]) - (:require - [clojure.core :as core] - [clojure.core.reducers :as r] - [fast-zip.core :as zip] - [quantum.untyped.core.compare :as comp - :refer [== not==]] - [quantum.untyped.core.core :as ucore - :refer [>sentinel]] - [quantum.untyped.core.form.evaluate - :refer [case-env]] - [quantum.untyped.core.qualify :as qual] - [quantum.untyped.core.type.predicates - :refer [seqable?]] - [quantum.untyped.core.vars :as uvar - :refer [defalias]])) + (:refer-clojure :exclude [apply every? vec == for seqable?]) + (:require + [clojure.core :as core] + [clojure.core.reducers :as r] + [fast-zip.core :as zip] + [quantum.untyped.core.compare :as comp + :refer [== not==]] + [quantum.untyped.core.core :as ucore + :refer [>sentinel]] + [quantum.untyped.core.data + :refer [seqable?]] + [quantum.untyped.core.error + :refer [err!]] + [quantum.untyped.core.form.evaluate + :refer [case-env]] + [quantum.untyped.core.identifiers :as uident] + [quantum.untyped.core.vars :as uvar + :refer [defalias]]) +#?(:cljs (:require-macros + [quantum.untyped.core.reducers :as self]))) (ucore/log-this-ns) @@ -22,16 +26,20 @@ ;; ===== Transformer and transducer conversion ===== ;; -;; TODO `xs` will hold on to heads of seqs while stepping through; see also http://dev.clojure.org/jira/browse/CLJ-1793 -;; A cross between a `reducer` and a `folder` -(deftype Transformer [xs prev xf] +(declare educe) + +(defprotocol PEduceInit (-educe-init [this f init])) + +(deftype + ^{:doc "A cross between an `r/reducer` and an `r/folder`. + NOTE: `xs` will hold on to heads of seqs while stepping through, pre-Clojure-1.9; see also + http://dev.clojure.org/jira/browse/CLJ-1793"} + Transformer [xs prev xf] #?(:clj clojure.lang.IReduce :cljs cljs.core/IReduce) - (#?(:clj reduce :cljs -reduce) [this f] - (let [rf (xf f)] - (rf (core/reduce rf (rf) prev)))) - (#?(:clj reduce :cljs -reduce) [this f init] - (let [rf (xf f)] - (rf (core/reduce rf init prev))))) + (#?(:clj reduce :cljs -reduce) [this f ] (core/reduce (xf f) prev)) + (#?(:clj reduce :cljs -reduce) [this f init] (core/reduce (xf f) init prev)) + PEduceInit + (-educe-init [this f init] (educe (xf f) init prev))) (defn transformer "Given a reducible collection, and a transformation function transform, @@ -49,15 +57,15 @@ {:todo #{"More arity"}} ([^long n xf tf] (case n - 0 (fn ([] (xf)) - ([xs] (tf xs (xf)))) - 1 (fn ([a0] (xf a0)) - ([a0 xs] (tf xs (xf a0)))) - 2 (fn ([a0 a1] (xf a0 a1)) - ([a0 a1 xs] (tf xs (xf a0 a1)))) - 3 (fn ([a0 a1 a2] (xf a0 a1 a2)) - ([a0 a1 a2 xs] (tf xs (xf a0 a1 a2)))) - (throw (ex-info "Unhandled arity for transducer" nil))))) + 0 (fn ([] (xf)) + ([xs] (tf xs (xf)))) + 1 (fn ([a0] (xf a0)) + ([a0 xs] (tf xs (xf a0)))) + 2 (fn ([a0 a1] (xf a0 a1)) + ([a0 a1 xs] (tf xs (xf a0 a1)))) + 3 (fn ([a0 a1 a2] (xf a0 a1 a2)) + ([a0 a1 a2 xs] (tf xs (xf a0 a1 a2)))) + (err! "Unhandled arity for transducer")))) (defn transducer->transformer "Converts a transducer into a transformer." @@ -67,18 +75,49 @@ "Converts a transducer into a reducer." [^long n xf] (transducer> n xf r/reducer)) +;; ===== Utils ===== ;; + +(defn preserving-reduced [rf] + (fn ([ret] ret) + ([ret x] + (let [ret (rf ret x)] + (if (reduced? ret) + (reduced ret) + ret))))) + ;; ===== Reduction functions ===== ;; -(def ^{:doc "A marriage of `transduce` and `reduce`. - Like `reduce`, does not have a notion of a transforming function - (unlike `transduce`). Like `transduce`, uses the seed (0-arity) and - completing (1-arity) arities of the reducing function when performing - a reduction (unlike `reduce`)."} - educe (partial transduce identity)) +(defn educe + "A blending of `transduce` and `reduce`. + Like `reduce`, does not have a notion of a transforming function (unlike `transduce`). Like + `transduce`, uses the seed (0-arity) and completing (1-arity) arities of the reducing function + when performing a reduction (unlike `reduce`)." + ([f xs] (educe f (f) xs)) + ([f init xs] + (if (satisfies? PEduceInit xs) + (-educe-init xs f init) + (f (reduce f init xs))))) + +(defn educei + "Like `educe`, but indexed." + ([f xs] (educei f (f) xs)) + ([f init xs] + (let [f' (let [*i (volatile! -1)] + (fn ([] (f)) + ([ret] (f ret)) + ([ret x] (f ret x (vreset! *i (unchecked-inc (long @*i))))) + ([ret k v] (f ret k v (vreset! *i (unchecked-inc (long @*i)))))))] + (educe f' init xs)))) (defn join + "Like `into`, but internally uses `educe`, and creates as little data + as possible." + ([] []) ([from] (if (vector? from) from (join [] from))) - ([to from] (core/into to from))) + ([to from] + (if (instance? clojure.lang.IEditableCollection to) + (with-meta (persistent! (educe conj! (transient to) from)) (meta to)) + (educe conj to from)))) (defn join' "Like `joinl`, but reduces into an empty version of the collection passed." @@ -87,42 +126,42 @@ (transformer? xs) (join (empty (.-xs ^Transformer xs)) xs) (seq? (empty xs)) ; `conj`es on left, not right - (core/into (empty xs) (reverse xs)) + (join (empty xs) (reverse xs)) :else (join (empty xs) xs))) ;; for purposes of `defeager` (declare pjoin pjoin') +(defn- >eager|code [sym plus-sym join-sym max-args docstring] + (list* 'defn sym docstring + (case (long max-args) + 0 `[([] (fn [xs#] (~sym xs#))) + ([ xs#] (->> xs# (~plus-sym ) ~join-sym))] + 1 `[([a0#] (fn [xs#] (~sym a0# xs#))) + ([a0# xs#] (->> xs# (~plus-sym a0#) ~join-sym))]))) + #?(:clj -(defmacro defeager [sym plus-sym] - (let [lazy-sym (when (resolve (symbol "clojure.core" (name sym))) - (symbol (str "l" sym))) - quoted-sym (symbol (str sym "'")) - parallel-sym (symbol (str "p" sym)) - parallel-quoted-sym (symbol (str "p" sym "'"))] - `(do ~(when lazy-sym - `(defalias ~lazy-sym ~(symbol (case-env :cljs "cljs.core" "clojure.core") (name sym)))) - (defalias ~(qual/unqualify plus-sym) ~plus-sym) - (defn ~sym - ~(str "Like `core/" sym "`, but eager. Reduces into vector.") - ([f#] (fn [coll#] (~sym f# coll#))) - ([f# coll#] (->> coll# (~plus-sym f#) join))) - (defn ~quoted-sym - ~(str "Like `" sym "`, but reduces into the empty version of the collection which was passed to it.") - ([f#] (fn [coll#] (~quoted-sym f# coll#))) - ([f# coll#] (->> coll# (~plus-sym f#) join'))) - (defn ~parallel-sym - ~(str "Like `core/" sym "`, but eager and parallelized. Folds into vector.") - ([f#] (fn [coll#] (~parallel-sym f# coll#))) - ([f# coll#] (->> coll# (~plus-sym f#) pjoin))) - (defn ~parallel-quoted-sym - ~(str "Like `" sym "`, but parallel-folds into the empty version of the collection which was passed to it.") - ([f#] (fn [coll#] (~parallel-quoted-sym f# coll#))) - ([f# coll#] (->> coll# (~plus-sym f#) pjoin'))))))) - - -(defn into! [xs0 xs1] (reduce (fn [xs0' x] (conj! xs0' x)) xs0 xs1)) +(defmacro defeager [sym plus-sym max-args & [lazy-sym]] + `(do ~(when (and (not lazy-sym) (resolve (symbol "clojure.core" (name sym)))) + `(defalias ~(symbol (str "l" sym)) ~(symbol (case-env :cljs "cljs.core" "clojure.core") (name sym)))) + (defalias ~(uident/unqualify plus-sym) ~plus-sym) + ~(>eager|code sym plus-sym `join max-args + (str "Like `core/" sym "`, but eager. Reduces into vector.")) + ~(>eager|code (symbol (str sym "'")) plus-sym `join' max-args + (str "Like `" sym "`, but reduces into the empty version of the collection which was passed to it.")) + ~(>eager|code (symbol (str "p" sym)) plus-sym `pjoin max-args + (str "Like `core/" sym "`, but eager and parallelized. Folds into vector.")) + ~(>eager|code (symbol (str "p" sym "'")) plus-sym `pjoin' max-args + (str "Like `" sym "`, but parallel-folds into the empty version of the collection which was passed to it."))))) + +#?(:clj +(defmacro def-transducer>eager [eager-sym transducer-sym max-args & [lazy-sym]] + (let [plus-sym (symbol (str eager-sym "+"))] + `(do (def ~plus-sym (transducer->transformer ~max-args ~transducer-sym)) + (defeager ~eager-sym ~plus-sym ~max-args ~lazy-sym))))) + +(defn join! [xs0 xs1] (educe conj! xs0 xs1)) (defn zip-reduce* [f init z] (loop [xs (zip/down z) v init] @@ -134,7 +173,7 @@ (recur (zip/right xs) ret)))))) (defn reducei - "`reduce`, indexed." + "Like `reduce`, but indexed." [f init xs] (let [f' (let [*i (volatile! -1)] (fn ([ret x] diff --git a/src-untyped/quantum/untyped/core/refs.cljc b/src-untyped/quantum/untyped/core/refs.cljc index 038a0076..d676dda7 100644 --- a/src-untyped/quantum/untyped/core/refs.cljc +++ b/src-untyped/quantum/untyped/core/refs.cljc @@ -1,12 +1,61 @@ (ns quantum.untyped.core.refs + (:refer-clojure :exclude + [get set]) (:require - [quantum.untyped.core.core :as ucore]) - #?(:clj (:import [clojure.lang IDeref IAtom]))) + [quantum.untyped.core.core :as ucore])) (ucore/log-this-ns) -(defn atom? [x] (#?(:clj instance? :cljs satisfies?) IAtom x)) +(defn atom? [x] + #?(:clj (instance? clojure.lang.IAtom x) + :cljs (satisfies? cljs.core/IAtom x))) -(defn derefable? [x] (#?(:clj instance? :cljs satisfies?) IDeref x)) +(defn derefable? [x] + #?(:clj (instance? clojure.lang.IDeref x) + :cljs (satisfies? cljs.core/IDeref x))) (defn ?deref [x] (if (derefable? x) @x x)) + +(defprotocol PMutableReference + (get [this]) + (set! [this v]) + (get-and-set! [this v])) + +(defprotocol PInterceptable + (add-interceptor! [this k f])) + +#?(:clj +(extend-protocol PMutableReference + ThreadLocal + (get [this] (.get this)) + (set! [this v] (.set this v) v) + (get-and-set! [this v] (let [v-prev (.get this)] (.set this v) v-prev)))) + +(defn update! + "A nonatomic update." + ([x f] (doto x (quantum.untyped.core.refs/set! (f (get x))))) + ([x f a0] (doto x (quantum.untyped.core.refs/set! (f (get x) a0)))) + ([x f a0 a1] (doto x (quantum.untyped.core.refs/set! (f (get x) a0 a1)))) + ([x f a0 a1 & as] (doto x (quantum.untyped.core.refs/set! (apply f (get x) a0 a1 as))))) + +;; ===== Unsynchronized mutability ===== ;; + +;; TODO create for every primitive datatype as well +(deftype MutableReference [#?(:clj ^:unsynchronized-mutable val :cljs ^:mutable val)] + PMutableReference + (get [this] val) + (set! [this v] (set! val v) val) + (get-and-set! [this v] (let [v-prev val] (set! val v) v-prev)) + #?(:clj clojure.lang.IDeref + :cljs cljs.core/IDeref) + (#?(:clj deref :cljs -deref) [this] val)) + +(defn ! [x] (MutableReference. x)) + +;; ===== Thread-local mutability ===== ;; + +(defn >!thread-local #_> #_(t/isa? PMutableReference) + ([] #?(:clj (ThreadLocal.) + :cljs (MutableReference. nil))) + ([x] #?(:clj (doto (ThreadLocal.) (quantum.untyped.core.refs/set! x)) + :cljs (MutableReference. x)))) diff --git a/src-untyped/quantum/untyped/core/spec.cljc b/src-untyped/quantum/untyped/core/spec.cljc index 9a8ad286..1a315fd1 100644 --- a/src-untyped/quantum/untyped/core/spec.cljc +++ b/src-untyped/quantum/untyped/core/spec.cljc @@ -1,23 +1,23 @@ (ns quantum.untyped.core.spec (:refer-clojure :exclude - [string? keyword? set? number? fn? any? + [ident? string? keyword? set? number? any? assert keys merge + * cat and or constantly]) (:require - [clojure.core :as core] - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as test] + [clojure.core :as core] + [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as test] [cljs.spec.alpha] - [clojure.spec.gen.alpha :as gen] + [clojure.spec.gen.alpha :as gen] [fipp.ednize] - [quantum.untyped.core.convert :as uconv] - [quantum.untyped.core.data :as udata] + [quantum.untyped.core.data :as udata] [quantum.untyped.core.error - :refer [catch-all err!]] + :refer [catch-all err! TODO]] [quantum.untyped.core.fn :refer [constantly with-do]] - [quantum.untyped.core.form.evaluate :as ufeval + [quantum.untyped.core.form.evaluate :as ufeval :refer [case-env]] - [quantum.untyped.core.qualify :as uqual] + [quantum.untyped.core.identifiers :as uident + :refer [>keyword ident?]] [quantum.untyped.core.vars :refer [defalias defmalias]]) #?(:cljs @@ -108,41 +108,53 @@ `(do ~@(->> args (partition-all 2) (map (fn [[v spec]] `(validate-one ~spec ~v))))))) -#?(:clj (quantum.untyped.core.vars/defmalias tuple clojure.spec.alpha/tuple cljs.spec.alpha/tuple )) -#?(:clj (quantum.untyped.core.vars/defmalias coll-of clojure.spec.alpha/coll-of cljs.spec.alpha/coll-of )) -#?(:clj (quantum.untyped.core.vars/defmalias map-of clojure.spec.alpha/map-of cljs.spec.alpha/map-of )) +#?(:clj (quantum.untyped.core.vars/defmalias tuple clojure.spec.alpha/tuple cljs.spec.alpha/tuple )) +#?(:clj (quantum.untyped.core.vars/defmalias coll-of clojure.spec.alpha/coll-of cljs.spec.alpha/coll-of )) +#?(:clj (quantum.untyped.core.vars/defmalias map-of clojure.spec.alpha/map-of cljs.spec.alpha/map-of )) -#?(:clj (quantum.untyped.core.vars/defmalias def clojure.spec.alpha/def cljs.spec.alpha/def )) -#?(:clj (quantum.untyped.core.vars/defmalias fdef clojure.spec.alpha/fdef cljs.spec.alpha/fdef )) +#?(:clj (quantum.untyped.core.vars/defmalias def clojure.spec.alpha/def cljs.spec.alpha/def )) +#?(:clj (quantum.untyped.core.vars/defmalias fdef clojure.spec.alpha/fdef cljs.spec.alpha/fdef )) -#?(:clj (quantum.untyped.core.vars/defmalias keys clojure.spec.alpha/keys cljs.spec.alpha/keys )) -#?(:clj (quantum.untyped.core.vars/defmalias keys* clojure.spec.alpha/keys* cljs.spec.alpha/keys* )) -#?(:clj (quantum.untyped.core.vars/defmalias merge clojure.spec.alpha/merge cljs.spec.alpha/merge )) +#?(:clj (quantum.untyped.core.vars/defmalias keys clojure.spec.alpha/keys cljs.spec.alpha/keys )) +#?(:clj (quantum.untyped.core.vars/defmalias keys* clojure.spec.alpha/keys* cljs.spec.alpha/keys* )) +#?(:clj (quantum.untyped.core.vars/defmalias merge clojure.spec.alpha/merge cljs.spec.alpha/merge )) -#?(:clj (quantum.untyped.core.vars/defmalias spec clojure.spec.alpha/spec cljs.spec.alpha/spec )) -#?(:clj (quantum.untyped.core.vars/defmalias + clojure.spec.alpha/+ cljs.spec.alpha/+ )) -#?(:clj (quantum.untyped.core.vars/defmalias * clojure.spec.alpha/* cljs.spec.alpha/* )) -#?(:clj (quantum.untyped.core.vars/defmalias ? clojure.spec.alpha/? cljs.spec.alpha/? )) +#?(:clj (quantum.untyped.core.vars/defmalias spec clojure.spec.alpha/spec cljs.spec.alpha/spec )) +#?(:clj (quantum.untyped.core.vars/defmalias + clojure.spec.alpha/+ cljs.spec.alpha/+ )) +#?(:clj (quantum.untyped.core.vars/defmalias * clojure.spec.alpha/* cljs.spec.alpha/* )) +#?(:clj (quantum.untyped.core.vars/defmalias ? clojure.spec.alpha/? cljs.spec.alpha/? )) +#?(:clj (quantum.untyped.core.vars/defmalias & clojure.spec.alpha/& cljs.spec.alpha/& )) ;; Note that `and` results in a spec, and as such creates a new regex context :/ -#?(:clj (quantum.untyped.core.vars/defmalias and clojure.spec.alpha/and cljs.spec.alpha/and )) -#?(:clj (quantum.untyped.core.vars/defmalias or clojure.spec.alpha/or cljs.spec.alpha/or )) -#?(:clj (quantum.untyped.core.vars/defmalias every clojure.spec.alpha/every cljs.spec.alpha/every )) +#?(:clj (quantum.untyped.core.vars/defmalias and clojure.spec.alpha/and cljs.spec.alpha/and )) +#?(:clj (quantum.untyped.core.vars/defmalias or clojure.spec.alpha/or cljs.spec.alpha/or )) +#?(:clj (quantum.untyped.core.vars/defmalias every clojure.spec.alpha/every cljs.spec.alpha/every )) -#?(:clj (quantum.untyped.core.vars/defmalias conformer clojure.spec.alpha/conformer cljs.spec.alpha/conformer)) -(defalias conform s/conform) -(defalias explain s/explain) +#?(:clj (quantum.untyped.core.vars/defmalias conformer clojure.spec.alpha/conformer cljs.spec.alpha/conformer)) + +#?(:clj (quantum.untyped.core.vars/defmalias nilable clojure.spec.alpha/nilable cljs.spec.alpha/nilable)) + +(defalias s/conform) +(defalias s/nonconforming) +#?(:clj (defalias • nonconforming)) +(defalias s/explain) +(defalias s/explain-data) +(defalias s/describe) +(defalias s/gen) +(defalias s/with-gen) #?(:clj (quantum.untyped.core.vars/defmalias cat clojure.spec.alpha/cat cljs.spec.alpha/cat)) -#?(:clj (defmacro cat* "`or` :`or*` :: `cat` : `cat*`" [& args] `(cat ~@(udata/quote-map-base uconv/>keyword args true)))) +#?(:clj (defmacro cat* "`or` :`or*` :: `cat` : `cat*`" [& args] + `(cat ~@(udata/quote-map-base >keyword args true)))) #?(:clj (quantum.untyped.core.vars/defmalias alt clojure.spec.alpha/alt cljs.spec.alpha/alt)) -#?(:clj (defmacro alt* "`or` :`or*` :: `alt` : `alt*`" [& args] `(alt ~@(udata/quote-map-base uconv/>keyword args true)))) +#?(:clj (defmacro alt* "`or` :`or*` :: `alt` : `alt*`" [& args] + `(alt ~@(udata/quote-map-base >keyword args true)))) #?(:clj (defmacro fdef! [sym & args] `(with-do (~(case-env :clj 'clojure.spec.alpha/fdef :cljs 'cljs.spec.alpha/fdef) ~sym ~@args) - (when (s/check-asserts?) (test/instrument '~(uqual/qualify *ns* sym)))))) + (when (s/check-asserts?) (test/instrument '~(uident/qualify *ns* sym)))))) #?(:clj (defmacro or-auto @@ -258,17 +270,126 @@ (defmacro constantly-or [& exprs] `(or* ~@(map #(list 'fn [(gensym "_")] %) exprs)))) -#?(:clj -(defmacro set-of [spec] ; TODO fix this up... - `(let [spec# ~spec] - (or*-forms (and core/set? (coll-of ~spec)) - (and core/set? (coll-of spec#)) - (coll-of ~spec :distinct true :into #{}) - (coll-of spec# :distinct true :into #{}))))) - -(defn validate:val? [x] +#?(:clj (defmacro vec-of [spec & opts] `(coll-of ~spec ~@opts :kind core/vector?))) +#?(:clj (defmacro set-of [spec & opts] `(coll-of ~spec ~@opts :kind core/set?))) +;; Really, `seqable-of` +#?(:clj (defmacro seq-of [spec & opts] `(coll-of ~spec ~@opts))) + +(defn validate|val? [x] (if (nil? x) (throw (ex-info "Value is not allowed to be nil but was" {})) x)) -(def any? (constantly true)) +(defn assert-conform [spec x] + (let [conformed (s/conform spec x)] + (if (s/invalid? conformed) + (let [ed (core/merge (assoc (s/explain-data* spec [] [] [] x) + ::s/failure :assertion-failed))] + (throw (ex-info (str "Spec assertion failed\n" (with-out-str (s/explain-out ed))) ed))) + conformed))) + +(defn kv + "Based on `s/map-spec-impl`" + ([k->s #_(s/map-of any? specable?)] (kv k->s nil)) + ([k->s #_(s/map-of any? specable?) gen-fn #_(? fn?)] + (let [id (#?(:clj java.util.UUID/randomUUID :cljs random-uuid)) + k->s|desc (->> k->s + (map (fn [[k specable]] + [k (if (ident? specable) specable (s/describe specable))])) + (into {}))] + (reify + s/Specize + (specize* [this] this) + (specize* [this _] this) + s/Spec + (conform* [_ x] + (reduce + (fn [x' [k s]] + (let [v (get x' k) + cv (s/conform s v)] + (if (s/invalid? cv) + ::s/invalid + (if (identical? cv v) + x' + ;; TODO we might want to do `assoc?!`, depending + (assoc x' k cv))))) + x + k->s)) + (unform* [_ x] + (reduce + (fn [x' [k s]] + (let [cv (get x' k) + v (s/unform s cv)] + (if (identical? cv v) + x' + ;; TODO we might want to do `assoc?!`, depending + (assoc x' k v)))) + x + k->s)) + (explain* [_ path via in x] + (if-not ;; TODO we might want a more generalized `map?` predicate like `t/map?`, depending, + ;; which would affect more code below + (map? x) + [{:path path :pred 'map? :val x :via via :in in}] + ;; TODO use reducers? + (->> k->s + (map (fn [[k s]] + (let [v (get x k)] + (when-not (s/valid? s v) + (@#'s/explain-1 (get k->s|desc k) s (conj path k) via (conj in k) v))))) + (filter some?) + (apply concat)))) + (gen* [_ overrides path rmap] + (if gen-fn + (gen-fn) + (let [rmap (assoc rmap id (inc (core/or (get rmap id) 0))) + gen (fn [[k s]] + (when-not (@#'s/recur-limit? rmap id path k) + [k (gen/delay (@#'s/gensub s overrides (conj path k) rmap k))])) + gens (->> k->s (map gen) (remove nil?) (into {}))] + (gen/bind (gen/choose 0 (count gens)) + (fn [n] + (let [args (-> gens seq shuffle)] + (->> args + (take n) + (apply concat) + (apply gen/hash-map)))))))) + (with-gen* [_ gen-fn'] (kv k->s gen-fn')) + (describe* [_] `(kv ~k->s|desc)))))) + +(defn with-gen-spec-impl + "Do not call this directly; use 'with-gen-spec'." + [extract-f extract-f|form gen-spec gen-spec|form] + (if (fn? gen-spec) + (let [form `(with-gen-spec ~extract-f|form ~gen-spec|form) + gen-spec' (fn [x] + (let [spec (gen-spec x) + desc (s/describe spec) + desc (if (= desc ::s/unknown) + (list 'some-generated-spec gen-spec|form) + desc)] + (s/nonconforming (s/and (s/conformer extract-f) + (@#'s/spec-impl desc spec nil nil)))))] + (reify + s/Specize + (s/specize* [this] this) + (s/specize* [this _] this) + s/Spec + (s/conform* [_ x] (s/conform* (gen-spec' x) x)) + (s/unform* [_ x] (s/unform* (gen-spec' x) x)) + (s/explain* [_ path via in x] (s/explain* (gen-spec' x) path via in x)) + (s/gen* [_ _ _ _] (gen/gen-for-pred gen-spec)) + (s/with-gen* [_ _] (throw (ex-info "TODO" {}))) + (s/describe* [_] form))) + (throw (ex-info "`wrap-spec` may only be called on fns" {:input gen-spec})))) + +#?(:clj +(defmacro with-gen-spec + "`gen-spec` : an fn that returns a spec based on the input. + `extract-f`: extracts the piece of data from the input that the generated spec will validate. + E.g.: + (s/explain + (s/with-gen-spec (fn [{:keys [a]}] a) (fn [{:keys [b]}] #(> % b))) + {:a 1 :b 1})" + [extract-f gen-spec] + `(with-gen-spec-impl ~extract-f '~extract-f ~gen-spec '~gen-spec))) diff --git a/src-untyped/quantum/untyped/core/specs.cljc b/src-untyped/quantum/untyped/core/specs.cljc new file mode 100644 index 00000000..ccf80e23 --- /dev/null +++ b/src-untyped/quantum/untyped/core/specs.cljc @@ -0,0 +1,364 @@ +(ns quantum.untyped.core.specs + "Adapted from clojure.core.specs version 1.9.0-alpha19 + and enabled in CLJS. Other specs added too. + See https://github.com/clojure/core.specs.alpha/blob/5d85f93ab78386855374256934475af0afe7f380/src/main/clojure/clojure/core/specs/alpha.clj" + (:require + [clojure.core :as core] + [clojure.set :as set] + [quantum.untyped.core.data + :refer [val?]] + [quantum.untyped.core.fn + :refer [fn1 fnl]] + [quantum.untyped.core.spec :as s]) +#?(:cljs + (:require-macros + [quantum.untyped.core.specs :as self + :refer [quotable]]))) + +;;;; GENERAL + +(s/def :quantum.core.specs/meta map?) + +;;;; destructure + +(s/def :quantum.core.specs/local-name (s/and simple-symbol? #(not= '& %))) + +(s/def :quantum.core.specs/binding-form + (s/or :sym :quantum.core.specs/local-name + :seq :quantum.core.specs/seq-binding-form + :map :quantum.core.specs/map-binding-form)) + +;; sequential destructuring + +(s/def :quantum.core.specs/seq-binding-form + (s/and vector? + (s/cat :elems (s/* :quantum.core.specs/binding-form) + :rest (s/? (s/cat :amp #{'&} :form :quantum.core.specs/binding-form)) + :as (s/? (s/cat :as #{:as} :sym :quantum.core.specs/local-name))))) + +;; map destructuring + +(s/def :quantum.core.specs/keys (s/coll-of ident? :kind vector?)) +(s/def :quantum.core.specs/syms (s/coll-of symbol? :kind vector?)) +(s/def :quantum.core.specs/strs (s/coll-of simple-symbol? :kind vector?)) +(s/def :quantum.core.specs/or (s/map-of simple-symbol? any?)) +(s/def :quantum.core.specs/as :quantum.core.specs/local-name) + +(s/def :quantum.core.specs/map-special-binding + (s/keys :opt-un [:quantum.core.specs/as :quantum.core.specs/or + :quantum.core.specs/keys :quantum.core.specs/syms :quantum.core.specs/strs])) + +(s/def :quantum.core.specs/map-binding (s/tuple :quantum.core.specs/binding-form any?)) + +(s/def :quantum.core.specs/ns-keys + (s/tuple + (s/and qualified-keyword? #(-> % name #{"keys" "syms"})) + (s/coll-of simple-symbol? :kind vector?))) + +(s/def :quantum.core.specs/map-bindings + (s/every (s/or :mb :quantum.core.specs/map-binding + :nsk :quantum.core.specs/ns-keys + :msb (s/tuple #{:as :or :keys :syms :strs} any?)) :into {})) + +(s/def :quantum.core.specs/map-binding-form + (s/merge :quantum.core.specs/map-bindings :quantum.core.specs/map-special-binding)) + +;; bindings + +(s/def :quantum.core.specs/binding (s/cat :binding :quantum.core.specs/binding-form :init-expr any?)) +(s/def :quantum.core.specs/bindings (s/and vector? (s/* :quantum.core.specs/binding))) + +;; let, if-let, when-let + +(s/fdef core/let + :args (s/cat :bindings :quantum.core.specs/bindings + :body (s/* any?))) + +(s/fdef core/if-let + :args (s/cat :bindings (s/and vector? :quantum.core.specs/binding) + :then any? + :else (s/? any?))) + +(s/fdef core/when-let + :args (s/cat :bindings (s/and vector? :quantum.core.specs/binding) + :body (s/* any?))) + +;; defn, defn-, fn + +(s/def :quantum.core.specs/fn|arglist + (s/and + vector? + (s/cat :args (s/* :quantum.core.specs/binding-form) + :varargs (s/? (s/cat :amp #{'&} :form :quantum.core.specs/binding-form))))) + +(s/def :quantum.core.specs/fn|prepost + (s/and (s/keys :req-un [(or :quantum.core.specs.core/pre :quantum.core.specs.core/post)]) ; TODO we actually really only want to accept un-namespaced keys... + (s/conformer #(set/rename-keys % {:quantum.core.specs.core/pre :pre + :quantum.core.specs.core/post :post})))) + +(s/def :quantum.core.specs/fn|body + (s/alt :prepost+body (s/cat :prepost :quantum.core.specs/fn|prepost + :body (s/+ any?)) + :body (s/* any?))) + +(s/def :quantum.core.specs/fn|arglist+body + (s/cat :quantum.core.specs/fn|arglist :quantum.core.specs/fn|arglist + :body :quantum.core.specs/fn|body)) + +(s/def :quantum.core.specs/fn|name simple-symbol?) +(s/def ::fn|name :quantum.core.specs/fn|name) + +(s/def :quantum.core.specs/docstring string?) + +(s/def :quantum.core.specs/pre-meta (s/? :quantum.core.specs/meta)) +(s/def :quantum.core.specs/post-meta (s/? :quantum.core.specs/meta)) + +(s/def :quantum.core.specs/fn|unique-doc + #(->> [(:quantum.core.specs/docstring %) + (-> % :quantum.core.specs/fn|name meta :doc) + (-> % :quantum.core.specs/pre-meta :doc) + (-> % :quantum.core.specs/post-meta :doc)] + (filter val?) + count + ((fn [x] (<= x 1))))) + +(s/def :quantum.core.specs/fn|unique-meta + #(empty? (set/intersection + (-> % :quantum.core.specs/fn|name meta keys set) + (-> % :quantum.core.specs/pre-meta keys set) + (-> % :quantum.core.specs/post-meta keys set)))) + +(s/def :quantum.core.specs/fn|aggregate-meta + (s/conformer + (fn [{:keys [:quantum.core.specs/fn|name :quantum.core.specs/docstring + :quantum.core.specs/pre-meta :quantum.core.specs/post-meta] :as m}] + (-> m + (dissoc :quantum.core.specs/docstring + :quantum.core.specs/pre-meta + :quantum.core.specs/post-meta) + (update :quantum.core.specs/fn|name #(some-> % (with-meta nil))) + (assoc :quantum.core.specs/meta + (-> ;; TODO use `merge-unique` instead of `:quantum.core.specs/fn|unique-meta` + (merge (meta fn|name) pre-meta post-meta) + (cond-> docstring (assoc :doc docstring)))))))) + +(defn fn-like|postchecks|gen [overloads-ident] + (s/and (s/conformer + (fn [v] + (let [[overloads-k overloads-v :as overloads] (get v overloads-ident) + overloads' + (when overloads + (-> (case overloads-k + :overload-1 {:overloads [overloads-v]} + :overload-n overloads-v) + (update :overloads + (fnl mapv + (fn1 update :body + (fn [[k v]] + (case k + :body {:body v} + :prepost+body v)))))))] + (assoc v :quantum.core.specs/post-meta (:quantum.core.specs/post-meta overloads') + overloads-ident (get overloads' :overloads))))) + :quantum.core.specs/fn|unique-doc + :quantum.core.specs/fn|unique-meta + ;; TODO validate metadata like return value etc. + :quantum.core.specs/fn|aggregate-meta)) + +(s/def :quantum.core.specs/fn|postchecks (fn-like|postchecks|gen :quantum.core.specs/fn|overloads)) + +(s/def :quantum.core.specs/fn + (s/and + (s/spec + (s/cat + :quantum.core.specs/fn|name (s/? :quantum.core.specs/fn|name) + :quantum.core.specs/fn|overloads + (s/alt + :overload-1 :quantum.core.specs/fn|arglist+body + :overload-n (s/cat :overloads (s/+ (s/spec :quantum.core.specs/fn|arglist+body)))))) + :quantum.core.specs/fn|postchecks)) + +(s/def :quantum.core.specs/defn + (s/and + (s/spec + (s/cat + :quantum.core.specs/fn|name :quantum.core.specs/fn|name + :quantum.core.specs/docstring (s/? :quantum.core.specs/docstring) + :quantum.core.specs/pre-meta :quantum.core.specs/pre-meta + :quantum.core.specs/fn|overloads + (s/alt + :overload-1 :quantum.core.specs/fn|arglist+body + :overload-n + (s/cat + :overloads (s/+ (s/spec :quantum.core.specs/fn|arglist+body)) + :quantum.core.specs/post-meta :quantum.core.specs/post-meta)))) + :quantum.core.specs/fn|postchecks)) + +(s/fdef core/defn :args :quantum.core.specs/defn :ret any?) +(s/fdef core/defn- :args :quantum.core.specs/defn :ret any?) +(s/fdef core/fn :args :quantum.core.specs/fn :ret any?) + +;;;; ns + +(s/def :quantum.core.specs/exclude (s/coll-of simple-symbol?)) +(s/def :quantum.core.specs/only (s/coll-of simple-symbol?)) +(s/def :quantum.core.specs/rename (s/map-of simple-symbol? simple-symbol?)) + +(s/def :quantum.core.specs/filters + (s/keys* :opt-un [:quantum.core.specs/exclude :quantum.core.specs/only :quantum.core.specs/rename])) + +(s/def :quantum.core.specs/ns-refer-clojure + (s/spec (s/cat :clause #{:refer-clojure} + :filters :quantum.core.specs/filters))) + +(s/def :quantum.core.specs/refer + (s/or :all #{:all} + :syms (s/coll-of simple-symbol?))) + +(s/def :quantum.core.specs/prefix-list + (s/spec + (s/cat :prefix simple-symbol? + :libspecs (s/+ :quantum.core.specs/libspec)))) + +(s/def :quantum.core.specs/libspec + (s/alt :lib simple-symbol? + :lib+opts (s/spec (s/cat :lib simple-symbol? + :options (s/keys* :opt-un [:quantum.core.specs/as :quantum.core.specs/refer]))))) + +(s/def :quantum.core.specs/ns-require + (s/spec (s/cat :clause #{:require} + :body (s/+ (s/alt :libspec :quantum.core.specs/libspec + :prefix-list :quantum.core.specs/prefix-list + :flag #{:reload :reload-all :verbose}))))) + +(s/def :quantum.core.specs/package-list + (s/spec + (s/cat :package simple-symbol? + :classes (s/* simple-symbol?)))) + +(s/def :quantum.core.specs/import-list + (s/* (s/alt :class simple-symbol? + :package-list :quantum.core.specs/package-list))) + +(s/def :quantum.core.specs/ns-import + (s/spec + (s/cat :clause #{:import} + :classes :quantum.core.specs/import-list))) + +(s/def :quantum.core.specs/ns-refer + (s/spec (s/cat :clause #{:refer} + :lib simple-symbol? + :filters :quantum.core.specs/filters))) + +;; same as :quantum.core.specs/prefix-list, but with :quantum.core.specs/use-libspec instead +(s/def :quantum.core.specs/use-prefix-list + (s/spec + (s/cat :prefix simple-symbol? + :libspecs (s/+ :quantum.core.specs/use-libspec)))) + +;; same as :quantum.core.specs/libspec, but also supports the :quantum.core.specs/filters options in the libspec +(s/def :quantum.core.specs/use-libspec + (s/alt :lib simple-symbol? + :lib+opts + (s/spec (s/cat :lib simple-symbol? + :options (s/keys* :opt-un [:quantum.core.specs/as :quantum.core.specs/refer + :quantum.core.specs/exclude :quantum.core.specs/only + :quantum.core.specs/rename]))))) + +(s/def :quantum.core.specs/ns-use + (s/spec (s/cat :clause #{:use} + :libs (s/+ (s/alt :libspecs :quantum.core.specs/use-libspec + :prefix-list :quantum.core.specs/use-prefix-list + :flag #{:reload :reload-all :verbose}))))) + +(s/def :quantum.core.specs/ns-load + (s/spec (s/cat :clause #{:load} + :libs (s/* string?)))) + +(s/def :quantum.core.specs/name simple-symbol?) +(s/def :quantum.core.specs/extends simple-symbol?) +(s/def :quantum.core.specs/implements (s/coll-of simple-symbol? :kind vector?)) +(s/def :quantum.core.specs/init symbol?) +(s/def :quantum.core.specs/class-ident (s/or :class simple-symbol? :class-name string?)) +(s/def :quantum.core.specs/signature (s/coll-of :quantum.core.specs/class-ident :kind vector?)) +(s/def :quantum.core.specs/constructors (s/map-of :quantum.core.specs/signature :quantum.core.specs/signature)) +(s/def :quantum.core.specs/post-init symbol?) + +(s/def :quantum.core.specs/method + (s/and vector? + (s/cat :name simple-symbol? + :param-types :quantum.core.specs/signature + :return-type simple-symbol?))) + +(s/def :quantum.core.specs/methods (s/coll-of :quantum.core.specs/method :kind vector?)) +(s/def :quantum.core.specs/main boolean?) +(s/def :quantum.core.specs/factory simple-symbol?) +(s/def :quantum.core.specs/state simple-symbol?) +(s/def :quantum.core.specs/get simple-symbol?) +(s/def :quantum.core.specs/set simple-symbol?) +(s/def :quantum.core.specs/expose (s/keys :opt-un [:quantum.core.specs/get :quantum.core.specs/set])) +(s/def :quantum.core.specs/exposes (s/map-of simple-symbol? :quantum.core.specs/expose)) +(s/def :quantum.core.specs/prefix string?) +(s/def :quantum.core.specs/impl-ns simple-symbol?) +(s/def :quantum.core.specs/load-impl-ns boolean?) + +(s/def :quantum.core.specs/ns-gen-class + (s/spec (s/cat :clause #{:gen-class} + :options (s/keys* :opt-un [:quantum.core.specs/name :quantum.core.specs/extends :quantum.core.specs/implements + :quantum.core.specs/init :quantum.core.specs/constructors :quantum.core.specs/post-init + :quantum.core.specs/methods :quantum.core.specs/main :quantum.core.specs/factory :quantum.core.specs/state + :quantum.core.specs/exposes :quantum.core.specs/prefix :quantum.core.specs/impl-ns :quantum.core.specs/load-impl-ns])))) + +(s/def :quantum.core.specs/ns-clauses + (s/* (s/alt :refer-clojure :quantum.core.specs/ns-refer-clojure + :require :quantum.core.specs/ns-require + :import :quantum.core.specs/ns-import + :use :quantum.core.specs/ns-use + :refer :quantum.core.specs/ns-refer + :load :quantum.core.specs/ns-load + :gen-class :quantum.core.specs/ns-gen-class))) + +(s/def :quantum.core.specs/ns-form + (s/cat :name simple-symbol? + :docstring (s/? :quantum.core.specs/docstring) + :attr-map (s/? :quantum.core.specs/meta) + :clauses :quantum.core.specs/ns-clauses)) + +(s/fdef core/ns + :args :quantum.core.specs/ns-form) + +#?(:clj +(defmacro ^:private quotable + "Returns a spec that accepts both the spec and a (quote ...) form of the spec" + [spec] + `(s/or :spec ~spec :quoted-spec (s/cat :quote #{'quote} :spec ~spec)))) + +(s/def :quantum.core.specs/quotable-import-list + (s/* (s/alt :class (quotable simple-symbol?) + :package-list (quotable :quantum.core.specs/package-list)))) + +(s/fdef core/import + :args :quantum.core.specs/quotable-import-list) + +(s/fdef core/refer-clojure + :args (s/* (s/alt + :exclude (s/cat :op (quotable #{:exclude}) :arg (quotable :quantum.core.specs/exclude)) + :only (s/cat :op (quotable #{:only}) :arg (quotable :quantum.core.specs/only)) + :rename (s/cat :op (quotable #{:rename}) :arg (quotable :quantum.core.specs/rename))))) + +;; ----- INTERFACE ----- ;; + +(s/def :quantum.core.specs/code any?) ; TODO must be embeddable + +(s/def :interface/name simple-symbol?) + +;; ----- REIFY ----- ;; + +(s/def :reify/method-name simple-symbol?) + +(s/def :reify|arglist/arg-sym simple-symbol?) ; technically, can be tagged with only particular tags +(s/def :reify/arglist (s/and vector? (s/+ :reify|arglist/arg-sym))) + +(s/def :reify|overload/ret-class-sym simple-symbol?) ; technically, one resolvable to a class + +(s/def :reify|overload/body (s/* :quantum.core.specs/code)) diff --git a/src-untyped/quantum/untyped/core/string.cljc b/src-untyped/quantum/untyped/core/string.cljc index 6d677504..ade90685 100644 --- a/src-untyped/quantum/untyped/core/string.cljc +++ b/src-untyped/quantum/untyped/core/string.cljc @@ -10,6 +10,8 @@ (ucore/log-this-ns) +(defn regex? [x] (instance? #?(:clj java.util.regex.Pattern :cljs js/RegExp) x)) + (defn join-once "Like /clojure.string/join/ but ensures no double separators." {:attribution "taoensso.encore"} diff --git a/src-untyped/quantum/untyped/core/system.cljc b/src-untyped/quantum/untyped/core/system.cljc index 3535344b..29cdef42 100644 --- a/src-untyped/quantum/untyped/core/system.cljc +++ b/src-untyped/quantum/untyped/core/system.cljc @@ -55,13 +55,13 @@ (.-chrome global) :chrome ; Firefox 1.0+ - (.-InstallTrigger global) + (aget global "InstallTrigger") :firefox ; At least Safari 3+: "[object HTMLElementConstructor]" (-> js/Object .-prototype .-toString (.call (.-HTMLElement global)) (.indexOf "Constructor") - (> 0)) + pos?) :safari ; At least IE6 (-> global .-document .-documentMode) @@ -69,7 +69,7 @@ :else :unknown))))) #?(:cljs -(def ReactNative +(def react-native (>module "ReactNative" ["react-native" "react-native-web"]))) ; https://github.com/necolas/react-native-web #?(:clj @@ -146,8 +146,8 @@ (def os ; TODO: make less naive - #?(:cljs (if ReactNative - (-> ReactNative .-Platform .-OS) + #?(:cljs (if react-native + (-> react-native .-Platform .-OS) (condp #(ucoll/containsv? %1 %2) (.-appVersion js/navigator) "Win" :windows "MacOS" :mac @@ -176,9 +176,9 @@ ;; ----- React-Native-specific ----- ;; -#?(:cljs (def app-registry (when ReactNative (.-AppRegistry ReactNative)))) -#?(:cljs (def AsyncStorage (when ReactNative (.-AsyncStorage ReactNative)))) -#?(:cljs (def StatusBar (when ReactNative (.-StatusBar ReactNative)))) +#?(:cljs (def app-registry (some-> react-native .-AppRegistry ))) +#?(:cljs (def AsyncStorage (some-> react-native .-AsyncStorage))) +#?(:cljs (def StatusBar (some-> react-native .-StatusBar ))) ;; ----- Features ----- ;; diff --git a/src-untyped/quantum/untyped/core/test.cljc b/src-untyped/quantum/untyped/core/test.cljc new file mode 100644 index 00000000..cfb7cde9 --- /dev/null +++ b/src-untyped/quantum/untyped/core/test.cljc @@ -0,0 +1,155 @@ +(ns quantum.untyped.core.test + (:require + [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as stest] + [clojure.string :as str] + [clojure.test :as test] + [quantum.untyped.core.collections :as uc] + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.data.map + :refer [+map-entry?]] + [quantum.untyped.core.error :as uerr] + [quantum.untyped.core.log + :refer [pr!]] + [quantum.untyped.core.print + :refer [ppr-meta]] + [quantum.untyped.core.vars + :refer [defalias defmalias metable?]])) + +#?(:clj (defmalias is clojure.test/is cljs.test/is )) +#?(:clj (defmalias deftest clojure.test/deftest cljs.test/deftest)) +#?(:clj (defmalias testing clojure.test/testing cljs.test/testing)) +#?(:clj (defalias test/test-ns)) + (defalias test/use-fixtures) + +#?(:clj (defn test-nss [& ns-syms] (->> ns-syms (map test-ns) doall))) + +#?(:clj +(defn test-nss-where [pred] + (->> (all-ns) (filter #(-> % ns-name name pred)) (map test-ns) doall))) + +(declare code=) + +(defn- code=|similar-class [c0 c1] + (let [similar-class? + (cond (seq? c0) (seq? c1) + (seq? c1) (seq? c0) + (vector? c0) (vector? c1) + (vector? c1) (vector? c0) + (map? c0) (map? c1) + (map? c1) (map? c0) + (set? c0) (set? c1) + (set? c1) (set? c0) + (+map-entry? c0) (+map-entry? c1) + (+map-entry? c1) (+map-entry? c0) + :else ::not-applicable)] + (if (= similar-class? ::not-applicable) + (or (= c0 c1) + (do (pr! "FAIL: should be `(= code0 code1)`" (pr-str c0) (pr-str c1)) false)) + (and (or similar-class? + (do (pr! "FAIL: should be similar class" + {:c0 (type c0) :x0 (pr-str c0) :c1 (type c1) :x1 (pr-str c1)}) + false)) + (or (if (or (set? c0) (map? c0)) + (uc/seq= (sort c0) (sort c1) code=) + (uc/seq= (seq c0) (seq c1) code=)) + (do (pr! "FAIL: `(seq= code0 code1 code=)`" (pr-str c0) (pr-str c1)) + false)))))) + +(defn code= + "`code=` but with helpful test-related logging" + ([c0 c1] + (if (metable? c0) + (and (or (metable? c1) + (do (pr! "FAIL: should be `(metable? c1)`" c1) + false)) + (let [meta0 (-> c0 meta (or {}) (dissoc :line :column)) + meta1 (-> c1 meta (or {}) (dissoc :line :column))] + (or (= meta0 meta1) + (do (pr! "FAIL: meta should be match for" (pr-str meta0) (pr-str meta1) + "on code" (pr-str c0) (pr-str c1)) + false))) + (code=|similar-class c0 c1)) + (and (or (not (metable? c1)) + (do (pr! "FAIL: should be `(not (metable? c1))`" c1) + false)) + (code=|similar-class c0 c1)))) + ([c0 c1 & codes] (and (code= c0 c1) (every? #(code= c0 %) codes)))) + +(defn is-code= [& args] (is (apply code= args))) + +#?(:clj (defmacro is= [& args] `(is (= ~@args)))) + +#?(:clj (defmacro throws + ([x] `(do (is (~'thrown? ~(uerr/env>generic-error &env) ~x)) true)) + ([expr err-pred] + `(try ~expr + (is (throws '~err-pred)) + (catch ~(uerr/env>generic-error &env) e# (is (~err-pred e#))))))) + +; Makes test failures and errors print prettily +; TODO CLJS +#?(:clj +(defmethod test/report :fail [m] + (test/with-test-out + (test/inc-report-counter :fail) + (println "\nFAIL in" (test/testing-vars-str m)) + (when (seq test/*testing-contexts*) (println (test/testing-contexts-str))) + (when-let [message (:message m)] (println message)) + (println "expected:" (with-out-str (ppr-meta (:expected m)))) + (println " actual:" (with-out-str (ppr-meta (:actual m))))))) + +#?(:clj +(defmethod test/report :error [m] + (test/with-test-out + (test/inc-report-counter :error) + (println "\nERROR in" (test/testing-vars-str m)) + (when (seq test/*testing-contexts*) (println (test/testing-contexts-str))) + (when-let [message (:message m)] (println message)) + (println "expected:" (with-out-str (ppr-meta (:expected m)))) + (print " actual: ") + (println (with-out-str (ppr-meta (:actual m))))))) + +#?(:clj +(defn test-syms! + "Tests the provided syms, in order, deduplicating them." + [& syms] + (try + (let [test-syms (distinct syms)] + (doseq [test-sym test-syms] + (try + (println "=====" "Testing" test-sym "..." "=====" ) + (let [v (find-var test-sym)] + (assert (some? v) (str "Test sym not found: " test-sym)) + (clojure.test/test-var v)) + (println "=====" "Done with" test-sym "=====" ) + (catch Throwable t + (println "ERROR in test" test-sym t)))))))) + +(defn report-generative-results [check-results] + (let [checks-passed? (->> check-results (map :failure) (every? nil?))] + (if checks-passed? + (test/do-report {:type :pass + :message (str "Generative tests pass for " + (str/join ", " (map :sym check-results)))}) + (doseq [failed-check (filter :failure check-results)] + (let [r (stest/abbrev-result failed-check) + failure (:failure r)] + (test/do-report + {:type :fail + :message (with-out-str (s/explain-out failure)) + :expected (->> r :spec rest (apply hash-map) :ret) + :actual (if (instance? #?(:clj Throwable :cljs js/Error) failure) + failure + (::stest/val failure))})))) + checks-passed?)) + +#?(:clj +(defmacro defspec-test + {:based-on "https://gist.github.com/kennyjwilli/8bf30478b8a2762d2d09baabc17e2f10"} + ([name sym-or-syms] `(defspec-test ~name ~sym-or-syms nil)) + ([name sym-or-syms opts] + (when test/*load-tests* + `(defn ~(vary-meta name assoc :test + `(fn [] (report-generative-results (stest/check ~sym-or-syms ~opts)))) + [] (test/test-var (var ~name))))))) diff --git a/src-untyped/quantum/untyped/core/type.cljc b/src-untyped/quantum/untyped/core/type.cljc index 1d43669b..21ef7b7a 100644 --- a/src-untyped/quantum/untyped/core/type.cljc +++ b/src-untyped/quantum/untyped/core/type.cljc @@ -1,777 +1,775 @@ (ns quantum.untyped.core.type "Essentially, set-theoretic definitions and operations on types." - (:refer-clojure :exclude - [< <= = >= > == compare - and or not - boolean byte char short int long float double - boolean? byte? char? short? int? long? float? double? - isa? - nil? any? class? tagged-literal? #?(:cljs object?) - number? decimal? bigdec? integer? ratio? - keyword? string? symbol? - meta - assoc-in]) - (:require - [clojure.core :as c] - [quantum.untyped.core.analyze.expr :as xp - :refer [>expr #?(:cljs Expression)]] - [quantum.untyped.core.collections :as ucoll - :refer [assoc-in dissoc-in - map+ filter+ remove+ distinct+ ]] - [quantum.untyped.core.collections.logic - :refer [seq-and]] - [quantum.untyped.core.compare :as ucomp - :refer [== not==]] - [quantum.untyped.core.convert :as uconv - :refer [>symbol]] - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.data.bits :as ubit] - [quantum.untyped.core.error :as uerr - :refer [err! TODO catch-all]] - [quantum.untyped.core.fn :as ufn - :refer [fn1 rcomp <- fn->]] - [quantum.untyped.core.form.generate.deftype :as udt] - [quantum.untyped.core.logic - :refer [fn-and]] - [quantum.untyped.core.numeric :as unum] - [quantum.untyped.core.print :as upr] - [quantum.untyped.core.qualify :as qual] - [quantum.untyped.core.reducers :as ur - :refer [join]] - [quantum.untyped.core.refs - :refer [?deref]] - [quantum.untyped.core.type.core :as utcore] - [quantum.untyped.core.type.predicates :as utpred] - [quantum.untyped.core.vars :as uvar - :refer [def- update-meta]]) - #?(:clj (:import quantum.untyped.core.analyze.expr.Expression)) -#?(:cljs - (:require-macros - [quantum.untyped.core.type :as self - :refer [-def]]))) + {:todo "Maybe reduce dependencies and distribute predicates to other namespaces"} + (:refer-clojure :exclude + [< <= = not= >= > == compare * - + and or not + boolean byte char short int long float double + boolean? byte? bytes? char? short? int? long? float? double? + isa? + nil? any? class? tagged-literal? #?(:cljs object?) + true? false? keyword? string? symbol? + fn? ifn? + meta + ref + type]) + (:require + [clojure.core :as c] + [clojure.set] + [clojure.string :as str] + [quantum.untyped.core.analyze.expr + :refer [>expr #?(:cljs Expression)]] + [quantum.untyped.core.classes :as uclass] + [quantum.untyped.core.collections :as uc] + [quantum.untyped.core.collections.logic + :refer [seq-and seq-or]] + [quantum.untyped.core.compare :as ucomp + :refer [==]] + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.data.bits :as ubit] + [quantum.untyped.core.data.hash :as uhash] + [quantum.untyped.core.data.reactive :as urx] + [quantum.untyped.core.data.set :as uset + :refer [ident >ident]] + [quantum.untyped.core.data.tuple] + [quantum.untyped.core.defnt + :refer [defns defns-]] + [quantum.untyped.core.error :as uerr + :refer [err! TODO catch-all]] + [quantum.untyped.core.fn :as ufn + :refer [fn1 rcomp <- fn-> fn->>]] + [quantum.untyped.core.form + :refer [$]] + [quantum.untyped.core.form.generate.deftype :as udt] + [quantum.untyped.core.identifiers :as uid + :refer [>symbol]] + [quantum.untyped.core.logic + :refer [fn-and ifs whenp->]] + [quantum.untyped.core.numeric :as unum] + [quantum.untyped.core.numeric.combinatorics :as ucombo] + [quantum.untyped.core.print :as upr] + [quantum.untyped.core.reducers :as ur + :refer [educe join reducei]] + [quantum.untyped.core.refs + :refer [?deref]] + [quantum.untyped.core.spec :as us] + [quantum.untyped.core.type.compare :as utcomp] + [quantum.untyped.core.type.core :as utcore] + [quantum.untyped.core.type.defs :as utdef] + [quantum.untyped.core.type.reifications :as utr + :refer [->AndType ->OrType PType + #?@(:cljs [UniversalSetType EmptySetType + NotType OrType AndType + ProtocolType DirectProtocolType ClassType + UnorderedType OrderedType + ValueType + FnType TypedFn + MetaType MetaOrType + ReactiveType])]] + [quantum.untyped.core.vars :as uvar + :refer [def- defmacro- update-meta]]) +#?(:cljs (:require-macros + [quantum.untyped.core.type :as self + :refer [def-preds|map|any def-preds|map|same-types]])) +#?(:clj (:import + [quantum.untyped.core.analyze.expr Expression] + [quantum.untyped.core.type.reifications + UniversalSetType EmptySetType + NotType OrType AndType + ProtocolType ClassType + UnorderedType OrderedType + ValueType + FnType TypedFn + MetaType MetaOrType + ReactiveType]))) (ucore/log-this-ns) -#_(defmacro -> - ("Anything that is coercible to x" - [x] - ...) - ("Anything satisfying `from` that is coercible to `to`. - Will be coerced to `to`." - [from to])) +#?(:clj (defmacro def + ([sym t] `(uvar/def ~sym (utr/with-name ~t '~(uid/qualify *ns* sym)))) + ([sym x t] `(uvar/def ~sym ~x (utr/with-name ~t '~(uid/qualify *ns* sym)))))) -#_(defmacro range-of) +#?(:clj (uvar/defalias def* quantum.untyped.core.type/def)) -#_(defn instance? []) +(declare - create-logical-type maybe-look-up-type-from-class meta-or with-expand-meta-ors nil? val? + and or val|by-class?) -(do +;; ===== Comparison ===== ;; -(defonce *spec-registry (atom {})) -(swap! *spec-registry empty) +(uvar/defaliases utcomp compare < <= = not= >= > >< <> compare|in compare|out) -;; ===== SPECS ===== ;; +;; ===== Type Reification Constructors ===== ;; -(defprotocol PSpec) +;; ----- UniversalSetType (`t/U`) ----- ;; -(udt/deftype ValueSpec [v] - {PSpec nil - fipp.ednize/IOverride nil - fipp.ednize/IEdn {-edn ([this] (list `value v))} - ?Fn {invoke ([_ x] (c/= x v))} - ?Object {equals ([this that] - (c/or (identical? this that) - (c/and (instance? ValueSpec that) - (c/= v (.-v ^ValueSpec that)))))} - ?Comparable {compare ([this that] - (if-not (instance? ValueSpec that) - (err! "Cannot compare with non-ValueSpec") - (c/compare v (.-v ^ValueSpec that))))}}) - -(defn value [v] (ValueSpec. v)) - -(defn value-spec? [x] (instance? ValueSpec x)) - -(defn value-spec>value [x] - (if (value-spec? x) - (.-v ^ValueSpec x) - (err! "Not a value spec" x))) - -;; ----- - -(udt/deftype ClassSpec - [meta #_(t/? ::meta) - ^Class c #_t/class? - name #_(t/? t/symbol?)] - {PSpec nil - fipp.ednize/IOverride nil - fipp.ednize/IEdn - {-edn ([this] (c/or name (list `isa? c)))} - ?Fn {invoke ([_ x] (instance? c x))} - ?Meta {meta ([this] meta) - with-meta ([this meta'] (ClassSpec. meta' c name))} - ?Object {equals ([this that] - (c/or (identical? this that) - (c/and (instance? ClassSpec that) - (c/= c (.-c ^ClassSpec that)))))}}) - -(defn class-spec? [x] (instance? ClassSpec x)) - -(defn class-spec>class [spec] - (if (class-spec? spec) - (.-c ^ClassSpec spec) - (err! "Cannot cast to ClassSpec" {:x spec}))) - -(udt/deftype ProtocolSpec - [meta #_(t/? ::meta) - p #_t/protocol? - name #_(t/? t/symbol?)] - {PSpec nil - fipp.ednize/IOverride nil - fipp.ednize/IEdn - {-edn ([this] (c/or name (list `isa|protocol? p)))} - ?Fn {invoke ([_ x] (satisfies? p x))} - ?Meta {meta ([this] meta) - with-meta ([this meta'] (ProtocolSpec. meta' p name))}}) +;; `t/>` everything else +(uvar/defalias utr/universal-set) -(defn isa? [c] - #?(:clj (assert (c/class? c))) ; TODO CLJS - (ClassSpec. nil c nil)) +;; ----- EmptySetType (`t/∅`) ----- ;; -#?(:clj -(defn isa|protocol? [c] - #_(assert (protocol? c)) - (ProtocolSpec. nil c nil))) - -;; ===== CREATION ===== ;; - -(defonce *spec-registry (atom {})) - -#?(:clj (extend-protocol PSpec Expression)) - -(declare nil?) - -(defn >spec - "Coerces ->`x` to a spec, recording its ->`name-sym` if provided." - ([x] (>spec x nil)) - ([x name-sym] - (assert (c/or (c/nil? name-sym) (c/symbol? name-sym))) - #?(:clj - (cond (satisfies? PSpec x) - x ; TODO should add in its name? - (c/class? x) - (let [x (c/or #?(:clj (utcore/unboxed->boxed x)) x) - reg (if (c/nil? name-sym) - @*spec-registry - (swap! *spec-registry - (fn [reg] - (if-let [spec (get reg name-sym)] - (if (c/= (.-name ^ClassSpec spec) name-sym) - reg - (err! "Class already registered with spec; must first undef" {:class x :spec-name name-sym})) - (let [spec (ClassSpec. nil x name-sym)] - (assoc-in reg [name-sym] spec - [:by-class x] spec))))))] - (c/or (get-in reg [:by-class x]) - (ClassSpec. nil ^Class x name-sym))) - (c/fn? x) - (let [sym (c/or name-sym (>symbol x)) - _ (when-not name-sym - (let [resolved (?deref (ns-resolve *ns* sym))] - (assert (== resolved x) {:x x :sym sym :resolved resolved})))] - (Expression. sym x)) - (c/nil? x) - nil? - (utpred/protocol? x) - (ProtocolSpec. nil x name-sym) - :else - (value x)) - :cljs nil))) - -;; ===== DEFINITION ===== ;; - -#?(:clj -(defmacro define [sym specable] - `(~'def ~sym (>spec ~specable '~(qual/qualify sym))))) +;; `t/<>` everything else except `universal-set`, to which it is `t/<` +(uvar/defalias utr/empty-set) -(defn undef [reg sym] - (if-let [spec (get reg sym)] - (let [reg' (dissoc reg sym)] - (if (instance? ClassSpec spec) - (dissoc-in reg' [:by-class (.-c ^ClassSpec spec)]))) - reg)) +;; ----- ReactiveType (`t/rx`) ----- ;; -(defn undef! [sym] (swap! *spec-registry undef sym)) +(defns rx* [r urx/reactive?, body-codelist _ > utr/rx-type?] + (ReactiveType. uhash/default uhash/default nil nil body-codelist nil r)) #?(:clj -(defmacro defalias [sym spec] - `(~'def ~sym (>spec ~spec)))) +(defmacro rx + "Creates a reactive type. Note that the current implementation of reactivity is thread-unsafe. + + Note that if a type-generating fn (e.g. `and` or `or`) is provided with even one reactive input, + then the whole type will become reactive. Thus, reactivity is 'infectious'. + + The only macro in all of the core type predicates." + [& body] `(rx* (urx/!rx ~@body) ($ ~(vec body))))) + +(defns- separate-rx-and-apply + "Only works for commutative functions." + [f c/fn?, type-args c/sequential? > utr/type?] + ;; For efficiency, so as much as possible gets run outside a reaction + (if-let [rx-args (->> type-args (filter utr/rx-type?) seq)] + (if-let [norx-args (->> type-args (remove utr/rx-type?) seq)] + (let [t (f norx-args)] + (rx (f (cons t (map deref rx-args))))) + (rx (f (map deref rx-args)))) + (f type-args))) + +;; ----- NotType (`t/not` / `t/!`) ----- ;; + +(defns not [t utr/type? > utr/type?] + (ifs (utr/rx-type? t) (rx (not @t)) + (= t universal-set) empty-set + (= t empty-set) universal-set + (= t val|by-class?) nil? + (utr/not-type? t) (utr/not-type>inner-type t) + ;; DeMorgan's Law + (utr/or-type? t) (->> t utr/or-type>args (uc/lmap not) (apply and)) + ;; DeMorgan's Law + (utr/and-type? t) (->> t utr/and-type>args (uc/lmap not) (apply or )) + (NotType. uhash/default uhash/default nil nil t))) + +(uvar/defalias ! not) + +;; ----- OrType (`t/or` / `t/|`) ----- ;; + +(def- comparison-denotes-supersession?|or (fn1 c/= >ident)) + +(defn- or* [ts] + (create-logical-type :or ->OrType utr/or-type? utr/or-type>args + comparison-denotes-supersession?|or ts)) -#?(:clj (uvar/defalias -def define)) - -(-def spec? PSpec) +(defn or + "Unordered `or`. Analogous to `set/union`. + Applies as much 'compression'/deduplication/simplification as possible to the supplied types. + Effectively computes the union of the extension of the ->`ts`." + ([] empty-set) + ([t] t) + ([t & ts] (separate-rx-and-apply or* (cons t ts)))) -(defn ! [spec] - (if (spec? spec) - (update-meta spec assoc :runtime? true) - (err! "Input must be spec" spec))) +(uvar/defalias | or) -(udt/deftype DeducibleSpec [*spec #_(t/atom-of t/spec?)] - {PSpec nil - fipp.ednize/IOverride nil - fipp.ednize/IEdn {-edn ([this] (list `deducible @*spec))} - ?Atom {swap! (([this f] (swap! *spec f))) - reset! ([this v] (reset! *spec v))}}) - -(defn deducible [x] - (if (spec? x) - (DeducibleSpec. (atom x)) - (err! "`x` must be spec to be part of DeducibleSpec" x))) - -(defn deducible-spec? [x] (instance? DeducibleSpec x)) - -;; ===== EXTENSIONALITY COMPARISON IMPLEMENTATIONS ===== ;; - -#_(is (coll&/incremental-every? (aritoid nil (constantly true) t/in>) - [String Comparable Object]) - (coll&/incremental-every? (aritoid nil (constantly true) t/in>) - [Long Number])) - -(defn compare|class|class - "Compare extension (generality|specificity) of ->`c0` to ->`c1`. - `0` means they are equally general/specific: - - ✓ `(t/= c0 c1)` : the extension of ->`c0` is equal to that of ->`c1`. - `-1` means ->`c0` is less general (more specific) than ->`c1`. - - ✓ `(t/< c0 c1)` : the extension of ->`c0` is a strict subset of that of ->`c1`. - `1` means ->`c0` is more general (less specific) than ->`c1`: - - ✓ `(t/> c0 c1)` : the extension of ->`c0` is a strict superset of that of ->`c1`. - `nil` means their generality/specificity is incomparable: - - ✓ `(t/incomparable? c0 c1)` : - the extension of ->`c0` is neither a subset nor a superset of that of ->`c1`. - Unboxed primitives are considered to be less general (more specific) than boxed primitives." - [^Class c0 ^Class c1] - #?(:clj (cond (== c0 c1) 0 - (== c0 Object) 1 - (== c1 Object) -1 - (== (utcore/boxed->unboxed c0) c1) 1 - (== c0 (utcore/boxed->unboxed c1)) -1 - (c/or (utcore/primitive-array-type? c0) - (utcore/primitive-array-type? c1)) nil ; we'll consider the two unrelated - (.isAssignableFrom c0 c1) 1 - (.isAssignableFrom c1 c0) -1 - :else nil) ; unrelated - :cljs nil)) - -;; ===== EXTENSIONALITY COMPARISON ===== ;; - -(declare compare|dispatch) - -(defn #_long compare ; TODO for some reason primitive type hints break it for the time being - ;; TODO optimize the `recur`s here as they re-take old code paths - "Returns the value of the comparison of the extensions of ->`s0` and ->`s1`. - `-1` means (ex ->`s0`) ⊂ (ex ->`s1`) - `0` means (ex ->`s0`) = (ex ->`s1`) - `1` means (ex ->`s0`) ⊃ (ex ->`s1`) - `nil` means (ex ->`s0`) ⊄,≠,⊅ (ex ->`s1`) - - Does not compare cardinalities or other relations of sets, but rather only sub/superset - relations." - [s0 s1] - (assert (spec? s0) {:s0 s0}) - (assert (spec? s1) {:s1 s1}) - (let [dispatched (-> compare|dispatch (get (type s0)) (get (type s1)))] - (if (c/nil? dispatched) - (err! (str "Specs not handled: " {:s0 s0 :s1 s1}) {:s0 s0 :s1 s1}) - (dispatched s0 s1)))) - -#_(compare (numerically byte?) byte?) ; -> 1 -#_(compare byte? (numerically byte?)) ; -> -1 - -(defn boolean-compare - "Incomparables return `false` for the boolean comparator `pred`." - [pred s0 s1] - (let [ret (compare s0 s1)] - (if (c/nil? ret) false (pred ret 0)))) - -(defn < - "Computes whether the extension of spec ->`s0` is a strict subset of that of ->`s1`." - [s0 s1] (boolean-compare c/< s0 s1)) - -(defn <= - "Computes whether the extension of spec ->`s0` is a (lax) subset of that of ->`s1`." - [s0 s1] (boolean-compare c/<= s0 s1)) - -(defn = - "Computes whether the extension of spec ->`s0` is equal to that of ->`s1`." - [s0 s1] (boolean-compare c/= s0 s1)) - -(defn >= - "Computes whether the extension of spec ->`s0` is a (lax) superset of that of ->`s1`." - [s0 s1] (boolean-compare c/>= s0 s1)) - -(defn > - "Computes whether the extension of spec ->`s0` is a strict superset of that of ->`s1`." - [s0 s1] (boolean-compare c/> s0 s1)) - -;; ===== LOGICAL ===== ;; - -(defn create-logical-spec - [construct-fn arg args compare-fn] - (if (empty? args) - (>spec arg) - (let [;; simplification via identity - simp|identity (->> (cons arg args) (map+ >spec) distinct+) - ;; simplification via intension comparison - args' (->> simp|identity - (reduce - (fn - ([x] x) - ([args' s] - (let [with-comparisons - (->> args' - (map+ (juxt identity #(compare s %))) - ;; remove all args for which `s` has a intension - (remove+ (rcomp second (fn-and c/some? compare-fn))) - join)] - (if (c/or ;; at least one arg with a intension than `s` - (c/< (count with-comparisons) (count args')) - ;; `s` is incomparable to all args - (->> with-comparisons (seq-and (fn-> second c/nil?)))) - (->> with-comparisons (mapv first) (<- conj s)) - args')))) - []))] - (if (-> args' count (c/= 1)) - (first args') - (construct-fn args'))))) - -;; ===== AND ===== ;; - -(udt/deftype AndSpec [args #_(t/and t/indexed? (t/seq spec?))] - {PSpec nil - fipp.ednize/IOverride nil - fipp.ednize/IEdn - {-edn ([this] (list* `and args))} - ?Fn {invoke ([_ x] (reduce (fn [_ pred] (c/or (pred x) (reduced false))) - true ; vacuously - args))}}) +;; ----- AndType (`t/and` | `t/&`) ----- ;; -(defn and-spec? [x] (instance? AndSpec x)) +(def- comparison-denotes-supersession?|and (fn1 c/= args [x] - (if (instance? AndSpec x) - (.-args ^AndSpec x) - (err! "Cannot cast to AndSpec" x))) +(defn- and* [ts] + (create-logical-type :and ->AndType utr/and-type? utr/and-type>args + comparison-denotes-supersession?|and ts)) (defn and - "Sequential/ordered `and`. - Applies as much 'compression'/deduplication/simplification as possible to the supplied specs. - Yields error if provided with incompatible specs (ones whose logical intersection is empty)." - [arg & args] - (create-logical-spec ->AndSpec arg args c/neg?)) - -(deftype - UnorderedAndSpec [args #_(t/unkeyed spec?)] - PSpec - fipp.ednize/IOverride - fipp.ednize/IEdn (-edn [this] (list* `and* args))) - -(defn intersection|spec - ([a] a) - ([a b] - (assert (spec? a) (spec? b)) - (if (c/= a b) - a - (let [comparison (compare a b)] - (cond (c/nil? comparison) - nil ;; intersection of unrelated specs is `nil` - (zero? comparison) - a ;; technically, choose the simpler one, but these will all be simplified anyway - (neg? comparison) - a - :else b))))) - -(defn and* - "Unordered `and`. Analogous to `set/intersection`, not `core/and`: - rather than ensuring specific conditional application of specs, `and*` merely - ensures all specs are met in *some* order. - Applies as much 'compression'/deduplication/simplification as possible to the supplied specs. - Effectively computes the intersection of the intension of the ->`args`." - [arg & args] - (let [specs (->> (cons arg args) (map+ >spec) (ur/incremental-apply intersection|spec))] - (if (coll? specs) ; technically, `unkeyed?` - (UnorderedAndSpec. specs) - specs))) - -;; ===== OR ===== ;; - -(udt/deftype OrSpec [args #_(t/and t/indexed? (t/seq spec?))] - {PSpec nil - fipp.ednize/IOverride nil - fipp.ednize/IEdn - {-edn ([this] (list* `or args))} - ?Fn {invoke ([_ x] (reduce (fn [_ pred] (let [p (pred x)] (c/and p (reduced p)))) - true ; vacuously - args))}}) + "Unordered `and`. Analogous to `set/intersection`. + Applies as much 'compression'/deduplication/simplification as possible to the supplied types. + Effectively computes the intersection of the extension of the ->`ts`." + ([] universal-set) + ([t] t) + ([t & ts] (separate-rx-and-apply and* (cons t ts)))) -(defn or-spec? [x] (instance? OrSpec x)) +(uvar/defalias & and) -(defn or-spec>args [x] - (if (instance? OrSpec x) - (.-args ^OrSpec x) - (err! "Cannot cast to OrSpec" x))) +;; ----- If ----- ;; -(defn or - "Sequential/ordered `or`. - Applies as much 'compression'/deduplication/simplification as possible to the supplied specs." - [arg & args] - (create-logical-spec ->OrSpec arg args c/pos?)) - -(deftype - UnorderedOrSpec [args #_(t/unkeyed spec?)] - PSpec - fipp.ednize/IOverride - fipp.ednize/IEdn (-edn [this] (list* `or* args))) - -(defn union|spec - ([a] a) - ([a b] - (assert (spec? a) (spec? b)) - (if (c/= a b) - a - (let [comparison (compare a b)] - (cond (c/nil? comparison) - #{a b} - (zero? comparison) - a ;; technically, choose the simpler one, but these will all be simplified anyway - (neg? comparison) - b - :else a))))) - -(defn or* - "Unordered `or`. Analogous to `set/union`, not `core/or`: - rather than ensuring specific conditional application of specs, `or*` merely - ensures at least one spec is met in *some* order. - Applies as much 'compression'/deduplication/simplification as possible to the supplied specs. - Effectively computes the union of the intension of the ->`args`." - [arg & args] - (TODO "or*")) - -;; ===== OR ===== ;; - -(udt/deftype NotSpec [spec #_t/spec?] - {PSpec nil - fipp.ednize/IOverride nil - fipp.ednize/IEdn - {-edn ([this] (list `not spec))} - ?Fn {invoke ([_ x] (spec x))}}) +;; This won't shadow anything because `if` and `def` are non-shadowable +(defns if + "(if a b c) + : (a->b) & (~a->c) + : (~a | b) & (a | c) + : (a & b) | (~a & c)" + [pred utr/type?, then utr/type?, else utr/type? > utr/type?] + (or (and pred then) (and (not pred) else))) -(defn not [x] (NotSpec. (>spec x))) +;; ----- Expression ----- ;; -#?(:clj -(defmacro spec - "Creates a spec function" - [arglist & body] ; TODO spec this - `(FnSpec. nil (fn ~arglist ~@body) (list* `spec '~arglist '~body)))) - -(deftype FnConstantlySpec - [name #_(t/? t/symbol?) - f #_t/fn? - inner-object #_t/_] - PSpec - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (c/or name (list `fn' inner-object)))) +;; ----- ProtocolType ----- ;; -#?(:clj -(defmacro fn' [x] - `(let [x# ~x] (FnConstantlySpec. nil (ufn/fn' x#) x#)))) - -(defn unkeyed - "Creates an unkeyed collection spec, in which the collection may - or may not be sequential or even seqable, but must not have key-value - pairs like a map. - Examples of unkeyed collections include a vector (despite its associativity), - a list, and a set (despite its values doubling as keys). - A map is not an unkeyed collection." - [x] (TODO)) - -(-def nil? (value nil)) - -(udt/deftype NilableSpec [meta #_(t/? ::meta) spec #_t/spec?] - {PSpec nil - ?Fn {invoke ([this x] (c/or (c/nil? x) (spec x)))} - ?Meta {meta ([this] meta) - with-meta ([this meta'] (NilableSpec. meta' spec))} - ?Object {equals ([this that] - (c/or (identical? this that) - (c/and (instance? NilableSpec that) - (c/= spec (.-spec ^NilableSpec that)))))} - fipp.ednize/IOverride nil - fipp.ednize/IEdn - {-edn ([this] (list `? spec))}}) - -(defn nilable-spec? [x] (instance? NilableSpec x)) - -(defn nilable-spec>inner-spec [spec] - (if (instance? NilableSpec spec) - (.-spec ^NilableSpec spec) - (err! "Cannot cast to NilableSpec" {:x spec}))) - -;; This sadly gets a java.lang.AbstractMethodError when one tries to do as simple as: -;; `(def ? (InferSpec. nil))` -;; `(def abcde (? 1)) -(udt/deftype InferSpec [meta #_(t/? ::meta)] - {PSpec nil - ?Fn {invoke (([this x] (NilableSpec. nil (>spec x))) - ([this spec x] (c/or (c/nil? x) (spec x))))} - ?Meta {meta ([this] meta) - with-meta ([this meta'] (InferSpec. meta'))} +(defns- isa?|protocol [p uclass/protocol?] + (ProtocolType. uhash/default uhash/default nil nil p)) + +#?(:cljs +(defns- isa?|protocol|direct [p uclass/protocol?] + (DirectProtocolType. uhash/default uhash/default nil nil p))) + +;; ----- ClassType ----- ;; + +(defns- isa?|class [c #?(:clj c/class? :cljs c/fn?)] + (ClassType. uhash/default uhash/default nil nil c)) + +;; ----- OrderedType ----- ;; + +(defns unordered + "Creates a type representing an unordered collection." + ([> utr/unordered-type?] (unordered [])) + ([data _ > utr/unordered-type?] + (ifs (utr/rx-type? data) + (rx (UnorderedType. uhash/default uhash/default nil nil {@data 1})) + (utr/type? data) + (UnorderedType. uhash/default uhash/default nil nil {data 1}) + (c/not (sequential? data)) + (err! "Finite type info must be sequential" {:type (c/type data)}) + (c/not (seq-and utr/type? data)) + (err! "Not every element of finite type data is a type") + (seq-or utr/rx-type? data) + (rx (UnorderedType. uhash/default uhash/default nil nil + (->> data (uc/map+ utr/deref-when-reactive) uc/frequencies))) + (UnorderedType. uhash/default uhash/default nil nil (frequencies data)))) + ([datum _ & data _ > utr/unordered-type?] (unordered (cons datum data)))) + +(defns ordered + "Creates a type representing an ordered collection." + ([> utr/ordered-type?] (ordered [])) + ([data _ > utr/ordered-type?] + (ifs (utr/rx-type? data) + (rx (OrderedType. uhash/default uhash/default nil nil [@data])) + (utr/type? data) + (OrderedType. uhash/default uhash/default nil nil [data]) + (c/not (sequential? data)) + (err! "Finite type info must be sequential" {:type (c/type data)}) + (c/not (seq-and utr/type? data)) + (err! "Not every element of finite type data is a type") + (seq-or utr/rx-type? data) + (rx (OrderedType. uhash/default uhash/default nil nil + (->> data (uc/map utr/deref-when-reactive)))) + (OrderedType. uhash/default uhash/default nil nil data))) + ([datum _ & data _ > utr/ordered-type?] (ordered (cons datum data)))) + +;; ----- ValueType ----- ;; + +(defn value + "Creates a type whose extension is the singleton set containing only the value `v`." + [v] (ValueType. uhash/default uhash/default nil nil v)) + +(defns unvalue + [t utr/type?] + (ifs (utr/value-type? t) (utr/value-type>value t) + (c/= t universal-set) t + (err! "Don't know how to handle `unvalue` for type" {:t t}))) + +;; ----- `isa?` / Class-Inheritance ----- ;; + +(defn isa? [x] + (ifs (uclass/protocol? x) + (isa?|protocol x) + + (#?(:clj c/class? :cljs c/fn?) x) + (isa?|class x) + + (throw (ex-info "`isa?` cannot be applied to" {:x x})))) + +(defn isa?|direct [x] + (if (uclass/protocol? x) + #?(:clj (isa?|class (uclass/protocol>class x)) + :cljs (isa?|protocol|direct x)) + (isa? x))) + +;; ------------------ + +(defns- -|or [t0 utr/type?, t1 utr/type? > utr/type?] + (let [args (->> t0 utr/or-type>args (uc/remove (fn1 = t1)))] + (case (count args) + 0 empty-set + 1 (first args) + (OrType. uhash/default uhash/default nil nil args (atom nil))))) + +(defns -|norx [t0 utr/type?, t1 utr/type? > utr/type?] + (let [c (c/int (compare t0 t1))] + (case c + (0 -1) empty-set + 3 t0 + (1 2) + (let [c0 (c/type t0) c1 (c/type t1)] + ;; TODO add dispatch? + (condp == c0 + ClassType (condp == c1 + ClassType (AndType. uhash/default uhash/default nil nil + [t0 (not t1)] (atom nil))) + NotType (condp == (-> t0 utr/not-type>inner-type c/type) + ClassType (condp == c1 + ClassType (AndType. uhash/default uhash/default nil nil + [t0 (not t1)] (atom nil))) + ValueType (condp == c1 + ValueType (AndType. uhash/default uhash/default nil nil + [t0 (not t1)] (atom nil)))) + OrType (condp == c1 + ClassType (-|or t0 t1) + ValueType (-|or t0 t1))))))) + +(defn - + "Computes the difference of `t0` from `t1`: (& t0 (! t1)) + If `t0` = `t1`, `∅` + If `t0` < `t1`, `∅` + If `t0` <> `t1`, `t0` + If `t0` > | >< `t1`, `t0` with all elements of `t1` removed" + ([t0 #_utr/type? #_> #_utr/type?] t0) + ([t0 #_utr/type?, t1 #_utr/type? #_> #_utr/type?] + (if (utr/rx-type? t0) + (if (utr/rx-type? t1) + (rx (- @t0 @t1)) + (rx (- @t0 t1))) + (if (utr/rx-type? t1) + (rx (- t0 @t1)) + (with-expand-meta-ors [t0 t1] + (fn [types'] + (assert (-> types' count (c/= 2))) + (-|norx (first types') (second types'))))))) + ([t0 #_utr/type?, t1 #_utr/type? & ts #_ _ #_> #_utr/type?] (reduce - (- t0 t1) ts))) + +(def* type? (isa? PType)) +(def* not-type? (isa? NotType)) +(def* or-type? (isa? OrType)) +(def* and-type? (isa? AndType)) +(def* protocol-type? (isa? ProtocolType)) +(def* class-type? (isa? ClassType)) +(def* value-type? (isa? ValueType)) + +;; For use in logical operators +(def* nil? (value nil)) +(def* object? (isa? #?(:clj java.lang.Object :cljs js/Object))) + +;; ===== Type metadata (not for reactive types) ===== ;; + +(defn assume + "Denotes that, whatever the declared output type (to which `assume` is applied) of a function may + be, it is assumed that the output satisfies that type." + [t #_utr/type? #_> #_utr/type?] + (assert (c/not (utr/rx-type? t))) + (if (utr/meta-type? t) + (if (.-assume? ^MetaType t) + t + (MetaType. (.-meta ^MetaType t) nil (.-t ^MetaType t) + true (.-ref? ^MetaType t) false)) ; un-`t/run`s it + (MetaType. (c/meta t) nil t true false false))) + +(defns assume? [t utr/type? > c/boolean?] (c/and (utr/meta-type? t) (.-assume? ^MetaType t))) + +(defn unassume [t #_utr/type? #_> #_utr/type?] + (assert (c/not (utr/rx-type? t))) + (if (utr/meta-type? t) + (if-not (.-assume? ^MetaType t) + t + (MetaType. (.-meta ^MetaType t) nil (.-t ^MetaType t) + false (.-ref? ^MetaType t) (.-runtime? ^MetaType t))) ; un-`t/run`s it + t)) + +(defn run + "Denote on a type that it must be enforced at runtime. + For use with `defnt`." + [t #_utr/type? #_> #_utr/type?] + (assert (c/not (utr/rx-type? t))) + (if (utr/meta-type? t) + (if (.-runtime? ^MetaType t) + t + (MetaType. (.-meta ^MetaType t) nil (.-t ^MetaType t) + false (.-ref? ^MetaType t) true)) ; un-`t/assume`s it + (MetaType. (c/meta t) nil t false false true))) + +(defns run? [t utr/type? > c/boolean?] (c/and (utr/meta-type? t) (.-runtime? ^MetaType t))) + +(defn ref + "Denote on a type that it must not be expanded to use primitive values. + For use with `defnt`." + [t #_utr/type? #_> #_utr/type?] + (assert (c/not (utr/rx-type? t))) + (if (utr/meta-type? t) + (if (.-ref? ^MetaType t) + t + (MetaType. (.-meta ^MetaType t) nil (.-t ^MetaType t) + (.-assume? ^MetaType t) true (.-runtime? ^MetaType t))) + (MetaType. (c/meta t) nil t false true false))) + +(defn unref [t #_utr/type? #_> #_utr/type?] + (assert (c/not (utr/rx-type? t))) + (if (utr/meta-type? t) + (if-not (.-ref? ^MetaType t) + t + (MetaType. (.-meta ^MetaType t) nil (.-t ^MetaType t) + (.-assume? ^MetaType t) false (.-runtime? ^MetaType t))) + t)) + +(defns type-ref? [t utr/type? > c/boolean?] (c/and (utr/meta-type? t) (.-ref? ^MetaType t))) + +;; ===== Logical ===== ;; + +(defns >logical-complement + "Returns the content inside a `t/not` applied to the `args` of an n-ary logical type (e.g. `or`, + `and`). Stored in such types to more easily compare them with `not` types. + E.g. `(>logical-complement (and a b))` -> `(or (not a) (not b))` + `(>logical-complement (or a b))` -> `(and (not a) (not b))`." + [t utr/type? > utr/type?] + (cond (utr/or-type? t) (c/or @(.-*logical-complement ^OrType t) + (reset! (.-*logical-complement ^OrType t) (not t))) + (utr/and-type? t) (c/or @(.-*logical-complement ^AndType t) + (reset! (.-*logical-complement ^AndType t) (not t))) + :else (err! "`>logical-complement` not supported on type" {:type t}))) + +(defns complementary? [t0 utr/type? t1 utr/type?] (= t0 (not t1))) + +(defn- logical-compare + "This is so `t/empty-set` doesn't get left in `t/or`s or `t/and`s." + [t0 #_utr/type?, t1 #_utr/type? #_> #_uset/comparison?] + (if (== t0 empty-set) + (if (== t1 empty-set) =ident ident (compare t0 t1)))) + +(defns- create-logical-type|inner|or + [{:as accum :keys [t' utr/type?]} _, t* utr/type?, c* uset/comparison?] + (if #?(:clj (c/or (c/and (c/= t' object?) (c/= t* nil?)) + (c/and (c/= t* object?) (c/= t' nil?))) + :cljs false) + (reduced (assoc accum :conj-t? false :types [universal-set])) + (if ;; `s` must be either `><` or `<>` w.r.t. to all other args + (case c* (2 3) true false) + (if ;; Tautology/universal-set: (| A (! A)) + (c/and (c/= c* <>ident) ; optimization before `complementary?` + (complementary? t' t*)) + (reduced (assoc accum :conj-t? false :types [universal-set])) + (update accum :types conj t*)) + (reduced (assoc accum :prefer-orig-args? true))))) + +(defns- create-logical-type|inner|and + [{:as accum :keys [conj-t? c/boolean?, prefer-orig-args? c/boolean?, t' utr/type?, types _]} _ + t* utr/type?, c* uset/comparison?] + (if ;; Contradiction/empty-set: (& A (! A)) + (c/or (c/= c* <>ident) ; optimization before `complementary?` + (complementary? t' t*)) + (do #_(println "BRANCH 1") + (reduced (assoc accum :conj-t? false :types [empty-set]))) + (do #_(println "BRANCH 2") + (let [conj-t?' (if ;; `s` must be `><` w.r.t. to all other args if it is to be `conj`ed + (c/not= c* >args diff) + [diff])) + [t*])] + (assoc accum :conj-t? conj-t?' :types (into types tt*)))))) + +(defns- create-logical-type|inner + [args' _, t utr/type?, kind #{:or :and}, comparison-denotes-supersession? c/fn?] + (let [args+comparisons|without-superseded + (->> args' + (uc/map+ (juxt identity #(logical-compare t %))) + ;; remove all args whose extensions are superseded by `t` + (uc/remove+ (fn-> second comparison-denotes-supersession?)) + join) ; TODO elide `join` + t-redundant? (->> args+comparisons|without-superseded (seq-or (fn-> second (c/= =ident))))] + (ifs t-redundant? + args' + (empty? args+comparisons|without-superseded) + [t] + (let [{:keys [conj-t? prefer-orig-args? t' types]} + (->> args+comparisons|without-superseded + (educe + (c/fn ([accum] accum) + ([accum [t* c*]] + (case kind + :or (create-logical-type|inner|or accum t* c*) + :and (create-logical-type|inner|and accum t* c*)))) + {:conj-t? ;; If `t` is a `NotType`, and kind is `:and`, then it will + ;; be applied by being `-` from all args, not by being + ;; `conj`ed + (c/not (c/and (c/= kind :and) (utr/not-type? t))) + :prefer-orig-args? false + :t' t + :types []}))] + (if prefer-orig-args? + args' + (whenp-> types conj-t? (conj t'))))))) + +(defn- simplify-logical-type|inner-expansion+ + "Simplification via inner expansion: `(| (| a b) c)` -> `(| a b c)`" + [type-pred type>args type-args #_(of reducible? utr/type?)] + (->> type-args + (uc/map+ (c/fn [arg] (if (type-pred arg) + (type>args arg) + [arg]))) + uc/cat+)) + +(defn- simplify-logical-type|structural-identity+ + "Simplification via structural identity: `(| a b a)` -> `(| a b)`" + [type-args #_(of reducible? utr/type?)] + (->> type-args uc/distinct+)) + +(defn- simplify-logical-type|comparison + "Simplification via intension comparison" + [kind comparison-denotes-supersession? type-args #_(of reducible? utr/type?)] + (educe + (c/fn ([type-args'] type-args') + ([type-args' t #_utr/type?] + (if (empty? type-args') + (conj type-args' t) + (create-logical-type|inner type-args' t kind comparison-denotes-supersession?)))) + [] + type-args)) + +(defns- create-logical-type|non-meta-ors + [kind #{:or :and}, construct-fn _, type-pred _, type>args _ + comparison-denotes-supersession? c/fn?, type-args (fn-> count (c/>= 1)) > utr/type?] + (let [simplified + (->> type-args + (simplify-logical-type|inner-expansion+ type-pred type>args) + simplify-logical-type|structural-identity+ + (simplify-logical-type|comparison kind comparison-denotes-supersession?))] + (assert (-> simplified count (c/>= 1))) ; for internal implementation correctness + (if (-> simplified count (c/= 1)) + (first simplified) + (construct-fn uhash/default uhash/default nil nil simplified (atom nil))))) + +(defns- create-logical-type + [kind #{:or :and}, construct-fn _, type-pred _, type>args _ + comparison-denotes-supersession? c/fn?, type-args (fn-> count (c/>= 1)) > utr/type?] + (with-expand-meta-ors type-args + (fn [types'] + (create-logical-type|non-meta-ors + kind construct-fn type-pred type>args comparison-denotes-supersession? types')))) + +;; ===== `t/ftype` ===== ;; + +(defn arities>ored-input-types [arities] + (->> arities + (uc/map-vals' + (c/fn [overloads] + (->> overloads (uc/lmap :input-types) (apply uc/lmap or)))) + delay)) + +(defn arities>ored-output-types [arities] + (->> arities + vals + (apply concat) + (uc/lmap :output-type) + (apply or) + delay)) + +(defn ftype [& args] + (let [?fn-name (when (-> args first c/symbol?) + (first args)) + rest-args (if ?fn-name (rest args) args) + output-type (if (-> rest-args first c/sequential?) + universal-set + (first rest-args)) + arities-form (if (-> rest-args first c/sequential?) + rest-args + (rest rest-args)) + arities (->> arities-form + (uc/map+ (c/fn [arity-form] + (-> (us/conform ::fn-type|arity arity-form) + (update :output-type #(c/or % output-type universal-set))))) + (uc/group-by #(-> % :input-types count))) + ored-input-types (arities>ored-input-types arities) + ored-output-type (arities>ored-output-types arities)] + (FnType. nil nil ?fn-name output-type arities-form arities ored-input-types ored-output-type))) + +(us/def ::match-spec + (us/seq-of (us/or* #{:_ :?} type? + (us/tuple #{:?} type?) + (us/tuple c/ifn? type?) + (us/tuple #{:?} c/ifn? type?)))) + +(defn- find-spec? [match-spec-element] + (c/or (c/= match-spec-element :?) + (c/and (sequential? match-spec-element) + (-> match-spec-element first (c/= :?))))) + +(defn- match-spec>type-data-seq + "Returns the type data of overloads that support the specified arg types." + [t match-spec] + (let [type-data-seq (-> t utr/fn-type>arities (get (count match-spec)))] + (->> match-spec + (uc/map-indexed+ vector) + (uc/remove #(c/or (-> % second (c/= :_)) (-> % second (c/= :?)))) + (educe + (c/fn ([] type-data-seq) + ([type-data-seq'] type-data-seq') + ([type-data-seq' [i|arg arg-type-or-vec]] + (let [[compf arg-type] + (if (sequential? arg-type-or-vec) + (if (-> arg-type-or-vec first (c/= :?)) + (if (-> arg-type-or-vec count (c/= 3)) + [(nth arg-type-or-vec 1) (nth arg-type-or-vec 2)] + [utcomp/<= (nth arg-type-or-vec 1)]) + [(nth arg-type-or-vec 0) (nth arg-type-or-vec 1)]) + [utcomp/<= arg-type-or-vec])] + (c/or (->> type-data-seq' + (uc/lfilter (c/fn [{:keys [input-types]}] + (compf arg-type (get input-types i|arg)))) + seq) + (reduced nil))))))))) + +(defn- input-or-output-handle-reactive [f t args] + (if (utr/rx-type? t) + (if (seq-or utr/rx-type? args) + (rx (f @t (map utr/deref-when-reactive args))) + (rx (f @t args))) + (if (seq-or utr/rx-type? args) + (rx (f t (map utr/deref-when-reactive args))) + (f t args)))) + +(defn- input|meta-or|norx [t match-spec #_::match-spec] + (let [i|? (->> match-spec (reducei (c/fn [_ t i] (when (find-spec? t) (reduced i))) nil)) + type-args + (->> match-spec + (match-spec>type-data-seq t) + (uc/map (c/fn [{:keys [input-types]}] (get input-types i|?))))] + (with-expand-meta-ors type-args meta-or))) + +(defns input|meta-or + [t (us/or* utr/fn-type? utr/rx-type?), match-spec _ #_::match-spec + | (->> match-spec (filter find-spec?) count (c/= 1)) + > type?] + (input-or-output-handle-reactive input|meta-or|norx t match-spec)) + +(defn- input|or|norx [t match-spec] + (let [t' (input|meta-or|norx t match-spec)] + (cond-> t' (utr/meta-or-type? t') (->> utr/meta-or-type>types (apply or))))) + +(defns input|or + "Outputs the type of a specified input to a typed fn." + [t (us/or* utr/fn-type? utr/rx-type?), match-spec _ #_::match-spec + | (->> match-spec (filter find-spec?) count (c/= 1)) + > type?] + (input-or-output-handle-reactive input|or|norx t match-spec)) + +(defn input + "Usage in arglist contexts: + - `(t/input >namespace :?)` + - Outputs a reactive type embodying the union of the possible types of the first input to + `>namespace`. + - `(t/input reduce :_ :_ :?)` + - Outputs a reactive type embodying the union of the possible types of the third input to + `reduce`. + - `(t/input reduce :? :_ string?)` + - Outputs a reactive type embodying the union of the possible types of the first input to + `reduce` when the third input satisfies `string?`." + ([t & args] (err! "Can't use `input` outside of arglist contexts"))) + +(defn- output|meta-or|norx [t match-spec] + (let [type-args (->> match-spec (match-spec>type-data-seq t) (uc/map :output-type))] + (with-expand-meta-ors type-args meta-or))) + +(defns output|meta-or + [t (us/or* utr/fn-type? utr/rx-type?) args (us/seq-of (us/or* #{:_} type?)) > type?] + (input-or-output-handle-reactive output|meta-or|norx t args)) + +(defn- output|or|norx [t args] + (let [t' (output|meta-or|norx t args)] + (cond-> t' (utr/meta-or-type? t') (->> utr/meta-or-type>types (apply or))))) + +(defns output|or + "Outputs the output type of a typed fn." + [t (us/or* utr/fn-type? utr/rx-type?) args (us/seq-of (us/or* #{:_} type?)) > type?] + (input-or-output-handle-reactive output|or|norx t args)) + +(defn output + "Usage in arglist contexts: + - `(t/output >namespace :any)` + - (TODO) Outputs a reactive type embodying the union of the possible output types of + `>namespace` given any valid inputs at all + - `(t/output reduce [:_ :_ string?])` + - Outputs a reactive type embodying the union of the possible output types of `reduce` when + the third input satisfies `string?`." + ([t & args] (err! "Can't use `output` outside of arglist contexts"))) + +;; ===== Dependent types ===== ;; + +(defns type + "When used within the type declaration of a function input, returns the compile-time type of `x`. + For all other cases, returns `(t/value x)` at runtime." + [x _ > type?] (value x)) + +;; TODO figure this out +;; TODO move to reifications +#_(do (udt/deftype DeducibleType [*t #_(t/atom-of t/type?)] + {PSpec nil fipp.ednize/IOverride nil - fipp.ednize/IEdn - {-edn ([this] `?)}}) + fipp.ednize/IEdn {-edn ([this] (list `deducible @*t))} + ?Atom {swap! (([this f] (swap! *t f))) + reset! ([this v] (reset! *t v))}}) -(defn ? - "Denotes type inference should be performed. - Arity 1: Computes a spec denoting a nilable value satisfying `spec`. - Arity 2: Computes whether `x` is nil or satisfies `spec`." - ([x] (NilableSpec. nil (>spec x))) - ([spec x] (c/or (c/nil? x) (spec x)))) - -(def- compare|dispatch - (let [with-invert-comparison - (fn [f] (fn [s0 s1] (ucomp/invert (f s1 s0)))) - v+c (fn [s0 s1] - (let [v (.-v ^ValueSpec s0) - c (.-c ^ClassSpec s1)] - (if (instance? c v) - ;; e.g. asking how the set containing only the string "abc" - ;; relates to the set of all strings (the class String) - -1 ; the extension is a strict subset - ;; e.g. asking how the set containing only the string "abc" - ;; relates the set of all bytes (the class Byte) - nil))) ; neither subset nor superset - v+o (fn [s0 s1] - (let [specs (.-args ^OrSpec s1)] - (reduce - (fn [ret s] - (let [ret' (compare s0 s)] - (case ret' - nil ret - -1 (reduced ret') ; because the extension of `s1` only gets bigger - ret'))) - nil - specs))) - v+a (fn [s0 s1] - (let [specs (.-args ^AndSpec s1)] - (reduce - (fn [ret s] - (let [ret' (compare s0 s)] - (case ret' - nil (reduced ret') - 1 (reduced ret') ; because the extension of `s1` only gets smaller - ret'))) - nil - specs))) - v+n (fn [s0 s1] - (if (-> s0 value-spec>value nil?) - -1 - (err! "TODO dispatch" {:s0 s0 :s1 s1}))) - ident 2 ; 1 - !ident 3 ; nil - <+! (-> ubit/empty (ubit/conj +! (-> ubit/empty (ubit/conj >ident) (ubit/conj !ident)) ; 12 - =+! (-> ubit/empty (ubit/conj =ident) (ubit/conj !ident)) ; 10 - - ;; #{(⊂ | =) ∅} -> ⊂ - ;; #{(⊃ ?) ∅} -> ∅ - ;; Otherwise whatever it is - c+o (fn [s0 s1] - (let [specs (.-args ^OrSpec s1)] - (first - (reduce - (fn [[ret found] s] - (let [ret' (compare s0 s) - found' (ubit/conj found (case ret' -1 0, 0 1, 1 2, nil 3))] - (case (c/long found') - (9 #_<+! 10 #_=+!) (reduced [-1 nil]) - (12 #_>+!) (reduced [nil nil]) - [ret' found']))) - [nil ubit/empty] - specs)))) - ;; Any ∅ -> ∅ - ;; Otherwise whatever it is - c+a (fn [s0 s1] - (let [specs (.-args ^AndSpec s1)] - (reduce - (fn [ret s] - (let [ret' (compare s0 s)] - (if (c/nil? ret') (reduced nil) ret'))) - nil - specs))) - c+n (fn [s0 s1] - (case (compare s0 (nilable-spec>inner-spec s1)) - (0 -1) -1 - nil)) - o+o (fn [^OrSpec s0 ^OrSpec s1] - (let [;; every element in s0 an extensional strict subset of s1 - l (->> s0 .-args (map+ (fn1 compare s1)) (seq-and (fn1 c/= -1))) - ;; every element in s1 an extensional strict subset of s0 - r (->> s1 .-args (map+ (fn1 compare s0)) (seq-and (fn1 c/= -1)))] - (if l - (if r 0 -1) - (if r 1 nil)))) - o+a (fn [^OrSpec s0 ^AndSpec s1] - (let [;; every element in s1 an extensional strict subset of s0 - r (->> s1 .-args (map+ (fn1 compare s0)) (seq-and (fn1 c/= -1)))] - (if r 1 nil))) - e+e (fn [s0 s1] (if (c/= s0 s1) 0 nil)) - incomparable (fn [s0 s1] nil) - ] - {InferSpec - {InferSpec (ufn/fn' 0) - ValueSpec (ufn/fn' 1) - ClassSpec (ufn/fn' 1) - ProtocolSpec (ufn/fn' 1) - NilableSpec (ufn/fn' 1) - OrSpec (ufn/fn' 1) - UnorderedOrSpec (ufn/fn' 1) - AndSpec (ufn/fn' 1) - UnorderedAndSpec (ufn/fn' 1) - Expression (ufn/fn' 1)} - ValueSpec - {InferSpec (ufn/fn' -1) - ValueSpec (fn [s0 s1] (catch-all - (unum/signum|long (c/compare s0 s1)) - nil)) - ClassSpec v+c - ProtocolSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - NilableSpec v+n - OrSpec v+o - UnorderedOrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - AndSpec v+a - UnorderedAndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - Expression incomparable} - ClassSpec - {InferSpec (ufn/fn' -1) - ValueSpec (with-invert-comparison v+c) - ClassSpec (fn [s0 s1] (compare|class|class (.-c ^ClassSpec s0) (.-c ^ClassSpec s1))) - ProtocolSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - NilableSpec c+n - OrSpec c+o - UnorderedOrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - AndSpec c+a - UnorderedAndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - Expression incomparable} - ProtocolSpec - {InferSpec (ufn/fn' -1) - ValueSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - ClassSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - ProtocolSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - NilableSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - OrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - UnorderedOrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - AndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - UnorderedAndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - Expression incomparable} - NilableSpec - {InferSpec (ufn/fn' -1) - ValueSpec (with-invert-comparison v+n) - ClassSpec (with-invert-comparison c+n) - ProtocolSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - NilableSpec (fn [s0 s1] (compare (nilable-spec>inner-spec s0) (nilable-spec>inner-spec s1))) - OrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - UnorderedOrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - AndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - UnorderedAndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - Expression incomparable} - OrSpec - {InferSpec (ufn/fn' -1) - ValueSpec (with-invert-comparison v+o) - ClassSpec (with-invert-comparison c+o) - ProtocolSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - NilableSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - OrSpec o+o - UnorderedOrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - AndSpec o+a - UnorderedAndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - Expression incomparable} - UnorderedOrSpec - {InferSpec (ufn/fn' -1) - ValueSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - ClassSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - ProtocolSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - NilableSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - OrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - UnorderedOrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - AndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - UnorderedAndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - Expression incomparable} - AndSpec - {InferSpec (ufn/fn' -1) - ValueSpec (with-invert-comparison v+a) - ClassSpec (with-invert-comparison c+a) - ProtocolSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - NilableSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - OrSpec (with-invert-comparison o+a) - UnorderedOrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - AndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - UnorderedAndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - Expression incomparable} - UnorderedAndSpec - {InferSpec (ufn/fn' -1) - ValueSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - ClassSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - ProtocolSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - NilableSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - OrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - UnorderedOrSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - AndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - UnorderedAndSpec (fn [s0 s1] (err! "TODO dispatch" {:s0 s0 :s1 s1})) - Expression incomparable} - Expression - {InferSpec (ufn/fn' -1) - ValueSpec incomparable - ClassSpec incomparable - ProtocolSpec incomparable - NilableSpec incomparable - OrSpec incomparable - UnorderedOrSpec incomparable - AndSpec incomparable - UnorderedAndSpec incomparable - Expression e+e}})) - -;; ===== PRIMITIVES ===== ;; - - (-def boolean? #?(:clj Boolean :cljs js/Boolean)) - (-def ?boolean? (? boolean?)) - -#?(:clj (-def byte? Byte)) -#?(:clj (-def ?byte? (? byte?))) - -#?(:clj (-def char? Character)) -#?(:clj (-def ?char? (? char?))) - -#?(:clj (-def short? Short)) -#?(:clj (-def ?short? (? short?))) - -#?(:clj (-def int? Integer)) -#?(:clj (-def ?int? (? int?))) - -#?(:clj (-def long? Long)) -#?(:clj (-def ?long? (? long?))) - -#?(:clj (-def float? Float)) -#?(:clj (-def ?float? (? float?))) - - (-def double? #?(:clj Double :cljs js/Number)) - (-def ?double? (? double?)) - - (-def primitive? (or boolean? #?@(:clj [byte? char? short? int? long? float?]) double?)) - -#_(:clj (-def comparable-primitive? (and primitive? (not boolean?)))) +(defns deducible-type? [x _] (instance? DeducibleType x)) +(defns deducible [x type? > deducible-type?] (DeducibleType. (atom x)))) +(defn ? + "Computes a type denoting a nilable value satisfying `t`." + ([t #_utr/type? #_> #_utr/type?] (or nil? t))) + +;; ===== `meta-or` ===== ;; + +(defns- with-expand-meta-ors [type-args (us/seq-of type?), f c/fn?] + (if-not (seq-or utr/meta-or-type? type-args) + (f type-args) + (->> type-args + (uc/map (fn [t] (if (utr/meta-or-type? t) + (utr/meta-or-type>types t) + [t]))) + (apply ucombo/cartesian-product) + (uc/map f) + meta-or))) + +(defns- meta-or|norx + [types (us/seq-of utr/type?) > utr/type?] + (let [types' (->> types uc/distinct (sort-by identity utcomp/compare) (uc/dedupe-by utcomp/=))] + (case (bounded-count 2 types') + 0 empty-set + 1 (first types') + (MetaOrType. uhash/default uhash/default nil nil types')))) + +(defns meta-or + "Essentially a combinatorial combinator: + + (t/or (t/meta-or [byte? short? char?]) string?) + -> (t/meta-or [(t/or byte? string?) + (t/or short? string?) + (t/or char? string?)])) + + - Commutative. + - Dedupes inputs that are either structurally `=` or `t/=`. + - Does not currently handle nested `meta-or`s." + > utr/type? + [types (us/seq-of utr/type?)] (separate-rx-and-apply meta-or|norx types)) + +;; ===== Etc. ===== ;; + +;; TODO figure out the best place to put this +#?(:clj +(def unboxed-class->boxed-class + {Boolean/TYPE Boolean + Byte/TYPE Byte + Short/TYPE Short + Character/TYPE Character + Integer/TYPE Integer + Long/TYPE Long + Float/TYPE Float + Double/TYPE Double})) + +#?(:clj (def boxed-class->unboxed-class (clojure.set/map-invert unboxed-class->boxed-class))) + +;; TODO figure out the best place to put this #?(:clj (def boxed-class->unboxed-symbol {Boolean 'boolean @@ -783,215 +781,280 @@ Float 'float Double 'double})) -(def ^{:doc "Could do /MAX_VALUE for the maxes in Java but JS doesn't like it of course - In JavaScript, all numbers are 64-bit floating point numbers. - This means you can't represent in JavaScript all the Java longs - Max 'safe' int: (dec (Math/pow 2 53))"} - unboxed-symbol->type-meta - {'boolean {:bits 1 - :min 0 - :max 1 - #?@(:clj [:array-ident "Z" - :outer-type "[Z" - :boxed java.lang.Boolean - :unboxed Boolean/TYPE])} - 'byte {:bits 8 - :min -128 - :max 127 - #?@(:clj [:array-ident "B" - :outer-type "[B" - :boxed java.lang.Byte - :unboxed Byte/TYPE])} - 'short {:bits 16 - :min -32768 - :max 32767 - #?@(:clj [:array-ident "S" - :outer-type "[S" - :boxed java.lang.Short - :unboxed Short/TYPE])} - 'char {:bits 16 - :min 0 - :max 65535 - #?@(:clj [:array-ident "C" - :outer-type "[C" - :boxed java.lang.Character - :unboxed Character/TYPE])} - 'int {:bits 32 - :min -2147483648 - :max 2147483647 - #?@(:clj [:array-ident "I" - :outer-type "[I" - :boxed java.lang.Integer - :unboxed Integer/TYPE])} - 'long {:bits 64 - :min -9223372036854775808 - :max 9223372036854775807 - #?@(:clj [:array-ident "J" - :outer-type "[J" - :boxed java.lang.Long - :unboxed Long/TYPE])} - ; Technically with floating-point nums, "min" isn't the most negative; - ; it's the smallest absolute - 'float {:bits 32 - :min-absolute 1.4E-45 - :min -3.4028235E38 - :max 3.4028235E38 - :min-int -16777216 ; -2^24 - :max-int 16777216 ; 2^24 - #?@(:clj [:array-ident "F" - :outer-type "[F" - :boxed java.lang.Float - :unboxed Float/TYPE])} - 'double {:bits 64 - ; Because: - ; Double/MIN_VALUE = 4.9E-324 - ; (.-MIN_VALUE js/Number) = 5e-324 - :min-absolute #?(:clj Double/MIN_VALUE - :cljs (.-MIN_VALUE js/Number)) - :min -1.7976931348623157E308 - :max 1.7976931348623157E308 ; Max number in JS - :min-int -9007199254740992 ; -2^53 - :max-int 9007199254740992 ; 2^53 - #?@(:clj [:array-ident "D" - :outer-type "[D" - :boxed java.lang.Double - :unboxed Double/TYPE])}}) - -#?(:clj (def primitive-classes (->> unboxed-symbol->type-meta vals (map+ :unboxed) (join #{})))) - -(defn- -spec>class [spec spec-nilable?] - (cond (class-spec? spec) - {:class (class-spec>class spec) :nilable? spec-nilable?} - (value-spec? spec) - (let [v (value-spec>value spec)] - {:class (type v) :nilable? spec-nilable?}) - (c/and (nilable-spec? spec) (c/not spec-nilable?)) - (recur (nilable-spec>inner-spec spec) true) +(uvar/defalias utdef/unboxed-symbol->type-meta) + +;; TODO figure out the best place to put this +#?(:clj (def primitive-classes (->> unboxed-symbol->type-meta vals (uc/map+ :unboxed) (join #{})))) + +(defns- -type>classes + [t utr/type?, include-classes-of-value-type? c/boolean?, classes c/set? + > (us/set-of (us/nilable #?(:clj c/class? :cljs c/fn?)))] + (cond (utr/meta-type? t) + (recur (utr/meta-type>inner-type t) include-classes-of-value-type? classes) + (utr/class-type? t) + (conj classes (utr/class-type>class t)) + (utr/protocol-type? t) + ;; probably better than specifying *all* implementing classes + (conj classes (-> t utr/protocol-type>protocol :on-interface) Object) + (utr/value-type? t) + (cond-> classes + include-classes-of-value-type? (conj (-> t utr/value-type>value c/type))) + (c/= t universal-set) + #?(:clj (conj classes nil java.lang.Object) + :cljs (TODO "Not sure what to do in the case of universal CLJS set")) + (c/= t empty-set) + classes + (utr/and-type? t) + (reduce (c/fn [classes' t'] (-type>classes t' include-classes-of-value-type? classes')) + classes (utr/and-type>args t)) + (utr/or-type? t) + (reduce (c/fn [classes' t'] (-type>classes t' include-classes-of-value-type? classes')) + classes (utr/or-type>args t)) + (utr/fn-type? t) + (conj classes TypedFn) + (c/= t val?) ; TODO make this less ad-hoc + (-type>classes val|by-class? include-classes-of-value-type? classes) :else - (err! "Don't know how to handle spec" spec))) - -(defn spec>class - "Outputs the single class embodied by ->`spec`. - Outputs `{:class :nilable? }` if the spec embodies only one (possibly nilable) class. - Outputs `{:class nil :nilable? true }` if the spec embodies the value `nil`. - Outputs `{:class ::multiple :nilable? nil }` if the spec embodies multiple classes." - [spec] (-spec>class spec false)) - -(defn- -spec>classes [spec classes] - (cond (class-spec? spec) - (conj classes (class-spec>class spec)) - (value-spec? spec) - (conj classes (value-spec>value spec)) - (nilable-spec? spec) - (recur (nilable-spec>inner-spec spec) classes) - (and-spec? spec) - (reduce (fn [classes' spec'] (-spec>classes spec' classes')) - classes (and-spec>args spec)) - (or-spec? spec) - (reduce (fn [classes' spec'] (-spec>classes spec' classes')) - classes (or-spec>args spec)) - :else - (err! "Not sure how to handle spec"))) + (err! "Not sure how to handle type" t))) -(defn spec>classes - "Outputs the set of all the classes ->`spec` can embody according to its various conditional branches, - if any. Ignores nils, treating in Clojure simply as a `java.lang.Object`." - [spec] (-spec>classes spec #{})) +(defns type>classes + "Outputs the set of all the classes ->`t` can embody, possibly including nil." + ([t utr/type? > (us/set-of (us/nilable #?(:clj c/class? :cljs c/fn?)))] (type>classes t true)) + ([t utr/type?, include-classes-of-value-type? c/boolean? + > (us/set-of (us/nilable #?(:clj c/class? :cljs c/fn?)))] + (-type>classes t include-classes-of-value-type? #{}))) +;; TODO move #?(:clj -(defn- -spec>?class-value [spec spec-nilable?] - (cond (value-spec? spec) - (let [v (value-spec>value spec)] - (when (c/class? v) {:class v :nilable? spec-nilable?})) - (c/and (nilable-spec? spec) (c/not spec-nilable?)) - (recur (nilable-spec>inner-spec spec) true) - :else nil))) +(defns class>boxed-subclasses+ [c (us/nilable c/class?) #_> #_(educer-of c/class?)] + (when (some? c) + (->> boxed-class->unboxed-class + uc/keys+ + (uc/filter+ (fn [^Class uc] (.isAssignableFrom ^Class c uc))))))) +;; TODO move #?(:clj -(defn spec>?class-value - "Outputs the single class value embodied by ->`spec`. - Differs from `spec>class` in that if a spec is a extensionally equal of the *value* of a class, - outputs that class. - - However, if a spec does not embody the value of a class but rather merely embodies (as all specs) - an extensional subset of the set of all objects conforming to a class, outputs nil." - {:examples `{(spec>?class-value (value String)) {:class String :nilable? false} - (spec>?class-value (isa? String)) nil}} - [spec] (-spec>?class-value spec false))) - -;; ===== GENERAL ===== ;; - - (-def object? #?(:clj java.lang.Object :cljs js/Object)) - - (-def any? (? (or object? #?@(:cljs [js/String js/Symbol])))) - -;; ===== META ===== ;; - -#?(:clj (-def class? (isa? java.lang.Class))) -#?(:clj (-def primitive-class? (fn [x] (c/and (class? x) (.isPrimitive ^Class x))))) -#?(:clj (-def protocol? (>expr (ufn/fn-> :on-interface class?)))) - -;; ===== NUMBERS ===== ;; +(defns class>most-primitive-class + "Unboxes the class if possible." + [c (us/nilable c/class?) > (us/nilable c/class?)] + (c/or (boxed-class->unboxed-class c) c))) - (-def bigint? (or #?@(:clj [clojure.lang.BigInt java.math.BigInteger] - :cljs [com.gfredericks.goog.math.Integer]))) - (-def integer? (or #?@(:clj [byte? short? int? long?]) bigint?)) - -#?(:clj (-def bigdec? java.math.BigDecimal)) ; TODO CLJS may have this - - (-def decimal? (or #?@(:clj [float?]) double? #?(:clj bigdec?))) - - (-def ratio? #?(:clj clojure.lang.Ratio - :cljs quantum.core.numeric.types.Ratio)) ; TODO add this CLJS entry to the predicate after the fact - -#?(:clj (-def primitive-number? (or short? int? long? float? double?))) - - (-def number? (or #?@(:clj [Number] - :cljs [integer? decimal? ratio?]))) - -;; ----- NUMBER LIKENESSES ----- ;; +#?(:clj +(defns type>most-primitive-classes + "The same as `type>classes` except unboxes all possible classes. + Distinct from primitive-expansion / primitivization." + [t type? > (us/set-of (us/nilable c/class?))] + (let [cs (type>classes t)] + (if (c/or (contains? cs nil) (type-ref? t)) + cs + (->> cs (uc/map+ class>most-primitive-class) (ur/join #{})))))) - (-def integer-value? (or integer? (and decimal? (>expr unum/integer-value?)))) +#?(:clj +(defns type>primitive-subtypes + ([t type? > (us/set-of type?)] (type>primitive-subtypes t true)) + ([t type?, include-subtypes-of-value-type? c/boolean? > (us/set-of type?)] + (if (type-ref? t) + #{} + (->> (type>classes t include-subtypes-of-value-type?) + (uc/mapcat+ class>boxed-subclasses+) + uc/distinct+ + (uc/map+ maybe-look-up-type-from-class) + (ur/join #{})))))) - #_(-def numeric-primitive? (and primitive? (not boolean?))) +#?(:clj +(defns primitive-type? [t type? > c/boolean?] + (c/and (-> t type-ref? c/not) + (let [cs (type>classes t)] + (c/and (-> cs count (c/= 1)) + (contains? boxed-class->unboxed-symbol (first cs))))))) - (-def numerically-byte? (and integer-value? (>expr (fn [x] (c/<= -128 x 127))))) - (-def numerically-short? (and integer-value? (>expr (fn [x] (c/<= -32768 x 32767))))) - (-def numerically-char? (and integer-value? (>expr (fn [x] (c/<= 0 x 65535))))) - (-def numerically-unsigned-short? numerically-char?) - (-def numerically-int? (and integer-value? (>expr (fn [x] (c/<= -2147483648 x 2147483647))))) - (-def numerically-long? (and integer-value? (>expr (fn [x] (c/<= -9223372036854775808 x 9223372036854775807))))) - (-def numerically-float? (and number? - (>expr (fn [x] (c/<= -3.4028235E38 x 3.4028235E38))) - (>expr (fn [x] (-> x #?(:clj clojure.lang.RT/floatCast :cljs c/float) (c/== x)))))) - #_(-def numerically-double? (and number? - (>expr (fn [x] (c/<= -1.7976931348623157E308 x 1.7976931348623157E308))) - (>expr (fn [x] (-> x clojure.lang.RT/doubleCast (c/== x)))))) +#?(:clj +(defns- -type>?class-value [t utr/type?, type-nilable? c/boolean?] + (if (utr/value-type? t) + (let [v (utr/value-type>value t)] + (when (c/class? v) {:class v :nilable? type-nilable?})) + nil))) - (-def int-like? (and integer-value? numerically-int?)) +#?(:clj +(defns type>?class-value + "Outputs the single class value embodied by ->`t`. + If a type is extensionally equal the *value* of a class, outputs that class. -(defn numerically - [spec] - (assert (instance? ClassSpec spec)) - (let [c (.-c ^ClassSpec spec)] - (case (.getName ^Class c) - "java.lang.Byte" numerically-byte? - "java.lang.Short" numerically-short? - "java.lang.Character" numerically-char? - "java.lang.Integer" numerically-int? - "java.lang.Long" numerically-long? - "java.lang.Float" numerically-float? - ;; TODO fix - ;;"java.lang.Double" numerically-double? - (err! "Could not find numerical range spec for class" {:c c})))) + However, if a type does not embody the value of a class but rather merely embodies (as all types) + an extensional subset of the set of all objects conforming to a class, outputs nil." + {:examples `{(type>?class-value (value String)) {:class String :nilable? false} + (type>?class-value (isa? String)) nil}} + [t utr/type?] (-type>?class-value t false))) + +;; ===== Validation and Conformance ===== ;; + +(defns validate [x _ t utr/type?] + (if-let [valid? (t x)] + x + (err! "Type-validation failed" {:type t :to-validate x}))) + +;; ---------------------- ;; +;; ===== Predicates ===== ;; +;; ---------------------- ;; + +;; ===== General ===== ;; + + (def* none? empty-set) + (def* any? universal-set) + + ;; TODO this is incomplete for CLJS base classes + ;; TODO is this necessary? + (def* val|by-class? (or object? #?@(:cljs [(isa? js/String) (isa? js/Symbol)]))) + (def* val? (not nil?)) + + (def* ref? (ref any?)) + +;; ===== Meta ===== ;; + + ;; TODO probably move, but this is used by `quantum.untyped.core.type` etc. +#?(:clj (def* primitive-class? (or (value Boolean/TYPE) + (value Byte/TYPE) + (value Character/TYPE) + (value Short/TYPE) + (value Integer/TYPE) + (value Long/TYPE) + (value Float/TYPE) + (value Double/TYPE)))) + +;; ===== Primitives ===== ;; +;; NOTE these are kept here because they're used in both type analysis and various test namespaces + + (def* boolean? (isa? #?(:clj Boolean :cljs js/Boolean))) +#?(:clj (def* byte? (isa? Byte))) +#?(:clj (def* char? (isa? Character))) +#?(:clj (def* short? (isa? Short))) +#?(:clj (def* int? (isa? Integer))) ; only primitive int, not goog.math.Integer +#?(:clj (def* long? (isa? Long))) ; only primitive long, not goog.math.Long +#?(:clj (def* float? (isa? Float))) + (def* double? (isa? #?(:clj Double :cljs js/Number))) + + ;; These are special for CLJS protocols + ;; Possibly planned to be used by `quantum.untyped.core.analyze` +#?(:cljs (def* native? (or (isa? js/Boolean) + (isa? js/Number) + (isa? js/Object) + (isa? js/Array) + (isa? js/String) + (isa? js/Function) + nil?))) -#?(:clj (-def char-seq? java.lang.CharSequence)) -#?(:clj (-def comparable? java.lang.Comparable)) - (-def string? #?(:clj java.lang.String :cljs js/String)) - (-def keyword? #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword)) - (-def symbol? #?(:clj clojure.lang.Symbol :cljs cljs.core/Symbol)) -#?(:clj (-def tagged-literal? clojure.lang.TaggedLiteral)) +#?(:clj +(defns maybe-look-up-type-from-class + "To save on memory — rather than creating a new `t/isa?` for every primitive class, uses the ones + already created in `quantum.untyped.core.type`." + [^Class c c/class? > utr/type?] + (case (.getName c) + "java.lang.Boolean" boolean? + "java.lang.Byte" byte? + "java.lang.Short" short? + "java.lang.Character" char? + "java.lang.Integer" int? + "java.lang.Long" long? + "java.lang.Float" float? + "java.lang.Double" double? + (isa? c)))) + +;; ===== Booleans ===== ;; + +;; Used by `quantum.untyped.core.analyze` +(def* true? (value true)) +(def* false? (value false)) + +;; ========== Collections ========== ;; + +;; Possibly planned to be used by `quantum.untyped.core.analyze` +(def* +list|built-in? + (or (isa? #?(:clj clojure.lang.PersistentList$EmptyList :cljs cljs.core/EmptyList)) + (isa? #?(:clj clojure.lang.PersistentList :cljs cljs.core/List)))) + +;; Used by `quantum.untyped.core.analyze` +(def* +vector|built-in? + (isa? #?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector))) + +;; Used by `quantum.untyped.core.analyze` +(def* +unordered-map|built-in? + (or (isa? #?(:clj clojure.lang.PersistentHashMap :cljs cljs.core/PersistentHashMap)) + (isa? #?(:clj clojure.lang.PersistentArrayMap :cljs cljs.core/PersistentArrayMap)))) + +;; Used by `quantum.untyped.core.analyze` +(def* +map|built-in? + (or +unordered-map|built-in? + (isa? #?(:clj clojure.lang.PersistentTreeMap :cljs cljs.core/PersistentTreeMap)))) + +;; Used by `quantum.untyped.core.analyze` +(def* +unordered-set|built-in? + (isa? #?(:clj clojure.lang.PersistentHashSet :cljs cljs.core/PersistentHashSet))) + +;; Used by `quantum.untyped.core.analyze` +(def* +set|built-in? + (or +unordered-set|built-in? + (isa? #?(:clj clojure.lang.PersistentTreeSet :cljs cljs.core/PersistentTreeSet)))) + +;; ===== Functions ===== ;; + +;; Used by `quantum.untyped.core.analyze` +(def* fn? #?(:clj (isa? clojure.lang.Fn) + :cljs (or (isa? js/Function) (isa? cljs.core/Fn)))) + +;; Used by `quantum.untyped.core.analyze` via `t/callable?` +(uvar/def ifn? + "Note that in CLJS, `cljs.core/ifn?` checks if something is either `fn?` or if it satisfies + `cljs.core/IFn`. By contrast, this type encompasses only direct implementers of `cljs.core/IFn`." + (isa?|direct #?(:clj clojure.lang.IFn :cljs cljs.core/IFn))) + +;; Used by `quantum.untyped.core.analyze` via `t/callable?` +(def* fnt? (and fn? (>expr (fn-> c/meta :quantum.core.type/type type?)))) + +;; TODO should we allow java.lang.Runnable, java.util.concurrent.Callable, and other +;; functional interfaces to be `callable?`? +;; Used by `quantum.untyped.core.analyze` +(uvar/def callable? + "The set of all objects that are able to called/invoked by being in functor position + (first element of an unquoted list) within a typed context." + (or fn? ifn? fnt?)) + +;; ===== Metadata ===== ;; + +;; Used by `quantum.untyped.core.analyze.ast` +(def* with-metable? (isa? #?(:clj clojure.lang.IObj :cljs cljs.core/IWithMeta))) + +;; ===== Errors ===== ;; + +;; Used by `quantum.untyped.core.analyze` +(def* throwable? "Able to be used with `throw`" #?(:clj (isa? java.lang.Throwable) :cljs any?)) + +;; ===== Literals ===== ;; + +;; Used by `quantum.untyped.core.analyze`, including via `t/literal?` +(def* regex? (isa? #?(:clj java.util.regex.Pattern :cljs js/RegExp))) + +;; Used by `quantum.untyped.core.analyze`, including via `t/literal?` +(def* keyword? (isa? #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword))) + +;; Used by `quantum.untyped.core.analyze` via `t/literal?` +(def* string? (isa? #?(:clj java.lang.String :cljs js/String))) + +;; Used by `quantum.untyped.core.analyze` via `t/literal?` +(def* symbol? (isa? #?(:clj clojure.lang.Symbol :cljs cljs.core/Symbol))) + + ;; Used by `quantum.untyped.core.analyze` via `t/literal?` +#?(:clj (def* tagged-literal? (isa? clojure.lang.TaggedLiteral))) + +;; Used by `quantum.untyped.core.analyze` +(def* literal? + (or nil? boolean? char? string? symbol? keyword? + ;; These primitives are allowed even though macros emit them incorrectly, because they're + ;; converted via `>form` during analysis + #?(:clj byte?) #?(:clj short?) #?(:clj int?) #?(:clj float?) + #?(:clj long?) double? #?(:clj (isa? clojure.lang.BigInt)) #?(:clj (isa? BigDecimal)) + regex? #?(:clj tagged-literal?))) - (-def literal? (or nil? boolean? symbol? keyword? string? #?(:clj long?) double? #?(:clj tagged-literal?))) -#_(t/def ::form (t/or ::literal t/list? t/vector? ...)) -) +;; TODO this might not be right — quite possibly any seq is a valid form +;; TODO this has to be recursively true for seq, vector, map, and set +;; Possibly planned to be used by `quantum.untyped.core.analyze` +#_(def form? (or literal? +list|built-in? +vector|built-in? +map|built-in? +set|built-in?)) diff --git a/src-untyped/quantum/untyped/core/type/compare.cljc b/src-untyped/quantum/untyped/core/type/compare.cljc new file mode 100644 index 00000000..748b2778 --- /dev/null +++ b/src-untyped/quantum/untyped/core/type/compare.cljc @@ -0,0 +1,840 @@ +(ns quantum.untyped.core.type.compare + "Set-theoretic comparisons on types (subset, equality, superset, intersection, disjointness)." + (:refer-clojure :exclude + [compare < <= = not= >= >, ==]) + (:require + [clojure.core :as c] + [quantum.untyped.core.analyze.expr + #?@(:cljs [:refer [Expression]])] + [quantum.untyped.core.collections.logic + :refer [seq-and seq-or]] + ;; TODO remove this dependency + [quantum.untyped.core.classes :as uclass] + [quantum.untyped.core.collections :as uc] + [quantum.untyped.core.compare :as ucomp + :refer [==]] + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.data.bits :as ubit] + [quantum.untyped.core.data.hash :as uhash] + [quantum.untyped.core.data.set :as uset + :refer [ident >ident comparison?]] + [quantum.untyped.core.defnt + :refer [defns defns-]] + [quantum.untyped.core.error + :refer [err! TODO]] + [quantum.untyped.core.fn + :refer [fn' fn1]] + [quantum.untyped.core.logic + :refer [case-val ifs]] + [quantum.untyped.core.reducers + :refer [educe]] + [quantum.untyped.core.spec :as us] + ;; TODO remove this dependency + [quantum.untyped.core.type.core :as utcore] + [quantum.untyped.core.type.reifications :as utr + :refer [type? + universal-set empty-set + not-type? or-type? and-type? + protocol-type? class-type? + value-type? + fn-type? + #?@(:cljs [UniversalSetType EmptySetType + NotType OrType AndType + ProtocolType DirectProtocolType ClassType + UnorderedType OrderedType + ValueType + FnType + MetaType MetaOrType + ReactiveType])]] + [quantum.untyped.core.vars + :refer [def-]]) + #?(:clj (:import + [quantum.untyped.core.analyze.expr Expression] + [quantum.untyped.core.type.reifications + UniversalSetType EmptySetType + NotType OrType AndType + ProtocolType ClassType + UnorderedType OrderedType + ValueType + FnType + MetaType MetaOrType + ReactiveType]))) + +(ucore/log-this-ns) + +(declare compare < <= = not= >= > >< <> combine-comparisons) + +(def inverted (fn [f] (fn [t0 t1] (uset/invert-comparison (f t1 t0))))) + +;; ===== (Comparison) idents and bit-sets ===== ;; + +(def- fn< (fn' (fn' >ident)) +(def- fn>< (fn' > (fn' <>ident)) + +(def b< (reduce ubit/conj ubit/empty [< (reduce ubit/conj ubit/empty [<|<> (reduce ubit/conj ubit/empty [ident])) +(def b<|<> (reduce ubit/conj ubit/empty [ident])) +(def b=|>< (reduce ubit/conj ubit/empty [=ident ><|<> (reduce ubit/conj ubit/empty [=ident >ident])) +(def b=|<> (reduce ubit/conj ubit/empty [=ident <>ident])) +(def b> (reduce ubit/conj ubit/empty [>ident])) +(def b>|>< (reduce ubit/conj ubit/empty [>ident >|><|<> (reduce ubit/conj ubit/empty [>ident >ident])) +(def b>|<> (reduce ubit/conj ubit/empty [>ident <>ident])) +(def b>< (reduce ubit/conj ubit/empty [><|<> (reduce ubit/conj ubit/empty [>ident])) +(def b<> (reduce ubit/conj ubit/empty [<>ident])) + +(defn bit-set>set [x] + (cond-> #{} + (ubit/contains? x ident) (conj >ident) + (ubit/contains? x >ident) (conj <>ident))) + +(defn- comparison-err! [t0+t1 t1+t0] + (err! "comparison not thought through yet" + {:t0+t1 (bit-set>set t0+t1) :t1+t0 (bit-set>set t1+t0)})) + +;; ===== Comparison Implementations ===== ;; + +(defns- compare|todo [t0 type?, t1 type?] + (err! "TODO dispatch" {:t0 t0 :t0|class (type t0) + :t1 t1 :t1|class (type t1)})) + +;; ----- Multiple ----- ;; + +(defns- compare|atomic+or [t0 type?, ^OrType t1 or-type? > comparison?] + (first + (reduce + (fn [[ret found] t] + (let [c (compare t0 t) + found' (-> found (ubit/conj c) long)] + (ifs (or (ubit/contains? found' ident) + (ubit/contains? found' <>ident))) + [>ident ubit/empty] + (.-args t1)))) + +(defns- compare|atomic+and [t0 type?, ^AndType t1 and-type? > comparison?] + (let [ts (.-args t1)] + (first + (reduce + (fn [[ret found] t] + (let [c (compare t0 t)] + (if (or (c/= c =ident) (c/= c >ident)) + (reduced [>ident nil]) + (let [found' (-> found (ubit/conj c) long) + ret' (ifs (ubit/contains? found' >ident)) <>ident >ident) + (if (ubit/contains? found' ident c) + c)] + [ret' found'])))) + [<>ident ubit/empty] + ts)))) + +(defns- compare|value+type [t0 utr/value-type?, t1 type? > comparison?] + (if (t1 (utr/value-type>value t0)) ident)) + +(defns- compare|meta+non-meta [t0 utr/meta-type?, t1 type? > comparison?] + (compare (utr/meta-type>inner-type t0) t1)) + +(defns- compare|non-meta+meta [t0 type?, t1 utr/meta-type? > comparison?] + (compare t0 (utr/meta-type>inner-type t1))) + +;; ----- UniversalSet ----- ;; + +(def- compare|universal+universal fn=) +(def- compare|universal+empty fn>) + +(defns- compare|universal+not [t0 type?, t1 not-type? > comparison?] + (let [t1|inner (utr/not-type>inner-type t1)] + (ifs (= t1|inner universal-set) >ident + (= t1|inner empty-set) =ident + (compare t0 t1|inner)))) + +(def- compare|universal+or fn>) +(def- compare|universal+and fn>) +(def- compare|universal+expr compare|todo) +(def- compare|universal+protocol fn>) +(def- compare|universal+class fn>) +(def- compare|universal+fn fn>) +(def- compare|universal+unordered fn>) +(def- compare|universal+ordered fn>) +(def- compare|universal+value fn>) +(def- compare|universal+meta compare|non-meta+meta) + +;; ----- EmptySet ----- ;; + +(def- compare|empty+not fn<>) +(def- compare|empty+or fn<>) +(def- compare|empty+and fn<>) +(def- compare|empty+expr compare|todo) +(def- compare|empty+protocol fn<>) +(def- compare|empty+class fn<>) +(def- compare|empty+fn fn<>) +(def- compare|empty+unordered fn<>) +(def- compare|empty+ordered fn<>) +(def- compare|empty+value fn<>) +(def- compare|empty+meta compare|non-meta+meta) + +;; ----- NotType ----- ;; + +(defns- compare|not+atomic [t0 not-type?, t1 type? > comparison?] + (let [t0|inner (utr/not-type>inner-type t0)] + (if (= t0|inner empty-set) + >ident + (case (int (compare t0|inner t1)) + ( 1 0) <>ident + (-1 2) >ident)))) + +(defns- compare|not+not [t0 not-type?, t1 not-type? > comparison?] + (let [c (int (compare (utr/not-type>inner-type t0) (utr/not-type>inner-type t1)))] + (case-val c + =ident =ident + ident + >ident ident > comparison?] + (let [t0|inner (utr/not-type>inner-type t0)] + (if (= t0|inner empty-set) >ident <>ident))) + +(defns- compare|not+class [t0 not-type?, t1 class-type? > comparison?] + (compare|not+atomic t0 t1)) + +(def- compare|not+fn compare|not+atomic) +(def- compare|not+unordered compare|not+atomic) +(def- compare|not+ordered compare|not+atomic) + +(defns- compare|not+value [t0 not-type?, t1 value-type? > comparison?] + (let [t0|inner (utr/not-type>inner-type t0)] + (if (= t0|inner empty-set) + >ident + ;; nothing is ever < ValueType (and therefore never ><) + (case (int (compare t0|inner t1)) + (1 0) <>ident + 3 >ident)))) + +(def- compare|not+meta compare|non-meta+meta) + +;; ----- OrType ----- ;; + +;; TODO performance can be improved here by doing fewer comparisons +;; Possibly look at `quantum.untyped.core.type.defnt/compare-args-types` for reference? +;; Expected to handle possibly non-distinct types within `ts0` and `ts1` +;; TODO follow the example of `compare|or+and` +(defns- compare|or+or-like + [ts0 _, ts1 _, ts1 fn? > comparison?] + (let [l (->> ts0 (seq-and > ts1 (seq-and ident + (if (->> ts0 (seq-and <>ts1)) + <>ident + > comparison?] + (compare|or+or-like (.-args t0) (.-args t1) (fn1 < t0) (fn1 < t1) (fn1 <> t1))) + +(defns- compare|or+and [^OrType t0 or-type?, ^AndType t1 and-type? > comparison?] + (let [t0+t1 (->> t0 .-args (uc/map+ #(compare % t1)) (educe ubit/conj ubit/empty)) + t1+t0 (->> t1 .-args (uc/map+ #(compare % t0)) (educe ubit/conj ubit/empty))] + (case-val t0+t1 + (list b< b<|>< b<|><|<> b<|<> b=|>< b=|><|<> b=|<>) + (comparison-err! t0+t1 t1+t0) + b> (case-val t1+t0 + b< >ident + b<|>< >ident + (list b<|><|<> b<|<> b=|>< b=|><|<> b=|<> b> b>|>< b>|><|<> b>|<> b>< b><|<> b<>) + (comparison-err! t0+t1 t1+t0)) + b>|>< + (case-val t1+t0 + b< >ident + (list b<|>< b<|><|<> b<|<> b=|>< b=|><|<> b=|<> b> b>|>< b>|><|<> b>|<> b>< b><|<> b<>) + (comparison-err! t0+t1 t1+t0)) + b>|><|<> + (comparison-err! t0+t1 t1+t0) + b>|<> + (case-val t1+t0 + b< (comparison-err! t0+t1 t1+t0) + b<|>< >ident + (list b<|><|<> b<|<> b=|>< b=|><|<> b=|<> b> b>|>< b>|><|<> b>|<> b>< b><|<> b<>) + (comparison-err! t0+t1 t1+t0)) + b>< (case-val t1+t0 + (list b< b<|>< b<|><|<> b<|<> b=|>< b=|><|<> b=|<> b> b>|>< b>|><|<> b>|<>) + (comparison-err! t0+t1 t1+t0) + b>< ><|<> b<>) + (comparison-err! t0+t1 t1+t0)) + (list b><|<> b<>) + (comparison-err! t0+t1 t1+t0)))) + +(def- compare|or+protocol (inverted compare|atomic+or)) +(def- compare|or+class (inverted compare|atomic+or)) +(def- compare|or+fn (inverted compare|atomic+or)) +(def- compare|or+unordered (inverted compare|atomic+or)) +(def- compare|or+ordered (inverted compare|atomic+or)) +(def- compare|or+value (inverted compare|value+type)) +(def- compare|or+meta compare|non-meta+meta) + +;; ----- AndType ----- ;; + +(defns- compare|and+and [^AndType t0 and-type?, ^AndType t1 and-type? > comparison?] + (let [t0+t1 (->> t0 .-args (uc/map+ #(compare % t1)) (educe ubit/conj ubit/empty)) + t1+t0 (->> t1 .-args (uc/map+ #(compare % t0)) (educe ubit/conj ubit/empty))] + (case-val t0+t1 + (list b< b<|>< b<|><|<> b<|<> b=|>< b=|><|<> b=|<>) + (comparison-err! t0+t1 t1+t0) + b> (case-val t1+t0 + (list b< b<|>< b<|><|<> b<|<> b=|>< b=|><|<> b=|<>) (comparison-err! t0+t1 t1+t0) + b> =ident + b>|>< >ident + (list b>|><|<> b>|<> b>< b><|<> b<>) (comparison-err! t0+t1 t1+t0)) + b>|>< + (case-val t1+t0 + (list b< b<|>< b<|><|<> b<|<> b=|>< b=|><|<> b=|<>) (comparison-err! t0+t1 t1+t0) + b> |>< >|><|<> b>|<> b>< b><|<> b<>) (comparison-err! t0+t1 t1+t0)) + (list b>|><|<> b>|<> b>< b><|<> b<>) + (comparison-err! t0+t1 t1+t0)))) + +(def- compare|and+protocol (inverted compare|atomic+and)) +(def- compare|and+class (inverted compare|atomic+and)) +(def- compare|and+fn (inverted compare|atomic+and)) +(def- compare|and+unordered (inverted compare|atomic+and)) +(def- compare|and+ordered (inverted compare|atomic+and)) +(def- compare|and+value (inverted compare|value+type)) +(def- compare|and+meta compare|non-meta+meta) + +;; ----- Expression ----- ;; + +(defns- compare|expr+expr [t0 _, t1 _ > comparison?] (if (c/= t0 t1) =ident <>ident)) + +(def- compare|expr+value fn><) ; TODO not entirely true + +(def- compare|expr+meta compare|non-meta+meta) + +;; ----- ProtocolType ----- ;; +;; Protocols cannot extend protocols. +;; A protocol may be seen as `(->> p extenders (map >type) (apply t/or))`." + +(declare compare|class+class*) + +(defns- compare|or+or-via-class [cs0 _, cs1 _ > comparison?] + (if (empty? cs0) + (if (empty? cs1) =ident <>ident) + (if (empty? cs1) + <>ident + (let [gen-compare (fn [compare-comparison c cs] + (->> cs (uc/map+ (fn [c*] (compare|class+class* c c*))) + (seq-or compare-comparison))) + cs1 (fn [c] (gen-compare uset/comparison<> c cs1))] + (compare|or+or-like cs0 cs1 cs1))))) + +(defns- compare|protocol+protocol + [t0 protocol-type?, t1 protocol-type? > comparison?] + (let [p0 (utr/protocol-type>protocol t0) + p1 (utr/protocol-type>protocol t1)] + (if (== p0 p1) + =ident + ;; TODO use clojure.logic / match + #?(:clj (ifs (-> p0 :impls empty?) + (if (-> p1 :impls empty?) =ident <>ident) + (-> p1 :impls empty?) + <>ident + (-> p0 :impls (contains? Object)) + (if (-> p1 :impls (contains? Object)) + (if (-> p0 :impls (contains? nil)) + (if (-> p1 :impls (contains? nil)) =ident >ident) + (if (-> p1 :impls (contains? nil)) p0 :impls (contains? nil)) + >ident + (if (-> p1 :impls (contains? nil)) + (if (-> p1 :impls count (c/> 1)) >ident) + >ident))) + (-> p1 :impls (contains? Object)) + (if (-> p0 :impls (contains? nil)) + (if (-> p1 :impls (contains? nil)) + p0 :impls count (c/> 1)) >ident)) + p0 :impls (contains? nil)) + (if (-> p0 :impls count (c/> 1)) + (compare|or+or-via-class (extenders p0) (extenders p1)) + <>ident) + (-> p1 :impls (contains? nil)) + (if (-> p1 :impls count (c/> 1)) + (compare|or+or-via-class (extenders p0) (extenders p1)) + <>ident) + (compare|or+or-via-class (extenders p0) (extenders p1))) + ;; TODO CLJS — also incorporate `default` etc. + ;; Simplistic but we don't have safe insight into what has been extended vs. not + :cljs <>ident)))) + +(defns- compare|protocol+class [t0 protocol-type?, t1 class-type? > comparison?] + (let [p0 (utr/protocol-type>protocol t0) + c1 (utr/class-type>class t1)] + #?(:clj (if (-> p0 :on-interface (== c1)) + =ident + (compare|or+or-via-class (extenders p0) [c1])) + :cljs (TODO)))) + +(defns- compare|protocol+value [t0 protocol-type?, t1 value-type? > comparison?] + (uset/invert-comparison (compare|value+type t1 t0))) + +(def- compare|protocol+meta compare|non-meta+meta) + +;; ----- ClassType ----- ;; + +#?(:clj +(defns compare|class+class* + "Compare extension (generality|specificity) of ->`c0` to ->`c1`. + `0` means they are equally general/specific: + - ✓ `(t/= c0 c1)` : the extension of ->`c0` is equal to that of ->`c1`. + `-1` means ->`c0` is less general (more specific) than ->`c1`. + - ✓ `(t/< c0 c1)` : the extension of ->`c0` is a strict subset of that of ->`c1`. + `1` means ->`c0` is more general (less specific) than ->`c1`: + - ✓ `(t/> c0 c1)` : the extension of ->`c0` is a strict superset of that of ->`c1`. + `2` means: + - ✓ `(t/>< c0 c1)` : the intersect of the extensions of ->`c0` and ->`c1` is non-empty, + but neither ->`c0` nor ->`c1` share a subset/equality/superset + relationship. + `3` means their generality/specificity is incomparable: + - ✓ `(t/<> c0 c1)` : the extension of ->`c0` is disjoint w.r.t. to that of ->`c1`. + Unboxed primitives are considered to be less general (more specific) than boxed primitives." + [^Class c0 (us/nilable class?) ^Class c1 (us/nilable class?) > comparison?] + (ifs (== c0 c1) =ident + (or (nil? c0) (nil? c1)) <>ident + (== c0 Object) >ident + (== c1 Object) unboxed c0) c1) >ident + (== c0 (utcore/boxed->unboxed c1)) ident + (.isAssignableFrom c0 c1) >ident + (.isAssignableFrom c1 c0) ident))) + +(defns- compare|class+class [t0 class-type?, t1 class-type? > comparison?] + #?(:clj (compare|class+class* (utr/class-type>class t0) (utr/class-type>class t1)) + :cljs (TODO))) + +;; This is used to make comparisons work with `UnorderedType` and `OrderedType`. +;; TODO we should not be using `seqable?` but rather `(t/input reduce :_ :_ :?)`. See also the +;; implementations of `UnorderedType` and `OrderedType`. +(def- seqable-except-array? + (OrType. + uhash/default uhash/default nil `seqable-except-array? + [#?(:clj (ClassType. uhash/default uhash/default nil nil clojure.lang.ISeq)) + #?(:clj (ClassType. uhash/default uhash/default nil nil clojure.lang.Seqable) + :cljs (ProtocolType. uhash/default uhash/default nil nil cljs.core/ISeqable)) + #?(:clj (ClassType. uhash/default uhash/default nil nil java.lang.Iterable)) + #_array? ; TODO handle later + (ClassType. uhash/default uhash/default nil nil #?(:clj java.lang.String :cljs js/String)) + #?(:clj (ClassType. uhash/default uhash/default nil nil java.util.Map))] + (atom nil))) + +(defns- compare|class+finite + [t0 class-type?, t1 _ #_(t/or unordered-type? ordered-type?) > comparison?] + ;; TODO technically we need to have it satisfy `dc/reducible?`, not merely `c/seqable?` + ;; — see also note in UnorderedType's implementation about this + (case (int (compare t0 seqable-except-array?)) + ;; `(combine-comparisons ident)` + ;; t/< w.r.t. seqable; t/> w.r.t contents (TODO unless contents have restrictions) + -1 >ident)` + ;; t/= w.r.t. seqable; t/> w.r.t contents (TODO unless contents have restrictions) + 0 ident >ident)` + ;; t/> w.r.t. seqable; t/> w.r.t contents (TODO unless contents have restrictions) + 1 >ident + ;; `(combine-comparisons >< w.r.t. seqable; t/>< w.r.t contents (TODO unless contents have restrictions) + 2 >ident <>ident)` + ;; t/<> w.r.t. seqable; t/<> w.r.t contents + 3 <>ident)) + +(defns- compare|class+unordered [t0 class-type?, t1 utr/unordered-type? > comparison?] + (compare|class+finite t0 t1)) + +(defns- compare|class+ordered [t0 class-type?, t1 utr/ordered-type? > comparison?] + (compare|class+finite t0 t1)) + +(defns- compare|class+value [t0 class-type?, t1 value-type? > comparison?] + (let [c (utr/class-type>class t0) + v (utr/value-type>value t1)] + (if (instance? c v) >ident <>ident))) + +(def- compare|class+meta compare|non-meta+meta) + +;; ----- FnType ----- ;; + +(defns compare|in [t0 utr/fn-type?, t1 utr/fn-type? > comparison?] + (let [ct->overloads|t0 (utr/fn-type>arities t0) + ct->overloads|t1 (utr/fn-type>arities t1) + cts-only-in-t0 (uset/- (-> ct->overloads|t0 keys set) (-> ct->overloads|t1 keys set)) + cts-only-in-t1 (uset/- (-> ct->overloads|t1 keys set) (-> ct->overloads|t0 keys set)) + comparison|cts (uset/compare cts-only-in-t0 cts-only-in-t1) + cts-in-both (->> ct->overloads|t0 keys (filter ct->overloads|t1))] + (combine-comparisons + comparison|cts + (->> cts-in-both + (map (c/fn [ct] + (if (zero? ct) + 0 + (combine-comparisons + (uc/lmap compare + (-> t0 utr/fn-type>ored-input-types (get ct)) + (-> t1 utr/fn-type>ored-input-types (get ct))))))) + combine-comparisons)))) + +(defns compare|out [t0 utr/fn-type?, t1 utr/fn-type? > comparison?] + (compare (utr/fn-type>ored-output-type t0) (utr/fn-type>ored-output-type t1))) + +(defns- compare|fn+fn [t0 utr/fn-type?, t1 utr/fn-type? > comparison?] + (combine-comparisons (compare|in t0 t1) (compare|out t0 t1))) + +(def- compare|fn+meta compare|non-meta+meta) + +;; ----- UnorderedType ----- ;; + +(def- compare|unordered+value (inverted compare|value+type)) +(def- compare|unordered+meta compare|non-meta+meta) + +;; ----- OrderedType ----- ;; + +(def- compare|ordered+value (inverted compare|value+type)) +(def- compare|ordered+meta compare|non-meta+meta) + +;; ----- ValueType ----- ;; + +(defns- compare|value+value + "What we'd really like is to have a different version of .equals or .equiv + like .equivBehavior in which it returns whether any behavior is different + whatsoever between two objects. For instance, `[52]` behaves differently from + `(list 52)` because `(get [52] 0)` -> `52` while `(get (list 52) 0)` -> `nil`. + + The issue with this is that yes, one could implement a `strict=` that tries to + emulate this behavior, but even though it is implementable for 'transparent' + objects such as collections, it is not for 'opaque' objects, which would + potentially have to have custom equality behavior per class. So we will simply + reluctantly accept whatever `=` tells us as well as the fallout that results. + Thus, `(t/or (t/value []) (t/value (list)))` will result in `(t/value [])`, + which is not ideal but both feasible and better than the alternative." + [t0 value-type?, t1 value-type? > comparison?] + (if (c/= (utr/value-type>value t0) + (utr/value-type>value t1)) + =ident + <>ident)) + +(def- compare|value+meta compare|non-meta+meta) + +;; ----- MetaType ----- ;; + +(defns- compare|meta+meta [t0 utr/meta-type?, t1 utr/meta-type?] + (compare (utr/meta-type>inner-type t0) (utr/meta-type>inner-type t1))) + +;; ===== Dispatch ===== ;; + +(def- compare|dispatch + {UniversalSetType + {UniversalSetType compare|universal+universal + EmptySetType compare|universal+empty + NotType compare|universal+not + OrType compare|universal+or + AndType compare|universal+and + Expression compare|universal+expr + ProtocolType compare|universal+protocol + ClassType compare|universal+class + FnType compare|universal+fn + UnorderedType compare|universal+unordered + OrderedType compare|universal+ordered + ValueType compare|universal+value + MetaType compare|universal+meta} + EmptySetType + {UniversalSetType (inverted compare|universal+empty) + EmptySetType fn= + NotType compare|empty+not + OrType compare|empty+or + AndType compare|empty+and + Expression compare|empty+expr + ProtocolType compare|empty+protocol + ClassType compare|empty+class + FnType compare|empty+fn + UnorderedType compare|empty+unordered + OrderedType compare|empty+ordered + ValueType compare|empty+value + MetaType compare|empty+meta} + NotType + {UniversalSetType (inverted compare|universal+not) + EmptySetType (inverted compare|empty+not) + NotType compare|not+not + OrType compare|not+or + AndType compare|not+and + Expression fn>< ; TODO not entirely true + ProtocolType compare|not+protocol + ClassType compare|not+class + FnType compare|not+fn + UnorderedType compare|not+unordered + OrderedType compare|not+ordered + ValueType compare|not+value + MetaType compare|not+meta} + OrType + {UniversalSetType (inverted compare|universal+or) + EmptySetType (inverted compare|empty+or) + NotType (inverted compare|not+or) + OrType compare|or+or + AndType compare|or+and + Expression fn>< ; TODO not entirely true + ProtocolType compare|or+protocol + ClassType compare|or+class + FnType compare|or+fn + UnorderedType compare|or+unordered + OrderedType compare|or+ordered + ValueType compare|or+value + MetaType compare|or+meta} + AndType + {UniversalSetType (inverted compare|universal+and) + EmptySetType (inverted compare|empty+and) + NotType compare|todo + OrType (inverted compare|or+and) + AndType compare|and+and + Expression fn>< ; TODO not entirely true + ProtocolType compare|and+protocol + ClassType compare|and+class + FnType compare|and+fn + UnorderedType compare|and+unordered + OrderedType compare|and+ordered + ValueType compare|and+value + MetaType compare|and+meta} + ;; TODO review this + Expression + {UniversalSetType (inverted compare|universal+expr) + EmptySetType (inverted compare|empty+expr) + NotType fn>< ; TODO not entirely true + OrType fn>< ; TODO not entirely true + AndType fn>< ; TODO not entirely true + Expression compare|expr+expr + ProtocolType fn>< ; TODO not entirely true + ClassType fn>< ; TODO not entirely true + FnType compare|todo + UnorderedType fn>< ; TODO not entirely true + OrderedType fn>< ; TODO not entirely true + ValueType compare|expr+value + MetaType compare|expr+meta} + ProtocolType + {UniversalSetType (inverted compare|universal+protocol) + EmptySetType (inverted compare|empty+protocol) + NotType (inverted compare|not+protocol) + OrType (inverted compare|or+protocol) + AndType (inverted compare|and+protocol) + Expression fn>< ; TODO not entirely true + ProtocolType compare|protocol+protocol + ClassType compare|protocol+class + FnType fn>< + UnorderedType compare|todo + OrderedType compare|todo + ValueType compare|protocol+value + MetaType compare|protocol+meta} + ClassType + {UniversalSetType (inverted compare|universal+class) + EmptySetType (inverted compare|empty+class) + NotType (inverted compare|not+class) + OrType (inverted compare|or+class) + AndType (inverted compare|and+class) + Expression fn>< ; TODO not entirely true + ProtocolType (inverted compare|protocol+class) + ClassType compare|class+class + FnType fn>< + UnorderedType compare|class+unordered + OrderedType compare|class+ordered + ValueType compare|class+value + MetaType compare|class+meta} + FnType + {UniversalSetType (inverted compare|universal+fn) + EmptySetType (inverted compare|empty+fn) + NotType (inverted compare|not+fn) + OrType (inverted compare|or+fn) + AndType (inverted compare|and+fn) + Expression compare|todo + ProtocolType fn>< ; TODO do `t/fn`s actually satisfy any protocols? + ClassType fn>< ; TODO are `t/fn`s `clojure.lang.IFn`s? only dynamic dispatch really is + FnType compare|fn+fn + UnorderedType fn>< + OrderedType fn>< + ValueType fn>< + MetaType compare|fn+meta} + UnorderedType + {UniversalSetType (inverted compare|universal+unordered) + EmptySetType (inverted compare|empty+unordered) + NotType (inverted compare|not+unordered) + OrType (inverted compare|or+unordered) + AndType (inverted compare|and+unordered) + Expression compare|todo + ProtocolType compare|todo + ClassType (inverted compare|class+unordered) + FnType compare|todo + UnorderedType compare|todo + OrderedType compare|todo + ValueType compare|unordered+value + MetaType compare|unordered+meta} + OrderedType + {UniversalSetType (inverted compare|universal+ordered) + EmptySetType (inverted compare|empty+ordered) + NotType (inverted compare|not+ordered) + OrType (inverted compare|or+ordered) + AndType (inverted compare|and+ordered) + Expression compare|todo + ProtocolType compare|todo + ClassType (inverted compare|class+ordered) + FnType compare|todo + UnorderedType compare|todo + OrderedType compare|todo + ValueType compare|ordered+value + MetaType compare|ordered+meta} + ValueType + {UniversalSetType (inverted compare|universal+value) + EmptySetType (inverted compare|empty+value) + NotType (inverted compare|not+value) + OrType (inverted compare|or+value) + AndType (inverted compare|and+value) + Expression (inverted compare|expr+value) + ProtocolType (inverted compare|protocol+value) + ClassType (inverted compare|class+value) + FnType compare|todo + UnorderedType (inverted compare|unordered+value) + OrderedType (inverted compare|ordered+value) + ValueType compare|value+value + MetaType compare|value+meta} + MetaType + {UniversalSetType (inverted compare|universal+meta) + EmptySetType (inverted compare|empty+meta) + NotType (inverted compare|not+meta) + OrType (inverted compare|or+meta) + AndType (inverted compare|and+meta) + Expression (inverted compare|expr+meta) + ProtocolType (inverted compare|protocol+meta) + ClassType (inverted compare|class+meta) + FnType (inverted compare|fn+meta) + UnorderedType (inverted compare|unordered+meta) + OrderedType (inverted compare|ordered+meta) + ValueType (inverted compare|value+meta) + MetaType compare|meta+meta}}) + +;; ===== Operators ===== ;; + +(defns compare + "Returns the value of the comparison of the extensions of ->`t0` and ->`t1`. + `-1` means (ex ->`t0`) ⊂ (ex ->`t1`) + `0` means (ex ->`t0`) = (ex ->`t1`) + `1` means (ex ->`t0`) ⊃ (ex ->`t1`) + `2` means (ex ->`t0`) shares other intersect w.r.t. (∩) (ex ->`t1`) + `3` means (ex ->`t0`) disjoint w.r.t. (∅) (ex ->`t1`) + + Does not compare cardinalities or other relations of sets, but rather only sub/superset + relations." + [t0 type?, t1 type? > comparison?] + (if (c/= t0 t1) + =ident + (let [dispatched (-> compare|dispatch (get (type t0)) (get (type t1)))] + (if (nil? dispatched) + (err! (str "Types not handled: " {:t0 t0 :t1 t1}) {:t0 t0 :t1 t1}) + (dispatched t0 t1))))) + +(defns < + "Computes whether the extension of type ->`t0` is a strict subset of that of ->`t1`." + ([t1 type?] #(< % t1)) + ([t0 type?, t1 type? > boolean?] (uset/comp< compare t0 t1))) + +(defns <= + "Computes whether the extension of type ->`t0` is a (lax) subset of that of ->`t1`." + ([t1 type?] #(<= % t1)) + ([t0 type?, t1 type? > boolean?] (uset/comp<= compare t0 t1))) + +(defns = + "Computes whether the extension of type ->`t0` is equal to that of ->`t1`." + ([t1 type?] #(= % t1)) + ([t0 type?, t1 type? > boolean?] (uset/comp= compare t0 t1))) + +(defns not= + "Computes whether the extension of type ->`t0` is not equal to that of ->`t1`." + ([t1 type?] #(not= % t1)) + ([t0 type?, t1 type? > boolean?] (uset/comp-not= compare t0 t1))) + +(defns >= + "Computes whether the extension of type ->`t0` is a (lax) superset of that of ->`t1`." + ([t1 type?] #(>= % t1)) + ([t0 type?, t1 type? > boolean?] (uset/comp>= compare t0 t1))) + +(defns > + "Computes whether the extension of type ->`t0` is a strict superset of that of ->`t1`." + ([t1 type?] #(> % t1)) + ([t0 type?, t1 type? > boolean?] (uset/comp> compare t0 t1))) + +(defns >< + "Computes whether it is the case that the intersect of the extensions of type ->`t0` + and ->`t1` is non-empty, and neither ->`t0` nor ->`t1` share a subset/equality/superset + relationship." + ([t1 type?] #(>< % t1)) + ([t0 type?, t1 type? > boolean?] (uset/comp>< compare t0 t1))) + +(defns <> + "Computes whether the respective extensions of types ->`t0` and ->`t1` are disjoint." + ([t1 type?] #(<> % t1)) + ([t0 type? t1 type? > boolean?] (uset/comp<> compare t0 t1))) + +;; ===== FnType ===== ;; + +(defns combine-comparisons + "Used in `t/compare|in` and `t/compare|out`. Might be used for other things too in the future. + Commutative in the 2-ary arity. + A `t/and`-style combination." + ([cs _ #_(seq-of comparison?) > comparison?] + ;; TODO it's possible to `reduced` early here depending + (if (empty? cs) + =ident + (reduce (fn [c' c] (combine-comparisons c' c)) (first cs) (rest cs)))) + ([c0 comparison?, c1 comparison? > comparison?] + (case (long c0) + -1 (case (long c1) -1 ident) + 0 (case (long c1) -1 ident, 2 >ident) + 1 (case (long c1) -1 >ident, 1 >ident, 2 >ident) + 2 (case (long c1) -1 >ident) + 3 (case (long c1) -1 <>ident, 0 <>ident, 1 <>ident, 2 <>ident, 3 <>ident)))) + +(defns compare-inputs + [arg-types0 _ #_(s/vec-of t/type?), arg-types1 _ #_(s/vec-of t/type?) > comparison?] + (let [ct-comparison (c/compare (count arg-types0) (count arg-types1))] + (if (zero? ct-comparison) + ;; TODO can use educers here + (combine-comparisons (map compare arg-types0 arg-types1)) + name]] [quantum.untyped.core.core :as ucore] [quantum.untyped.core.error :refer [>ex-info]] [quantum.untyped.core.fn :refer [<- fn->>]] - [quantum.untyped.core.type.defs :as utdef] + [quantum.untyped.core.identifiers + :refer [>name]] [quantum.untyped.core.vars - :refer [defalias]])) + :refer [defalias]] + [quantum.untyped.core.type.defs :as utdef])) (def class #?(:clj clojure.core/class :cljs type)) @@ -54,7 +55,7 @@ Byte/TYPE Byte Character/TYPE Character Double/TYPE Double - Void/TYPE Void })) + Void/TYPE Void})) #?(:clj (def unboxed->convertible @@ -89,15 +90,25 @@ (def unboxed-type-map (zipmap (vals boxed-type-map) (keys boxed-type-map)))) -(def prim-types (-> utdef/types (get 'prim?))) -(def prim-types|unevaled (-> utdef/types|unevaled :clj (get 'prim?))) -(def primitive-types (-> utdef/types (get 'primitive?))) -(def primitive-types|unevaled (-> utdef/types|unevaled :clj (get 'primitive?))) -(def primitive-boxed-types (-> utdef/types (get 'primitive-boxed?))) -(def primitive-boxed-types|unevaled (-> utdef/types|unevaled :clj (get 'primitive-boxed?))) +(def prim-types #?(:clj #{Boolean/TYPE Byte/TYPE Character/TYPE + Short/TYPE Integer/TYPE Long/TYPE + Float/TYPE Double/TYPE} + :cljs #{js/Boolean js/Number})) +(def prim-types|unevaled '#{boolean byte char short int long float double}) + +(def primitive-boxed-types #?(:clj #{Boolean Byte Character Short Integer Long Float Double} + :cljs #{js/Boolean js/Number})) +(def primitive-boxed-types|unevaled #?(:clj '#{java.lang.Boolean java.lang.Byte java.lang.Character + java.lang.Short java.lang.Integer java.lang.Long + java.lang.Float java.lang.Double} + :cljs '#{js/Boolean js/Number})) + +(def primitive-types (set/union prim-types primitive-boxed-types)) +(def primitive-types|unevaled (set/union prim-types|unevaled primitive-boxed-types|unevaled)) (def prim|unevaled? #(contains? prim-types|unevaled %)) (def primitive|unevaled? #(contains? primitive-types|unevaled %)) + #?(:clj (def auto-unboxable|unevaled? #(contains? primitive-boxed-types|unevaled %)) :cljs (defn auto-unboxable|unevaled? [x] (throw (>ex-info :unsupported "`auto-unboxable?` not supported by CLJS")))) @@ -113,7 +124,16 @@ :cljs #{ubytes ubytes-clamped ushorts uints bytes shorts ints floats doubles}}) (def cljs-typed-array-convertible-classes - (let [cljs-typed-array-types (-> utdef/array-1d-types* :cljs (dissoc :object)) + (let [cljs-typed-array-types '{:byte js/Int8Array + :ubyte js/Uint8Array + :ubyte-clamped js/Uint8ClampedArray + :char js/Uint16Array ; kind of + :ushort js/Uint16Array + :short js/Int16Array + :int js/Int32Array + :uint js/Uint32Array + :float js/Float32Array + :double js/Float64Array} generalize-type (fn->> name str/lower-case (remove #{\u}))] (->> cljs-typed-array-types (reduce @@ -123,11 +143,22 @@ (filter (fn [[type-sym1 _]] (-> type-sym1 generalize-type (= type-sym')))) (map val) set - (<- disj k))))) + (<- (disj k)))))) {})))) (def java-array-type-regex #"(\[+)(?:(Z|S|B|C|I|J|F|D)|(?:L(.+);))") ; TODO create this regex dynamically +#?(:clj +(defn array-depth-equal? + "Efficiency prioritized because this fn is used a lot in `untyped.core.type/compare|class|class`" + [^Class class0 ^Class class1] + (let [s0 (.getName class0) s1 (.getName class1)] + (loop [i 0] + (let [c0 (.charAt s0 i) c1 (.charAt s1 i) + c0? (identical? c0 \[) c1? (identical? c1 \[)] + (or (and (not c0?) (not c1?)) + (and c0? c1? (recur (unchecked-inc i))))))))) + #?(:clj (defn nth-elem-type|clj "`x` must be Java array type (for now) @@ -150,7 +181,7 @@ (symbol ?object-type) (str (apply str (drop n brackets)) "L" ?object-type ";")))))) -(def default-types (-> utdef/types|unevaled (get ucore/lang) :any)) +(def default-types '#{#?(:clj java.lang.Object :cljs (quote default))}) (defn ->boxed|sym [t] #?(:clj (if-let [boxed (get boxed-type-map t)] boxed t) @@ -195,26 +226,9 @@ float java.lang.Float/TYPE double java.lang.Double/TYPE})}) -(defn static-cast-code - "`(with-meta (list 'do expr) {:tag class-sym})` isn't enough" - [class-sym expr] - (let [cast-sym (gensym "cast-sym")] - ; `let*` to preserve metadata even when macroexpanding - (with-meta `(let* [~(with-meta cast-sym {:tag class-sym}) ~expr] ~cast-sym) {:tag class-sym}))) - -#?(:clj -(defmacro static-cast - "Performs a static type cast" - [class-sym expr] - (static-cast-code class-sym expr))) - #?(:clj -(defn class>prim-subclasses - {:examples '{(class>prim-subclasses Number) - #{utdef/long utdef/int utdef/short utdef/byte utdef/float utdef/double}}} - [^Class c] - (let [boxed-types (get utdef/types 'primitive-boxed?)] - (->> boxed-types - (filter #(isa? % c)) - (map boxed->unboxed) - set)))) +(defn class>prim-subclasses [^Class c] + (->> primitive-boxed-types + (r/filter #(isa? % c)) + (r/map boxed->unboxed) + (into #{})))) diff --git a/src-untyped/quantum/untyped/core/type/defnt.cljc b/src-untyped/quantum/untyped/core/type/defnt.cljc new file mode 100644 index 00000000..831c627b --- /dev/null +++ b/src-untyped/quantum/untyped/core/type/defnt.cljc @@ -0,0 +1,1411 @@ +(ns quantum.untyped.core.type.defnt + (:refer-clojure :exclude + [defn fn]) + (:require + [clojure.core :as c] + [clojure.string :as str] + [fipp.ednize :as fedn] + ;; TODO excise this reference + [quantum.core.type.core :as tcore] + ;; TODO excise this reference + [quantum.core.type.defs :as tdef] + [quantum.untyped.core.analyze :as uana] + [quantum.untyped.core.analyze.ast :as uast] + [quantum.untyped.core.core :as ucore + :refer [istr sentinel]] ; TODO use quantum.untyped.core.string/istr instead + [quantum.untyped.core.defnt + :refer [defns defns- fns]] + [quantum.untyped.core.collections :as uc + :refer [>set >vec]] + [quantum.untyped.core.collections.logic + :refer [seq-or]] + [quantum.untyped.core.compare :as ucomp + :refer [not==]] + [quantum.untyped.core.data + :refer [kw-map]] + [quantum.untyped.core.data.array :as uarr] + [quantum.untyped.core.data.map :as umap] + [quantum.untyped.core.data.reactive :as urx + :refer [?norx-deref norx-deref]] + [quantum.untyped.core.data.set :as uset] + [quantum.untyped.core.data.vector :as uvec + :refer [alist-conj!]] + [quantum.untyped.core.error :as uerr + :refer [TODO err!]] + [quantum.untyped.core.fn + :refer [<- aritoid fn' fn1 fn-> fn->> with-do with-do-let]] + [quantum.untyped.core.form :as uform + :refer [>form]] + [quantum.untyped.core.form.evaluate :as ufeval] + [quantum.untyped.core.form.generate :as ufgen] + [quantum.untyped.core.form.type-hint :as ufth] + [quantum.untyped.core.identifiers :as uid + :refer [>name >?namespace >symbol]] + [quantum.untyped.core.log :as ulog] + [quantum.untyped.core.logic :as ul + :refer [fn-or fn= if-not-let ifs ifs-let]] + [quantum.untyped.core.loops + :refer [reduce-2]] + [quantum.untyped.core.reducers :as ur + :refer [educe educei join reducei]] + [quantum.untyped.core.refs :as uref + :refer [?deref]] + [quantum.untyped.core.spec :as us] + [quantum.untyped.core.specs :as uss] + [quantum.untyped.core.type :as t + :refer [?]] + [quantum.untyped.core.type.compare :as utcomp] + [quantum.untyped.core.type.reifications :as utr + #?@(:cljs [:refer [TypedFn]])] + [quantum.untyped.core.vars :as uvar + :refer [update-meta]]) +#?(:clj (:import + [java.util ArrayList HashMap TreeMap] + [quantum.core Numeric] + [quantum.core.data Array] + [quantum.untyped.core.type.reifications TypedFn]))) + +;; TODO move +(def index? #(and (integer? %) (>= % 0))) +(def count? index?) + +(defonce *fn->type (atom {})) + +(defonce *interfaces (atom {})) + +;; ===== Effects management ===== ;; + +(defonce !global-overload-queue (uvec/alist)) ; (t/!seq-of ::types-decl-datum-with-overload) + +(uvar/defonce !global-rollback-queue + "To ensure that side-effects are as atomic as possible in the case of a failure in `defn` or + `extend-defn!`." + (uvec/alist)) ; (t/!seq-of (t/ftype [])) + +(defns- intern-with-rollback! + ([ns-sym simple-symbol?, sym simple-symbol?, v _] + (intern-with-rollback! !global-rollback-queue ns-sym sym v)) + ([!rollback-queue _, ns-sym simple-symbol?, sym simple-symbol?, v _] + (let [var-val (resolve (uid/qualify ns-sym sym)) + !value (atom nil)] + (when var-val (reset! !value (var-get var-val))) + (intern ns-sym sym v) + (alist-conj! !rollback-queue + #(if var-val + (intern ns-sym sym @!value) + (uvar/unintern! ns-sym sym)))))) + +(defn- drain-rollback-queue! + "Rolls back already-executed effects in reverse order." + ([] (drain-rollback-queue! !global-rollback-queue)) + ([!rollback-queue] + (->> !rollback-queue + reverse + (uc/run! + (c/fn [rollback-fn] + (uerr/catch-all (rollback-fn) + rollback-err + (err! nil "Unable to roll back all effects" {:failed-rollback-fn rollback-fn} + nil rollback-err))))))) + +(defns- with-rollback! [!rollback-queue _, f fn?] + (uerr/catch-all + (f) + e + (do (ulog/ppr :error e) + (drain-rollback-queue! !rollback-queue) + (err! nil "Exception; rolled back successfully" nil nil e)) + (do (uvec/alist-empty! !rollback-queue)))) + +(defns- analyze-with-rollback! + ([unanalyzed-form _] (analyze-with-rollback! !global-rollback-queue unanalyzed-form)) + ([!rollback-queue _, unanalyzed-form _] + (with-rollback! !rollback-queue + (c/fn [] (-> unanalyzed-form uana/analyze :form))))) + +;; ===== Macros ===== ;; + +;; TODO move +#?(:clj +(defmacro dotyped + "Like `do`, but evaluates `args` in a typed context." + [& args] (analyze-with-rollback! `(dotyped ~@args)))) + +;; TODO move +#?(:clj +(defmacro def + "Like `def`, but: + - Allows for docstring and metadata placement like `defn`. + - Performs type analysis. + - For values that satisfy `t/type?`, calls `utr/with-name` on them with the provided `sym`." + ([sym] (list 'def sym)) + ([sym v] (list 'quantum.untyped.core.type.defnt/def sym nil nil v)) + ([sym doc-or-meta v] + (if (string? doc-or-meta) + (list 'quantum.untyped.core.type.defnt/def sym doc-or-meta nil v) + (list 'quantum.untyped.core.type.defnt/def sym nil doc-or-meta v))) + ([sym doc meta-val v] + (with-rollback! + (c/fn [] + (list 'def + (if (or doc meta-val) + (update-meta sym merge + (-> meta-val (cond-> doc (assoc :doc doc)) uana/analyze :form)) + sym) + (let [node (uana/analyze v)] + (if (and (-> node :type utr/value-type?) + (-> node :type t/unvalue t/type?)) + `(utr/with-name ~(:form node) '~(uid/qualify *ns* sym)) + (:form node))))))))) + +#?(:clj +(defmacro def- + "Like `t/def`, but creates a private var." + ([sym] (list 'def (update-meta sym merge {:private true}))) + ([sym v] (list 'quantum.untyped.core.type.defnt/def (update-meta sym merge {:private true}) v)) + ([sym doc-or-meta v] (list 'quantum.untyped.core.type.defnt/def + (update-meta sym merge {:private true}) doc-or-meta v)) + ([sym doc meta-val v] (list 'quantum.untyped.core.type.defnt/def + (update-meta sym merge {:private true}) doc meta-val v)))) + + +#?(:clj +(defmacro fn + "With `t/fn`, protocols, interfaces, and multimethods become unnecessary. The preferred method of + dispatch becomes the function alone. + + `t/fn` is intended to catch many runtime errors at compile time, but cannot catch all of them. + + `t/fn`, along with `t/defn`, `t/dotyped`, and others, creates a typed context in which its + internal forms are analyzed, type-consistency is checked, and type-dispatch is resolved at + compile time inasmuch as possible, and at runtime only when necessary. + + Recommendations for the type system: + - Primitives are always preferred to boxed values. All values that can be primitives (i.e. ones + that are `t/<=` w.r.t. a `(t/isa? )`) are treated as primitives unless + specifically marked otherwise with the `t/ref` metadata-adding directive. + - One could imagine a dynamic set of types corresponding to a given predicate, e.g. `decimal?`. + Say someone comes up with a new `decimal?`-like class and wants to redefine `decimal?` to + accommodate. One could define `decimal?` as a reactive/extensible type to do this. However, it + is preferable to instead define a marker protocol called `PDecimal` or some such and put that + on the defined `deftype` itself, and incorporate `PDecimal` into `decimal?` from the start. In + this way fewer reactive changes have to happen and less compilation occurs. + + Compile-Time (Direct) Dispatch characteristics + - Any input, if its type is `t/<=` a non-nil primitive (boxed or not) class, it will be marked + as a primitive in the corresponding `reify`. + - If an input is a nilable primitive, its nilability will not result in only one `reify` + overload with a boxed input, but rather will result in two `reify` overloads — one + corresponding to a nil input and another for the primitive input. + + Runtime (Dynamic) Dispatch characteristics + - Compile-Time Dispatch is preferred to Runtime Dispatch in all but the following situations, in + which Compile-Time Dispatch is not possible: + - When a typed function (or a typed object with function-like characteristics such as a + `t/deftype`) is referenced outside of a typed context. + + Metadata directives special to all typed contexts include: + - `:val` : If `true` and attached as metadata to a form, it will cause that form's type to be + `t/and`ed with `t/val?`. + - `:dyn` : If `true` and attached as metadata to a form corresponding with a typed fn in functor + position, it will cause that typed fn to be called dynamically if no direct dispatch + is found at compile time. + - For instance, `(name (read ...))` fails at compile-time; we want it to at least try + at runtime. So we annotate like `(^:dyn name (read ...))`, which tells the compiler + to figure out at runtime whether a call to `name` will succeed. + + Metadata directives special to `t/fn`/`t/defn` include: + - `:inline` : If `true` and attached as metadata to the arglist of an overload, will cause that + overload to be inlined if possible: + - `(t/defn abc (^:inline [] ...))` + If `true` and attached as metadata to the whole `t/defn` or `t/fn`, will cause + every one of its overloads to be inlined if possible. Overloads added to a `t/defn` + with `:inline` `true` will inherit this inline directive unless `:inline` is false + for the overload or `:unline` is true: + - `(t/defn ^:inline abc ([] ...) ([...] ...))` + - `(t/defn ^:inline abc (^{:inline false} [] ...) ([...] ...))` + - `(t/defn ^:inline abc ([] ...) (^:unline [...] ...))` + Note: + - Inlining is possible only in typed contexts. + - If the metadata for an overload changes via `extend-defn!` from designating it as + inline to designating it as non-inline, or vice versa, unexpected behavior may + occur. + + `t/fn` only works fully in contexts in which the metalanguage (compiler language) is the same as + the object language. Otherwise, while the compiler could still analyze types symbolically to an + extent, it could not actually run evaluated type-predicates on inputs to determine type-satisfaction. + - Consumers wishing to use the full-featured `t/fn` in ClojureScript must either use + bootstrapped ClojureScript or transpile ClojureScript via the JavaScript implementation of + the Google Closure Compiler. Consumers for whom the version of `t/fn` with purely symbolic + analysis is acceptable may use the standard approach of transpiling ClojureScript via the Java + implementation of the Google Closure Compiler." + [& args] (analyze-with-rollback! `(fn ~@args)))) + +#?(:clj +(defmacro defn + "A `defn` with an empty body is like using `declare`." + [& args] (analyze-with-rollback! `(defn ~@args)))) + +#?(:clj +(defmacro extend-defn! + "Currently undefining overloads is not possible." + [& args] (analyze-with-rollback! `(extend-defn! ~@args)))) + +;; ===== `t/extend-defn!` specs ===== ;; + +(us/def :quantum.core.defnt/fn|extended-name symbol?) + +(us/def :quantum.core.defnt/extend-defn! + (us/and (us/spec + (us/cat :quantum.core.defnt/fn|extended-name :quantum.core.defnt/fn|extended-name + :quantum.core.defnt/overloads :quantum.core.defnt/overloads)) + (uss/fn-like|postchecks|gen :quantum.core.defnt/overloads) + :quantum.core.defnt/postchecks)) + +;; ==== Internal specs ===== ;; + +(def ^:dynamic *compilation-mode* :normal) + +(us/def ::compilation-mode #{:normal :test}) + +(us/def ::kind #{:fn :defn :extend-defn!}) + +(us/def ::opts + (us/kv {:compilation-mode ::compilation-mode + :gen-gensym t/fn? + :kind ::kind})) + +;; "global" because they apply to the whole `t/fn` +(us/def ::fn|globals + (us/kv {:fn|globals-name simple-symbol? + :fn|inline? boolean? + :fn|meta (us/nilable :quantum.core.specs/meta) + :fn|ns-name simple-symbol? + :fn|name (us/nilable ::uss/fn|name) + :fn|name|global ::uss/fn|name + :fn|output-type t/type? + :fn|output-type|form t/any? + :fn|overload-bases-name simple-symbol? + :fn|overload-types-name simple-symbol? + :fn|type-name simple-symbol?})) + +(us/def ::overload-basis|types|split + (us/vec-of (us/kv {:arg-types (us/vec-of t/type?) :output-type t/type?}))) + +(us/def ::overload-basis|norx + ;; None of these types should be reactive + (us/kv {:arg-types|basis (us/vec-of t/type?) + :output-type|basis t/type? + ;; This is non-nil only for arglists with dependent types + :types|split (us/nilable ::overload-basis|types|split) + :body-codelist (us/vec-of t/any?) + :dependent? boolean? + :reactive? boolean? + :inline? boolean?})) + +(us/def ::overload-basis + (us/kv {:ns-name simple-symbol? + :args-form map? ; from binding to form + :varargs-form (us/nilable map?) ; from binding to form + :arglist-form|unanalyzed t/any? + :arg-types|basis (us/vec-of t/type?) + :output-type|form t/any? + :output-type|basis t/type? + ;; This is non-nil only for arglists with dependent types + :types|split (us/nilable ::overload-basis|types|split) + :body-codelist (us/vec-of t/any?) + :dependent? boolean? + :reactive? boolean? + :inline? boolean?})) + +;; Interned as `!overload-bases` +(us/def ::overload-bases-data + (us/kv {:prev-norx (us/nilable (us/vec-of ::overload-basis|norx)) + :current (us/vec-of ::overload-basis)})) + + ;; Technically it's partially analyzed — its type definitions are analyzed (with the exception of + ;; requests for type inference) while its body is not. + (us/def ::unanalyzed-overload + (us/kv {:ns-name simple-symbol? + :arg-classes (us/vec-of class?) + :arg-classes|reify (us/vec-of class?) + :arg-types (us/vec-of t/type?) + :arglist-code|hinted (us/vec-of simple-symbol?) + :arglist-code|reify|unhinted (us/vec-of simple-symbol?) + :arglist-form|unanalyzed t/any? + :args-form map? ; from binding to form + :varargs-vorm (us/nilable map?) ; from binding to form + :output-class class? + :output-class|reify class? + :output-type|form t/any? + :output-type t/type? + :pre-type (us/nilable t/type?) + :body-codelist (us/vec-of t/any?) + :i|basis index? + :inline? boolean? + :interface class?})) + +;; This is the overload after the input specs are split by their respective `t/or` constituents, +;; and after primitivization, but before readiness for incorporation into a `reify`. +;; One of these corresponds to one reify overload. +(us/def ::overload + (us/kv {:arg-classes (us/vec-of class?) + :arg-types (us/vec-of t/type?) + :arglist-form|unanalyzed t/any? + :arglist-code|fn|hinted (us/vec-of simple-symbol?) + :arglist-code|hinted (us/vec-of simple-symbol?) + :arglist-code|reify|unhinted (us/vec-of simple-symbol?) + :interface class? + :body-node uast/node? + :output-class (us/nilable class?) + :output-type t/type? + :positional-args-ct count? + ;; When present, varargs are considered to be of class Object + :variadic? t/boolean?})) + +(us/def ::overload|id index?) +(us/def ::overload|index index?) + +(us/def ::overload-types-decl + (us/kv {:form t/any? + :name simple-symbol?})) + +(us/def ::reify|name simple-symbol?) ; hinted with the interface name + +(us/def ::reify + (us/kv {:form t/any? + :id ::overload|id + :index ::overload|index + :overload ::overload})) + +(us/def ::direct-dispatch-seq (us/vec-of ::reify)) ; sorted by ID + +(us/def ::type-datum + (us/kv {:arg-types (us/vec-of t/type?) + :pre-type (us/nilable t/type?) + :output-type t/type?})) + +(us/def ::types-decl-datum + (us/kv {:id ::overload|id + :index index? ; overload-index (position in the overall types-decl) + :ns-name simple-symbol? + :interface class? + :arglist-code|hinted (us/vec-of simple-symbol?) + :arg-types (us/vec-of t/type?) + :output-type t/type? + :body-codelist (us/vec-of t/any?) + :inline? boolean?})) + +;; Interned as `!fn|types` +(us/def ::fn|types + (us/kv {:fn|output-type-norx t/type? + :fn|type-norx t/type? + :overload-types (us/vec-of ::types-decl-datum)})) + +(c/defn >with-runtime-output-type [body output-type|form] `(t/validate ~body ~output-type|form)) + +(c/defn with-array-type-hint [x] + (ufth/with-type-hint x #?(:clj "[Ljava.lang.Object;" :cljs "array"))) + +;; TODO simplify this class computation + +;; ===== Arg type/class extraction/comparison ===== ;; + +#?(:clj +(defns class>simplest-class + "This ensures that special overloads are not created for non-primitive subclasses + of java.lang.Object (e.g. String, etc.)." + [c class? > class?] + (if (t/primitive-class? c) c java.lang.Object))) + +#?(:clj +(defns type>class + "Converts type to class after type has gone through the split+primitivization process." + [t t/type? > class?] + (let [cs (t/type>classes t) + cs' (disj cs nil)] + (if (-> cs' count (not= 1)) + java.lang.Object + (-> (first cs') + (cond-> (and (not (contains? cs nil)) + (not (t/type-ref? t))) + t/class>most-primitive-class)))))) + +;; TODO we may want to prefer actual output types; not sure yet +(defns- with-validate-output-type [declared-output-type t/type?, body-node uast/node? > t/type?] + (let [err-info {:form (:form body-node) + :type (:type body-node) + :declared-output-type declared-output-type}] + (case (t/compare (:type body-node) declared-output-type) + (-1 0) declared-output-type + 1 (if (or (-> declared-output-type t/run?) + (-> declared-output-type t/assume?)) + declared-output-type + (err! "Body type incompatible with declared output type" err-info)) + (2 3) (err! "Body type incompatible with declared output type" err-info)))) + +(c/defn compare-arg-types [t0 #_t/type?, t1 #_t/type? #_> #_ucomp/comparison?] + (uset/normalize-comparison (t/compare t0 t1))) + +(c/defn compare-args-types [arg-types0 #_(us/vec-of t/type?) arg-types1 #_(us/vec-of t/type?)] + (let [ct-comparison (compare (count arg-types0) (count arg-types1))] + (if (zero? ct-comparison) + (reduce-2 + (c/fn [^long c t0 t1] + (let [c' (long (compare-arg-types t0 t1))] + (if (zero? c') c' (reduced c')))) + 0 + arg-types0 arg-types1) + ct-comparison))) + +(c/defn- >comparator-respecting-arglist-counts [compf #_fn?, i #_index? #_> #_fn?] + (c/fn [a b] + (let [ct|a (count a) + ct|b (count b) + ct-comparison (compare ct|a ct|b)] + (if (zero? ct-comparison) + (if (< i ct|a) + (compf (get a i) (get b i)) + 0) + ct-comparison)))) + +(defonce thing (atom nil)) + +(uvar/def- ^:const min-int-value -2147483648) + +(c/defn sort-overload-types + "A naïve implementation would do an aggregate compare on the arg-types vectors, but the resulting + comparator would not be transitive due to the behavior of `<>` and `><`, and the arg-types + vectors would not be sorted in a 'multilevel' (by first input type, then second, etc.) way. For + example, for the below arg-types vectors, x0 comp< x1, x1 comp< x2, but x0 not comp< x2: + - x0: [t/boolean? t/nil?] + - x1: [(t/ref (t/isa? Comparable)) t/byte?] + - x2: [t/nil? t/val?] + + Because of this, we are forced to do as many sorts as the max arity of the typed fn, which + results in an O(m•n•log(n))) algorithm, where `m` is the max arity and `n` is the number of + overloads. + + The comparator used here is transitive for `t/<` and `t/>` comparisons but not for `t/=`: + - x0: t/char? <> t/nil? + - x1: t/nil? <> (t/ref (t/isa? Comparable)) + - x2: t/char? < (t/ref (t/isa? Comparable)) + + Given this fact, we have to avoid `java.util.TimSort` and use a sorting implementation tolerant + to non-transitive comparators." + [kf overload-types] + (let [max-arity (->> overload-types (uc/map+ kf) (uc/map+ count) (educe max 0)) + ;; With `sort-guide` and/or hashing also aggregated into the main comparator, a comparator + ;; violation occurs: + ;; `t/nil?` < `t/boolean?`, `t/boolean?` < `t/val?`, but `t/nil?` <> `t/val?` + !overload-types (->> overload-types + (uc/group-deep-by-into max-arity + (c/fn [i x] (let [t (-> x kf (get i))] + (if-let [c (uana/sort-guide t)] + ;; To ensure sort-guide ones always come first + (+ min-int-value c) + (hash t)))) + (c/fn ([] (umap/>!sorted-map)) + ([ret] (->> ret uc/vals+ uc/cat+ (educe alist-conj!))) + #?(:clj ([^TreeMap ret k v] (doto ret (.put k v))) + :cljs ([ ret k v] (doto ret (.add k v))))) + alist-conj!) + to-array)] + ;; We use insertion sort because it's tolerant to non-transitive comparators, and because + ;; the `group-deep` into sorted map will already produce a partially sorted array + (dotimes [i max-arity] + (uc/sort-by|insertion! kf + (>comparator-respecting-arglist-counts compare-arg-types i) !overload-types)) + (>vec !overload-types))) + +(c/defn- dedupe-type-data + "Performs both structural and `t/compare` deduplication." + [on-dupe #_fn?, type-data #_(vec-of ::types-decl-datum)] + (reduce (let [!prev-datum (volatile! nil) + !unique-data (transient #{})] + (c/fn [data {:as datum :keys [arg-types]}] + (with-do + (ifs (nil? @!prev-datum) + (conj data datum) + (or (contains? !unique-data datum) + (= uset/=ident + (utcomp/compare-inputs (:arg-types @!prev-datum) arg-types))) + (on-dupe data @!prev-datum datum) + (conj data datum)) + (conj! !unique-data datum) + (vreset! !prev-datum datum)))) + [] + type-data)) + +;; ===== `unanalyzed-overload>overload` ===== ;; + +#?(:clj +(defns- unanalyzed-overload>overload + "Given an `::unanalyzed-overload`, performs type analysis on the body and computes a resulting + `t/fn` overload, which is the foundation for one `reify`." + [{:as opts :keys [gen-gensym _, kind _]} ::opts + {:as fn|globals :keys [fn|globals-name _, fn|name _, fn|ns-name _, fn|output-type _ + fn|overload-types-name|local _]} ::fn|globals + env ::uana/env + {:as unanalyzed-overload + :keys [arg-classes _, arg-classes|reify _, arg-types _, arglist-code|hinted _, + arglist-code|reify|unhinted _, arglist-form|unanalyzed _, args-form _, body-codelist _, + interface _, output-class|reify _, output-type|form _, varargs-form _, variadic? _] + declared-output-class [:output-class _] + declared-output-type [:output-type _]} ::unanalyzed-overload + overload|id index? + fn|overload-types (us/vec-of ::types-decl-datum) + fn|type (us/nilable t/type?) + > ::overload] + (let [;; Not sure if `nil` is the right approach for the value + ?recursive-ast-node-reference + (when fn|name (uast/symbol {} fn|name nil fn|type)) + local-env (->> (zipmap (keys args-form) arg-types) + (uc/map' (c/fn [[arg-binding arg-type]] + [arg-binding (uast/unbound nil arg-binding arg-type)])) + ;; To support recursion + (<- (cond-> fn|name + (assoc fn|name + ?recursive-ast-node-reference + ;; TODO maybe there's a better way for `t/fn`s + (uid/qualify fn|ns-name fn|overload-types-name|local) + (uast/var-value fn|overload-types-name|local fn|overload-types + (t/value fn|overload-types)))))) + env' (-> env + (merge local-env) + (assoc-in [:opts :ns] (-> unanalyzed-overload :ns-name the-ns))) + body-node (uana/analyze env' (ufgen/?wrap-do body-codelist)) + output-type (with-validate-output-type declared-output-type body-node) + output-class declared-output-class + body-node + (-> body-node + (cond-> (t/run? output-type) + ;; TODO here the output type is being re-created each time (unless the fn's overall + ;; output type is being preferred) because it could reference inputs, but we + ;; should probably analyze to determine whether it references inputs so we can, + ;; in the 90% case, extern the output type + (update :form >with-runtime-output-type + (or output-type|form + `(?norx-deref (:fn|output-type ~(uid/qualify fn|ns-name fn|globals-name))))))) + positional-args-ct (count args-form) + hint-arg|fn (c/fn [i arg-binding] + (ufth/with-type-hint arg-binding + (ufth/>fn-arglist-tag + (uc/get arg-classes i) + ucore/lang + (uc/count args-form) + variadic?))) + arglist-code|fn|hinted + (cond-> (->> args-form keys (uc/map-indexed hint-arg|fn)) + variadic? (conj '& (-> varargs-form keys first)))] + (kw-map arg-classes arg-classes|reify arg-types arglist-code|fn|hinted arglist-code|hinted + arglist-code|reify|unhinted arglist-form|unanalyzed body-node interface output-class + output-class|reify output-type positional-args-ct variadic?)))) + +;; ===== Direct dispatch ===== ;; + +;; ----- Direct dispatch: `reify` ---- ;; + +#?(:clj +(defns overload>reify + [{:as opts :keys [gen-gensym _]} ::opts + {:keys [fn|name _]} ::fn|globals + {:as overload + :keys [arg-classes|reify _, arglist-code|reify|unhinted _, body-node _, interface _ + output-class|reify _]} ::overload + overload|id ::overload|id + overload|index ::overload|index + > ::reify] + (let [arglist-code + (join [(gen-gensym '_)] + (->> arglist-code|reify|unhinted + (uc/map-indexed + (c/fn [i|arg arg|form] + (ufth/with-type-hint arg|form + (-> arg-classes|reify (uc/get i|arg) ufth/>arglist-embeddable-tag)))))) + form `(reify* [~(-> interface >name >symbol)] + (~(ufth/with-type-hint uana/direct-dispatch-method-sym + (ufth/>arglist-embeddable-tag output-class|reify)) + ~arglist-code ~(:form body-node))) + id overload|id + index overload|index] + (kw-map form id index overload)))) + +;; ----- Type declarations ----- ;; + +(c/defn overload-types>arg-types + [?!fn|types #_(t/or ::fn|types (t/of urx/reactive? ::fn|types)), overload-index #_index? + #_> #_(objects-of type?)] + (apply uarr/*<>|fn (-> ?!fn|types ?norx-deref :overload-types (get overload-index) :arg-types))) + +(c/defn overload-types>ftype + [{:as opts :keys [fn|name|local fn|ns-name]} #_::opts + overload-types #_(vec-of ::type-datum) + fn|output-type #_t/type?] + (let [overload-types' (->> overload-types + (uc/lmap (c/fn [{:keys [arg-types pre-type output-type]}] + (cond-> arg-types + pre-type (conj :| pre-type) + output-type (conj :> output-type)))))] + (apply t/ftype (uid/qualify fn|ns-name fn|name|local) fn|output-type overload-types'))) + +(c/defn- dedupe-overload-types-data [fn|ns-name fn|name types-decl-data] + (->> types-decl-data + (dedupe-type-data + (c/fn [data prev-datum datum] + (ulog/ppr :warn + (str "Overwriting type overload for `" + (cond->> fn|name fn|name (uid/qualify fn|ns-name)) "`") + {:arg-types-prev (:arg-types prev-datum) :arg-types (:arg-types datum)}) + (-> data pop + (conj (assoc datum :id (:id prev-datum) + :arg-types (:arg-types prev-datum) + :output-type (:output-type prev-datum) + :replacing-id (:id datum)))))))) + +(defns- overload-basis-data>types+ + "Split and primitivized; not yet sorted." + [{:keys [fn|output-type _]} ::fn|globals, env ::uana/env, ns-name-val _, args-form _ + output-type|form _, body-codelist _] + (->> (uana/analyze-arg-syms (assoc-in env [:opts :ns] (the-ns ns-name-val)) + args-form (or output-type|form fn|output-type) true) + (uc/map+ (c/fn [{:keys [env output-type-node]}] + (let [arg-env (->> env :opts :arg-env deref) + arg-types (->> args-form keys (uc/map #(:type (get arg-env %)))) + output-type (:type output-type-node) + pre-type nil] ; TODO fix + (when-not (t/<= output-type fn|output-type) + (err! (str "Overload's declared output type does not satisfy function's" + "overall declared output type") + (kw-map output-type fn|output-type))) + (kw-map arg-types output-type pre-type)))))) + +(defns- overload-basis|changed? + [overload-basis ::overload-basis, prev-basis ::overload-basis|norx > boolean?] + (or (not= (:body-codelist overload-basis) (:body-codelist prev-basis)) + (if (:types|split overload-basis) + (not= (:types|split overload-basis) (:types|split prev-basis)) + (or ;; We don't check changedness via `=` when checking type bases because it's possible + ;; that a change in a reactive type might result in a change in how types are split, + ;; which is hidden by a lack of change in basis type value. + (not== (-> overload-basis :output-type|basis ?norx-deref) + (:output-type|basis prev-basis)) + (->> overload-basis + :arg-types|basis + (uc/map-indexed+ + (c/fn [i|t t] (not== (?norx-deref t) + (-> prev-basis :arg-types|basis (get i|t))))) + (seq-or true?)))))) + +(defns- establish-dependency-relations-on-new-overload-bases! + "This establishes a dependency relation on both the `fn|output-type` and on new reactive types + defined in `!overload-bases`. + + Currently only intended to be used by `!fn|types`." + [fn|output-type t/type?, {:keys [prev-norx _, current _]} ::overload-bases-data] + (?deref fn|output-type) + (->> current + (uc/drop+ (count prev-norx)) + (uc/run! (c/fn [{:keys [arg-types|basis output-type|basis]}] + (->> arg-types|basis (uc/run! ?deref)) + (?deref output-type|basis))))) + +(defns- class>interface-part-name [c class? > string?] + (case (>name c) + "java.lang.Object" "O" + "boolean" "B" + "byte" "Y" + "short" "S" + "char" "C" + "int" "I" + "long" "L" + "float" "F" + "double" "D")) + +(defns- overload-classes>interface-sym [args-classes (us/seq-of class?), out-class class? > symbol?] + (>symbol (str (->> args-classes (uc/lmap class>interface-part-name) (apply str)) + "__" (class>interface-part-name out-class)))) + +(defns- overload-classes>interface + [args-classes (us/vec-of class?), out-class class?, gen-gensym fn?] + (let [interface-sym (overload-classes>interface-sym args-classes out-class) + hinted-method-sym (ufth/with-type-hint uana/direct-dispatch-method-sym + (ufth/>interface-method-tag out-class)) + hinted-args (ufth/hint-arglist-with + (ufgen/gen-args 0 (count args-classes) "x" gen-gensym) + (map ufth/>interface-method-tag args-classes))] + `(~'definterface ~interface-sym (~hinted-method-sym ~hinted-args)))) + +(defns- >unanalyzed-overload + [{:as opts :keys [gen-gensym _]} ::opts + {:as basis :keys [args-form _, varargs-form _]} ::overload-basis + i|basis index? + type-datum ::type-datum + > ::unanalyzed-overload] + (let [variadic? (not (empty? varargs-form)) + arg-classes (->> type-datum :arg-types (uc/map type>class)) + arg-classes|reify (->> arg-classes (uc/map class>simplest-class)) + output-class (-> type-datum :output-type type>class) + output-class|reify (class>simplest-class output-class) + interface-k [output-class|reify arg-classes|reify] + interface + (-> *interfaces + (swap! update interface-k + #(or % (eval (overload-classes>interface arg-classes|reify output-class|reify + gen-gensym)))) + (uc/get interface-k)) + arglist-code|reify|unhinted + (cond-> (-> args-form keys vec) + variadic? (conj (-> varargs-form keys first))) + arglist-code|hinted + (->> arglist-code|reify|unhinted + (uc/map-indexed + (c/fn [i|arg arg|form] + (ufth/with-type-hint arg|form + ;; `>body-embeddable-tag` because this will go in a `let*` + (-> arg-classes (uc/get i|arg) ufth/>body-embeddable-tag)))))] + (-> (select-keys basis + [:arglist-form|unanalyzed :args-form :body-codelist :inline? :output-type|form + :varargs-form]) + (merge type-datum) + (assoc :ns-name (:ns-name basis)) + (merge (kw-map arg-classes arg-classes|reify arglist-code|hinted arglist-code|reify|unhinted + i|basis interface output-class output-class|reify variadic?))))) + +(defns- >changed-unanalyzed-overloads + "A 'changed' overload here means one of three things: + - An overload from an overload basis whose type signature has changed, and after being split, + does not have the same type signature as that of an existing overload + - An overload from an overload basis for which its body has changed and it is an inline overload + - An overload from a newly declared overload basis whose type signature is unique for the + `t/defn` in question + - An overload from a newly declared overload basis whose type signature is the same as one that + already exists for the `t/defn` in question (in which case its implementation will overwrite + the existing one). + + 'Cheaply' O(m•n) where `m` is the number split types resulting from changed overload bases, and + `n` is the size of the existing overload types. 'Cheap' because only a `=` check is performed `n` + times for each `m`. All other computations are done only once for each `m`." + [opts ::opts + fn|globals ::fn|globals + env ::uana/env + {:keys [prev-norx _, current _]} ::overload-bases-data + existing-overload-types (us/nilable (us/vec-of ::types-decl-datum)) + > (us/vec-of ::unanalyzed-overload)] + (let [first-new-basis-index (count prev-norx)] + (->> current + (uc/map-indexed+ + (c/fn [i|basis + {:as basis + :keys [args-form body-codelist|unanalyzed output-type|form types|split]}] + (let [new-overload-basis? (>= i|basis first-new-basis-index) + prev-basis (get prev-norx i|basis) + changed? (when prev-basis (overload-basis|changed? basis prev-basis))] + (when (or new-overload-basis? changed?) + (let [type-signature-equal-to-existing? + (c/fn [{:keys [arg-types output-type]}] + (seq-or #(and (= output-type (:output-type %)) + (= arg-types (:arg-types %))) + existing-overload-types))] + (->> (or types|split (overload-basis-data>types+ fn|globals env (:ns-name basis) + args-form output-type|form body-codelist|unanalyzed)) + (cond->> (and (not new-overload-basis?) + (= (:body-codelist basis) (:body-codelist prev-basis))) + (uc/remove+ type-signature-equal-to-existing?)) + (uc/map+ (c/fn [type-datum] + (>unanalyzed-overload opts basis i|basis type-datum))))))))) + (uc/filter+ identity) + uc/cat))) + +(defns- validate-unique-types-for-unanalyzed-overloads + "Prior to validation we must first sort the overloads by comparing their arg types. Then if we + find any type signature duplicates in a linear scan, we throw an error." + [unanalyzed-overloads (us/seq-of ::unanalyzed-overload) + > (us/vec-of ::unanalyzed-overload)] + (->> unanalyzed-overloads + (dedupe-type-data + (c/fn [overloads prev-overload overload] + (err! "Duplicate input types for overload" + (umap/om :arglist-form-0 (:arglist-form|unanalyzed prev-overload) + :arg-types-0 (:arg-types prev-overload) + :body-0 (-> prev-overload :body-node :form) + :arglist-form-1 (:arglist-form|unanalyzed overload) + :arg-types-1 (:arg-types overload) + :body-1 (-> overload :body-node :form))))))) + +(defns- overload-bases-data>fn|types + "Each overload type is structurally (`=`) unique and if an overload is introduced which is `t/=` + but not `=` then that overload will be rejected." + [overload-bases-data ::overload-bases-data + existing-fn-types (us/nilable ::fn|types) + {:as opts :keys [kind _]} ::opts + {:as fn|globals + :keys [fn|name _, fn|name|local _, fn|ns-name _, fn|output-type _, fn|overload-types-name _]} + ::fn|globals + env ::uana/env + > ::fn|types] + (establish-dependency-relations-on-new-overload-bases! fn|output-type overload-bases-data) + (let [fn|output-type-norx|prev (:fn|output-type-norx existing-fn-types) + fn|output-type-norx (?deref fn|output-type) + existing-overload-types (:overload-types existing-fn-types)] + (when (and existing-fn-types + (t/not= fn|output-type-norx fn|output-type-norx|prev)) + (TODO "`fn|output-type` changed; not sure what to do at this point" + {:fn|output-type|prev fn|output-type-norx|prev + :fn|output-type|new fn|output-type-norx})) + (if-not-let [changed-unanalyzed-overloads + (seq (>changed-unanalyzed-overloads + opts fn|globals env overload-bases-data existing-overload-types))] + (or existing-fn-types + {:fn|output-type-norx fn|output-type-norx + :fn|type-norx (t/ftype (uid/qualify fn|ns-name fn|name|local) fn|output-type-norx) + :overload-types []}) + (let [sorted-changed-unanalyzed-overloads + (->> changed-unanalyzed-overloads + (sort-overload-types :arg-types) + validate-unique-types-for-unanalyzed-overloads) + first-current-overload-id (count existing-overload-types) + new-overload? (c/fn [type-datum] (>= (:id type-datum) first-current-overload-id)) + sorted-changed-overload-types + (->> sorted-changed-unanalyzed-overloads + (uc/map-indexed + (c/fn [i unanalyzed-overload] + (-> unanalyzed-overload + (select-keys + [:arg-types :arglist-code|hinted :body-codelist :inline? :interface + :output-type]) + (assoc :id (+ i first-current-overload-id) + :ns-name (:ns-name unanalyzed-overload)))))) + ;; We need to maintain the `overload-types` ordering by type-specificity so the dynamic + ;; dispatch and fn-type work correctly. + overload-types-with-replacing-ids + (if (empty? existing-overload-types) + (->> sorted-changed-overload-types + (uc/map-indexed (c/fn [i datum] (assoc datum :index i)))) + (->> ;; We `join` in this order because if two overloads are of equal sorting + ;; priority, the ones with earlier IDs should appear in + ;; `dedupe-overload-types-data` + (join existing-overload-types sorted-changed-overload-types) + (sort-overload-types :arg-types) + (dedupe-overload-types-data fn|ns-name fn|name) + (uc/map-indexed (c/fn [i datum] (assoc datum :index i))))) + ;; Partially for recursive purposes + fn|type-norx + (overload-types>ftype fn|globals overload-types-with-replacing-ids fn|output-type-norx) + ;; We should analyze everything first in order to figure out body-dependent input types + ;; before we can compare them against each other, but we're ignoring body-dependent input + ;; types for now + sorted-changed-overloads + (->> sorted-changed-unanalyzed-overloads + (uc/map-indexed + (c/fn [i x] + (let [id (+ i first-current-overload-id)] + (unanalyzed-overload>overload opts fn|globals env x id + overload-types-with-replacing-ids fn|type-norx))))) + overload-types + (->> overload-types-with-replacing-ids + (uc/map + (c/fn [datum] + (let [id (or (:replacing-id datum) (:id datum)) + datum' + (if (>= id first-current-overload-id) + (do ;; So that direct dispatch can use `overload` later on + (alist-conj! !global-overload-queue + (assoc datum :overload + (get sorted-changed-overloads + (- id first-current-overload-id)))) + datum) + datum)] + (dissoc datum' :replacing-id)))))] + ;; TODO use records here and other memory-friendly things + (kw-map fn|output-type-norx fn|type-norx overload-types))))) + +;; ----- Direct dispatch ----- ;; + +(defns- >direct-dispatch-seq + "Generates a seq of unevaluated direct-dispatch `reify`s sorted by index." + [{:as opts :keys [gen-gensym _, kind _]} ::opts + fn|globals ::fn|globals + fn|types ::fn|types + > ::direct-dispatch-seq] + (case ucore/lang + :clj (->> !global-overload-queue + (uc/map + (c/fn [{:as type-decl-datum :keys [arg-types id index overload]}] + (overload>reify opts fn|globals overload id index))) + (sort-by :index) + >vec) + :cljs (TODO))) + +;; ===== Dynamic dispatch ===== ;; + +(defns >direct-dispatch|reify-call + [overload|id ::overload|id, reify|interface class?, fs|name simple-symbol? + relevant-arglist (us/vec-of simple-symbol?)] + `(. ~(ufth/with-type-hint + (uana/aget* fs|name overload|id) (ufth/>body-embeddable-tag reify|interface)) + ~uana/direct-dispatch-method-sym ~@relevant-arglist)) + +;; TODO spec +(defns unsupported! + ([args _ #_indexed?, i index?] (unsupported! nil args i)) + ([name- _ #_t/qualified-symbol?, args _ #_indexed?, i index?] + (throw (ex-info "This function is unsupported for the type combination at the argument index." + {:name (if (nil? name-) (symbol "#anonymous") name-) + :args args + :arg-index i})))) + +(defns- >combinatoric-seq+ + [overload-types-for-arity (us/vec-of ::types-decl-datum) + ts|name simple-symbol? + fs|name simple-symbol? + relevant-arglist (us/vec-of simple-symbol?)] + (let [] + (->> overload-types-for-arity + (uc/map+ + (c/fn [{:as types-decl-datum :keys [arg-types id interface] ns-name- :ns-name}] + [(>direct-dispatch|reify-call id interface fs|name relevant-arglist) + (->> arg-types + (uc/map-indexed + (c/fn [i|arg arg-type] + {:i i|arg + :t arg-type + :getf `(~(uana/aget* (with-array-type-hint (uana/aget* ts|name id)) i|arg) + ~(get relevant-arglist i|arg))})))]))))) + +(defns- >dynamic-dispatch|body-for-arity + [{:as opts :keys [kind _]} ::opts + {:as fn|globals :keys [fn|ns-name _, fn|name _]} ::fn|globals + overload-types-for-arity (us/vec-of ::types-decl-datum) + arglist (us/vec-of simple-symbol?)] + (let [[ts|name fs|name & relevant-arglist] arglist + relevant-arglist (>vec relevant-arglist) + unsupported-name (if fn|name + (if (= kind :fn) fn|name (uid/qualify fn|ns-name fn|name)) + ')] + (if (empty? relevant-arglist) + (let [{:as types-decl-datum :keys [id interface]} (first overload-types-for-arity)] + (>direct-dispatch|reify-call id interface fs|name relevant-arglist)) + (let [!!i|arg (atom 0) + combinef + (c/fn + ([] (transient [`ifs])) + ([ret] + (-> ret (conj! `(unsupported! + '~unsupported-name ~relevant-arglist ~(deref !!i|arg))) + persistent! + seq)) + ([ret getf x i] + (reset! !!i|arg i) + (uc/conj! ret getf x)))] + (uc/>combinatoric-tree (count relevant-arglist) + (c/fn [a b] (t/= (:t a) (:t b))) + (aritoid combinef combinef (c/fn [x [{:keys [getf i]} group]] (combinef x getf group i))) + uc/conj!|rf + (aritoid combinef combinef (c/fn [x [k [{:keys [getf i]}]]] (combinef x getf k i))) + (>combinatoric-seq+ overload-types-for-arity ts|name fs|name relevant-arglist)))))) + +(defns- >dynamic-dispatch + [{:as opts :keys [compilation-mode _, gen-gensym _, kind _]} ::opts + {:as fn|globals :keys [fn|meta _, fn|ns-name _, fn|output-type _ + fn|overload-types-name _, fn|type-name _]} ::fn|globals + fn|types ::fn|types] + (let [overload-forms + (->> fn|types + :overload-types + (group-by (fn-> :arg-types count)) + (sort-by key) ; for purposes of reproducibility and organization + (map (c/fn [[arg-ct overload-types-for-arity]] + (let [ts|name (with-array-type-hint (gen-gensym "ts")) + fs|name (with-array-type-hint (gen-gensym "fs")) + arglist (join [ts|name fs|name] (ufgen/gen-args 0 arg-ct "x" gen-gensym)) + body (>dynamic-dispatch|body-for-arity + opts fn|globals overload-types-for-arity arglist)] + (list arglist body)))))] + {:form (when-not (empty? overload-forms) `(fn* ~@overload-forms))})) + +;; ===== End dynamic dispatch ===== ;; + +(defns- overload-basis-form>overload-basis + "This is for overloads being created brand-new within `defn` or `extend-defn!`." + [opts ::opts + {:as fn|globals + :keys [fn|inline? _, fn|output-type _, fn|output-type _, fn|output-type|form _]} ::fn|globals + env ::uana/env + {:as overload-basis-form + {:as arglist-form + args [:args _] + varargs [:varargs _] + pre-type|form [:pre _] + [_ _, output-type|form _] [:post _]} [:arglist _] + body-codelist|unanalyzed [:body _]} _ + > ::overload-basis] + (when pre-type|form (TODO "Need to handle pre")) + (when varargs (TODO "Need to handle varargs")) + (let [arg-types|form (->> args (mapv (c/fn [{[kind #_#{:any :spec}, t #_t/form?] :spec}] + (case kind :any `t/any? :spec t)))) + output-type|form (case output-type|form _ `t/any?, nil nil, output-type|form) + arg-bindings (->> args + (mapv (c/fn [{[kind binding-] :binding-form}] + ;; TODO this assertion is purely temporary until destructuring + ;; is supported + (assert kind :sym) + binding-))) + ;; TODO support varargs + varargs-binding (when varargs + ;; TODO this assertion is purely temporary until destructuring is + ;; supported + (assert (-> varargs :binding-form first (= :sym)))) + args-form (reduce-2 assoc (umap/om) arg-bindings arg-types|form) + ns-name-val (>symbol *ns*) + [arglist-basis] (uana/analyze-arg-syms + (assoc-in env [:opts :ns] (the-ns ns-name-val)) args-form + (or output-type|form fn|output-type) false) + binding->arg-type|basis (->> arglist-basis :env :opts :arg-env deref (uc/map-vals' :type)) + arg-types|basis (->> args-form keys (uc/map binding->arg-type|basis)) + output-type|basis (-> arglist-basis :output-type-node :type) + dependent? (:dependent? arglist-basis) + reactive? (or (utr/rx-type? output-type|basis) + (seq-or utr/rx-type? arg-types|basis)) + inline? (boolean (or (and fn|inline? (-> arglist-form meta :unline? not)) + (-> arglist-form meta :inline?)))] + {:ns-name ns-name-val + ;; TODO Only needed if `dependent?` or if new + :args-form args-form + :arg-types|basis arg-types|basis + ;; TODO Only needed if `dependent?` or if new + :varargs-form (when varargs {varargs-binding nil}) ; TODO `nil` isn't right + :arglist-form|unanalyzed (cond-> (uc/cat args-form) + varargs (conj '& varargs) + pre-type|form (conj '| pre-type|form) + output-type|form (conj '> output-type|form)) + ;; TODO Only needed if `dependent?` or if new + :output-type|form output-type|form + :output-type|basis output-type|basis + ;; We store this only for arglists with dependent types. If the arglist is reactive, then + ;; downstream, if the reactive types change, the new split types can be compared with the + ;; previous split types. If non-reactive, then the split types of this overload basis can be + ;; compared to existing overload bases. + :types|split (when dependent? + (->> (overload-basis-data>types+ fn|globals env ns-name-val + args-form output-type|form body-codelist|unanalyzed) + join)) + ;; TODO Only needed if `inline? or `reactive?`, or if new + :body-codelist body-codelist|unanalyzed + :dependent? dependent? + :reactive? reactive? + :inline? inline?})) + +;; ===== Reactive auxiliary vars ===== ;; + +(defns- incorporate-overload-bases + "O(m•n) where `m` = # of existing overload bases and `n` = # of new overload bases." + [existing-bases (us/vec-of ::overload-basis), new-bases (us/vec-of ::overload-basis) + > (us/vec-of ::overload-basis)] + (reduce + (c/fn [bases new-basis] + (if-let [i|existing + (->> existing-bases + (uc/map-indexed+ + (c/fn [i existing-basis] + (ifs-let + [same-code? + (and (= (:arglist-form|unanalyzed existing-basis) + (:arglist-form|unanalyzed new-basis)) + (= (:body-codelist existing-basis) + (:body-codelist new-basis)))] + (do (ulog/pr :warn + "Overwriting existing overload with same arglist and body" + {:arglist|form (:arglist-form|unanalyzed new-basis)}) + i) + ;; This only checks for `=` because `t/=` will be deduped later on in + ;; overloads, not overload bases + ;; TODO this doesn't take into account `|` types + [same-unreactive-type? + (and (not (:reactive? existing-basis)) + (not (:reactive? new-basis)) + (if (and (:dependent? existing-basis) + (:dependent? new-basis)) + (= (:types|split existing-basis) + (:types|split new-basis)) + (and (= (:output-type|basis existing-basis) + (:output-type|basis new-basis)) + (= (:arg-types|basis existing-basis) + (:arg-types|basis new-basis)))))] + (do (ulog/pr :warn "Overwriting existing overload with same types" + {:arglist|form|prev (:arglist-form|unanalyzed existing-basis) + :arglist|form (:arglist-form|unanalyzed new-basis)}) + i) + ;; TODO enhance this; figure out how to effectively compare reactive + ;; and dependent types, if that's even possible + ;; TODO maybe we don't even want this; maybe this should be based on + ;; an atom that's configurable. It does override/nullify some + ;; safety behavior in `overload-basis|changed?` + [probably-same-reactive-type? + (and (= (:reactive? existing-basis) + (:reactive? new-basis)) + (= (:dependent? existing-basis) + (:dependent? new-basis)) + (= (:types|split existing-basis) + (:types|split new-basis)) + (= (-> existing-basis :output-type|basis ?norx-deref) + (-> new-basis :output-type|basis ?norx-deref)) + (= (-> existing-basis :arg-types|basis ?norx-deref) + (-> new-basis :arg-types|basis ?norx-deref)))] + (do (ulog/pr :warn + (str "Assuming that new reactive overload basis is a subsequent " + "version of existing reactive overload basis") + {:new (:arglist-form|unanalyzed existing-basis) + :existing (:arglist-form|unanalyzed existing-basis)}) + i) + nil))) + (uc/filter+ some?) + uc/first)] + (assoc bases i|existing new-basis) + (conj bases new-basis))) + existing-bases + new-bases)) + +(defns- with-optional-validate-overload-bases [overload-bases ::overload-bases-data] overload-bases) + +(defns- >!overload-bases + "`!overload-bases` is a reactive atom updated by `t/extend-defn!`, which cannot be deleted from + but which can be updated and appended to." + [{:as opts :keys [kind _]} ::opts + {:as fn|globals :keys [fn|ns-name _, fn|overload-bases-name _]} ::fn|globals + env ::uana/env + overload-bases-form _] + (let [new-overload-bases + (->> overload-bases-form + (uc/map (c/fn [x] (overload-basis-form>overload-basis opts fn|globals env x))))] + (if (= kind :extend-defn!) + (with-do-let [!overload-bases + (-> (uid/qualify fn|ns-name fn|overload-bases-name) resolve var-get)] + (let [{:as overload-bases :keys [current]} (norx-deref !overload-bases) + overload-bases' + {:prev-norx + (->> current + (uc/map + (c/fn [basis] + ;; TODO use record here + {:arg-types|basis (->> basis :arg-types|basis (uc/map ?norx-deref)) + :output-type|basis (-> basis :output-type|basis ?norx-deref) + :types|split (:types|split basis) + :body-codelist (:body-codelist basis) + :dependent? (:dependent? basis) + :reactive? (:reactive? basis) + :inline? (:inline? basis)}))) + :current (incorporate-overload-bases current new-overload-bases)}] + (with-optional-validate-overload-bases overload-bases') + (let [prev-overload-bases (norx-deref !overload-bases)] + (when-not (= kind :fn) + (alist-conj! !global-rollback-queue + #(uref/set! !overload-bases prev-overload-bases))) + (uref/set! !overload-bases overload-bases')))) + (with-do-let [!overload-bases (urx/! {:prev-norx nil :current new-overload-bases})] + (when-not (= kind :fn) + (intern-with-rollback! fn|ns-name fn|overload-bases-name !overload-bases)))))) + +(defns- >!fn|types + "`!fn|types` is a reaction which depends on the `!overload-bases` atom and all reactive types + declared in any arglist of the `t/defn` in question, as well as the overall output type (if + reactive) of the `t/defn`. + + Whatever the values of `opts` and `fn|globals` are at the time of `t/defn` definition, that's + what they'll be for the lifetime of the function." + [{:as opts :keys [kind _]} ::opts + {:as fn|globals :keys [fn|ns-name _, fn|overload-types-name _, fn|type-name _]} ::fn|globals + env ::uana/env + !overload-bases urx/reactive?] + (if (= kind :extend-defn!) + (-> (uid/qualify fn|ns-name fn|overload-types-name) resolve var-get) + (with-do-let [!fn|types (doto (urx/!rx @!overload-bases) + (uref/add-interceptor! :the-interceptor + (c/fn [_ _ old-overload-types overload-bases-data] + ;; `opts` and `fn|globals` are closed over + (overload-bases-data>fn|types overload-bases-data + old-overload-types opts fn|globals env))) + norx-deref)] + (when-not (= kind :fn) + (intern-with-rollback! fn|ns-name fn|overload-types-name !fn|types))))) + +(defns- >!fn|type + [{:as opts :keys [kind _]} ::opts + {:as fn|globals :keys [fn|ns-name _, fn|output-type _, fn|type-name _]} ::fn|globals + !fn|types _] + (if (= kind :extend-defn!) + (-> (uid/qualify fn|ns-name fn|type-name) resolve var-get) + (with-do-let [!fn|type (t/rx* (urx/>!rx #(:fn|type-norx @!fn|types) {:eq-fn t/=}) nil)] + (when-not (= kind :fn) (intern-with-rollback! fn|ns-name fn|type-name !fn|type))))) + +;; ===== `opts` + `fn|globals` ===== ;; + +(defns- >fn|opts + "`opts` are per invocation of `t/defn` and/or `extend-defn!`, while `globals` persist for as long + as the `t/defn` does." + [env ::uana/env, kind ::kind, compilation-mode ::compilation-mode > ::opts] + (let [gen-gensym (or (-> env :opts :gen-gensym) + (let [gen-gensym-base + (if (= compilation-mode :test) + (ufgen/>reproducible-gensym|generator) + gensym)] + (c/fn [x] (symbol (str (gen-gensym-base x) "__")))))] + (kw-map compilation-mode gen-gensym kind))) + +(defns- >fn|globals+?overload-bases-form + "`opts` are per invocation of `t/defn` and/or `extend-defn!`, while `globals` persist for as long + as the `t/defn` does." + [{:as opts :keys [gen-gensym _, kind _]} ::opts, unanalyzed-form _ + > (us/kv {:fn|globals ::fn|globals :overload-bases-form t/any?})] + (let [{:keys [:quantum.core.specs/fn|name + :quantum.core.defnt/fn|extended-name + :quantum.core.defnt/output-spec] + overload-bases-form :quantum.core.defnt/overloads + fn|meta :quantum.core.specs/meta} + (us/validate (rest unanalyzed-form) + (case kind :defn :quantum.core.defnt/defnt + :fn :quantum.core.defnt/fnt + :extend-defn! :quantum.core.defnt/extend-defn!)) + fn|var (when (= kind :extend-defn!) + (or (uvar/resolve *ns* fn|extended-name) + (err! "Could not resolve fn name to extend" + {:sym fn|extended-name}))) + fn|ns-name (if (= kind :extend-defn!) + (-> fn|var >?namespace >symbol) + (>symbol *ns*)) + fn|name (case kind + :extend-defn! (-> fn|extended-name >name symbol) + (:defn :fn) fn|name) + fn|name|global (if (= kind :fn) + (symbol (str fn|name (when fn|name "|") (gen-gensym "__anon"))) + fn|name) + fn|name|local (or fn|name fn|name|global) + fn|globals-name (symbol (str fn|name|global "|__globals"))] + (if (= kind :extend-defn!) + {:fn|globals (-> (uid/qualify fn|ns-name fn|globals-name) resolve var-get) + :overload-bases-form overload-bases-form} + (let [fn|inline? (if (nil? (:inline fn|meta)) + false + (us/validate (:inline fn|meta) t/boolean?)) + fn|meta (dissoc fn|meta :inline) + fn|output-type|form (or (second output-spec) `t/any?) + ;; TODO this needs to be analyzed for dependent types referring to local vars + fn|output-type (eval fn|output-type|form) + fn|overload-bases-name (symbol (str fn|name|global "|__bases")) + fn|overload-types-name (symbol (str fn|name|global "|__types")) + fn|overload-types-name|local (symbol (str fn|name|local "|__types")) + fn|type-name (symbol (str fn|name|global "|__type")) + fn|ts-name (symbol (str fn|name|global "|__ts")) + fn|fs-name (symbol (str fn|name|local "|__fs")) + fn|globals ; TODO use record here + (kw-map fn|fs-name fn|globals-name fn|inline? fn|meta fn|name fn|name|global + fn|name|local fn|ns-name fn|output-type|form fn|output-type + fn|overload-bases-name fn|overload-types-name fn|overload-types-name|local + fn|ts-name fn|type-name)] + (when-not (= kind :fn) (intern-with-rollback! fn|ns-name fn|globals-name fn|globals)) + (kw-map fn|globals overload-bases-form))))) + +;; ===== Whole `t/(de)fn` creation ===== ;; + +(defns- >fn|ts + "Creates the array-of-arrays containing the type input data, for consumption by dynamic dispatch. + Interns the result as `fn|ts-name`." + ;; TODO but maybe can use a 2D array to avoid having to double cast with `(aget* (aget* &ts 1) 0)` + {:performance "Can't flatten this array because the param sizes are variable."} + [{:as opts :keys [kind _]} ::opts + {:as fn|globals :keys [fn|ns-name _, fn|ts-name _]} ::fn|globals + fn|types ::fn|types + > (us/kv {:ts t/any? ; (t/of oarray? (t/of oarray? t/type?) + :form t/any?})] + ;; TODO perhaps extern this (and parts thereof) whenever possible in `let*` statement on the very + ;; outside of the fn (so around the outer `reify*`) ? + (let [ts (->> fn|types + :overload-types + (uc/map+ (fn-> :arg-types uc/>array)) + uc/>array)] + (if (= kind :fn) + (let [form (list* `uarr/*<> + (->> fn|types + :overload-types + (uc/lmap (fn->> :arg-types (uc/lmap >form) (list* `uarr/*<>)))))] + {:ts ts :form form}) + (do ;; TODO need to avoid this in CLJS and when there are closed over locals in the type + (intern-with-rollback! fn|ns-name fn|ts-name ts) + {:ts ts :form (uid/qualify fn|ns-name fn|ts-name)})))) + +;; TODO lazily and incrementally analyze this; maybe we want to do code transformations which don't +;; require analysis, as shown in tests +(defns- analyze-fn* + [kind #{:defn :extend-defn! :fn}, env ::uana/env, unanalyzed-form _ > uast/node?] + (try + (let [opts (>fn|opts env kind *compilation-mode*) + env (assoc-in env [:opts :gen-gensym] (:gen-gensym opts)) + {:keys [fn|globals overload-bases-form] + {:keys [fn|fs-name fn|globals-name fn|meta fn|name fn|name|global fn|name|local + fn|ns-name fn|ts-name fn|type-name]} + :fn|globals} + (>fn|globals+?overload-bases-form opts unanalyzed-form) + !overload-bases (>!overload-bases opts fn|globals env overload-bases-form) + !fn|types (>!fn|types opts fn|globals env !overload-bases) + fn|types (norx-deref !fn|types) + fn|ts (>fn|ts opts fn|globals fn|types) + !fn|type (>!fn|type opts fn|globals !fn|types) + {:keys [form overloads]} + (if (empty? (norx-deref !overload-bases)) + (if (= kind :defn) + {:form `(declare ~(:fn|name|global fn|globals)) + :overloads []} + (err! "Overloads cannot be empty for non-`t/defn`s." {:form unanalyzed-form})) + (let [fn|meta (cond-> fn|meta + (not= kind :fn) (merge {:quantum.core.type/type + (uid/qualify fn|ns-name fn|type-name)})) + direct-dispatch-seq (>direct-dispatch-seq opts fn|globals fn|types) + dynamic-dispatch (>dynamic-dispatch opts fn|globals fn|types) + fn-form + `(let* [~fn|fs-name (uarr/*<>|sized ~(-> fn|types :overload-types count)) + ~fn|name|local (new TypedFn ~fn|meta ~(:form fn|ts) ~fn|fs-name + ~(:form dynamic-dispatch))] + ~@(->> direct-dispatch-seq + (map (c/fn [{:as reify-data :keys [id form]}] + (uana/aset* fn|fs-name id form)))) + ~fn|name|local)] + {:form (case kind + :fn fn-form + :defn `(do (uvar/defmeta-from ~fn|name|global ~fn-form)) + ;; FIXME extend-defn should redefine the fs, ts, and dynamic + ;; dispatch of the existing TypedFn object + :extend-defn! (TODO)) + :overloads (->> direct-dispatch-seq + (uc/map + (c/fn [{:keys [overload]}] + {:type (:output-type overload) + :arg-types (:arg-types overload) + :body (:body-node overload)})))})) + ast-basis + {:env env + :unanalyzed-form unanalyzed-form + :name fn|name + :meta fn|meta + :overloads overloads + :form form + ;; TODO is `norx-deref` the right approach? What if something else + ;; refers to the defn that then is extended? Will that not happen + ;; correctly? + :type (norx-deref !fn|type)}] + (case kind + :fn (uast/fnt-node ast-basis) + :defn (uast/defnt-node ast-basis) + :extend-defn! (uast/extend-defnt-node ast-basis))) + (finally (uvec/alist-empty! !global-overload-queue)))) + +(defns analyze-fn [env ::uana/env, form _] (analyze-fn* :fn env form)) + +(reset! uana/!!analyze-fnt analyze-fn) + +(defns analyze-defn [env ::uana/env, form _ > uast/node?] (analyze-fn* :defn env form)) + +(reset! uana/!!analyze-defnt analyze-defn) + +(defns analyze-extend-defn [env ::uana/env, form _] (analyze-fn* :extend-defn! env form)) + +(reset! uana/!!analyze-extend-defnt analyze-extend-defn) diff --git a/src-untyped/quantum/untyped/core/type/defs.cljc b/src-untyped/quantum/untyped/core/type/defs.cljc index 89d7d680..96b91035 100644 --- a/src-untyped/quantum/untyped/core/type/defs.cljc +++ b/src-untyped/quantum/untyped/core/type/defs.cljc @@ -14,33 +14,21 @@ [clojure.core.rrb-vector.rrbt] [clojure.string :as str] [quantum.untyped.core.data.map :as umap - :refer [map-entry]] + :refer [om]] [quantum.untyped.core.data.set :as uset] [quantum.untyped.core.data.tuple #?@(:cljs [:refer [Tuple]])] + [quantum.untyped.core.defnt + :refer [defns]] [quantum.untyped.core.fn - :refer [<- fn-> rcomp]] + :refer [<- fn-> fnl rcomp]] [quantum.untyped.core.form.evaluate :refer [env-lang]] [quantum.untyped.core.logic :refer [fn-and fn= condf1]] [quantum.untyped.core.numeric.combinatorics :as combo]) -#?(:cljs - (:require-macros - [quantum.untyped.core.type.defs :as self - :refer [gen-types gen-types|unevaled - ->array-nd-types* - !hash-map-types:gen - !unsorted-map-types:gen - !sorted-map-types:gen - !map-types:gen - !hash-set-types:gen - !unsorted-set-types:gen - !sorted-set-types:gen - !set-types:gen - gen-type>]])) (:import - #?@(:clj [; clojure.core.async.impl.channels.ManyToManyChannel + #?@(:clj [#_clojure.core.async.impl.channels.ManyToManyChannel com.google.common.util.concurrent.AtomicDouble quantum.untyped.core.data.tuple.Tuple] :cljs [goog.string.StringBuffer @@ -62,75 +50,83 @@ In JavaScript, all numbers are 64-bit floating point numbers. This means you can't represent in JavaScript all the Java longs Max 'safe' int: (dec (Math/pow 2 53))"} - primitive-type-meta + unboxed-symbol->type-meta {'boolean {:bits 1 :min 0 :max 1 - #?@(:clj [:array-ident "Z" - :outer-type "[Z" - :boxed 'java.lang.Boolean - :unboxed 'Boolean/TYPE])} + #?@(:clj [:array-ident "Z" + :outer-type "[Z" + :boxed java.lang.Boolean + :unboxed Boolean/TYPE])} 'byte {:bits 8 :min -128 :max 127 - #?@(:clj [:array-ident "B" + #?@(:clj [:array-ident "B" :outer-type "[B" - :boxed 'java.lang.Byte - :unboxed 'Byte/TYPE])} + :boxed java.lang.Byte + :unboxed Byte/TYPE])} 'short {:bits 16 :min -32768 :max 32767 - #?@(:clj [:array-ident "S" + #?@(:clj [:array-ident "S" :outer-type "[S" - :boxed 'java.lang.Short - :unboxed 'Short/TYPE])} + :boxed java.lang.Short + :unboxed Short/TYPE])} 'char {:bits 16 :min 0 :max 65535 - #?@(:clj [:array-ident "C" + #?@(:clj [:array-ident "C" :outer-type "[C" - :boxed 'java.lang.Character - :unboxed 'Character/TYPE])} + :boxed java.lang.Character + :unboxed Character/TYPE])} 'int {:bits 32 :min -2147483648 :max 2147483647 - #?@(:clj [:array-ident "I" + #?@(:clj [:array-ident "I" :outer-type "[I" - :boxed 'java.lang.Integer - :unboxed 'Integer/TYPE])} + :boxed java.lang.Integer + :unboxed Integer/TYPE])} 'long {:bits 64 :min -9223372036854775808 :max 9223372036854775807 - #?@(:clj [:array-ident "J" + #?@(:clj [:array-ident "J" :outer-type "[J" - :boxed 'java.lang.Long - :unboxed 'Long/TYPE])} + :boxed java.lang.Long + :unboxed Long/TYPE])} ; Technically with floating-point nums, "min" isn't the most negative; ; it's the smallest absolute - 'float {:bits 32 - :min 1.4E-45 - :max 3.4028235E38 - #?@(:clj [:array-ident "F" + 'float {:bits 32 + :min-absolute 1.4E-45 + :min -3.4028235E38 + :max 3.4028235E38 + :min-int -16777216 ; -2^24 + :max-int 16777216 ; 2^24 + #?@(:clj [:array-ident "F" :outer-type "[F" - :boxed 'java.lang.Float - :unboxed 'Float/TYPE])} - 'double {:bits 64 + :boxed java.lang.Float + :unboxed Float/TYPE])} + 'double {:bits 64 ; Because: ; Double/MIN_VALUE = 4.9E-324 ; (.-MIN_VALUE js/Number) = 5e-324 - :min #?(:clj Double/MIN_VALUE - :cljs (.-MIN_VALUE js/Number)) - :max 1.7976931348623157E308 ; Max number in JS - #?@(:clj [:array-ident "D" + :min-absolute #?(:clj Double/MIN_VALUE + :cljs (.-MIN_VALUE js/Number)) + :min -1.7976931348623157E308 + :max 1.7976931348623157E308 ; Max number in JS + :min-int -9007199254740992 ; -2^53 + :max-int 9007199254740992 ; 2^53 + #?@(:clj [:array-ident "D" :outer-type "[D" - :boxed 'java.lang.Double - :unboxed 'Double/TYPE])}}) + :boxed java.lang.Double + :unboxed Double/TYPE])}}) + +(def primitive-type-meta unboxed-symbol->type-meta) (def array-ident->primitive-sym - (->> primitive-type-meta (map (juxt (rcomp val :array-ident) key)) (into {}))) + (->> unboxed-symbol->type-meta (map (juxt (rcomp val :array-ident) key)) (into {}))) (def elem-types-clj - (->> primitive-type-meta + (->> unboxed-symbol->type-meta (map (fn [[k v]] [(:outer-type v) k])) (reduce (fn [m [k v]] @@ -138,31 +134,33 @@ {}))) #?(:clj -(def boxed-types* - (->> primitive-type-meta +(def boxed-types + (->> unboxed-symbol->type-meta (map (fn [[k v]] [k (:boxed v)])) (into {})))) #?(:clj -(def unboxed-types* - (zipmap (vals boxed-types*) (keys boxed-types*)))) +(def unboxed-types + (zipmap (vals boxed-types) (keys boxed-types)))) #?(:clj -(def boxed->unboxed-types-evaled (->> primitive-type-meta vals (map (juxt :boxed :unboxed)) (into {}) eval))) +(def boxed->unboxed-types-evaled + (->> unboxed-symbol->type-meta vals (map (juxt :boxed :unboxed)) (into {}) eval))) (def max-values - (->> primitive-type-meta + (->> unboxed-symbol->type-meta (map (fn [[k v]] [k (:max v)])) (into {}))) #?(:clj -(def promoted-types* +(def promoted-types {'short 'int 'byte 'short ; Because char is unsigned 'char 'int 'int 'long 'float 'double})) +;; TODO move this (defn max-type [types] (->> types (map (fn [type] [(get max-values type) type])) @@ -172,847 +170,3 @@ #?(:clj (def class->str (fn-> str (.substring 6)))) -(defn- retrieve [lang-n sets] (->> sets (map lang-n) (remove empty?) (apply uset/union))) - -(defn- cond-union [& sets] - {:clj (retrieve :clj sets) - :cljs (retrieve :cljs sets)}) - -#?(:clj -(defmacro ->array-nd-types* [n] - `{:boolean '~(symbol (str (apply str (repeat n \[)) "Z")) - :byte '~(symbol (str (apply str (repeat n \[)) "B")) - :char '~(symbol (str (apply str (repeat n \[)) "C")) - :short '~(symbol (str (apply str (repeat n \[)) "S")) - :int '~(symbol (str (apply str (repeat n \[)) "I")) - :long '~(symbol (str (apply str (repeat n \[)) "J")) - :float '~(symbol (str (apply str (repeat n \[)) "F")) - :double '~(symbol (str (apply str (repeat n \[)) "D")) - :object '~(symbol (str (apply str (repeat n \[)) "Ljava.lang.Object;"))})) - -(def primitive-type-map {:clj {'(type (boolean-array [false])) (symbol "[Z") - '(type (byte-array 0) ) (symbol "[B") - '(type (char-array "") ) (symbol "[C") - '(type (short-array 0) ) (symbol "[S") - '(type (long-array 0) ) (symbol "[J") - '(type (float-array 0) ) (symbol "[F") - '(type (int-array 0) ) (symbol "[I") - '(type (double-array 0.0) ) (symbol "[D") - '(type (object-array []) ) (symbol "[Ljava.lang.Object;")} - :cljs `{(type "" ) ~'string - (type 123 ) ~'number - (type (cljs.core/clj->js {}) ) ~'object - (type true ) ~'boolean - (type (cljs.core/array) ) ~'array - (type inc ) ~'function}}) - -; ______________________ ; -; ===== PRIMITIVES ===== ; -; •••••••••••••••••••••• ; - -(def nil-types '{:clj #{nil} :cljs #{nil}}) - -; ===== NON-NUMERIC PRIMITIVES ===== ; ; TODO CLJS - -(def unboxed-bool-types {:clj '#{boolean} - :cljs `#{(type true)}}) -(def unboxed-boolean-types unboxed-bool-types) -(def boxed-bool-types {:clj '#{java.lang.Boolean} - :cljs `#{(type true)}}) -(def boxed-boolean-types boxed-bool-types) -(def ?bool-types boxed-bool-types) -(def ?boolean-types ?bool-types) -(def bool-types (cond-union unboxed-bool-types boxed-bool-types)) -(def boolean-types bool-types) - -(def unboxed-byte-types '{:clj #{byte}}) -(def boxed-byte-types '{:clj #{java.lang.Byte}}) -(def ?byte-types boxed-byte-types) -(def byte-types (cond-union unboxed-byte-types boxed-byte-types)) - -(def unboxed-char-types '{:clj #{char}}) -(def boxed-char-types '{:clj #{java.lang.Character}}) -(def ?char-types boxed-char-types) -(def char-types (cond-union unboxed-char-types boxed-char-types)) - -; ===== NUMBERS ===== ; ; TODO CLJS - -; ----- INTEGERS ----- ; - -(def unboxed-short-types '{:clj #{short}}) -(def boxed-short-types '{:clj #{java.lang.Short}}) -(def ?short-types boxed-short-types) -(def short-types (cond-union unboxed-short-types boxed-short-types)) - -(def unboxed-int-types {:clj '#{int} - ; because the integral values representable by JS numbers are in the - ; range of Java ints, though technically one needs to ensure that - ; there is only an integral value, no decimal value - :cljs `#{(type 123)}}) -(def boxed-int-types {:clj '#{java.lang.Integer} - :cljs `#{(type 123)}}) -(def ?int-types boxed-int-types) -(def int-types (cond-union unboxed-int-types boxed-int-types)) - -(def unboxed-long-types '{:clj #{long}}) -(def boxed-long-types '{:clj #{java.lang.Long}}) -(def ?long-types boxed-long-types) -(def long-types (cond-union unboxed-long-types boxed-long-types)) - -(def bigint-types '{:clj #{clojure.lang.BigInt java.math.BigInteger} - :cljs #{com.gfredericks.goog.math.Integer}}) - -(def integer-types (cond-union unboxed-short-types unboxed-int-types unboxed-long-types bigint-types)) - -; ----- DECIMALS ----- ; - -(def unboxed-float-types '{:clj #{float}}) -(def boxed-float-types '{:clj #{java.lang.Float}}) -(def ?float-types boxed-float-types) -(def float-types (cond-union unboxed-float-types boxed-float-types)) - -(def unboxed-double-types {:clj '#{double} - :cljs `#{(type 123)}}) -(def boxed-double-types {:clj '#{java.lang.Double} - :cljs `#{(type 123)}}) -(def ?double-types boxed-double-types) -(def double-types (cond-union unboxed-double-types boxed-double-types)) - -(def bigdec-types '{:clj #{java.math.BigDecimal}}) - -(def decimal-types (cond-union unboxed-float-types unboxed-double-types bigdec-types)) - -; ----- GENERAL ----- ; - -(def ratio-types '{:clj #{clojure.lang.Ratio} - :cljs #{quantum.core.numeric.types.Ratio}}) - -(def number-types {:clj (uset/union - (:clj (cond-union unboxed-short-types unboxed-int-types unboxed-long-types - unboxed-float-types unboxed-double-types)) - '#{java.lang.Number}) - :cljs (:cljs (cond-union integer-types decimal-types ratio-types))}) - - -(def pnumber-types `{:cljs #{(type 123)}}) - -; The closest thing to a native int the platform has -(def nat-int-types `{:clj #{~'int} - :cljs #{(type 123)}}) - -; The closest thing to a native long the platform has -(def nat-long-types `{:clj #{~'long} - :cljs #{(type 123)}}) - -; _______________________ ; -; ===== COLLECTIONS ===== ; -; ••••••••••••••••••••••• ; - -; ===== TUPLES ===== ; - -(def tuple-types `{:clj #{Tuple} ; clojure.lang.Tuple was discontinued; we won't support it for now - :cljs #{Tuple}}) -(def map-entry-types '{:clj #{java.util.Map$Entry}}) - -; ===== SEQUENCES ===== ; Sequential (generally not efficient Lookup / RandomAccess) - -(def cons-types '{:clj #{clojure.lang.Cons} - :cljs #{cljs.core/Cons}}) -(def lseq-types '{:clj #{clojure.lang.LazySeq} - :cljs #{cljs.core/LazySeq }}) -(def misc-seq-types '{:clj #{clojure.lang.APersistentMap$ValSeq - clojure.lang.APersistentMap$KeySeq - clojure.lang.PersistentVector$ChunkedSeq - clojure.lang.IndexedSeq} - :cljs #{cljs.core/ValSeq - cljs.core/KeySeq - cljs.core/IndexedSeq - cljs.core/ChunkedSeq}}) - -(def non-list-seq-types (cond-union cons-types lseq-types misc-seq-types)) - -; ----- LISTS ----- ; Not extremely different from Sequences ; TODO clean this up - -(def cdlist-types {} - #_'{:clj #{clojure.data.finger_tree.CountedDoubleList - quantum.core.data.finger_tree.CountedDoubleList} - :cljs #{quantum.core.data.finger-tree/CountedDoubleList}}) -(def dlist-types {} - #_'{:clj #{clojure.data.finger_tree.CountedDoubleList - quantum.core.data.finger_tree.CountedDoubleList} - :cljs #{quantum.core.data.finger-tree/CountedDoubleList}}) -(def +list-types {:clj '#{clojure.lang.IPersistentList} - :cljs (uset/union (:cljs dlist-types) - (:cljs cdlist-types) - '#{cljs.core/List cljs.core/EmptyList})}) -(def !list-types '{:clj #{java.util.LinkedList}}) -(def list-types {:clj '#{java.util.List} - :cljs (:cljs +list-types)}) - -; ----- GENERIC ----- ; - -(def seq-types {:clj '#{clojure.lang.ISeq} - :cljs (:cljs (cond-union non-list-seq-types list-types))}) - -; ===== MAPS ===== ; Associative - -; ----- Generators ----- ; - -(defn x name str/capitalize))) - -(defn !map-type:gen [from to suffixes] - (let [fastutil-class-name-base - (str "it.unimi.dsi.fastutil." (> suffixes - (map #(symbol (str fastutil-class-name-base %))) - set)})) - -(defn !map-types*:gen [prefix genf ref->ref] - (let [?prefix (when prefix (str prefix "-")) - base-types (conj (keys primitive-type-meta) 'ref) - type-combos (->> base-types - (<- combo/selections 2) - (remove (fn-> first (= 'boolean)))) - gen-same-sym (fn [t] (symbol (str "!" ?prefix "map:" t "-types"))) - gen-map-sym (fn [from to] (symbol (str "!" ?prefix "map:" from "->" to "-types"))) - any-*-defs - (->> base-types - (map (fn [t] - (let [any-key-sym (symbol (str "!" ?prefix "map:" "any" "->" t "-types")) - any-val-sym (symbol (str "!" ?prefix "map:" t "->" "any" "-types")) - cond-union:any - (fn [pred] (list* 'cond-union - (->> type-combos (filter (fn-> pred (= t))) (map (partial apply gen-map-sym)))))] - `(do (def ~any-key-sym ~(cond-union:any second)) - (def ~any-val-sym ~(cond-union:any first ))))))) - sym=>code - (->> type-combos - (map (fn [[from to]] - (let [body (genf from to) - sym (gen-map-sym from to)] - [sym `(do (def ~sym ~body) - ~(when (= from to) - `(def ~(gen-same-sym from) ~sym)))]))) - (into (umap/om)))] - (concat (vals sym=>code) - [(let [ref->ref-sym (gen-map-sym 'ref 'ref)] - `(do (def ~ref->ref-sym ~ref->ref) - (def ~(gen-same-sym 'ref) ~ref->ref-sym)))] - any-*-defs - [`(def ~(symbol (str "!" ?prefix "map-types")) (cond-union ~@(keys sym=>code)))]))) - -#?(:clj -(defmacro !hash-map-types:gen [ref->ref] - `(do ~@(!map-types*:gen "hash" - (fn [from to] (!map-type:gen from to #{"OpenHashMap" "OpenCustomHashMap"})) - ref->ref)))) - -#?(:clj -(defmacro !unsorted-map-types:gen [] - `(do ~@(!map-types*:gen "unsorted" - (fn [from to] (symbol (str "!hash-map:" from "->" to "-types"))) - '!hash-map:ref-types)))) - -#?(:clj -(defmacro !sorted-map-types:gen [ref->ref] - `(do ~@(!map-types*:gen "sorted" (fn [from to] {}) ref->ref)))) - -#?(:clj -(defmacro !map-types:gen [] - ; technically also `object` for CLJS - `(do ~@(!map-types*:gen nil (fn [from to] (!map-type:gen from to #{"Map"})) - '(cond-union !unsorted-map:ref-types !sorted-map:ref-types))))) - -(defn !set-type:gen [t suffixes] - (let [fastutil-class-name-base - (str "it.unimi.dsi.fastutil." (> suffixes - (map #(symbol (str fastutil-class-name-base %))) - set)})) - -(defn !set-types*:gen [prefix genf ref-val] - (let [?prefix (when prefix (str prefix "-")) - sym=>code - (->> (conj (keys primitive-type-meta) 'ref) - (remove (fn= 'boolean)) - (map (fn [t] - (let [body (genf t) - sym (symbol (str "!" ?prefix "set:" t "-types"))] - [sym `(def ~sym ~body)]))) - (into (umap/om)))] - (concat (vals sym=>code) - [`(def ~(symbol (str "!" ?prefix "set:ref-types")) ~ref-val) - `(def ~(symbol (str "!" ?prefix "set-types")) (cond-union ~@(keys sym=>code)))]))) - -#?(:clj -(defmacro !hash-set-types:gen [ref-val] - `(do ~@(!set-types*:gen "hash" - (fn [t] (!set-type:gen t #{"OpenHashSet" "OpenCustomHashSet"})) - ref-val)))) - -#?(:clj -(defmacro !unsorted-set-types:gen [] - `(do ~@(!set-types*:gen "unsorted" - (fn [t] (symbol (str "!hash-set:" t "-types"))) - '!hash-set:ref-types)))) - -#?(:clj -(defmacro !sorted-set-types:gen [ref-val] - `(do ~@(!set-types*:gen "sorted" (fn [t] {}) ref-val)))) - -#?(:clj -(defmacro !set-types:gen [] - `(do ~@(!set-types*:gen nil (fn [t] (!set-type:gen t #{"Set"})) - '(cond-union !unsorted-set:ref-types !sorted-set:ref-types))))) - -; ----- ; - -(def +array-map-types '{:clj #{clojure.lang.PersistentArrayMap} - :cljs #{cljs.core/PersistentArrayMap}}) -(def !+array-map-types '{:clj #{clojure.lang.PersistentArrayMap$TransientArrayMap} - :cljs #{cljs.core/TransientArrayMap}}) -(def ?!+array-map-types (cond-union !+array-map-types +array-map-types)) -(def !array-map-types {}) -(def !!array-map-types {}) -(def array-map-types (cond-union ?!+array-map-types - !array-map-types !!array-map-types)) - -(def +hash-map-types '{:clj #{clojure.lang.PersistentHashMap} - :cljs #{cljs.core/PersistentHashMap}}) -(def !+hash-map-types '{:clj #{clojure.lang.PersistentHashMap$TransientHashMap} - :cljs #{cljs.core/TransientHashMap}}) -(def ?!+hash-map-types (cond-union !+hash-map-types +hash-map-types)) - -(!hash-map-types:gen - '{:clj #{java.util.HashMap - java.util.IdentityHashMap - it.unimi.dsi.fastutil.objects.Reference2ReferenceOpenHashMap - it.unimi.dsi.fastutil.objects.Reference2ReferenceOpenCustomHashMap} - :cljs #{goog.structs.Map}}) - -(def !!hash-map-types '{:clj #{java.util.concurrent.ConcurrentHashMap}}) -(def hash-map-types (cond-union ?!+hash-map-types - !hash-map-types !!hash-map-types)) - -(def +unsorted-map-types (cond-union +hash-map-types +array-map-types)) -(def !+unsorted-map-types (cond-union !+hash-map-types !+array-map-types)) -(def ?!+unsorted-map-types (cond-union ?!+hash-map-types ?!+array-map-types)) - -(!unsorted-map-types:gen) - -(def !!unsorted-map-types !!hash-map-types) -(def unsorted-map-types (cond-union ?!+unsorted-map-types - !unsorted-map-types !!unsorted-map-types)) - -(def +sorted-map-types '{:clj #{clojure.lang.PersistentTreeMap} - :cljs #{cljs.core/PersistentTreeMap }}) -(def !+sorted-map-types {}) -(def ?!+sorted-map-types (cond-union +sorted-map-types !+sorted-map-types)) - -(!sorted-map-types:gen - '{:clj #{java.util.TreeMap} - :cljs #{goog.structs.AvlTree}}) - -(def !!sorted-map-types {}) -(def sorted-map-types {:clj (uset/union (:clj ?!+sorted-map-types) - '#{java.util.SortedMap}) - :cljs (uset/union (:cljs +sorted-map-types) - (:cljs !sorted-map-types))}) - -(def !insertion-ordered-map-types {:clj '#{java.util.LinkedHashMap}}) -(def +insertion-ordered-map-types {:clj '#{flatland.ordered.map.OrderedMap}}) -(def insertion-ordered-map-types (cond-union !insertion-ordered-map-types - +insertion-ordered-map-types)) - -(def !+map-types {:clj '#{clojure.lang.ITransientMap} - :cljs (uset/union (:cljs !+unsorted-map-types))}) -(def +map-types {:clj '#{clojure.lang.IPersistentMap} - :cljs (uset/union (:cljs +unsorted-map-types) - (:cljs +sorted-map-types))}) -(def ?!+map-types (cond-union !+map-types +map-types)) - -(!map-types:gen) - -(def !!map-types (cond-union !!unsorted-map-types !!sorted-map-types)) -(def map-types {:clj (uset/union (:clj !+map-types) - '#{; TODO IPersistentMap as well, yes, but all persistent Clojure maps implement java.util.Map - ; TODO add typed maps into this definition once lazy compilation is in place - java.util.Map}) - :cljs (uset/union (:cljs ?!+map-types) - (:cljs !map-types) - (:cljs !!map-types))}) - -; ===== SETS ===== ; Associative; A special type of Map whose keys and vals are identical - -(def +hash-set-types '{:clj #{clojure.lang.PersistentHashSet} - :cljs #{cljs.core/PersistentHashSet}}) -(def !+hash-set-types '{:clj #{clojure.lang.PersistentHashSet$TransientHashSet} - :cljs #{cljs.core/TransientHashSet}}) -(def ?!+hash-set-types (cond-union !+hash-set-types +hash-set-types)) - -(!hash-set-types:gen - '{:clj #{java.util.HashSet - #_java.util.IdentityHashSet} - :cljs #{goog.structs.Set}}) - -(def !!hash-set-types {}) ; technically you can make something from ConcurrentHashMap but... -(def hash-set-types (cond-union ?!+hash-set-types - !hash-set-types !!hash-set-types)) - -(def +unsorted-set-types +hash-set-types) -(def !+unsorted-set-types !+hash-set-types) -(def ?!+unsorted-set-types ?!+hash-set-types) - -(!unsorted-set-types:gen) - -(def !!unsorted-set-types !!hash-set-types) -(def unsorted-set-types hash-set-types) - -(def +sorted-set-types '{:clj #{clojure.lang.PersistentTreeSet} - :cljs #{cljs.core/PersistentTreeSet }}) -(def !+sorted-set-types {}) -(def ?!+sorted-set-types (cond-union +sorted-set-types !+sorted-set-types)) - -(!sorted-set-types:gen - '{:clj #{java.util.TreeSet}}) ; CLJS can have via AVLTree with same KVs - -(def !!sorted-set-types {}) -(def sorted-set-types {:clj (uset/union (:clj +sorted-set-types) - '#{java.util.SortedSet}) - :cljs (uset/union (:cljs +sorted-set-types) - (:cljs !sorted-set-types) - (:cljs !!sorted-set-types))}) - -(def !+set-types {:clj '#{clojure.lang.ITransientSet} - :cljs (uset/union (:cljs !+unsorted-set-types))}) -(def +set-types {:clj '#{clojure.lang.IPersistentSet} - :cljs (uset/union (:cljs +unsorted-set-types) - (:cljs +sorted-set-types))}) -(def ?!+set-types (cond-union !+set-types +set-types)) - -(!set-types:gen) - -(def !set-types:int {:clj '#{it.unimi.dsi.fastutil.ints.IntSet}}) -(def !set-types:long {:clj '#{it.unimi.dsi.fastutil.longs.LongSet}}) -(def !set-types:double {:clj '#{it.unimi.dsi.fastutil.doubles.DoubleSet}}) -(def !set-types:ref (cond-union !unsorted-set:ref-types - !sorted-set:ref-types)) -(def !set-types (cond-union !unsorted-set-types - !sorted-set-types)) -(def !!set-types (cond-union !!unsorted-set-types !!sorted-set-types)) -(def set-types {:clj (uset/union (:clj !+set-types) - '#{; TODO IPersistentSet as well, yes, but all persistent Clojure sets implement java.util.Set - java.util.Set}) - :cljs (uset/union (:cljs ?!+set-types) - (:cljs !set-types) - (:cljs !!set-types))}) - -; ===== ARRAYS ===== ; Sequential, Associative (specifically, whose keys are sequential, - ; dense integer values), not extensible -; TODO do e.g. {:clj {0 {:byte ...}}} -(def array-1d-types* `{:clj {:byte (type (byte-array 0) ) - :char (type (char-array "") ) - :short (type (short-array 0) ) - :long (type (long-array 0) ) - :float (type (float-array 0) ) - :int (type (int-array 0) ) - :double (type (double-array 0.0) ) - :boolean (type (boolean-array [false])) - :object (type (object-array []) )} - :cljs {:byte js/Int8Array - :ubyte js/Uint8Array - :ubyte-clamped js/Uint8ClampedArray - :char js/Uint16Array ; kind of - :ushort js/Uint16Array - :short js/Int16Array - :int js/Int32Array - :uint js/Uint32Array - :float js/Float32Array - :double js/Float64Array - :object (type (cljs.core/array))}}) -(def undistinguished-array-1d-types (->> array-1d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {}))) -(def array-2d-types* {:clj (->array-nd-types* 2 )}) -(def array-3d-types* {:clj (->array-nd-types* 3 )}) -(def array-4d-types* {:clj (->array-nd-types* 4 )}) -(def array-5d-types* {:clj (->array-nd-types* 5 )}) -(def array-6d-types* {:clj (->array-nd-types* 6 )}) -(def array-7d-types* {:clj (->array-nd-types* 7 )}) -(def array-8d-types* {:clj (->array-nd-types* 8 )}) -(def array-9d-types* {:clj (->array-nd-types* 9 )}) -(def array-10d-types* {:clj (->array-nd-types* 10)}) -(def array-types (cond-union (->> array-1d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {})) - (->> array-2d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {})) - (->> array-3d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {})) - (->> array-4d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {})) - (->> array-5d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {})) - (->> array-6d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {})) - (->> array-7d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {})) - (->> array-8d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {})) - (->> array-9d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {})) - (->> array-10d-types* (map (fn [[k v]] [k (-> v vals set)])) (into {})))) - -; String: A special wrapper for char array where different encodings, etc. are possible - -; Mutable String -(def !string-types '{:clj #{StringBuilder} :cljs #{goog.string.StringBuffer}}) -; Immutable String -(def string-types `{:clj #{String} :cljs #{(type "")}}) - -(def char-seq-types {:clj '#{CharSequence}}) - -; ===== VECTORS ===== ; Sequential, Associative (specifically, whose keys are sequential, - ; dense integer values), extensible - -(def !array-list-types '{:clj #{java.util.ArrayList - java.util.Arrays$ArrayList} ; indexed and associative, but not extensible - :cljs #_cljs.core.ArrayList ; not used - #{(type (cljs.core/array))}}) ; because supports .push etc. -; svec = "spliceable vector" -(def svector-types '{:clj #{clojure.core.rrb_vector.rrbt.Vector} - :cljs #{clojure.core.rrb_vector.rrbt.Vector}}) -(def +vector-types {:clj '#{clojure.lang.IPersistentVector} - :cljs (uset/union (:cljs svector-types) - '#{cljs.core/PersistentVector})}) -(def !+vector-types '{:clj #{clojure.lang.ITransientVector} - :cljs #{cljs.core/TransientVector}}) -(def ?!+vector-types (cond-union +vector-types !+vector-types)) -(def !vector:long-types '{:clj #{it.unimi.dsi.fastutil.longs.LongArrayList}}) -(def !vector:ref-types '{:clj #{java.util.ArrayList} - :cljs #{(type (cljs.core/array))}}) ; because supports .push etc. -(def !vector-types (cond-union !vector:long-types - !vector:ref-types)) - ; java.util.Vector is deprecated, because you can - ; just create a synchronized wrapper over an ArrayList - ; via java.util.Collections -(def !!vector-types {}) -(def vector-types (cond-union ?!+vector-types !vector-types !!vector-types)) - -; ===== QUEUES ===== ; Particularly FIFO queues, as LIFO = stack = any vector - -(def +queue-types '{:clj #{clojure.lang.PersistentQueue} - :cljs #{cljs.core/PersistentQueue }}) -(def !+queue-types {}) -(def ?!+queue-types (cond-union +queue-types !+queue-types)) -(def !queue-types '{:clj #{java.util.ArrayDeque} ; TODO *MANY* more here - :cljs #{goog.structs.Queue}}) -(def !!queue-types {}) ; TODO *MANY* more here -(def queue-types {:clj (uset/union (:clj ?!+queue-types) - '#{java.util.Queue}) - :cljs (uset/union (:cljs ?!+queue-types) - (:cljs !queue-types) - (:cljs !!queue-types))}) - -; ===== GENERIC ===== ; - -; ----- PRIMITIVES ----- ; - -(def primitive-unboxed-types (cond-union unboxed-bool-types unboxed-byte-types unboxed-char-types - unboxed-short-types unboxed-int-types unboxed-long-types - unboxed-float-types unboxed-double-types)) - -(def prim-types primitive-unboxed-types) - -(def prim-comparable-types (cond-union unboxed-byte-types unboxed-char-types - unboxed-short-types unboxed-int-types unboxed-long-types - unboxed-float-types unboxed-double-types)) - -; Possibly can't check for boxedness in Java because it does auto-(un)boxing, but it's nice to have -(def primitive-boxed-types (cond-union boxed-bool-types boxed-byte-types boxed-char-types - boxed-short-types boxed-int-types boxed-long-types - boxed-float-types boxed-double-types)) - -(def primitive-types (cond-union bool-types byte-types char-types - short-types int-types long-types - float-types double-types - #_{:cljs #{(type "")}})) - -; Standard "uncuttable" types -(def integral-types (cond-union bool-types byte-types char-types number-types)) - -; ----- COLLECTIONS ----- ; - - ; TODO this might be ambiguous - ; TODO clojure.lang.Indexed / cljs.core/IIndexed? -(def indexed-types (cond-union array-types string-types vector-types - '{:clj #{clojure.lang.APersistentVector$RSeq}})) - ; TODO this might be ambiguous - ; TODO clojure.lang.Associative / cljs.core/IAssociative? -(def associative-types (cond-union map-types set-types indexed-types)) - ; TODO this might be ambiguous - ; TODO clojure.lang.Sequential / cljs.core/ISequential? -(def sequential-types (cond-union seq-types list-types indexed-types)) - ; TODO this might be ambiguous - ; TODO clojure.lang.ICollection / cljs.core/ICollection? -(def counted-types (cond-union array-types string-types - {:clj (uset/union (:clj !vector-types) (:clj !!vector-types) - (:clj !map-types ) (:clj !!map-types) - (:clj !set-types ) (:clj !!set-types) - '#{clojure.lang.Counted}) - :cljs (uset/union (:cljs vector-types) - (:cljs map-types) - (:cljs set-types))})) - -(def coll-types (cond-union sequential-types associative-types)) - -(def sorted-types {:clj '#{clojure.lang.Sorted java.util.SortedMap java.util.SortedSet} - :cljs (:cljs (cond-union sorted-set-types sorted-map-types))}) ; TODO add in `cljs.core/ISorted - -(def transient-types '{:clj #{clojure.lang.ITransientCollection} - :cljs #{cljs.core/TransientVector - cljs.core/TransientHashSet - cljs.core/TransientArrayMap - cljs.core/TransientHashMap}}) - -; Collections that have Transient counterparts -(def transientizable-types (cond-union #_core-tuple-types - '{:clj #{clojure.lang.PersistentArrayMap - clojure.lang.PersistentHashMap - clojure.lang.PersistentHashSet - clojure.lang.PersistentVector} - :cljs #{cljs.core/PersistentArrayMap - cljs.core/PersistentHashMap - cljs.core/PersistentHashSet - cljs.core/PersistentVector}})) - -(def editable-types {:clj '#{clojure.lang.IEditableCollection} - :cljs #_#{cljs.core/IEditableCollection} ; can't dispatch on a protocol - (get transientizable-types :cljs)}) - -; ===== FUNCTIONS ===== ; - -(def fn-types `{:clj #{clojure.lang.Fn} :cljs #{(type inc)}}) -(def ifn-types `{:clj #{clojure.lang.IFn} :cljs #{(type inc)}}) ; TODO keyword types? -(def multimethod-types '{:clj #{clojure.lang.MultiFn}}) - -; ===== MISCELLANEOUS ===== ; - -(def regex-types '{:clj #{java.util.regex.Pattern} - :cljs #{js/RegExp }}) - -(def atom-types '{:clj #{clojure.lang.IAtom} - :cljs #{cljs.core/Atom}}) -(def volatile-types '{:clj #{clojure.lang.Volatile} - :cljs #{cljs.core/Volatile}}) -(def atomic-types {:clj (uset/union (:clj atom-types) (:clj volatile-types) - '#{java.util.concurrent.atomic.AtomicReference - ; From the java.util.concurrent package: - ; "Additionally, classes are provided only for those - ; types that are commonly useful in intended applications. - ; For example, there is no atomic class for representing - ; byte. In those infrequent cases where you would like - ; to do so, you can use an AtomicInteger to hold byte - ; values, and cast appropriately. You can also hold floats - ; using Float.floatToIntBits and Float.intBitstoFloat - ; conversions, and doubles using Double.doubleToLongBits - ; and Double.longBitsToDouble conversions. - java.util.concurrent.atomic.AtomicBoolean - #_java.util.concurrent.atomic.AtomicByte - #_java.util.concurrent.atomic.AtomicShort - java.util.concurrent.atomic.AtomicInteger - java.util.concurrent.atomic.AtomicLong - #_java.util.concurrent.atomic.AtomicFloat - #_java.util.concurrent.atomic.AtomicDouble - com.google.common.util.concurrent.AtomicDouble - })}) - -(def m2m-chan-types '{:clj #{clojure.core.async.impl.channels.ManyToManyChannel} - :cljs #{cljs.core.async.impl.channels/ManyToManyChannel}}) - -(def chan-types '{:clj #{clojure.core.async.impl.protocols.Channel} - :cljs #{cljs.core.async.impl.channels/ManyToManyChannel - #_"TODO more?"}}) - -(def keyword-types '{:clj #{clojure.lang.Keyword} - :cljs #{cljs.core/Keyword}}) - -(def symbol-types '{:clj #{clojure.lang.Symbol} - :cljs #{cljs.core/Symbol}}) - -(def file-types '{:clj #{java.io.File} - :cljs #{#_js/File}}) ; isn't always available! Use an abstraction - -(def any-types {:clj (uset/union (:clj prim-types) #{'java.lang.Object}) - :cljs '#{(quote default)}}) - -(def comparable-types {:clj (uset/union '#{byte char short int long float double} '#{Comparable}) - :cljs (:cljs number-types)}) - -(def record-types '{:clj #{clojure.lang.IRecord} - #_:cljs #_#{cljs.core/IRecord}}) ; because can't protocol-dispatch on protocols in CLJS - -(def transformer-types '{:clj #{#_clojure.core.protocols.CollReduce ; no, in order to find most specific type - quantum.untyped.core.reducers.Transformer} - :cljs #{#_cljs.core/IReduce ; CLJS problems with dispatching on protocol - quantum.untyped.core.reducers.Transformer}}) - -#_(def reducible-types (cond-union - array-types - string-types - record-types - reducer-types - chan-types - {:cljs (:cljs +map-types)} - {:cljs (:cljs +set-types)} - integer-types - {:clj '#{clojure.lang.IReduce - clojure.lang.IReduceInit - clojure.lang.IKVReduce - #_clojure.core.protocols.CollReduce} ; no, in order to find most specific type - #_:cljs #_'#{cljs.core/IReduce}} ; because can't protocol-dispatch on protocols in CLJS - {:clj '#{fast_zip.core.ZipperLocation} - :cljs '#{fast-zip.core/ZipperLocation}})) - -(def booleans-types {:clj #{(-> array-1d-types* :clj :boolean)}}) -(def bytes-types {:clj #{(-> array-1d-types* :clj :byte )} :cljs #{(-> array-1d-types* :cljs :byte )}}) -(def ubytes-types { :cljs #{(-> array-1d-types* :cljs :ubyte )}}) -(def ubytes-clamped-types { :cljs #{(-> array-1d-types* :cljs :ubyte-clamped)}}) -(def chars-types {:clj #{(-> array-1d-types* :clj :char )} :cljs #{(-> array-1d-types* :cljs :char )}}) -(def shorts-types {:clj #{(-> array-1d-types* :clj :short )} :cljs #{(-> array-1d-types* :cljs :short )}}) -(def ushorts-types { :cljs #{(-> array-1d-types* :cljs :ushort )}}) -(def ints-types {:clj #{(-> array-1d-types* :clj :int )} :cljs #{(-> array-1d-types* :cljs :int )}}) -(def uints-types { :cljs #{(-> array-1d-types* :cljs :uint )}}) -(def longs-types {:clj #{(-> array-1d-types* :clj :long )} :cljs #{(-> array-1d-types* :cljs :long )}}) -(def floats-types {:clj #{(-> array-1d-types* :clj :float )} :cljs #{(-> array-1d-types* :cljs :float )}}) -(def doubles-types {:clj #{(-> array-1d-types* :clj :double )} :cljs #{(-> array-1d-types* :cljs :double )}}) -(def objects-types {:clj #{(-> array-1d-types* :clj :object )} :cljs #{(-> array-1d-types* :cljs :object )}}) - -(def objects-nd-types {:clj #{(-> array-1d-types* :clj :object ) - (-> array-2d-types* :clj :object ) - (-> array-3d-types* :clj :object ) - (-> array-4d-types* :clj :object ) - (-> array-5d-types* :clj :object ) - (-> array-6d-types* :clj :object ) - (-> array-7d-types* :clj :object ) - (-> array-8d-types* :clj :object ) - (-> array-9d-types* :clj :object ) - (-> array-10d-types* :clj :object ) } - :cljs (:cljs objects-types)}) - -(def numeric-1d-types (cond-union bytes-types - ubytes-types - ubytes-clamped-types - chars-types - shorts-types - ints-types - uints-types - longs-types - floats-types - doubles-types)) - -(def booleans-2d-types {:clj #{(-> array-2d-types* :clj :boolean)} :cljs #{(-> array-2d-types* :cljs :boolean)}}) -(def bytes-2d-types {:clj #{(-> array-2d-types* :clj :byte )} :cljs #{(-> array-2d-types* :cljs :byte )}}) -(def chars-2d-types {:clj #{(-> array-2d-types* :clj :char )} :cljs #{(-> array-2d-types* :cljs :char )}}) -(def shorts-2d-types {:clj #{(-> array-2d-types* :clj :short )} :cljs #{(-> array-2d-types* :cljs :short )}}) -(def ints-2d-types {:clj #{(-> array-2d-types* :clj :int )} :cljs #{(-> array-2d-types* :cljs :int )}}) -(def longs-2d-types {:clj #{(-> array-2d-types* :clj :long )} :cljs #{(-> array-2d-types* :cljs :long )}}) -(def floats-2d-types {:clj #{(-> array-2d-types* :clj :float )} :cljs #{(-> array-2d-types* :cljs :float )}}) -(def doubles-2d-types {:clj #{(-> array-2d-types* :clj :double )} :cljs #{(-> array-2d-types* :cljs :double )}}) -(def objects-2d-types {:clj #{(-> array-2d-types* :clj :object )} :cljs #{(-> array-2d-types* :cljs :object )}}) -(def numeric-2d-types (cond-union bytes-2d-types - chars-2d-types - shorts-2d-types - ints-2d-types - longs-2d-types - floats-2d-types - doubles-2d-types)) - -; ===== PREDICATES ===== ; - -#?(:clj -(defmacro gen-type> [] - (->> (ns-interns *ns*) - keys - (filter (fn-> name (str/ends-with? "-types"))) - (map (fn [t] [(list 'quote (symbol (str/replace (name t) #"-types$" "?"))) - t])) - (into {})))) - -(def type-pred=>type - (merge (gen-type>) - {'default {:clj '#{Object} - :cljs '#{(quote default)}} - 'boolean-array? {:clj #{(-> array-1d-types* :clj :boolean)}} - 'byte-array? {:clj #{(-> array-1d-types* :clj :byte )} :cljs #{(-> array-1d-types* :cljs :byte )}} - 'ubyte-array? { :cljs #{(-> array-1d-types* :cljs :ubyte )}} - 'ubyte-array-clamped? { :cljs #{(-> array-1d-types* :cljs :ubyte-clamped)}} - 'char-array? {:clj #{(-> array-1d-types* :clj :char )} :cljs #{(-> array-1d-types* :cljs :char )}} - 'short-array? {:clj #{(-> array-1d-types* :clj :short )} :cljs #{(-> array-1d-types* :cljs :short )}} - 'ushort-array? { :cljs #{(-> array-1d-types* :cljs :ushort )}} - 'int-array? {:clj #{(-> array-1d-types* :clj :int )} :cljs #{(-> array-1d-types* :cljs :int )}} - 'uint-array? { :cljs #{(-> array-1d-types* :cljs :uint )}} - 'long-array? {:clj #{(-> array-1d-types* :clj :long )} :cljs #{(-> array-1d-types* :cljs :long )}} - 'float-array? {:clj #{(-> array-1d-types* :clj :float )} :cljs #{(-> array-1d-types* :cljs :float )}} - 'double-array? {:clj #{(-> array-1d-types* :clj :double )} :cljs #{(-> array-1d-types* :cljs :double )}} - 'object-array? {:clj #{(-> array-1d-types* :clj :object )} :cljs #{(-> array-1d-types* :cljs :object )}} - - #_'objects - - 'array-1d? {:clj (->> array-1d-types* :clj vals set) - :cljs (->> array-1d-types* :cljs vals set)} - - 'array-2d? {:clj (->> array-2d-types* :clj vals set) - :cljs (->> array-2d-types* :cljs vals set)} - 'array-3d? {:clj (->> array-3d-types* :clj vals set) - :cljs (->> array-3d-types* :cljs vals set)} - 'array-4d? {:clj (->> array-4d-types* :clj vals set) - :cljs (->> array-4d-types* :cljs vals set)} - 'array-5d? {:clj (->> array-5d-types* :clj vals set) - :cljs (->> array-5d-types* :cljs vals set)} - 'array-6d? {:clj (->> array-6d-types* :clj vals set) - :cljs (->> array-6d-types* :cljs vals set)} - 'array-7d? {:clj (->> array-7d-types* :clj vals set) - :cljs (->> array-7d-types* :cljs vals set)} - 'array-8d? {:clj (->> array-8d-types* :clj vals set) - :cljs (->> array-8d-types* :cljs vals set)} - 'array-9d? {:clj (->> array-9d-types* :clj vals set) - :cljs (->> array-9d-types* :cljs vals set)} - 'array-10d? {:clj (->> array-10d-types* :clj vals set) - :cljs (->> array-10d-types* :cljs vals set)}})) - -; TODO make all this extensible - -(defn- unevaled-fn [lang] - (->> type-pred=>type - (map (fn [[pred types-n]] (map-entry pred (get types-n lang)))) - (remove (fn-> val empty?)) - (into {}))) - -#?(:clj -(defmacro gen-types|unevaled [] - (let [langs #{:clj :cljs} - #_code #_`(do ~(list 'def 'types-unevaled `'~unevaled))] - `'~(->> langs - (map unevaled-fn) - (zipmap langs) - (map (fn [[lang-n type-map-n]] - (map-entry lang-n - (->> type-map-n - (map (fn [[pred-n types-n]] - (map-entry pred-n - (->> types-n - (map (condf1 - (fn-and seq? (fn-> first name (= "type"))) - (fn [obj] - (condp = lang-n - :clj (-> obj eval class->str symbol) - :cljs (get-in primitive-type-map [lang-n obj]) - obj)) - (fn-and seq? (fn-> first name (= "quote"))) - second - identity)) - (into #{}))))) - (into {}))))) - (into {}))))) - -(defmacro gen-types [] - (let [lang-unevaled (unevaled-fn (env-lang))] - `(zipmap '[~@(keys lang-unevaled)] - [~@(vals lang-unevaled)]))) - -(def types|unevaled (gen-types|unevaled)) -(def types (gen-types)) diff --git a/src-untyped/quantum/untyped/core/type/predicates.cljc b/src-untyped/quantum/untyped/core/type/predicates.cljc deleted file mode 100644 index 013ff0cb..00000000 --- a/src-untyped/quantum/untyped/core/type/predicates.cljc +++ /dev/null @@ -1,59 +0,0 @@ -(ns quantum.untyped.core.type.predicates - "For type predicates that are not yet turned into specs. - TODO excise and place in `quantum.untyped.core.type`." - (:refer-clojure :exclude [boolean? seqable?]) - (:require - [clojure.core :as core] - #_[quantum.untyped.core.core :as ucore])) - -#_(ucore/log-this-ns) - -#?(:clj (defn namespace? [x] (instance? clojure.lang.Namespace x))) - -(def val? some?) - -(defn boolean? [x] #?(:clj (instance? Boolean x) - :cljs (or (true? x) (false? x)))) - -(defn lookup? [x] - #?(:clj (instance? clojure.lang.ILookup x) - :cljs (satisfies? ILookup x))) - -#?(:clj -(defn protocol? [x] - (and (lookup? x) (-> x (get :on-interface) class?)))) - -(defn regex? [x] (instance? #?(:clj java.util.regex.Pattern :cljs js/RegExp) x)) - -#?(:clj (defn seqable? - "Returns true if (seq x) will succeed, false otherwise." - {:from "clojure.contrib.core"} - [x] - (or (seq? x) - (instance? clojure.lang.Seqable x) - (nil? x) - (instance? Iterable x) - (-> x class .isArray) - (string? x) - (instance? java.util.Map x))) - :cljs (def seqable? core/seqable?)) - -(defn editable? [coll] - #?(:clj (instance? clojure.lang.IEditableCollection coll) - :cljs (satisfies? cljs.core.IEditableCollection coll))) - -#?(:clj (defn namespace? [x] (instance? clojure.lang.Namespace x))) - -(defn metable? [x] - #?(:clj (instance? clojure.lang.IMeta x) - :cljs (satisfies? cljs.core/IMeta x))) - -(defn with-metable? [x] - #?(:clj (instance? clojure.lang.IObj x) - :cljs (satisfies? cljs.core/IWithMeta x))) - -(defn derefable? [x] - #?(:clj (instance? clojure.lang.IDeref x) - :cljs (satisfies? cljs.core/IDeref x))) - -#?(:cljs (defn defined? [x] (not (undefined? x)))) diff --git a/src-untyped/quantum/untyped/core/type/reifications.cljc b/src-untyped/quantum/untyped/core/type/reifications.cljc new file mode 100644 index 00000000..b19d8d36 --- /dev/null +++ b/src-untyped/quantum/untyped/core/type/reifications.cljc @@ -0,0 +1,638 @@ +(ns quantum.untyped.core.type.reifications + "Some notes on these types: + - Here `c/=` tests for structural equivalence + - If a type is named, its name must be a qualified symbol and is assumed to be globally + resolvable. + - If you define a named type, `>form` it, and redefine the type, the value will change when you + `eval` the form" + (:refer-clojure :exclude + [==]) + (:require + [clojure.core :as core] + [clojure.set :as set] + [fipp.ednize :as fedn] + [quantum.untyped.core.analyze.expr +#?@(:cljs [:refer [Expression]])] + [quantum.untyped.core.collections + :refer [>vec]] + [quantum.untyped.core.collections.logic + :refer [seq-and-2]] + [quantum.untyped.core.compare + :refer [== not==]] + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.data.array :as uarr + :refer [*<>]] + [quantum.untyped.core.data.hash :as uhash] + [quantum.untyped.core.data.reactive :as urx] + [quantum.untyped.core.defnt + :refer [defns]] + [quantum.untyped.core.error + :refer [err! TODO]] + [quantum.untyped.core.form :as uform + :refer [>form]] + [quantum.untyped.core.form.generate.deftype :as udt] + [quantum.untyped.core.identifiers + :refer [>symbol]] + [quantum.untyped.core.loops + :refer [reduce-2]] + [quantum.untyped.core.numeric :as unum] + [quantum.untyped.core.print] ; for fipp.edn extensions + [quantum.untyped.core.refs :as uref + :refer [!]] + [quantum.untyped.core.spec :as us]) + #?(:clj (:import + [quantum.untyped.core.analyze.expr Expression]))) + +(ucore/log-this-ns) + +(defprotocol PType (with-name [this name'])) + +(defn type? [x #_> #_boolean?] (satisfies? PType x)) + +(def ^:dynamic *expand-names?* false) + +(defn- ?with-name [form ?name] + (if ?name + (if *expand-names?* + (list 'quantum.untyped.core.type/named ?name form) + ?name) + form)) + +;; ----- MetaType ----- ;; + +(udt/deftype MetaType + [ meta #_(t/? ::meta) + name #_qualified-symbol? + t #_t/type? + ^boolean assume? + ^boolean ref? + ^boolean runtime?] + {PType {with-name ([this name'] (MetaType. meta name' t assume? ref? runtime?))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (MetaType. meta' name t assume? ref? runtime?))} + ?Equals {= ([this that] (or (== this that) + (if (instance? MetaType that) + (= t (.-t ^MetaType that)) + (= that t))))} + uform/PGenForm {>form ([this] (or name + (list 'new 'quantum.untyped.core.type.reifications.MetaType + (>form meta) name (>form t) assume? ref? runtime?)))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (cond->> (fedn/-edn t) + assume? (list 'quantum.untyped.core.type/assume) + ref? (list 'quantum.untyped.core.type/ref) + runtime? (list 'quantum.untyped.core.type/run)) + (?with-name name)))}}) + +(defns meta-type? [x _ > boolean?] (instance? MetaType x)) + +(defns meta-type>inner-type [t meta-type?] (.-t ^MetaType t)) + +;; ----- UniversalSetType (`t/U`) ----- ;; + +(udt/deftype + ^{:doc "Represents the set of all sets that do not include themselves (including the empty set). + Equivalent to `(constantly true)`."} + UniversalSetType [meta #_(t/? ::meta)] + {PType {with-name ([this _] this)} + ?Fn {invoke ([_ x] true)} + ?Hash {hash ([this] (hash UniversalSetType)) + hash-code ([this] (uhash/code UniversalSetType))} + ?Equals {= ([this that] (or (== this that) (instance? UniversalSetType that)))} + uform/PGenForm {>form ([this] 'quantum.untyped.core.type/any?)} + fedn/IOverride nil + fedn/IEdn {-edn ([this] 'quantum.untyped.core.type/any?)}}) + +(def universal-set (UniversalSetType. nil)) + +;; ----- EmptySetType (`t/∅`) ----- ;; + +(udt/deftype + ^{:doc "Represents the empty set. + Equivalent to `(constantly false)`."} + EmptySetType [meta #_(t/? ::meta)] + {PType {with-name ([this _] this)} + ?Fn {invoke ([_ x] false)} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (EmptySetType. meta'))} + ?Hash {hash ([this] (hash EmptySetType)) + hash-code ([this] (uhash/code EmptySetType))} + ?Equals {= ([this that] (or (== this that) (instance? EmptySetType that)))} + uform/PGenForm {>form ([this] 'quantum.untyped.core.type/none?)} + fedn/IOverride nil + fedn/IEdn {-edn ([this] 'quantum.untyped.core.type/none?)}}) + +(def empty-set (EmptySetType. nil)) + +;; ----- NotType (`t/not` / `t/!`) ----- ;; + +(udt/deftype NotType + [#?(:clj ^int ^:! hash :cljs ^number ^:! hash) + #?(:clj ^int ^:! hash-code :cljs ^number ^:! hash-code) + meta #_(t/? ::meta) + name #_(t/? qualified-symbol?) + t #_t/type?] + {PType {with-name ([this name'] (NotType. hash hash-code meta name' t))} + ?Fn {invoke ([_ x] (not (t x)))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (NotType. hash hash-code meta' name t))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash NotType t)) + hash-code ([this] (uhash/caching-set-code! hash-code NotType t))} + ?Equals {= ([this that] + (or (== this that) + (and (instance? NotType that) + (= t (.-t ^NotType that)))))} + uform/PGenForm {>form ([this] + (or name (list 'new 'quantum.untyped.core.type.reifications.NotType + hash hash-code (>form meta) name (>form t))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (list 'quantum.untyped.core.type/not (fedn/-edn t)) + (?with-name name)))}}) + +(defns not-type? [x _ > boolean?] (instance? NotType x)) + +(defns not-type>inner-type [t not-type?] (.-t ^NotType t)) + +;; ----- OrType (`t/or` / `t/|`) ----- ;; + +(udt/deftype OrType + [#?(:clj ^int ^:! hash :cljs ^number ^:! hash) + #?(:clj ^int ^:! hash-code :cljs ^number ^:! hash-code) + meta #_(t/? ::meta) + name #_(t/? qualified-symbol?) + args #_(t/and t/indexed? (t/seq t/type?)) + *logical-complement] + {PType {with-name ([this name'] (OrType. hash hash-code meta name' args + *logical-complement))} + ?Fn {invoke ([_ x] (reduce + (fn [_ t] + (let [satisfies-type? (t x)] + (and satisfies-type? (reduced satisfies-type?)))) + true ; vacuously + args))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (OrType. hash hash-code meta' name args + *logical-complement))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash OrType args)) + hash-code ([this] (uhash/caching-set-code! hash-code OrType args))} + ?Equals {= ([this that] + (or (== this that) + (and (instance? OrType that) + (= args (.-args ^OrType that)))))} + uform/PGenForm {>form ([this] + (or name (list 'new 'quantum.untyped.core.type.reifications.OrType + hash hash-code (>form meta) name (-> args >vec >form) + `(atom nil))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (list* 'quantum.untyped.core.type/or (map fedn/-edn args)) + (?with-name name)))}}) + +(defns or-type? [x _ > boolean?] (instance? OrType x)) + +(defns or-type>args [x or-type?] (.-args ^OrType x)) + +;; ----- AndType (`t/and` | `t/&`) ----- ;; + +(udt/deftype AndType + [#?(:clj ^int ^:! hash :cljs ^number ^:! hash) + #?(:clj ^int ^:! hash-code :cljs ^number ^:! hash-code) + meta #_(t/? ::meta) + name #_(t/? qualified-symbol?) + args #_(t/and t/indexed? (t/seq t/type?)) + *logical-complement] + {PType {with-name ([this name'] (AndType. hash hash-code meta name' args + *logical-complement))} + ?Fn {invoke ([_ x] (reduce (fn [_ t] (or (t x) (reduced false))) + true ; vacuously + args))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (AndType. hash hash-code meta' name args + *logical-complement))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash AndType args)) + hash-code ([this] (uhash/caching-set-code! hash-code AndType args))} + ?Equals {= ([this that] + (or (== this that) + (and (instance? AndType that) + (= args (.-args ^AndType that)))))} + uform/PGenForm {>form ([this] + (or name (list 'new 'quantum.untyped.core.type.reifications.AndType + hash hash-code (>form meta) name (-> args >vec >form) + `(atom nil))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (list* 'quantum.untyped.core.type/and (map fedn/-edn args)) + (?with-name name)))}}) + +(defns and-type? [x _ > boolean?] (instance? AndType x)) + +(defns and-type>args [x and-type?] (.-args ^AndType x)) + +;; ----- Expression ----- ;; + +#?(:clj (extend-protocol PType Expression)) + +;; ----- ProtocolType ----- ;; + +(udt/deftype ProtocolType + [#?(:clj ^int ^:! hash :cljs ^number ^:! hash) + #?(:clj ^int ^:! hash-code :cljs ^number ^:! hash-code) + meta #_(t/? ::meta) + name #_(t/? qualified-symbol?) + p #_t/protocol?] + {PType {with-name ([this name'] (ProtocolType. hash hash-code meta name' p))} + ?Fn {invoke ([_ x] (satisfies? p x))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (ProtocolType. hash hash-code meta' name p))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash ProtocolType p)) + hash-code ([this] (uhash/caching-set-code! hash-code ProtocolType p))} + ?Equals {= ([this that #_any?] + (or (== this that) + (and (instance? ProtocolType that) + (= p (.-p ^ProtocolType that)))))} + uform/PGenForm {>form ([this] + (or name (list 'new + 'quantum.untyped.core.type.reifications.ProtocolType + hash hash-code (>form meta) name (-> p :var >symbol))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (list 'quantum.untyped.core.type/isa?|protocol + (-> p :var >symbol)) + (?with-name name)))}}) + +(defns protocol-type? [x _] (instance? ProtocolType x)) + +(defns protocol-type>protocol [t protocol-type?] (.-p ^ProtocolType t)) + +;; ----- DirectProtocolType ----- ;; + +#?(:cljs +(udt/deftype + ^{:doc "Differs from `ProtocolType` in that an `implements?` check is performed instead of a + `satisfies?` check, i.e. native-type protocol dispatch is ignored."} + DirectProtocolType + [^number ^:! hash + ^number ^:! hash-code + meta #_(t/? ::meta) + name #_(t/? qualified-symbol?) + p #_t/protocol?] + {PType {with-name ([this name'] (DirectProtocolType. hash hash-code meta name' p))} + ?Fn {invoke ([_ x] (implements? p x))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (DirectProtocolType. hash hash-code meta' name p))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash DirectProtocolType p)) + hash-code ([this] (uhash/caching-set-code! hash-code DirectProtocolType p))} + ?Equals {= ([this that #_any?] + (or (== this that) + (and (instance? DirectProtocolType that) + (= p (.-p ^DirectProtocolType that)))))} + uform/PGenForm {>form ([this] + (or name (list 'new + 'quantum.untyped.core.type.reifications.DirectProtocolType + hash hash-code (>form meta) name (-> p :var >symbol))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (list 'quantum.untyped.core.type/isa?|protocol|direct + (-> p :var >symbol)) + (?with-name name)))}})) + +#?(:cljs (defns direct-protocol-type? [x _] (instance? DirectProtocolType x))) + +#?(:cljs (defns direct-protocol-type>protocol [t direct-protocol-type?] (.-p t))) + +;; ----- ClassType ----- ;; + +(udt/deftype ClassType + [#?(:clj ^int ^:! hash :cljs ^number ^:! hash) + #?(:clj ^int ^:! hash-code :cljs ^number ^:! hash-code) + meta #_meta/meta? + name #_(t/? qualified-symbol?) + ^Class c #_t/class?] + {PType {with-name ([this name'] (ClassType. hash hash-code meta name' c))} + ?Fn {invoke ([_ x] (instance? c x))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (ClassType. hash hash-code meta' name c))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash ClassType c)) + hash-code ([this] (uhash/caching-set-code! hash-code ClassType c))} + ?Equals {= ([this that #_any?] + (or (== this that) + (and (instance? ClassType that) + (= c (.-c ^ClassType that)))))} + uform/PGenForm {>form ([this] + (or name (list 'new 'quantum.untyped.core.type.reifications.ClassType + hash hash-code (>form meta) name (>form c))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (list 'quantum.untyped.core.type/isa? (fedn/-edn c)) + (?with-name name)))}}) + +(defns class-type? [x _] (instance? ClassType x)) + +(defns class-type>class [t class-type?] (.-c ^ClassType t)) + +;; ----- UnorderedType ----- ;; + +(defn- satisfies-unordered-type? [xs data] + (and (seqable? xs) ; TODO we should rather use `(t/input reduce :_ :_ :?)` + (let [!frequencies (! {}) + each-input-matches-one-type-not-exceeding-frequency? + (->> xs + (reduce + (fn [each-input-matches-one-type-not-exceeding-frequency? x] + (->> data + (reduce-kv + (fn [input-matches-one-type? t freq] + (if (t x) + (do (uref/update! !frequencies #(update % t unum/inc-default)) + (if (> (get @!frequencies t) (get data t)) + (reduced (reduced false)) + true)) + input-matches-one-type?)) + false))) + true))] + (and each-input-matches-one-type-not-exceeding-frequency? + (= @!frequencies data))))) + +(udt/deftype UnorderedType + [#?(:clj ^int ^:! hash :cljs ^number ^:! hash) + #?(:clj ^int ^:! hash-code :cljs ^number ^:! hash-code) + meta #_meta/meta? + name #_(t/? qualified-symbol?) + data #_(t/type (dc/map-of t/type? (t/and integer? (> 1))) "Val is frequency of type")] + {PType {with-name ([this name'] (UnorderedType. hash hash-code meta name' data))} + ?Fn {invoke ([_ xs] (satisfies-unordered-type? xs data))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (UnorderedType. hash hash-code meta' name data))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash UnorderedType data)) + hash-code ([this] (uhash/caching-set-code! hash-code UnorderedType data))} + ?Equals {= ([this that #_any?] + (or (== this that) + (and (instance? UnorderedType that) + (= data (.-data ^UnorderedType that)))))} + uform/PGenForm {>form ([this] + (or name + (list 'new 'quantum.untyped.core.type.reifications.UnorderedType + hash hash-code (>form meta) name (>form data))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] + (-> (list 'quantum.untyped.core.type/unordered (fedn/-edn data)) + (?with-name name)))}}) + +(defn unordered-type? [x] (instance? UnorderedType x)) + +(defns unordered-type>data [t unordered-type?] (.-data ^UnorderedType t)) + +;; ----- OrderedType ----- ;; + +(udt/deftype OrderedType + [#?(:clj ^int ^:! hash :cljs ^number ^:! hash) + #?(:clj ^int ^:! hash-code :cljs ^number ^:! hash-code) + meta #_meta/meta? + name #_(t/? qualified-symbol?) + data #_dc/sequential?] + {PType {with-name ([this name'] (OrderedType. hash hash-code meta name' data))} + ?Fn {invoke ([_ xs] (and (seqable? xs) ; TODO `dc/reducible?` + (seq-and-2 (fn [t x] (t x)) + (sequence data) (sequence xs))))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (OrderedType. hash hash-code meta' name data))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash OrderedType data)) + hash-code ([this] (uhash/caching-set-code! hash-code OrderedType data))} + ?Equals {= ([this that #_any?] + (or (== this that) + (and (instance? OrderedType that) + (= data (.-data ^OrderedType that)))))} + uform/PGenForm {>form ([this] + (or name + (list 'new 'quantum.untyped.core.type.reifications.OrderedType + hash hash-code (>form meta) name (-> data >vec >form))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (list 'quantum.untyped.core.type/ordered + (-> data >vec fedn/-edn)) + (?with-name name)))}}) + +(defn ordered-type? [x] (instance? OrderedType x)) + +(defns ordered-type>data [t ordered-type?] (.-data ^OrderedType t)) + +;; ----- ValueType ----- ;; + +(udt/deftype ValueType + [#?(:clj ^int ^:! hash :cljs ^number ^:! hash) + #?(:clj ^int ^:! hash-code :cljs ^number ^:! hash-code) + meta #_(t/? ::meta) + name #_(t/? qualified-symbol?) + v #_any?] + {PType {with-name ([this name'] (ValueType. hash hash-code meta name' v))} + ?Fn {invoke ([_ x] (= x v))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (ValueType. hash hash-code meta' name v))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash ValueType v)) + hash-code ([this] (uhash/caching-set-code! hash-code ValueType v))} + ?Equals {= ([this that #_any?] + (or (== this that) + (and (instance? ValueType that) + (= v (.-v ^ValueType that)))))} + uform/PGenForm {>form ([this] + (or name (list 'new 'quantum.untyped.core.type.reifications.ValueType + hash hash-code (>form meta) name (>form v))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (list 'quantum.untyped.core.type/value (fedn/-edn v)) + (?with-name name)))}}) + +(defns value-type? [x _] (instance? ValueType x)) + +(defns value-type>value [v value-type?] (.-v ^ValueType v)) + +;; ----- FnType ----- ;; + +;; TODO add `hash` and `hash-code` +(udt/deftype FnType + [meta #_(t/? ::meta) + name #_(t/? qualified-symbol?) + fn-name #_(t/? qualified-symbol?) + output-type #_t/type? + arities-form + arities #_(s/map-of nneg-int? (s/seq-of (s/kv {:input-types (s/vec-of type?) + :output-type type?}))) + ored-input-types #_(s/delay-of (s/map-of nneg-int? (s/seq-of type?))) + ored-output-type #_(s/delay-of type?)] + {PType {with-name ([this name'] + (FnType. meta name' fn-name output-type arities-form arities + ored-input-types ored-output-type))} + ;; Outputs whether the args match any input spec + ?Fn {invoke ([this args] (TODO))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] + (FnType. meta' name fn-name output-type arities-form arities + ored-input-types ored-output-type))} + uform/PGenForm {>form + ([this] + (or name + `(let* [arities# ~(>form arities)] + (new quantum.untyped.core.type.reifications.FnType + ~(>form meta) ~name ~fn-name ~(>form output-type) + ~(>form arities-form) arities + (quantum.untyped.core.type/arities>ored-input-types arities#) + (quantum.untyped.core.type/arities>ored-output-types arities#)))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (if fn-name + (-> (list* 'quantum.untyped.core.type/ftype fn-name + (fedn/-edn output-type) (fedn/-edn arities-form)) + (?with-name name)) + (-> (list* 'quantum.untyped.core.type/ftype + (fedn/-edn output-type) (fedn/-edn arities-form)) + (?with-name name))))}}) + +(defns fn-type? [x _ > boolean?] (instance? FnType x)) + +(defns fn-type>fn-name [^FnType x fn-type?] (.-fn-name x)) +(defns fn-type>arities [^FnType x fn-type?] (.-arities x)) +(defns fn-type>output-type [^FnType x fn-type?] (.-output-type x)) +(defns fn-type>ored-input-types [^FnType x fn-type?] (force (.-ored-input-types x))) +(defns fn-type>ored-output-type [^FnType x fn-type?] (force (.-ored-output-type x))) + +(us/def :quantum.untyped.core.type/fn-type|arity + (us/and + (us/cat + :input-types (us/* type?) + :output-type-pair (us/? (us/cat :ident #{:>} :type type?))) + (us/conformer + (fn [x] (-> x (update :output-type-pair :type) + (update :input-types >vec) + (set/rename-keys {:output-type-pair :output-type})))))) + +;; ----- TypedFn (for FnType) ----- ;; +;; TODO figure out where this goes + +;; TODO should we provide one with no `^:!` metadata, for optimization purposes? +(udt/deftype TypedFn + [meta + ;; The types for direct dispatch overloads + ^:! ^:get ^:set #?(:clj ^"[Ljava.lang.Object;" ts :cljs ^array ts) + ;; The direct dispatch fns / `reify` overloads + ;; Keys/indices are overload IDs, not dynamic overload-indices + ^:! ^:get ^:set #?(:clj ^"[Ljava.lang.Object;" fs :cljs ^array fs) + ;; The dynamic dispatch fn + #?(:clj ^clojure.lang.IFn dynf :cljs dynf)] + {clojure.lang.IFn + {invoke + (([ this] + (.invoke dynf ts fs)) + ([ this x0] + (.invoke dynf ts fs x0)) + ([ this x0 x1] + (.invoke dynf ts fs x0 x1)) + ([ this x0 x1 x2] + (.invoke dynf ts fs x0 x1 x2)) + ([ this x0 x1 x2 x3] + (.invoke dynf ts fs x0 x1 x2 x3)) + ([ this x0 x1 x2 x3 x4] + (.invoke dynf ts fs x0 x1 x2 x3 x4)) + ([ this x0 x1 x2 x3 x4 x5] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5)) + ([ this x0 x1 x2 x3 x4 x5 x6] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17)) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 + (*<> x18))) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19] + (.invoke dynf ts fs x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 + (*<> x18 x19))) + ([ this x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 + ^"[Ljava.lang.Object;" xs] + (.applyTo dynf (->> xs (cons x19) (cons x18) (cons x17) (cons x16) (cons x15) (cons x14) + (cons x13) (cons x12) (cons x11) (cons x10) (cons x9) (cons x8) + (cons x7) (cons x6) (cons x5) (cons x4) (cons x3) (cons x2) + (cons x1) (cons x0) (cons fs) (cons ts))))) + applyTo ([this ^clojure.lang.ISeq xs] (.applyTo dynf (cons ts (cons fs xs))))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (TypedFn. meta' ts fs dynf))}}) + +;; ----- MetaOrType ----- ;; + +(udt/deftype MetaOrType + [#?(:clj ^int ^:! hash :cljs ^number ^:! hash) + #?(:clj ^int ^:! hash-code :cljs ^number ^:! hash-code) + meta #_(t/? ::meta) + name #_(t/? qualified-symbol?) + types #_(t/seq-of form?)] + {PType {with-name ([this name'] (MetaOrType. hash hash-code meta name' types))} + ?Meta {meta ([this] meta) + with-meta ([this meta'] (MetaOrType. hash hash-code meta' name types))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash MetaOrType types)) + hash-code ([this] (uhash/caching-set-code! hash-code MetaOrType types))} + ?Equals {= ([this that #_any?] + (or (== this that) + (and (instance? MetaOrType that) + (= types (.-types ^MetaOrType that)))))} + uform/PGenForm {>form ([this] + (or name + (list 'new 'quantum.untyped.core.type.reifications.MetaOrType + hash hash-code (>form meta) name (>form types))))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (list 'quantum.untyped.core.type/meta-or types) + (?with-name name)))}}) + +(defn meta-or-type? [x] (instance? MetaOrType x)) + +(defns meta-or-type>types [^MetaOrType t meta-or-type?] (.-types t)) + +;; ----- ReactiveType ----- ;; + +(declare rx-type?) + +(defn- validate-type [x] + (or (and (type? x) (not (rx-type? x))) + (err! "Found invalid value when derefing `ReactiveType`" + {:kind (core/type x)}))) + +(udt/deftype ReactiveType + [#?(:clj ^int ^:! hash :cljs ^number ^:! hash) + #?(:clj ^int ^:! hash-code :cljs ^number ^:! hash-code) + meta #_(t/? ::meta) + name #_(t/? qualified-symbol?) + body-codelist #_(t/seq-of form?) + ^:! v #_(t/? type?) + rx #_(t/isa? urx/PReactive)] + {PType {with-name ([this name'] + (ReactiveType. hash hash-code meta name' body-codelist v rx))} + urx/PReactive nil + ?Meta {meta ([this] meta) + with-meta ([this meta'] + (ReactiveType. hash hash-code meta' name body-codelist v rx))} + ?Hash {hash ([this] (uhash/caching-set-ordered! hash ReactiveType rx)) + hash-code ([this] (uhash/caching-set-code! hash-code ReactiveType rx))} + ?Equals {= ([this that #_any?] + (or (== this that) + (and (instance? ReactiveType that) + (= rx (.-rx ^ReactiveType that)))))} + ?Deref {deref ([this] (doto @rx validate-type))} + uform/PGenForm {>form ([this] + (or name (err! "Can't call `>form` on anonymous reactive type" + {:t this})))} + fedn/IOverride nil + fedn/IEdn {-edn ([this] (-> (list 'quantum.untyped.core.type/reactive-type + {:value (urx/norx-deref this)}) + (?with-name name)))}}) + +(defn rx-type? [x] (instance? ReactiveType x)) + +(defn deref-when-reactive [x] (if (rx-type? x) @x x)) diff --git a/src-untyped/quantum/untyped/core/vars.cljc b/src-untyped/quantum/untyped/core/vars.cljc index 8b0770c9..88655c5c 100644 --- a/src-untyped/quantum/untyped/core/vars.cljc +++ b/src-untyped/quantum/untyped/core/vars.cljc @@ -1,17 +1,31 @@ (ns quantum.untyped.core.vars - (:refer-clojure :exclude [defonce]) - (:require - [clojure.core :as core] - [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.form :as uform] - [quantum.untyped.core.form.evaluate - :refer [case-env case-env*]] - [quantum.untyped.core.form.generate :as ufgen])) + (:refer-clojure :exclude + [defonce resolve]) + (:require + [clojure.core :as core] + [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.form.evaluate + :refer [case-env case-env*]] + [quantum.untyped.core.form.generate :as ufgen]) +#?(:cljs (:require-macros + [quantum.untyped.core.vars :as self]))) (ucore/log-this-ns) +#?(:clj (defn unbound? [x] (instance? clojure.lang.Var$Unbound x))) +#?(:clj (defn dynamic? [x] (.isDynamic ^clojure.lang.Var x))) +#?(:cljs (defn defined? [x] (not (undefined? x)))) + ;; ===== Metadata ===== ;; +(defn metable? [x] + #?(:clj (instance? clojure.lang.IMeta x) + :cljs (satisfies? cljs.core/IMeta x))) + +(defn with-metable? [x] + #?(:clj (instance? clojure.lang.IObj x) + :cljs (satisfies? cljs.core/IWithMeta x))) + (def update-meta ucore/update-meta) (def merge-meta-from ucore/merge-meta-from) (def replace-meta-from ucore/replace-meta-from) @@ -26,6 +40,13 @@ (let [[name [expr]] (ufgen/name-with-attrs name sigs)] `(core/defonce ~name ~expr)))) +#?(:clj +(defmacro defonce- + "`defonce-` : `defonce` :: `defn-` : `defn`" + [name & sigs] + (let [[name [expr]] (ufgen/name-with-attrs (vary-meta name assoc :private true) sigs)] + `(core/defonce ~name ~expr)))) + #?(:clj (defmacro def- "Like `def` but adds the ^:private metadatum to the bound var. @@ -44,6 +65,22 @@ [name & decls] (list* `defmacro (with-meta name (assoc (meta name) :private true)) decls))) +#?(:clj +(defmacro defmeta + "Like `def`, but applies metadata to the var *and* the bound object (if `metable?`)." + [sym meta-val x] + `(def ~(vary-meta sym merge meta-val) + ~(if (with-metable? x) + (vary-meta x merge meta-val) + x)))) + +#?(:clj +(defmacro defmeta-from + "Like `defmeta-from`, but gets the metadata from the bound object." + [sym x] + `(do (def ~sym ~x) + (alter-meta! (var ~sym) merge (meta ~sym))))) + ;; ===== Aliases ===== ;; #?(:clj (ucore/defaliases ucore defalias defaliases defaliases')) @@ -68,3 +105,63 @@ _# (when (= ~orig-sym-f 'nil) (throw (IllegalArgumentException. (str "Macro '" '~name "' not defined."))))] (cons ~orig-sym-f ~args-sym))))))) + +#?(:clj +(defmacro def + "Like `clojure.core/def`, but allows for docstring and metadata placement + like `defn`." + ([sym] `(~'def ~sym)) + ([sym v] `(~'def ~sym ~v)) + ([sym doc-or-meta v] + (if (string? doc-or-meta) + `(quantum.untyped.core.vars/def ~sym ~doc-or-meta nil ~v) + `(quantum.untyped.core.vars/def ~sym nil ~doc-or-meta ~v))) + ([sym -doc -meta v] `(~'def ~(with-meta sym (assoc -meta :doc -doc)) ~v)))) + +;; ===== Symbol Resolution ===== ;; + +(defn resolve-ns + "Resolves the namespace of a symbol, checking in aliases first. + Totally distinct from `core/ns-resolve`." + {:incorporated {'clojure.lang.Compiler/namespaceFor "10/3/2018"}} + ([sym] (resolve-ns *ns* sym)) + ([ns-val #_namespace?, sym] + (let [ns-sym (-> sym namespace symbol)] + (or (.lookupAlias ^clojure.lang.Namespace ns-val ns-sym) + (find-ns ns-sym))))) + +(defn resolve + "Combines `core/resolve` with `core/ns-resolve` and does not throw an exception when a class can't + be resolved." + {:incorporated {'clojure.core/resolve "10/3/2018" + 'clojure.core/ns-resolve "10/3/2018" + 'clojure.lang.Compiler/maybeResolveIn "10/3/2018"}} + ([sym] (resolve *ns* sym)) + ([ns-val #_namespace?, sym] (resolve ns-val nil sym)) + ([ns-val #_namespace?, env #_map?, sym] + (if (contains? env sym) + (get env sym) + (if (some? (namespace sym)) + (when-let [sym-ns-val (resolve-ns sym)] + (.findInternedVar ^clojure.lang.Namespace sym-ns-val (-> sym name symbol))) + (let [^String sym-name (name sym)] + (cond (or (and (pos? (.indexOf sym-name ".")) + (not (.endsWith sym-name "."))) + (= (.charAt sym-name 0) \[)) + (try (clojure.lang.RT/classForName sym-name) + (catch ClassNotFoundException _ nil)) + (= sym 'ns) + #'core/ns + (= sym 'in-ns) + #'core/in-ns + :else (.getMapping ^clojure.lang.Namespace ns-val sym))))))) + +(def intern! intern) + +(defn intern-once! + "Interns a var corresponding to ->`sym` only if the var has not already been interned." + ([ns-sym #_symbol?, sym #_symbol?, v #_t/ref?] + (or (resolve (find-ns ns-sym) sym) + (intern! ns-sym sym v)))) + +(def unintern! ns-unmap) diff --git a/src-untyped/quantum/untyped/reactive/core.cljc b/src-untyped/quantum/untyped/reactive/core.cljc index 597c3e22..f2a4955f 100644 --- a/src-untyped/quantum/untyped/reactive/core.cljc +++ b/src-untyped/quantum/untyped/reactive/core.cljc @@ -5,8 +5,28 @@ [re-frame.core :as re] [reagent.core :as reagent]))) -#?(:cljs (def sub re/subscribe)) -#?(:cljs (def transform! re/dispatch)) -#?(:cljs (def transform-sync! re/dispatch-sync)) +#?(:cljs (def reg-sub re/reg-sub)) -#?(:cljs (def atom reagent/atom)) +#?(:cljs +(def std-interceptors + [(when js/goog.DEBUG re/debug)])) + +#?(:cljs +(defn- reg-event* + ([reg-event-fn k f] (reg-event* reg-event-fn k std-interceptors f)) + ([reg-event-fn k interceptors f] + (reg-event-fn k + (if (false? interceptors) + nil + (conj std-interceptors interceptors)) f)))) + +#?(:cljs (def reg-event-db (partial reg-event* re/reg-event-db))) +#?(:cljs (def reg-event-fx (partial reg-event* re/reg-event-fx))) + +#?(:cljs (def reg-fx re/reg-fx)) + +#?(:cljs (def sub re/subscribe)) +#?(:cljs (def event! re/dispatch)) +#?(:cljs (def event-sync! re/dispatch-sync)) + +#?(:cljs (def atom reagent/atom)) diff --git a/src-untyped/quantum/untyped/ui/components.cljc b/src-untyped/quantum/untyped/ui/components.cljc index a4809225..a5f24789 100644 --- a/src-untyped/quantum/untyped/ui/components.cljc +++ b/src-untyped/quantum/untyped/ui/components.cljc @@ -5,47 +5,115 @@ (:refer-clojure :exclude [for reduce]) (:require #?@(:cljs - [[reagent.core :as rx]]) - [quantum.untyped.core.log :as log] - [quantum.untyped.core.system :as usys - :refer [#?@(:cljs [ReactNative])]] - [quantum.untyped.core.type.predicates - :refer [val?]])) + [[reagent.core :as rx] + [reagent.impl.component + :refer [react-class?]] + [reagent.interop + :refer [$ $!]]]) + [quantum.untyped.core.data + :refer [val?]] + [quantum.untyped.core.log :as log] + [quantum.untyped.core.system :as usys + :refer [#?@(:cljs [react-native])]] + [quantum.untyped.reactive.core :as re])) + +(def id :testID) ; because camelCase is a little ugly in Clojure :) + +;; ----- Local state ----- ;; + +(defn update-local-state + ([db ident f] + (update-in db [:local-state ident] f)) + ([db ident f & args] + (apply update-in db [:local-state ident] f args))) + +(defn >local-state [db ident] (-> db :local-state (get ident))) + +#?(:cljs (re/reg-sub :local-state get-in)) + +#?(:cljs +(re/reg-event-db :local-state + (fn [db msg] (assoc-in db (butlast msg) (last msg))))) + +#?(:cljs +(re/reg-event-db ::gc-local-state false + (fn [db [_ ident]] (update db :local-state dissoc ident)))) + +#?(:cljs +(defn with-local-state [component-f] + (assert (fn? component-f)) + (-> (fn [& args] + (let [ident (cljs.core/random-uuid) + component-ret (apply component-f ident args)] + (assert (or (fn? component-ret) (react-class? component-ret))) + (if (react-class? component-ret) + (let [orig-component-will-unmount + (-> component-ret ($ :prototype) ($ :componentWillUnmount))] + (doto component-ret + (-> ($ :prototype) + ($! :componentWillUnmount + (fn componentWillUnmount [] + (this-as c + (when-not (nil? orig-component-will-unmount) + (.call orig-component-will-unmount c)) + (re/event! [::gc-local-state ident]))))))) + (rx/create-class + {:render component-ret + :component-will-unmount + (fn [_] (re/event-sync! [::gc-local-state ident]))})))) + (with-meta (meta component-f)) + (doto ($! :name (.-name component-f)))))) + +;; ----- General components ----- ;; #?(:cljs (defn alert [title] (if (= usys/os "web") (js/alert title) ; totally stops everything - (.alert (.-Alert ReactNative) title)))) + (.alert (.-Alert react-native) title)))) #?(:cljs (def react-native-animatable (usys/>module nil ["react-native-animatable"]))) +#?(:cljs (def adapt-animated + (when-let [adapt-animated* (some-> react-native-animatable .-createAnimatableComponent)] + (fn [react-component] (-> react-component adapt-animated* rx/adapt-react-class))))) -#?(:cljs (def text (some-> ReactNative .-Text rx/adapt-react-class))) -#?(:cljs (def text|animated +#?(:cljs (def text (some-> react-native .-Text rx/adapt-react-class))) +#?(:cljs (def text|animatable (if (= usys/os "web") - (some-> ReactNative .-Animated .-Text rx/adapt-react-class) + (some-> react-native .-Animated .-Text rx/adapt-react-class) (some-> react-native-animatable .-Text rx/adapt-react-class)))) -#?(:cljs (def view (some-> ReactNative .-View rx/adapt-react-class))) -#?(:cljs (def view|animated +#?(:cljs (def view (some-> react-native .-View rx/adapt-react-class))) +#?(:cljs (def view|animatable (if (= usys/os "web") - (some-> ReactNative .-Animated .-View rx/adapt-react-class) + (some-> react-native .-Animated .-View rx/adapt-react-class) (some-> react-native-animatable .-View rx/adapt-react-class)))) -#?(:cljs (def image (some-> ReactNative .-Image rx/adapt-react-class))) -#?(:cljs (def image|animated +#?(:cljs (def view|masked|ios + (when-not (= usys/os "web") + (some-> react-native .-MaskedViewIOS rx/adapt-react-class)))) +#?(:cljs (def view|masked|animatable|ios + (when-not (= usys/os "web") + (when adapt-animated + (some-> react-native .-MaskedViewIOS adapt-animated))))) + +#?(:cljs (def view|keyboard-avoiding (some-> react-native .-KeyboardAvoidingView rx/adapt-react-class))) + +#?(:cljs (def image (some-> react-native .-Image rx/adapt-react-class))) +#?(:cljs (def image|animatable (if (= usys/os "web") - (some-> ReactNative .-Animated .-Image rx/adapt-react-class) + (some-> react-native .-Animated .-Image rx/adapt-react-class) (some-> react-native-animatable .-Image rx/adapt-react-class)))) #?(:cljs (def svg-enabled-image (some-> (usys/>module nil ["react-native-remote-svg"]) .-default rx/adapt-react-class))) ; var CacheImage = require('@remobile/react-native-cache-image'); doesn't work on web ; better to have something else -#?(:cljs (def touchable-highlight (some-> ReactNative .-TouchableHighlight rx/adapt-react-class))) -#?(:cljs (def touchable-opacity (some-> ReactNative .-TouchableOpacity rx/adapt-react-class))) +#?(:cljs (def touchable (some-> react-native .-TouchableWithoutFeedback rx/adapt-react-class))) +#?(:cljs (def touchable-highlight (some-> react-native .-TouchableHighlight rx/adapt-react-class))) +#?(:cljs (def touchable-opacity (some-> react-native .-TouchableOpacity rx/adapt-react-class))) #?(:cljs (def accordion (when-not (= usys/os "web") (some-> (usys/>module nil ["react-native-accordion"]) rx/adapt-react-class)))) -#?(:cljs (def text-input* (some-> ReactNative .-TextInput rx/adapt-react-class))) +#?(:cljs (def text-input* (some-> react-native .-TextInput rx/adapt-react-class))) #?(:cljs (def text-input @@ -65,14 +133,16 @@ text-input*))) #?(:cljs (def modal (when-not (= usys/os "web") - (some-> ReactNative .-Modal rx/adapt-react-class)))) -#?(:cljs (def scroll-view (some-> ReactNative .-ScrollView rx/adapt-react-class))) -#?(:cljs (def list-view (some-> ReactNative .-ListView rx/adapt-react-class))) + (some-> react-native .-Modal rx/adapt-react-class)))) +#?(:cljs (def scroll-view (some-> react-native .-ScrollView rx/adapt-react-class))) +#?(:cljs (def list-view (some-> react-native .-ListView rx/adapt-react-class))) #?(:cljs (def video (if (= usys/os "web") :video ; https://github.com/react-native-community/react-native-video #_(rx/adapt-react-class (js/require "react-native-video"))))) +#?(:cljs (def web-view (some-> react-native .-WebView rx/adapt-react-class))) + ; Uses StreamingKit ; Supported codecs (list incomplete): #_"mp4 audio (m4a) @@ -90,7 +160,7 @@ #?(:cljs (def audio (when (= usys/os "web") :audio))) -#?(:cljs (def list-view-data-source (some-> ReactNative .-ListView .-DataSource))) +#?(:cljs (def list-view-data-source (some-> react-native .-ListView .-DataSource))) #?(:cljs (def react-virtualized (usys/>module nil ["react-virtualized"]))) @@ -99,3 +169,5 @@ #?(:cljs (def react-sortable-hoc (usys/>module nil ["react-sortable-hoc"]))) #?(:cljs (def sortable-container (some-> react-sortable-hoc .-SortableContainer rx/adapt-react-class))) + +;; ----- Custom ----- ;; diff --git a/src-untyped/quantum/untyped/ui/dom.cljc b/src-untyped/quantum/untyped/ui/dom.cljc index b7b2ba8a..e243bb32 100644 --- a/src-untyped/quantum/untyped/ui/dom.cljc +++ b/src-untyped/quantum/untyped/ui/dom.cljc @@ -1,7 +1,8 @@ -(ns quantum.untyped.ui.dom) +(ns quantum.untyped.ui.dom + #?(:cljs (:require [quantum.untyped.reactive.core :as re]))) #?(:cljs -(defn append-element! [parent #_dom-element? tag #_t/string? id #_t/string?] +(defn append-element! [parent #_dom-element? tag #_dstr/string? id #_dstr/string?] (or (.getElementById js/document id) (doto (.createElement js/document tag) (-> .-id (set! id)) @@ -13,6 +14,14 @@ (.removeChild parent node)) (append-element! parent tag id))) +#?(:cljs +(defn test-id>element [id] + (let [nodes (js/Array.from (js/document.querySelectorAll (str "[data-testid='" id "']"))) + _ (assert (-> nodes count (> 1) not))] + (when-let [node (first nodes)] + #js {:id (.getAttribute node "data-testid") + :node node})))) + #?(:cljs (defn viewport-w [] (-> js/document .-documentElement .-clientWidth))) @@ -26,3 +35,15 @@ (let [elem (.createElement js/document "span")] (set! (.-innerHTML elem) text) (.-clientWidth elem)))) + +#?(:cljs +(re/reg-fx :dom/prevent-default + (fn [e] (.preventDefault e)))) + +#?(:cljs +(re/reg-fx :dom/focus + (fn [dom-node] (.focus dom-node)))) + +#?(:cljs +(re/reg-fx :dom/unfocus + (fn [dom-node] (.blur dom-node)))) diff --git a/src-untyped/quantum/untyped/ui/features.cljc b/src-untyped/quantum/untyped/ui/features.cljc index 00c6c9df..b96f0a28 100644 --- a/src-untyped/quantum/untyped/ui/features.cljc +++ b/src-untyped/quantum/untyped/ui/features.cljc @@ -1,12 +1,10 @@ (ns quantum.untyped.ui.features (:require [quantum.untyped.core.core :as ucore] - [quantum.untyped.core.data.map - :refer [map-entry]] [quantum.untyped.core.logic :refer [whenc fn=]] [quantum.untyped.core.system :as usys] - [quantum.untyped.core.type.predicates + [quantum.untyped.core.vars #?@(:cljs [:refer [defined?]])])) (ucore/log-this-ns) @@ -25,5 +23,5 @@ :safari "-webkit-flex" :safari- "-webkit-box" ; (Older) :ie "-ms-flexbox"} - (map (fn [browser s] (map-entry (whenc browser (fn= :safari-) :safari) (flex-test div s)))) + (map (fn [browser s] [(whenc browser (fn= :safari-) :safari) (flex-test div s)])) (into {}))))) diff --git a/src-untyped/quantum/untyped/ui/keys.cljc b/src-untyped/quantum/untyped/ui/keys.cljc index de0c9a54..476319f8 100644 --- a/src-untyped/quantum/untyped/ui/keys.cljc +++ b/src-untyped/quantum/untyped/ui/keys.cljc @@ -3,7 +3,7 @@ [clojure.set :as set])) (def ^{:doc "From https://www.w3.org/TR/uievents-key/#named-key-attribute-values, accessed 2/1/2018"} - key-ident>label + key-ident->label {;; Special keys "Unidentified" :unidentified ;; Modifier keys @@ -306,4 +306,8 @@ "Wink" :wink "ZoomToggle" :zoom-toggle}) -(def label>key-ident (set/map-invert key-ident>label)) +(defn key-ident>label [ident] (get key-ident->label ident ident)) + +(def label->key-ident (set/map-invert key-ident->label)) + +(defn label>key-ident [label] (get label->key-ident label label)) diff --git a/src-untyped/quantum/untyped/ui/style/color.cljc b/src-untyped/quantum/untyped/ui/style/color.cljc new file mode 100644 index 00000000..77a4ee4e --- /dev/null +++ b/src-untyped/quantum/untyped/ui/style/color.cljc @@ -0,0 +1,70 @@ +(ns quantum.untyped.ui.style.color + (:require + [clojure.string :as str] + [garden.color :as color + #?@(:cljs [:refer [CSSColor]])] + [quantum.untyped.core.vars :as uvar + :refer [defalias]]) +#?(:clj + (:import + garden.color.CSSColor))) + +(defn css-color? [obj] (instance? CSSColor obj)) + +(defalias >rgb color/as-rgb) + +(defn >rgba + ([c] (if (and (css-color? c) + (:red c) + (:green c) + (:blue c) + (:alpha c)) + c + (-> c >rgb (assoc :alpha (or (:alpha c) 1))))) + ([r g b] (>rgba r g b 1)) + ([r g b a] (color/map->CSSColor {:red r :green g :blue b :alpha a}))) + +(defn >rgba|str + ([c] (let [{:keys [red green blue alpha]} (>rgba c)] + (str "rgba(" (str/join "," [red green blue alpha]) ")"))) + ([r g b] (>rgba|str (>rgba r g b))) + ([r g b a] (>rgba|str (>rgba r g b a)))) + +(defalias >hsl color/as-hsl) + +(defn >hsla [c] + (-> c >hsl (assoc :alpha (or (:alpha c) 1)))) + +(defn >hex [c] (-> c >hsla color/as-hex)) + +(defalias color/darken ) +(defalias color/lighten) + +(def colors + ;; `rgba` primarily because that's what `react-native-animatable` accepts + {;; ----- Brand-specific ----- ;; + :facebook-blue (>rgba|str 59 88 152) + :google-red (>rgba|str 214 72 55 ) + ;; ----- Miscellaneous ----- ;; + :cheery-seaside-blue (>rgba|str 51 197 255) + :sky-blue (>rgba|str 119 225 255) + :serious-sea-foam (>rgba|str 91 206 193) ; 'serious' because slightly desaturated + :dark-sea-foam (>rgba|str 49 120 133) + :golden (>rgba|str 255 197 37 ) + ;; ----- Grayscale ----- ;; + :white (>rgba|str 255 255 255) + ;; above white + :light-gray (>rgba|str 244 245 247) + ;; good placeholder text on `light-gray` + :medium-light-gray (>rgba|str 183 190 204) + :medium-gray (>rgba|str 122 134 154) + ;; good text on `light-gray` + :dark-gray (>rgba|str 66 82 110) + ;; essentially black; good text on white + :darkest-gray (>rgba|str 23 43 77 ) + :overlay (>rgba|str 9 30 66 0.04) + ;; good text on `light-gray`+`overlay` + :black (>rgba|str 0 0 0 ) + :transparent (>rgba|str 0 0 0 0)}) + +(defn >color [k] (get colors k)) diff --git a/src-untyped/quantum/untyped/ui/style/core.cljc b/src-untyped/quantum/untyped/ui/style/core.cljc index 485adfe9..e348fe44 100644 --- a/src-untyped/quantum/untyped/ui/style/core.cljc +++ b/src-untyped/quantum/untyped/ui/style/core.cljc @@ -4,9 +4,9 @@ (:require [clojure.string :as str] [quantum.untyped.core.collections :as uc] - [quantum.untyped.core.convert - :refer [>?name]] [quantum.untyped.core.core :as ucore] + [quantum.untyped.core.identifiers + :refer [>?name]] [quantum.untyped.core.system :as usys])) (ucore/log-this-ns) diff --git a/src-untyped/quantum/untyped/ui/style/css/dom.cljc b/src-untyped/quantum/untyped/ui/style/css/dom.cljc index 43f049fe..417ac160 100644 --- a/src-untyped/quantum/untyped/ui/style/css/dom.cljc +++ b/src-untyped/quantum/untyped/ui/style/css/dom.cljc @@ -1,11 +1,11 @@ (ns quantum.untyped.ui.style.css.dom (:require [clojure.string :as str] + [quantum.untyped.core.data + :refer [val?]] [quantum.untyped.core.fn :refer [fn->]] [quantum.untyped.core.spec :as us] - [quantum.untyped.core.type.predicates - :refer [val?]] [quantum.untyped.ui.dom :as udom])) #?(:cljs diff --git a/src-untyped/quantum/untyped/ui/style/fonts.cljc b/src-untyped/quantum/untyped/ui/style/fonts.cljc index fed7e021..32302ff5 100644 --- a/src-untyped/quantum/untyped/ui/style/fonts.cljc +++ b/src-untyped/quantum/untyped/ui/style/fonts.cljc @@ -4,7 +4,7 @@ [quantum.untyped.core.error :refer [err! TODO]] [quantum.untyped.core.system :as usys] - [quantum.untyped.core.type.predicates + [quantum.untyped.core.vars #?@(:cljs [:refer [defined?]])] [quantum.untyped.ui.style.css :as ucss] [quantum.untyped.ui.style.css.dom :as ucss-dom])) @@ -262,27 +262,22 @@ "ZapfDingbatsITC" "Zapfino"}) -(def families - {:garamond {:pref ["'EB Garamond'" "Baskerville" "Georgia" "Times" "serif" ]} - :gotham {:regular "Gotham-Book" - :rounded "Gotham Rounded"} - :optima {:pref ["'Optima'" "Segoe" "Calibri" "Arial" "sans-serif"]} - :firasans {:pref ["'Fira Sans'" "Calibri" "Arial" "sans-serif"]} - :sourcecode-pro {:pref ["'Source Code Pro'" "monospace" ]} - :helvetica-neue {:pref ["'Helvetica Neue'" "Helvetica" "Arial" "sans-serif"]} - :lato {:link "https://fonts.googleapis.com/css?family=Lato:100" - :pref ["'Lato'" "Helvetica" "Arial" "sans-serif"]} - :open-sans {:link "https://fonts.googleapis.com/css?family=Open+Sans:400,300,300italic,400italic,600,600italic,700,700italic" - :pref ["'Open Sans'" "Helvetica" "Arial" "sans-serif"]} - :montserrat {:link "https://fonts.googleapis.com/css?family=Montserrat:400,700" - :pref ["'Montserrat'" "Gotham" "Helvetica" "Arial" "sans-serif"]}}) +(def fonts + {:circular + {:light "CircularStd-Book" + :medium "CircularStd-Book" + :medium-contrast "CircularStd-Black" + :semibold "CircularStd-Medium"} + :metropolis + {:light "Metropolis-Light" + :regular "Metropolis-Regular" + :medium "Metropolis-Medium" + :medium-contrast "Metropolis-Medium" + :semibold "Metropolis-SemiBold"} + :gotham + {:rounded "Gotham Rounded"}}) -(defn family [k] (get-in families [k :pref])) -(defn link [k] (get-in families [k :link])) - -(defn font - ([k] (-> families (get k) :regular)) - ([k & ks] (-> families (get k) (get-in ks)))) +(defn >font [family-name weight-name] (-> fonts (get family-name) (get weight-name))) #?(:cljs (def ^{:doc "`FontFace` is a newer technology (no IE/Edge/Android, Chrome (2013), Safari @@ -305,7 +300,8 @@ ;; Most browsers do support it but still #?(:cljs (def supports-woff? true)) -#?(:cljs +;; TODO just need to add in `load-font-by-url!` +#_(:cljs (def ^{:doc "WOFF2 is a newer technology (no IE, Edge (late 2016), Firefox (2015), Chrome (2014), Safari (late 2016) post-El-Capitan, iOS (2016), no Android)" @@ -316,7 +312,8 @@ .-status (= "loading"))))) -#?(:cljs +;; TODO just need `supports-woff2?` +#_(:cljs (defn load-font! ([font-name] (TODO "Load from LocalStorage")) ([font-name css-src-coercible] (load-font-by-css-src! font-name (ucss/>css-src css-src-coercible))) diff --git a/src/data_readers.cljc b/src/data_readers.cljc index eb60bbe4..491fbf5e 100644 --- a/src/data_readers.cljc +++ b/src/data_readers.cljc @@ -1 +1,8 @@ -{r quantum.core.numeric.types/read-rational} +{b quantum.core.data.primitive/read-byte + s quantum.core.data.primitive/read-short + c quantum.core.data.primitive/read-char + i quantum.core.data.primitive/read-int + l quantum.core.data.primitive/read-long + f quantum.core.data.primitive/read-float + d quantum.core.data.primitive/read-double + r quantum.core.data.numeric/read-rational} diff --git a/src/quantum/ai/ml/classification.cljc b/src/quantum/ai/ml/classification.cljc index 32a20bed..8f66fce2 100644 --- a/src/quantum/ai/ml/classification.cljc +++ b/src/quantum/ai/ml/classification.cljc @@ -16,7 +16,7 @@ reduce-count]] [quantum.core.numeric :as num] [quantum.core.fn :as fn - :refer [<- fn-> fn->> fn']] + :refer [fn-> fn->> fn']] [quantum.core.cache :as cache :refer [defmemoized]] [quantum.core.error @@ -27,7 +27,7 @@ [quantum.core.nondeterministic :as rand] [quantum.core.thread :as thread :refer [async]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]] [quantum.core.vars :as var :refer [defalias]] diff --git a/src/quantum/ai/ml/clustering.cljc b/src/quantum/ai/ml/clustering.cljc index 4fae34ba..77342f7e 100644 --- a/src/quantum/ai/ml/clustering.cljc +++ b/src/quantum/ai/ml/clustering.cljc @@ -15,7 +15,7 @@ [quantum.ai.ml.similarity :refer [dist]] [quantum.core.fn :as fn - :refer [<- fn-> fn->>]] + :refer [fn-> fn->>]] [quantum.core.error :refer [>ex-info TODO]] [quantum.core.logic diff --git a/src/quantum/ai/ml/core.cljc b/src/quantum/ai/ml/core.cljc index b8d2e275..a2b45fd4 100644 --- a/src/quantum/ai/ml/core.cljc +++ b/src/quantum/ai/ml/core.cljc @@ -12,7 +12,7 @@ :refer [fn1]] [quantum.core.macros :refer [defnt]] - [quantum.core.type :as t])) + [quantum.core.type-old :as t])) (dv/def instances (fn1 t/sequential?)) ; TODO better validation (dv/def targets (fn1 t/sequential?)) ; TODO better validation diff --git a/src/quantum/ai/ml/feature/selection.cljc b/src/quantum/ai/ml/feature/selection.cljc index 288817f6..05a1c37d 100644 --- a/src/quantum/ai/ml/feature/selection.cljc +++ b/src/quantum/ai/ml/feature/selection.cljc @@ -12,7 +12,7 @@ ; ===== SUBSET SELECTION ===== ; -(defn subset:genetic +(defn subset|genetic "Genetic-algorithm-based feature selection. This method finds many (random) subsets of variables of expected classification power using a genetic algorithm. The \"fitness\" of each subset of variables is determined by its @@ -25,14 +25,14 @@ ; ===== FEATURE RANKING ===== ; -(defn rank:signal-noise-ratio +(defn rank|signal-noise-ratio "The signal-to-noise (S2N) metric ratio is a univariate feature ranking metric, which can be used as a feature selection criterion for binary classification problems." {:implemented-by '#{smile.feature.SignalNoiseRatio}} [?] (TODO)) -(defn rank:sum-squares-ratio +(defn rank|sum-squares-ratio "The ratio of between-groups to within-groups sum of squares is a univariate feature ranking metric which can be used as a feature selection criterion for multi-class classification problems." diff --git a/src/quantum/ai/ml/instance/selection.cljc b/src/quantum/ai/ml/instance/selection.cljc index a072e94d..19a7055e 100644 --- a/src/quantum/ai/ml/instance/selection.cljc +++ b/src/quantum/ai/ml/instance/selection.cljc @@ -11,11 +11,11 @@ [quantum.core.collections.core :as ccoll :refer [->objects-nd]] [quantum.core.data.map :as map - :refer [!hash-map #?(:clj !hash-map:int->ref)]] + :refer [>!hash-map #?(:clj >!hash-map|int->ref)]] [quantum.core.data.set :as set - :refer [!hash-set #?(:clj !hash-set:int)]] + :refer [>!hash-set #?(:clj >!hash-set|int)]] [quantum.core.data.vector - :refer [!vector]] + :refer [>!vector]] [quantum.core.error :refer [TODO]] [quantum.core.fn @@ -87,14 +87,14 @@ (; for multi-dimensional label vectors, with ; one hashf that outputs several bucket values and whose bucket values are dense longs 0..`ct:buckets` [#{doubles-2d?} x•• #{doubles-2d?} l•• ^fn? hashf ^long ct:buckets] - (let [x••':indices (do #?(:clj (!hash-set:int) :cljs (!hash-set))) + (let [x••':indices (do #?(:clj (!>hash-set|int) :cljs (!>hash-set))) i:hashf->bucket->hash:l•->x••:l• ; map of simulated hash-function index to (fortimes:objects2 [_ ct:buckets] ; map of bucket value `b` to (fortimes:objects [_ ct:buckets] ; map of label `l•` to all instances, `x••`, which are labeled with `l•` and in `b` - #?(:clj (!hash-map:int->ref) :cljs (!hash-map))))] + #?(:clj (!>hash-map|int->ref) :cljs (!>hash-map))))] (doseqi [x• x•• i:x•] ; T(|x••|*b*|x•|) (let [l• (get l•• i:x•)] (doseqi [bucket (hashf x•) i:hashf] ; T(b*|x•|) + T(hash) @@ -103,7 +103,7 @@ :cljs (hash l•)))] (if-let [x••:l• (get hash:l•->x••:l• hash:l•)] (conj! x••:l• x•) - (assoc! hash:l•->x••:l• hash:l• (!vector x•))))))) + (assoc! hash:l•->x••:l• hash:l• (!>vector x•))))))) (doseq [bucket->hash:l•->x••:l• i:hashf->bucket->hash:l•->x••:l•] ; T(|hashf•|*b*|l•◦|) (doseq [hash:l•->x••:l• bucket->hash:l•->x••:l•] ; T(b*|l•◦|) (doseq [_ x••:l• hash:l•->x••:l•] ; T(|l•◦|) diff --git a/src/quantum/ai/ml/similarity.cljc b/src/quantum/ai/ml/similarity.cljc index 6fd68a27..3b3d2390 100644 --- a/src/quantum/ai/ml/similarity.cljc +++ b/src/quantum/ai/ml/similarity.cljc @@ -127,7 +127,7 @@ {:implemented-by '{smile.math.distance.MinkowskiDistance "faster array implementation" smile.math.distance.SparseMinkowskiDistance "for sparse arrays"}} ([v p] - (->> v (map+ (fn-> abs (pow p))) sum (<- pow (/ p)))) + (->> v (map+ (fn-> abs (pow p))) sum (<- (pow (/ p))))) ([a b p] (TODO))) (defalias minkowski l-p) diff --git a/src/quantum/ai/ml/validation.cljc b/src/quantum/ai/ml/validation.cljc index 7e9cee75..ed9615f1 100644 --- a/src/quantum/ai/ml/validation.cljc +++ b/src/quantum/ai/ml/validation.cljc @@ -9,6 +9,7 @@ contains?, subset?, assoc-default, count]] [quantum.core.compare :as comp :refer [reduce-min reduce-max]] + [quantum.core.data.primitive :as p] [quantum.core.data.validated :as dv] [quantum.core.data.vector :refer [!vector]] @@ -23,7 +24,7 @@ [quantum.core.nondeterministic :as rand] [quantum.core.numeric :as num] [quantum.core.spec :as s] - [quantum.core.type :as t] + [quantum.core.type-old :as t] [quantum.core.vars :as var :refer [defalias]] [quantum.numeric.statistics.core :as stat])) @@ -67,14 +68,14 @@ ^{:doc "Will be passed 3 args, `model`, `instance`, `output`."} (def :this/accuracyf fn?) ; TODO must return a number, accept 3 args, etc. ^{:doc "Whether to shuffle the instances+targets before using the sliding window. Defaults to `true`"} - (def :this/shuffle? (fn1 t/boolean?)) + (def :this/shuffle? (fn1 p/boolean?)) (def :this/compute-for (s/and (fn1 t/+set?) (fn1 subset? #{:train :validation})))] :opt-un [^{:doc "Number of iterations"} (def :this/n (fn1 t/integer?)) ^{:doc "Desired ratio of training instances to validation instances"} (def :this/training-ratio (s/and (fn1 t/number?) (fn1 > 0) (fn1 < 1))) ^{:doc "Whether to report the accuracies per split instead of calling `mean` on them"} - (def :this/verbose? (fn1 t/boolean?))]) + (def :this/verbose? (fn1 p/boolean?))]) (defn n-fold-cross-validation "Assumes `instances` and `targets` have same length and correspond to each other. @@ -88,17 +89,17 @@ (fnl coll/sliding-window+ (* training-ratio (count instances))))] ; each split must be of that ratio (->> instances indices+ - (<- whenp->> shuffle? - (join (!vector)) - rand/shuffle!) + (<- (whenp->> shuffle? + (join (!vector)) + rand/shuffle!)) splitf ->n-fold-splits+ (map+ (accuracy:train-validation-split+ args')) - (<- whenp->> (not verbose?) - (map+ (fnl map-vals' stat/mean)) - ; compute means on each value - (reduce (fn [[ct m'] m] [(inc ct) (merge-with num/nils+ m' m)]) [0 nil]) - ((fn [[ct m]] (->> m (map-vals' (fn1 num/nils-div ct)))))))))) + (<- (whenp->> (not verbose?) + (map+ (fnl map-vals' stat/mean)) + ; compute means on each value + (reduce (fn [[ct m'] m] [(inc ct) (merge-with num/nils+ m' m)]) [0 nil]) + ((fn [[ct m]] (->> m (map-vals' (fn1 num/nils-div ct))))))))))) (defn silhouette "An effective and popular cluster validity metric that seeks to find a balance between diff --git a/src/quantum/apis/amazon/cloud_drive/core.cljc b/src/quantum/apis/amazon/cloud_drive/core.cljc index f88f4d82..de70370c 100644 --- a/src/quantum/apis/amazon/cloud_drive/core.cljc +++ b/src/quantum/apis/amazon/cloud_drive/core.cljc @@ -21,7 +21,7 @@ :include-macros true] [quantum.core.spec :as s :refer [validate]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]]) #?(:cljs (:require-macros @@ -77,13 +77,13 @@ :cljs go) (->> (request! :meta :account/usage) #?(:cljs ; The smallest f-number of the lens at the focal length used to create the photo (APEX value). ; :subjectDistance ; The distance to the subject of the photo, in meters. ; :lens ""}}) ; The lens used to create the photo. - diff --git a/src/quantum/apis/google/youtube/core.cljc b/src/quantum/apis/google/youtube/core.cljc index 123037b6..cabbb1d9 100644 --- a/src/quantum/apis/google/youtube/core.cljc +++ b/src/quantum/apis/google/youtube/core.cljc @@ -29,7 +29,7 @@ #_(defn list-channels [] (-> (http/request! {:url "https://www.googleapis.com/youtube/v3/channels" - :handlers {401 + :handlers {401 (fn [req resp] (gauth/access-token-refresh! :youtube) (http/request! @@ -53,7 +53,7 @@ ; :oauth-token (access-token)}] ; (->> (http/request! req) ; :body -; (<- json/parse-string str/keywordize) +; (<- (json/parse-string str/keywordize)) ; (get-all-pages req)))) diff --git a/src/quantum/apis/intuit/mint.cljc b/src/quantum/apis/intuit/mint.cljc index a2deaa48..9d686fb3 100644 --- a/src/quantum/apis/intuit/mint.cljc +++ b/src/quantum/apis/intuit/mint.cljc @@ -43,7 +43,7 @@ #(or (get account-remap %) %)) )) identity)] (->> csv - (<- csv/parse #{:as-map? :reducer?}) + (<- (csv/parse #{:as-map? :reducer?})) (map+ (fn1 update :amount (fn-> str/val rationalize))) (map+ (fn1 update :transaction-type keyword)) (map+ (fn1 update :date (fn-> (time/parse "M/dd/yyyy") diff --git a/src/quantum/apis/quip/core.cljc b/src/quantum/apis/quip/core.cljc index b2de2df8..fbbe41f0 100644 --- a/src/quantum/apis/quip/core.cljc +++ b/src/quantum/apis/quip/core.cljc @@ -1,8 +1,9 @@ (ns quantum.apis.quip.core #_(:require-quantum [:lib http auth]) - #_(:require [hickory.core :as hp] - [hickory.select :as hs] - [quantum.core.type :as t])) + #_(:require [hickory.core :as hp] + [hickory.select :as hs] + [quantum.core.type-old :as t] + [quantum.core.data.map :as map])) #_(defn request! [req] (http/request! @@ -29,7 +30,7 @@ (->> table second :content (mapv (fn->> :content (mapv (fn-> :content first :content first - (whenf (fn1 t/+map?) (fn-> :content first)))))))] + (whenf (fn1 map/+map?) (fn-> :content first)))))))] (coll/zipmap map/om (first columns) (-> columns rest coll/transpose)))) #_(def ^{:doc "Checks whether the argument is a singleton string consisting of diff --git a/src/quantum/audio/midi.clj b/src/quantum/audio/midi.clj index 5fec3e18..7b5486fc 100644 --- a/src/quantum/audio/midi.clj +++ b/src/quantum/audio/midi.clj @@ -4,10 +4,11 @@ (:require [clojure.core.match :refer [match]] + [quantum.core.data.primitive :as p] [quantum.core.fn :refer [<- fn-> fn->> fn1 fnl]] [quantum.core.logic - :refer [fn-and whenc whenf whenf1 xor cond-let]] + :refer [fn-and whenc whenf whenf1 xor ifs-let]] [quantum.core.collections :as coll :refer [ffilter filter+ remove+ remove partition-all+ keys+ partition-all lpartition-all cat lcat concatv @@ -16,6 +17,7 @@ while-let lfor doseqi for fori red-for join reduce zip lzip]] [quantum.core.async :as async :refer [go ! put! timeout]] + [quantum.core.data.map :as map] [quantum.core.data.validated :as dv] [quantum.core.spec :as s :refer [validate]] @@ -24,11 +26,10 @@ [quantum.core.log :as log] [quantum.core.resources :as res] [quantum.core.string :as str] - [quantum.core.convert.primitive :as pconv] [quantum.core.convert :as conv] [quantum.measure.convert :refer [convert]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]] [quantum.core.async.pool :as pool] [quantum.db.datomic.core :as dbc]) ; TODO just for the spec @@ -156,7 +157,7 @@ [s] (validate s string?) (let [lines-then-measures - (->> s (<- str/split #"\n") + (->> s (<- (str/split #"\n")) (remove+ empty?) (map+ (fn-> str/trim (str/split #"\|") popl)) join) @@ -204,11 +205,11 @@ {:instrument (-> label str/trim) :expr-0 (-> expr-0 str/trim) :measures measures - :octave (-> octave str/trim pconv/->int)}))) + :octave (-> octave str/trim p/>int)}))) join) _ (dotimes [i-measure num-all-measures] (let [count-this-measure (fn [line] - (->> line :measures (<- get i-measure) + (->> line :measures (<- (get i-measure)) (map+ (fn-> second :relative-duration)) (reduce +))) measure-duration (-> music first count-this-measure)] @@ -290,11 +291,11 @@ _ (validate expr #(not (and (contains? % \^) (contains? % \v)))) [octave' expr'] - (cond-let [ups (get expr \^)] - [(+ octave ups ) (dissoc expr \^)] - [downs (get expr \v)] - [(- octave downs) (dissoc expr \v)] - [octave expr]) + (ifs-let [ups (get expr \^)] + [(+ octave ups ) (dissoc expr \^)] + [downs (get expr \v)] + [(- octave downs) (dissoc expr \v)] + [octave expr]) expr' (->> expr' keys+ (join #{})) found-articulation (-> (get articulations->articulation-name expr') (validate keyword?)) @@ -351,7 +352,7 @@ (release-all! offset)) (defn gen-ops-for-note [{:keys [chan pitch velocity duration tie-on? measure-ties scheduler]}] - (let [_ (validate measure-ties (fn1 t/+map?)) + (let [_ (validate measure-ties (fn1 map/+map?)) tied (get measure-ties chan) prev-tied? (= tied pitch)] (cond prev-tied? @@ -378,7 +379,7 @@ {:as line :keys [instrument expr-0 measures octave]} {:keys [base-duration scheduler normal-chan bar-ties]}] - (validate bar-ties (fn1 t/+map?)) + (validate bar-ties (fn1 map/+map?)) (red-for [note* measure {:keys [measure-ties measure-ops]} {:measure-ties bar-ties :measure-ops []}] (let [{:keys [note note-duration duration relative-duration octave' pitch-int modwheel chan velocity tie?] :as setup} @@ -405,7 +406,7 @@ (defn gen-ops-for-bar [{:keys [music base-duration scheduler normal-chans i-measure ties ops]}] - (validate ties (fn1 t/+map?)) + (validate ties (fn1 map/+map?)) (red-for [[i-line line] (coll/lindexed music) {:keys [bar-ties bar-ops]} {:bar-ties ties :bar-ops []}] (let [measure (-> line :measures (get i-measure)) @@ -484,10 +485,9 @@ (defn join-staves [& staves] (->> staves - (map (fn->> (<- str/split #"\n") + (map (fn->> (<- (str/split #"\n")) (map+ str/trim) (map+ (fn1 popl)) join)) (apply (partial mapv (partial apply str))) (str/join "\n"))) - diff --git a/src/quantum/browser/core.cljc b/src/quantum/browser/core.cljc index e1037b49..094eabee 100644 --- a/src/quantum/browser/core.cljc +++ b/src/quantum/browser/core.cljc @@ -24,7 +24,7 @@ :refer [join map+]] [quantum.core.macros :refer [defnt]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]]) #?(:clj (:import ;(com.teamdev.jxbrowser.chromium.javafx BrowserView) diff --git a/src/quantum/compile/transpile/from/java.cljc b/src/quantum/compile/transpile/from/java.cljc index 1614a154..d3c3155f 100644 --- a/src/quantum/compile/transpile/from/java.cljc +++ b/src/quantum/compile/transpile/from/java.cljc @@ -10,16 +10,16 @@ containsv? popl popr kw-map contains?]] [quantum.core.convert :as conv :refer [->name] ] - [quantum.core.convert.primitive :as pconv] + [quantum.core.data.primitive :as p] [quantum.core.error :as err :refer [>ex-info] ] [quantum.core.macros :as macros :refer [#?(:clj defnt)] ] [quantum.core.fn :as fn - :refer [fn' fn-> fn->> fn1 rcomp <-]] + :refer [fn' fn-> fn->> fn1 rcomp]] [quantum.core.logic :as logic - :refer [fn= fn-or fn-and whenf whenf1 ifn1 condf1 if-let cond-let]] - [quantum.core.type :as t + :refer [fn= fn-or fn-and whenf whenf1 ifn1 condf1 if-let ifs-let]] + [quantum.core.type-old :as t :refer [val?]] [quantum.core.type.core :as tcore] [quantum.core.match :as m @@ -372,7 +372,7 @@ ([^StringLiteralExpr x] (-> x .getValue)) ([^LongLiteralExpr x] - `(~'long ~(->> x .getValue popr pconv/->long))) + `(~'long ~(->> x .getValue popr p/>long))) ([^BooleanLiteralExpr x] (-> x .getValue)) ([^IntegerLiteralExpr x] @@ -464,7 +464,7 @@ (fn-> last anap/return-statement?)) (fn1 update-last (fn1 second)) anap/sym-call? - (fn [x] (cond-let + (fn [x] (ifs-let [{[form] :form [oper] :oper} (re-match-whole x (m/& (m/as :oper (| '+ '-)) @@ -515,4 +515,3 @@ first (map (ifn1 (fn-and seq? (fn-> first (= 'do)) (fn-> count (= 2))) rest list)) (apply concat)))) - diff --git a/src/quantum/compile/transpile/to/core.cljc b/src/quantum/compile/transpile/to/core.cljc index 79d2e67d..f91c06ae 100644 --- a/src/quantum/compile/transpile/to/core.cljc +++ b/src/quantum/compile/transpile/to/core.cljc @@ -1,18 +1,18 @@ (ns quantum.compile.transpile.to.core (:require - [quantum.compile.transpile.util :as util ] - [quantum.core.analyze.clojure.predicates :as anap ] - [quantum.core.data.map :as map ] + [quantum.compile.transpile.util :as util] + [quantum.core.analyze.clojure.predicates :as anap] + [quantum.core.data.map :as map] [quantum.core.collections :as coll :refer [containsv? kw-map popr popl contains? in? dropl]] [quantum.core.convert :as conv :refer [->name]] [quantum.core.error :as err :refer [throw-unless >ex-info]] - [quantum.core.log :as log ] - [quantum.core.compare :as comp ] - [quantum.core.string :as str ] - [quantum.core.string.format :as strf ] + [quantum.core.log :as log] + [quantum.core.compare :as comp] + [quantum.core.string :as str] + [quantum.core.string.format :as strf] [quantum.core.fn :as fn :refer [<- fn-> fn->> fn1 fn']] [quantum.core.logic :as logic @@ -20,7 +20,7 @@ whenf1 whenc ifn condfc condpc coll-or]] [quantum.core.macros :as macros :refer [defnt]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]])) ; special-symbol? is a clojure thing @@ -97,10 +97,10 @@ (declare obj-class) -; TODO insert in quantum.core.type +; TODO insert in quantum.core.type-old (def primitive? (partial (fn-not coll?))) ; TODO this is definitely not right -; TODO use quantum.core.type +; TODO use quantum.core.type-old (def primitives-map {(type (long 0)) "long" (type (int 0)) "int" @@ -364,7 +364,7 @@ (let [ standard #(let [pred-str (str/sp "if" (str/paren (eval-form pred)))] (->> args (cons 'do) eval-form - (<- str "\n") + (<- (str "\n")) (util/bracket pred-str)))] (condp = *lang* :js (standard) @@ -380,8 +380,8 @@ (fn [] (let [pred-str (str/sp "if" (str/paren (eval-form pred))) ^Fn do-eval (fn->> do-form eval-form) - expr-t-str (->> expr-t do-eval (<- str "\n") (util/bracket pred-str)) - expr-f-str (->> expr-f do-eval (<- str "\n") (util/bracket "else"))] + expr-t-str (->> expr-t do-eval (<- (str "\n")) (util/bracket pred-str)) + expr-f-str (->> expr-f do-eval (<- (str "\n")) (util/bracket "else"))] (str/sp expr-t-str expr-f-str)))] (condp = *lang* :js (default-fn) @@ -406,11 +406,11 @@ catches (->> args (filter (fn-and seq? catch?))) finallys (->> args (filter (fn-and seq? finally?))) ^Fn do-eval (fn->> apply-do-form eval-form) - try-str (->> try-body do-eval (<- str "\n") (util/bracket "try")) + try-str (->> try-body do-eval (<- (str "\n")) (util/bracket "try")) catch-str (when (contains? catches) - (->> catches first rest rest do-eval (<- str "\n") (util/bracket (str/sp "catch" (str/paren (-> catches first second str demunge-class)))))) + (->> catches first rest rest do-eval (<- (str "\n")) (util/bracket (str/sp "catch" (str/paren (-> catches first second str demunge-class)))))) finally-str (when (contains? finallys) - (->> finallys first rest do-eval (<- str "\n") (util/bracket "finally")))] + (->> finallys first rest do-eval (<- (str "\n")) (util/bracket "finally")))] (str/sp try-str catch-str finally-str)))] (condp = *lang* :js (default-fn) @@ -461,10 +461,10 @@ _ (println "BLOCK EVALED IN DO" block-evaled) ^String block (->> block-evaled - (<- whenf (fn-and contains? - (fn-not (fn1 str/ends-with? "}"))) - util/scolon) ; Could be a macro, in which case it wouldn't show up in the .js file - (<- whenf contains? (partial str spacing)))] + (<- (whenf (fn-and contains? + (fn-not (fn1 str/ends-with? "}"))) + util/scolon)) ; Could be a macro, in which case it wouldn't show up in the .js file + (<- (whenf contains? (partial str spacing))))] (when (contains? block) (reset! prev-block block)) block))) (apply str)))) @@ -564,7 +564,7 @@ (cond (even? arg-ct) (apply sorted-map arg-0 args) ; sorts the keys - (and (= 1 arg-ct) (t/+map? arg-0)) + (and (= 1 arg-ct) (map/+map? arg-0)) arg-0 (and (= 1 arg-ct) (nil? arg-0)) {} @@ -573,7 +573,7 @@ longest-key-length (->> obj-map keys (map (fn->> name symbol eval-form count)) - (<- ifn empty? (fn' 0) comp/greatest)) + (<- (ifn empty? (fn' 0) comp/greatest))) ^String obj-map-contents (let [prev-line (atom nil)] (reduce @@ -731,9 +731,9 @@ (log/pr :debug "IN SYM WITH" (str obj)) (if (anap/qualified? obj) (do (log/pr :debug "QUALIFIED SYMBOL:" (str obj)) - (if (->> obj str (filter (fn= \/)) count (<- > 1)) + (if (->> obj str (filter (fn= \/)) count (<- (> 1))) (throw (>ex-info (str "Qualified symbol" (-> obj str str/squote) "cannot have more than one namespace."))) - (->> obj str (<- str/replace backslash-regex ".") symbol eval-form))) + (->> obj str (<- (str/replace backslash-regex ".")) symbol eval-form))) (->> obj str replace-specials))) ([^string? obj] (str \" obj \")) #?(:clj ([^char? obj] (str \' obj \'))) @@ -762,5 +762,3 @@ (map (partial eval-form)) (interpose (if whitespace? ", " ",")) (apply str)))) - - diff --git a/src/quantum/compile/transpile/util.cljc b/src/quantum/compile/transpile/util.cljc index d9dac8e1..4da14b14 100644 --- a/src/quantum/compile/transpile/util.cljc +++ b/src/quantum/compile/transpile/util.cljc @@ -26,7 +26,7 @@ (def indentation (->> (repeat *indent-num* \space) (apply str))) (defn indent [s] - (->> s (str indentation) (<- str/replace #"\n" (str "\n" indentation)))) + (->> s (str indentation) (<- (str/replace #"\n" (str "\n" indentation))))) (defn bracket {:in '["class ABC" "println()"] diff --git a/src/quantum/convert/core.cljc b/src/quantum/convert/core.cljc index d52eed51..044331a0 100644 --- a/src/quantum/convert/core.cljc +++ b/src/quantum/convert/core.cljc @@ -9,6 +9,7 @@ (:import [javax.imageio.metadata IIOAttr IIOMetadataNode])) +;; TODO MOVE (defnt ->hiccup [^IIOMetadataNode x] ; .getPrefix ; .getLocalName @@ -29,4 +30,3 @@ (conj! !children (->hiccup child)) (reduced !children)))) (range)))) - diff --git a/src/quantum/core/analyze/clojure/core.cljc b/src/quantum/core/analyze/clojure/core.cljc index 9494954f..e4f7bd44 100644 --- a/src/quantum/core/analyze/clojure/core.cljc +++ b/src/quantum/core/analyze/clojure/core.cljc @@ -14,9 +14,10 @@ :refer [defalias]] [quantum.untyped.core.data :refer [kw-map]] - [quantum.untyped.core.form.evaluate :as ufeval] - [quantum.untyped.core.type.predicates - :refer [val?]]) + [quantum.untyped.core.data.bits + :refer [val?]] + [quantum.untyped.core.form.evaluate :as ufeval] + [quantum.untyped.core.form.type-hint :as ufth]) #?(:clj (:import (clojure.lang RT Compiler)))) @@ -129,5 +130,5 @@ _ (assert hint {:xs xs :hint hint}) cast-class (th/tag->class (tcore/nth-elem-type|clj hint depth))] (if (.isPrimitive ^Class cast-class) - `(~(symbol "clojure.core" (str cast-class)) ~x) - (tcore/static-cast-code (th/>body-embeddable-tag cast-class) x)))))) + (ufth/primitive-cast|code x cast-class) + (ufth/static-cast|code (th/>body-embeddable-tag cast-class) x)))))) diff --git a/src/quantum/core/analyze/clojure/predicates.cljc b/src/quantum/core/analyze/clojure/predicates.cljc index 23e3be2e..9ca5636a 100644 --- a/src/quantum/core/analyze/clojure/predicates.cljc +++ b/src/quantum/core/analyze/clojure/predicates.cljc @@ -7,7 +7,7 @@ #?(:clj [clojure.jvm.tools.analyzer :as tana]) [quantum.core.analyze.clojure.core :as ana] - [quantum.core.core :as qcore] + [quantum.core.data.primitive :as p] [quantum.core.fn :as fn :refer [fnl <- fn-> fn->> fn']] [quantum.core.logic :as logic @@ -16,7 +16,8 @@ [quantum.core.type.core :as tcore] [quantum.core.vars :as var :refer [defalias]] - [quantum.untyped.core.type.predicates :as utpred])) + [quantum.untyped.core.data.bits :as ubit] + [quantum.untyped.core.string :as ustr])) (defn safe-mapcat "Like |mapcat|, but works if the returned values aren't sequences." @@ -49,13 +50,14 @@ (def possible-type-predicate? (fn-or keyword? (fn-and symbol? (fn-or (fn= 'default) (fn-> name (str-index-of "?") (not= -1)))))) -(def hinted-literal? (fn-or #?(:clj char?) number? string? vector? map? nil? keyword? utpred/boolean? utpred/regex?)) +(def hinted-literal? + (fn-or #?(:clj char?) number? string? vector? map? nil? keyword? p/boolean? ustr/regex?)) ; ===== SCOPE ===== (defn shadows-var? [bindings v] (->> bindings (apply hash-map) keys (filter symbol?) (map name) ; TODO filtering by symbol because ignoring destructuring, but that's bad (into #{}) - (<- contains? (name v)))) + (<- (contains? (name v))))) (def new-scope? (fn-and seq? (fn-> first symbol?) (fn-> first name (= "let")))) diff --git a/src/quantum/core/async.cljc b/src/quantum/core/async.cljc index 845aeedf..cde93558 100644 --- a/src/quantum/core/async.cljc +++ b/src/quantum/core/async.cljc @@ -24,7 +24,7 @@ map, map-indexed map-indexed+ seq-and]] [quantum.core.data.vector :as vec - :refer [!+vector:sized]] + :refer [!+vector|sized]] [quantum.core.error :as err :refer [>ex-info TODO catch-all]] [quantum.core.fn @@ -38,15 +38,16 @@ [quantum.core.spec :as s :refer [validate]] [quantum.core.system :as sys] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]] [quantum.core.vars :as var :refer [defalias defmalias]] + [quantum.untyped.core.async :as uasync] [quantum.untyped.core.form.evaluate :as ufeval :refer [case-env]] [quantum.untyped.core.string :refer [istr]] - [quantum.untyped.core.type.predicates + [quantum.untyped.core.vars #?@(:cljs [:refer [defined?]])]) #?(:cljs (:require-macros @@ -819,16 +820,4 @@ #?(:clj (defmacro if-timeout! [[v c timeout-ms] then else] `(handle-timeout! [~v ~c ~timeout-ms] if ~then ~else))) #?(:clj (defmacro when-timeout! [[v c timeout-ms] & body] `(handle-timeout! [~v ~c ~timeout-ms] when ~@body))) -#?(:cljs -(def request-animation-frame - (or - (.-requestAnimationFrame sys/global) - (.-webkitRequestAnimationFrame sys/global) - (.-mozRequestAnimationFrame sys/global) - (.-msRequestAnimationFrame sys/global) - (.-oRequestAnimationFrame sys/global) - (let [t0 (.getTime (js/Date.))] - (fn [f] - (js/setTimeout - #(f (- (.getTime (js/Date.)) t0)) - 16.66666)))))) +(defalias uasync/at-next-tick) diff --git a/src/quantum/core/async/pool.cljc b/src/quantum/core/async/pool.cljc index 4224053f..f7e5454f 100644 --- a/src/quantum/core/async/pool.cljc +++ b/src/quantum/core/async/pool.cljc @@ -10,10 +10,11 @@ :refer [close! go-loop put!]] [quantum.core.core :as qcore] [quantum.core.data.map :as map] + [quantum.core.data.primitive :as p] [quantum.core.data.set :as set] [quantum.core.data.validated :as dv] [quantum.core.fn - :refer [<- fn1 fn& fnl, fn-> fn->>, call with-do]] + :refer [fn1 fn& fnl, fn-> fn->>, call with-do]] [quantum.core.collections :as c :refer [for, kw-map, update, assoc-in, join, key val, updates map-keys+, map-vals']] @@ -25,15 +26,14 @@ [quantum.core.macros :as macros :refer [defnt]] [quantum.core.reflect :as refl] - [quantum.core.refs :as refs + [quantum.core.refs :as ref :refer [fref]] [quantum.core.spec :as s :refer [validate]] [quantum.core.resources :as res] [quantum.core.time.core :as time] [quantum.measure.convert :as uconv] - [quantum.core.type :as t - :refer [atom?]] + [quantum.core.type-old :as t] [quantum.core.vars :as var]) #?(:cljs (:require-macros @@ -152,8 +152,8 @@ ([^BusyWaitScheduler scheduler at f] (validate at (s/and number? (fn1 >= 0)) f fn?) - (let [shut-down? (-> scheduler :shut-down? (validate atom?) deref) - queue (-> scheduler :queue (validate atom?))] + (let [shut-down? (-> scheduler :shut-down? (validate ref/atom?) deref) + queue (-> scheduler :queue (validate ref/atom?))] (if shut-down? false (do (swap! queue update (long at) (fn-> (c/ensurec []) (conj f))) @@ -361,7 +361,7 @@ :generated shut-down-pools!))) (log/pr ::debug "Stopped ThreadpoolManager."))))) -#?(:clj (defn validate-pools-map [x] (t/+map? x))) ; TODO more validation +#?(:clj (defn validate-pools-map [x] (map/+map? x))) ; TODO more validation #?(:clj (dv/def-map threadpool-manager:config ; TODO merge with ThreadpoolManager @@ -449,9 +449,9 @@ ;; TODO make `chan` the primary point of contact for components ;; It's used to ensure that resources are stopped being used before cleanup starts chan #_chan? stop-ch #_promise? - *tasks #_(t/of atom? (t/of map? ident? - (t/and ::task - (t/keys :req-un [(spec :stop-ch promise?)]))))] + *tasks #_(t/of ref/atom? (t/of map? ident? + (t/and ::task + (t/keys :req-un [(spec :stop-ch promise?)]))))] ([this] (let [chan' (async/chan 100) ; `100` is arbitrary *tasks' (atom {}) @@ -534,7 +534,7 @@ threadpool-f (atom (or threadpool (->pool :fixed max-threads-f))) threadpool-interrupted? (doto (atom false) - (set-validator! (fn1 t/boolean?)) + (set-validator! (fn1 p/boolean?)) (add-watch :interrupt-monitor (fn [_ _ _ newv] (when (true? newv) @@ -588,4 +588,3 @@ (if apply? (apply distribute! distributor inputs) (distribute! distributor inputs))))) - diff --git a/src/quantum/core/automata.cljc b/src/quantum/core/automata.cljc index afa50ff4..0c423eb6 100644 --- a/src/quantum/core/automata.cljc +++ b/src/quantum/core/automata.cljc @@ -48,7 +48,7 @@ ; :print-output :ffmpeg ; :handlers handlers-f} ; (merge-keep-left (dissoc opts :handlers)) -; (<- assoc :read-streams? true :close-reqs close-reqs))))) +; (<- (assoc :read-streams? true :close-reqs close-reqs)))))) ; (def log-buffer! ; (atom diff --git a/src/quantum/core/cache.cljc b/src/quantum/core/cache.cljc index 8a1cc8ff..8d6b47b9 100644 --- a/src/quantum/core/cache.cljc +++ b/src/quantum/core/cache.cljc @@ -1,12 +1,17 @@ (ns quantum.core.cache (:refer-clojure :exclude [memoize]) (:require + [quantum.core.typed :as t] + ;; TODO TYPED excise [quantum.untyped.core.cache :as u] + ;; TODO TYPED excise [quantum.untyped.core.vars :as uvar :refer [defaliases]])) +(def delay? (t/isa? #?(:clj clojure.lang.Delay :cljs cljs.core/Delay))) + +;; TODO TYPED (defaliases u memoize* memoize #?(:clj defmemoized) callable-times init! clear!) - diff --git a/src/quantum/core/collections.cljc b/src/quantum/core/collections.cljc index 0b29c10f..86a3f7a2 100644 --- a/src/quantum/core/collections.cljc +++ b/src/quantum/core/collections.cljc @@ -11,6 +11,9 @@ Many of them are aliased from other namespaces like quantum.core.collections.core, or quantum.core.reducers." + {:todo #{"Incorporate System.arrayCopy" + "Incorporate java.util.Arrays" + "Incorporate java.util.ArraysSupport"}} (:refer-clojure :exclude [for doseq reduce transduce dotimes contains? @@ -46,12 +49,12 @@ [clojure.core :as c ] [fast-zip.core :as zip ] [quantum.core.data.map :as map - :refer [!hash-map]] + :refer [!>hash-map]] [quantum.core.data.set :as set ] [quantum.core.data.string :refer [!str]] [quantum.core.data.vector :as vec - :refer [catvec subsvec !vector]] + :refer [catvec subsvec !>vector]] [quantum.core.collections.core :as coll] [quantum.core.collections.sociative :as soc ] [quantum.core.collections.differential :as diff @@ -86,12 +89,12 @@ :refer [setm! swapm! deref !ref]] [quantum.core.string :as str ] [quantum.core.string.format :as sform ] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [lseq? transient? editable? boolean? should-transientize? class]] [quantum.core.analyze.clojure.predicates :as anap] - [quantum.core.loops :as loops] + [quantum.core.loops :as loop] [quantum.core.vars :as var :refer [defalias defaliases]] [quantum.untyped.core.data :as udata]) @@ -109,7 +112,8 @@ #?(:clj (:import java.util.Comparator quantum.core.refs.MutableReference) :cljs (:import goog.string.StringBuffer))) -(defalias val? quantum.core.type/val?) +(defalias val? quantum.core.type-old/val?) +(defalias >combinatoric-tree u/>combinatoric-tree) #?(:clj (defmacro getf @@ -133,7 +137,7 @@ `(~accessor ~x ~v))))) (defaliases clog - seq-or some seq-nor not-any? seq-and every? seq-nand not-every? apply-and apply-or) + seq-or some seq-nor not-any? seq-and every? seq-nand not-every?) ; KV ; @@ -260,7 +264,7 @@ (defnt into! ; TODO delete "Like into, but for mutable collections" - [^transient? x coll] (loops/doseq [elem coll] (conj! x elem)) x) + [^transient? x coll] (loop/doseq [elem coll] (conj! x elem)) x) ; `take` <~> `lodash/take` (defalias take diff/takel ) @@ -356,48 +360,48 @@ ; _______________________________________________________________ ; ============================ LOOPS ============================ ; ••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• -#?(:clj (defalias dotimes loops/dotimes )) -#?(:clj (defalias fortimes loops/fortimes )) -#?(:clj (defalias fortimes:objects loops/fortimes:objects )) -#?(:clj (defalias fortimes:objects2 loops/fortimes:objects2)) -#?(:clj (defalias fortimes:doubles loops/fortimes:doubles )) -#?(:clj (defalias fortimes:doubles2 loops/fortimes:doubles2)) -#?(:clj (defalias fortimes:doubles3 loops/fortimes:doubles3)) +#?(:clj (defalias dotimes loop/dotimes )) +#?(:clj (defalias fortimes loop/fortimes )) +#?(:clj (defalias fortimes:objects loop/fortimes:objects )) +#?(:clj (defalias fortimes:objects2 loop/fortimes:objects2)) +#?(:clj (defalias fortimes:doubles loop/fortimes:doubles )) +#?(:clj (defalias fortimes:doubles2 loop/fortimes:doubles2)) +#?(:clj (defalias fortimes:doubles3 loop/fortimes:doubles3)) #?(:clj (defalias transduce red/transduce )) -#?(:clj (defalias reduce loops/reduce )) -#?(:clj (defalias reducei loops/reducei )) -#?(:clj (defalias reduce* loops/reduce* )) -#?(:clj (defalias reduce-multi loops/reduce-multi)) -#?(:clj (defalias red-for loops/red-for )) -#?(:clj (defalias red-fori loops/red-fori)) - (defalias reduce-pair loops/reduce-pair) - (defalias reduce-2 loops/reduce-2 ) - (defalias reducei-2 loops/reducei-2) -#?(:clj (defalias reduce-2:indexed loops/reduce-2:indexed)) -#?(:clj (defalias ifor loops/ifor )) -#?(:clj (defalias ifori loops/ifori )) +#?(:clj (defalias reduce loop/reduce )) +#?(:clj (defalias reducei loop/reducei )) +#?(:clj (defalias reduce* loop/reduce* )) +#?(:clj (defalias reduce-multi loop/reduce-multi)) +#?(:clj (defalias red-for loop/red-for )) +#?(:clj (defalias red-fori loop/red-fori)) + (defalias reduce-pair loop/reduce-pair) + (defalias reduce-2 loop/reduce-2 ) + (defalias reducei-2 loop/reducei-2) +#?(:clj (defalias reduce-2:indexed loop/reduce-2:indexed)) +#?(:clj (defalias ifor loop/ifor )) +#?(:clj (defalias ifori loop/ifori )) ; ===== COLLECTION COMPREHENSION ===== ; -#?(:clj (defalias for-join loops/for-join )) -#?(:clj (defalias for-join! loops/for-join! )) -#?(:clj (defalias for loops/for )) #?(:clj (alter-meta! (var for) c/assoc :macro true)) -#?(:clj (defalias for' loops/for' )) +#?(:clj (defalias for-join loop/for-join )) +#?(:clj (defalias for-join! loop/for-join! )) +#?(:clj (defalias for loop/for )) #?(:clj (alter-meta! (var for) c/assoc :macro true)) +#?(:clj (defalias for' loop/for' )) #?(:clj (defalias for+ red/for+ )) -#?(:clj (defalias fori loops/fori )) -#?(:clj (defalias fori' loops/fori' )) +#?(:clj (defalias fori loop/fori )) +#?(:clj (defalias fori' loop/fori' )) #?(:clj (defalias fori+ red/fori+ )) -#?(:clj (defalias fori-join loops/fori-join )) -#?(:clj (defalias fori-join! loops/fori-join!)) -#?(:clj (defmacro lfor [& args] `(loops/lfor ~@args))) - -#?(:clj (defmacro doseq [& args] `(loops/doseq ~@args))) -#?(:clj (defmacro doseqi [& args] `(loops/doseqi ~@args))) -#?(:clj (defalias until loops/until )) -#?(:clj (defalias while-let loops/while-let)) -#?(:clj (defalias doeach loops/doeach)) -#?(:clj (defalias each loops/each)) -#?(:clj (defalias eachi loops/eachi)) -#?(:clj (defalias doreduce loops/doreduce)) - (defalias mapfn loops/mapfn) +#?(:clj (defalias fori-join loop/fori-join )) +#?(:clj (defalias fori-join! loop/fori-join!)) +#?(:clj (defmacro lfor [& args] `(loop/lfor ~@args))) + +#?(:clj (defmacro doseq [& args] `(loop/doseq ~@args))) +#?(:clj (defmacro doseqi [& args] `(loop/doseqi ~@args))) +#?(:clj (defalias until loop/until )) +#?(:clj (defalias while-let loop/while-let)) +#?(:clj (defalias doeach loop/doeach)) +#?(:clj (defalias each loop/each)) +#?(:clj (defalias eachi loop/eachi)) +#?(:clj (defalias doreduce loop/doreduce)) + (defalias mapfn loop/mapfn) (defalias break reduced) ; _______________________________________________________________ ; ========================= GENERATIVE ========================== @@ -480,7 +484,7 @@ (->> tree m (dissoc k)))) (defn rename-keys [m-0 rename-m] - (loops/reduce + (loop/reduce (fn [ret k-0 k-f] (-> ret (assoc k-f (get ret k-0)) @@ -1007,7 +1011,7 @@ :todo ["Make it not output HashMaps but preserve records"] :contributors ["Alex Gunnarson"]} [f & maps] - (when (apply-or maps) + (when (seq-or maps) (let [merge-entry (fn [m e] (let [k (key e) v (val e)] @@ -1017,8 +1021,8 @@ merge2 (fn ([] {}) ([m1 m2] - (loops/reduce merge-entry (or m1 {}) (seq m2))))] - (loops/reduce merge2 maps)))) + (loop/reduce merge-entry (or m1 {}) (seq m2))))] + (loop/reduce merge2 maps)))) (defn merge-vals-left "Merges into the left map all elements of the right map whose @@ -1035,7 +1039,7 @@ :b {:aa 3}}} [left right f] (persistent! - (loops/reduce + (loop/reduce (fn [left-f k-right v-right] ;(if ((fn-not contains?) left-f k-right) ; can't call |contains?| on a transient, apparently... ; left-f) @@ -1067,7 +1071,7 @@ :attribution "alexandergunnarson" :out 'Map} ([coll kfs] - (->> (loops/reduce + (->> (loop/reduce (fn [ret k f] (assoc ret k (f coll))) {} @@ -1175,7 +1179,7 @@ (defnt probabilities+ ([ #_reducible? xs] - (let [ct (count xs)] (->> xs (frequencies (!hash-map)) (map-vals+ (fn1 / ct)))))) + (let [ct (count xs)] (->> xs (frequencies (!>hash-map)) (map-vals+ (fn1 / ct)))))) ;___________________________________________________________________________________________________________________________________ ;=================================================={ GROUPING }===================================================== ;=================================================={ group, aggregate }===================================================== @@ -1192,7 +1196,7 @@ (fn [grouped-elems] (if (single? grouped-elems) grouped-elems - (loops/reduce + (loop/reduce (fn [ret elem] (merge-with-k merge-with-f ret elem)) (first grouped-elems) @@ -1219,11 +1223,7 @@ (loop [[part & parts] work] (if-let [[pivot & xs] (seq part)] (let [smaller? #(< % pivot)] - (recur (list* - (lfilter smaller? xs) - pivot - (lremove smaller? xs) - parts))) + (recur (list* (lfilter smaller? xs) pivot (lremove smaller? xs) parts))) (when-let [[x & parts] parts] (cons x (sort-parts parts))))))) @@ -1235,6 +1235,10 @@ ; TODO subarray-only sort +;; TODO incorporate highly tuned radix sort with better performance than quicksort on n < 10000 +;; - http://fastutil.di.unimi.it/docs/it/unimi/dsi/fastutil/ints/IntArrays.html#radixSort-int:A-int-int- +;; - http://fastutil.di.unimi.it/docs/overview-summary.html + #?(:clj (defnt heap-sort! [#{ints? floats? doubles? "[Ljava.lang.Comparable;"} arr] @@ -1709,8 +1713,8 @@ (reduce-kv (fn [m k v] (if (or (and (not (> 0 max)) (<= max 1)) - (not (#?(:clj t/+hash-map? - :cljs t/+map?) v)) + (not (#?(:clj map/+hash-map? + :cljs map/+map?) v)) (and keep-empty (empty? v))) (assoc m (conj arr k) v) @@ -2182,12 +2186,12 @@ [1 2]}} [n percents] (let [_ (err/assert (>= n (count percents))) - _ (err/assert (->> percents (reduce + 0) (<- <= 1))) + _ (err/assert (->> percents (reduce + 0) (<- (<= 1)))) allocated (for [p percents] (long (num/ceil (double (* n p))))) ; TODO make not use long or double sorted (->> allocated (map-indexed+ vector) - (join! (!vector)) + (join! (!>vector)) (sort-by! (fn1 second))) total (->> allocated (reduce + 0)) *flow (long (- total n))] ; over- or underflow diff --git a/src/quantum/core/collections/core.cljc b/src/quantum/core/collections/core.cljc index 946d1ac8..c70d3824 100644 --- a/src/quantum/core/collections/core.cljc +++ b/src/quantum/core/collections/core.cljc @@ -10,22 +10,22 @@ #?(:clj [seqspert.vector]) #?(:clj [clojure.core.async :as casync]) [quantum.core.log :as log] - [quantum.core.convert.primitive :as pconvert - :refer [->boolean - ->byte - #?(:clj ->char) - ->short - ->int - ->long - #?(:clj ->float) - ->double - #?@(:clj [->byte* - ->char* - ->short* - ->int* - ->long* - ->float* - ->double*])]] + [quantum.core.data.primitive :as p + :refer [>boolean + >byte + >short + #?(:clj >char) + >int + >long + #?(:clj >float) + >double + #?@(:clj [>byte* + >short* + >char* + >int* + >long* + >float* + >double*])]] [quantum.core.data.string :refer [!str]] [quantum.core.data.vector :as vec @@ -33,26 +33,26 @@ [quantum.core.error :as err :refer [>ex-info TODO]] [quantum.core.fn :as fn - :refer [fn' fn1 fn&2 rfn rcomp firsta fn-> <- aritoid]] + :refer [<- fn' fn1 fn&2 rfn rcomp firsta fn-> aritoid]] [quantum.core.logic :as logic :refer [fn= whenc whenf ifn1]] [quantum.core.collections.logic :refer [seq-or]] [quantum.core.macros :as macros - :refer [defnt #?(:clj defnt') case-env env-lang]] - [quantum.core.macros.defnt :as defnt] + :refer [case-env env-lang]] [quantum.core.macros.optimization :refer [identity*]] - [quantum.core.reducers.reduce :as red - :refer [reduce reducei transformer]] - [quantum.core.type :as t - :refer [val? class regex?]] + [quantum.core.reducers.reduce :as r + :refer [reduce reducei]] + [quantum.core.type-old :as t + :refer [class defnt fnt regex? val?]] [quantum.core.type.defs :as tdef] [quantum.core.type.core :as tcore] [quantum.core.vars :as var :refer [defalias #?(:clj defmalias) def-]] [quantum.untyped.core.data - :refer [kw-map]]) + :refer [kw-map]] + [quantum.untyped.core.form.type-hint :as ufth]) #?(:cljs (:require-macros [quantum.core.collections.core @@ -98,26 +98,6 @@ (log/this-ns) -; FastUtil is the best -; http://java-performance.info/hashmap-overview-jdk-fastutil-goldman-sachs-hppc-koloboke-trove-january-2015/ - -; TODO notify of changes to: -; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/RT.java -; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/Util.java -; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/Numbers.java -; TODO Queues need support - -; TODO implement all these using wagjo/data-cljs -; split-at [o index] - clojure.core/split-at -; splice [o index n val] - fast remove and insert in one go -; splice-arr [o index n val-arr] - fast remove and insert in one go -; insert-before [o index val] - insert one item inside coll -; insert-before-arr [o index val] - insert array of items inside coll -; remove-at [o index] - remove one itfem from index pos -; remove-n [o index n] - remove n items starting at index pos -; rip [o index] - rips coll and returns [pre-coll item-at suf-coll] -; sew [pre-coll item-arr suf-coll] - opposite of rip, but with arr - ; Arbitrary. ; TODO test this on every permutation for inflection point. (def- parallelism-threshold 10000) @@ -126,105 +106,47 @@ ; Very useful sequence and data structure info. #?(:clj -(defn dropr+ ; This is extremely slow by comparison. About twice as slow - ; TODO for O(1) reversible inputs, you can just do that with `drop+` - ; TODO this is not suitable for `fold` contexts +(defnt dropr+ ; This is extremely slow by comparison. About twice as slow + ;; TODO CLJS + ;; TODO for O(1) reversible inputs, you can just do that with `drop+` + ;; TODO this is not suitable for `fold` contexts {:attribution "Christophe Grand - http://grokbase.com/t/gg/clojure/1388ev2krx/butlast-with-reducers"} - [n xs] - (transformer xs - (fn [rf] - (let [buffer (java.util.ArrayDeque. (int n))] - (fn ([] (rf)) - ([ret x] - (let [ret (if (= (.size buffer) n) ; because Java object - (rf ret (.pop buffer)) - ret)] - (.add buffer x) - ret)))))))) + [n (t/numerically p/int?), xs t/reducible? > t/reducible?] + (let [n' (>int n)] + (r/transformer xs + (t/fn [rf r/rf?] + (let [buffer (java.util.ArrayDeque. n')] + (t/fn ([] (rf)) + ([ret _, x _] + (let [ret' (if (identical? (.size buffer) n') + (rf ret (.pop buffer)) + ret)] + (.add buffer x) + ret'))))))))) #?(:clj (defn taker+ - ; TODO for O(1) reversible inputs, you can just do that with `take+` - ; TODO this is not suitable for `fold` contexts + ;; TODO for CLJS + ;; TODO for O(1) reversible inputs, you can just do that with `take+` + ;; TODO this is not suitable for `fold` contexts {:attribution "Christophe Grand - http://grokbase.com/t/gg/clojure/1388ev2krx/butlast-with-reducers"} - [n coll] - ; TODO use `reducer` - ; TODO for CLJS - (reify - clojure.core.protocols.CollReduce - ;#+cljs cljs.core/IReduce - (coll-reduce [this f1] - (clojure.core.protocols/coll-reduce this f1 (f1))) - (coll-reduce [_ f1 init] - (clojure.core.protocols/coll-reduce - (clojure.core.protocols/coll-reduce - coll - (fn [^java.util.Deque q x] - (when (= (.size q) n) - (.pop q)) - (.add q x) - q) - (java.util.ArrayDeque. (int n))) - f1 init))))) -;___________________________________________________________________________________________________________________________________ -;=================================================={ EQUIVALENCE }===================================================== -;=================================================={ =, identical? }===================================================== -; (defnt ^boolean identical? -; [^Object k1, ^Object k2] -; (clojure.lang.RT/identical k1 k2)) - -; static public boolean pcequiv(Object k1, Object k2){ -; if(k1 instanceof IPersistentCollection) -; return ((IPersistentCollection)k1).equiv(k2); -; return ((IPersistentCollection)k2).equiv(k1); -; } - -; static public boolean equals(Object k1, Object k2){ -; if(k1 == k2) -; return true; -; return k1 != null && k1.equals(k2); -; } - -; static public boolean equiv(Object k1, Object k2){ -; if(k1 == k2) -; return true; -; if(k1 != null) -; { -; if(k1 instanceof Number && k2 instanceof Number) -; return Numbers.equal((Number)k1, (Number)k2); -; else if(k1 instanceof IPersistentCollection || k2 instanceof IPersistentCollection) -; return pcequiv(k1,k2); -; return k1.equals(k2); -; } -; return false; -; } - -; equivNull : boolean equiv(Object k1, Object k2) return k2 == null -; equivEquals : boolean equiv(Object k1, Object k2) return k1.equals(k2) -; equivNumber : boolean equiv(Object k1, Object k2) -; if(k2 instanceof Number) -; return Numbers.equal((Number) k1, (Number) k2); -; return false - -; equivColl : boolean equiv(Object k1, Object k2) -; if(k1 instanceof IPersistentCollection || k2 instanceof IPersistentCollection) -; return pcequiv(k1, k2); -; return k1.equals(k2); - -; ; equivPred: -; ; nil : equivNull -; ; Number : equivNumber -; ; String, Symbol : equivEquals -; ; Collection, Map : equivColl -; ; :else : equivEquals - -; (defnt equiv ^boolean -; ([^Object a #{long double boolean} b] (clojure.lang.RT/equiv a b)) -; ([#{long double boolean} a ^Object b] (clojure.lang.RT/equiv a b)) -; ([#{long double boolean} a #{long double boolean} b] (clojure.lang.RT/equiv a b)) -; ([^char a ^char b] (clojure.lang.RT/equiv a b)) - -; ) + [n xs] + (reify + clojure.core.protocols.CollReduce + ;#+cljs cljs.core/IReduce + (coll-reduce [this f1] + (clojure.core.protocols/coll-reduce this f1 (f1))) + (coll-reduce [_ f1 init] + (clojure.core.protocols/coll-reduce + (clojure.core.protocols/coll-reduce + coll + (fn [^java.util.Deque q x] + (when (= (.size q) n) + (.pop q)) + (.add q x) + q) + (java.util.ArrayDeque. (int n))) + f1 init))))) ;___________________________________________________________________________________________________________________________________ ;=================================================={ RETRIEVAL }===================================================== @@ -267,28 +189,6 @@ `reduce-count` is 36.824665 ms - twice as fast"} [xs] (reduce count:rf xs)) -(defnt ^long count - "Incorporated `clojure.lang.RT/count` and `clojure.lang.RT/countFrom`" - {:todo #{"handle persistent maps"}} - ([^array? x] (#?(:clj Array/count :cljs .-length) x)) - ([^tuple? x] (count (.-vs x))) - #?(:cljs ([^string? x] (.-length x))) - #?(:cljs ([^!string? x] (.getLength x))) - #?(:clj ([^char-seq? x] (.length x))) - ([^keyword? x] (count ^String (name x))) - ([^m2m-chan? x] (count (#?(:clj .buf :cljs .-buf) x))) - ([^+vector? x] (#?(:clj .count :cljs core/count) x)) - #?(:clj ([#{Collection Map} x] (.size x))) - #?(:clj ([^Counted x] (.count x))) - #?(:clj ([^Map$Entry x] (if (nil? x) 0 2))) ; TODO fix this potential null issue - ([^transformer? x] (reduce-count x)) - ([^default x] (if (nil? x) - 0 - (core/count x) ; TODO need to fix this so certain interfaces are preferred - #_(throw (>ex-info "`count` not supported on type" {:type (type x)}))))) - -; TODO `pcount` - (defnt empty? {:todo #{"import clojure.lang.RT/seq"}} ([#{array? ; TODO anything that `count` accepts @@ -306,13 +206,13 @@ #?(:clj ([^clojure.lang.ILookup x k if-not-found] (.valAt x k if-not-found))) #?(:clj ([#{java.util.Map clojure.lang.IPersistentSet} x k ] (.get x k))) - #?(:clj ([#{!map:byte->any?} x ^byte k ] (.get x k))) - #?(:clj ([#{!map:char->any?} x ^char k ] (.get x k))) - #?(:clj ([#{!map:short->any?} x ^short k ] (.get x k))) - #?(:clj ([#{!map:int->any?} x ^int k ] (.get x k))) - #?(:clj ([#{!map:long->any?} x ^long k ] (.get x k))) - #?(:clj ([#{!map:float->ref?} x ^float k ] (.get x k))) - #?(:clj ([#{!map:double->ref?} x ^double k ] (.get x k))) + #?(:clj ([#{!map|byte->any?} x ^byte k ] (.get x k))) + #?(:clj ([#{!map|char->any?} x ^char k ] (.get x k))) + #?(:clj ([#{!map|short->any?} x ^short k ] (.get x k))) + #?(:clj ([#{!map|int->any?} x ^int k ] (.get x k))) + #?(:clj ([#{!map|long->any?} x ^long k ] (.get x k))) + #?(:clj ([#{!map|float->ref?} x ^float k ] (.get x k))) + #?(:clj ([#{!map|double->ref?} x ^double k ] (.get x k))) ([^string? x ^nat-long? i if-not-found] (if (>= i (count x)) if-not-found (.charAt x i))) #?(:clj ([^!array-list? x ^nat-long? i if-not-found] (if (>= i (count x)) if-not-found (.get x i)))) ([#{string? #?(:clj !array-list?)} x ^nat-long? i ] (get x i nil)) @@ -347,7 +247,7 @@ #?(:clj (^<0> [#{!map? !!map?} x k v] (.put x k v) x)) (^<0> [^transient? x k v] (core/assoc! x k v)) #?(:clj (^<0> [^default x ^int k v] - (if (t/array? x) + (if (arr/array? x) (java.lang.reflect.Array/set x k v) (throw (>ex-info :not-supported "`assoc!` not supported on this object" {:type (type x)})))))) @@ -394,10 +294,10 @@ ; size ([#{~'long} x#] (~(symbol "Array" (str "newUninitialized1d" capitalized-type-str "Array")) (int x#))) ; TODO uncast ; compatible arrays - ([~(->> tdef/array-1d-types* :clj keys + ([~(->> tdef/array-1d-types :clj keys (map type-key->pred-sym) set - (<- disj type-sym)) x#] + (<- (disj type-sym))) x#] (let [ct# (count x#) arr# (~fn-sym ct#)] (dotimes [i# ct#] (assoc! arr# i# (get x# i#))) arr#)) @@ -413,7 +313,7 @@ (let [type-sym type-unevaled array-compatible-types (if (= type-key :object) - (-> tdef/array-1d-types* :cljs (core/dissoc :object) keys set (core/conj 'number?)) + (-> tdef/array-1d-types :cljs (core/dissoc :object) keys set (core/conj 'number?)) (into (core/get tcore/cljs-typed-array-convertible-classes type-sym) '#{objects? number?}))] `(defnt ~fn-sym @@ -428,16 +328,16 @@ #?(:clj (defmacro gen-array-converters [] (let [lang (env-lang)] - `(do ~@(for [[type-key type-unevaled] (get tdef/array-1d-types* lang)] + `(do ~@(for [[type-key type-unevaled] (get tdef/array-1d-types lang)] (gen-array-converter lang type-key type-unevaled)) - ~@(for [[type-key _] (merge (:clj tdef/array-1d-types*) - (:cljs tdef/array-1d-types*))] + ~@(for [[type-key _] (merge (:clj tdef/array-1d-types) + (:cljs tdef/array-1d-types))] `(defmalias ~(if (= type-key :ubyte-clamped) '->ubytes-clamped (symbol (str "->" (name type-key) "s"))) - ~(when (-> tdef/array-1d-types* :clj (get type-key)) + ~(when (-> tdef/array-1d-types :clj (get type-key)) (symbol (str (ns-name *ns*)) (str "->" (name type-key) "s-clj"))) - ~(when (-> tdef/array-1d-types* :cljs (get type-key)) + ~(when (-> tdef/array-1d-types :cljs (get type-key)) (symbol (str (ns-name *ns*)) (if (= type-key :ubyte-clamped) "->ubytes-clamped-cljs" (str "->" (name type-key) "s-cljs")))))))))) @@ -498,49 +398,6 @@ #?(:clj (defalias ->!array-list ->!vector)) - -; TODO: `newUninitializeddArray` -; TODO boolean array doesn't work... ? -#?(:clj -(defmacro gen-arr<> [] - `(defnt' ~'arr<> - "Creates a 1-D array" - ~@(for [arglength (range 1 11) - kind '#{boolean byte char short int long float double Object}] - (let [arglist (vec (repeatedly arglength gensym)) - hints (vec (repeat arglength kind ))] - `(~(defnt/hint-arglist-with arglist hints) - (. quantum.core.data.Array ~(symbol (str "new1dArray")) ~@arglist))))))) - -#?(:clj (gen-arr<>)) - -; TODO generalize -#?(:clj -(defmacro gen-object<> [] - `(defnt' ~'object<> - "Creates a 1-D object array from the provided arguments" - ~@(for [arglength (range 1 11)] - (let [arglist (vec (repeatedly arglength gensym))] - `(~arglist - (. quantum.core.data.Array ~(symbol (str "new1dObjectArray")) ~@arglist))))))) - -#?(:clj (gen-object<>)) - -#?(:clj -(defmacro gen-array-nd [] - `(do ~@(for [kind '#{boolean byte char short int long float double object}] - `(defnt ~(symbol (str "->" kind "s-nd")) - ~(str "Creates an n-D " kind " array with the provided dims") - ~@(for [dim (range 1 11)] - (let [arglist (vec (repeatedly dim gensym)) - hints (apply core/vector 'long (repeat (dec dim) 'int))] ; first one should be long for protocol dispatch purposes - `(~(defnt/hint-arglist-with arglist hints) - (. quantum.core.data.Array - ~(symbol (str "newInitializedNd" (str/capitalize kind) "Array")) - ~@arglist))))))))) - -#?(:clj (gen-array-nd)) - (defnt elem->array ; TODO generate this #?(:clj ([^boolean x ^long n0 ] (->booleans-nd n0 ))) #?(:clj ([^boolean x ^long n0 ^long n1 ] (->booleans-nd n0 n1 ))) @@ -574,13 +431,13 @@ (defnt empty {:todo #{"implement core/empty"}} ( [^boolean x] false ) - #?(:clj ( [^char x] (->char 0) )) - #?(:clj ( [^byte x] (->byte 0) )) - #?(:clj ( [^short x] (->short 0) )) - #?(:clj ( [^int x] (->int 0) )) - #?(:clj ( [^long x] (->long 0) )) - #?(:clj ( [^float x] (->float 0) )) - #?(:clj ( [^double x] (->double 0) )) + #?(:clj ( [^char x] (>char 0) )) + #?(:clj ( [^byte x] (>byte 0) )) + #?(:clj ( [^short x] (>short 0) )) + #?(:clj ( [^int x] (>int 0) )) + #?(:clj ( [^long x] (>long 0) )) + #?(:clj ( [^float x] (>float 0) )) + #?(:clj ( [^double x] (>double 0) )) #?(:cljs (^<0> [^pnum? x] 0 )) (^<0> [^string? x] "" ) ; TODO ^array? @@ -992,7 +849,7 @@ ; TODO fix ([#{it.unimi.dsi.fastutil.longs.Long2ReferenceOpenHashMap} x kv] (doto x (.put (long (first kv)) (second kv)))) - ([#{!set:ref?} x v] (doto x (.add v))) + ([#{!set|ref?} x v] (doto x (.add v))) ; TODO use typedefs for these #?(:clj ([#{BooleanArrayList BooleanSet} x ^boolean v] (doto x (.add v)))) @@ -1194,7 +1051,7 @@ (index [this] i) #_clojure.lang.IObj ; TODO "mismatched return type"; will fix later - #_(withMeta [this ^clojure.lang.IPersistentMap meta'] (tcore/static-cast clojure.lang.IObj (IndexedListRSeq1. xs i meta'))) + #_(withMeta [this ^clojure.lang.IPersistentMap meta'] (ufgent/static-cast clojure.lang.IObj (IndexedListRSeq1. xs i meta'))) clojure.lang.IMeta (meta [this] meta) clojure.lang.Seqable diff --git a/src/quantum/core/collections/differential.cljc b/src/quantum/core/collections/differential.cljc index f64dda2d..449f4a6b 100644 --- a/src/quantum/core/collections/differential.cljc +++ b/src/quantum/core/collections/differential.cljc @@ -57,7 +57,7 @@ :refer [map+ reduce indexed+]] [quantum.core.vars :as var :refer [defalias]] - [quantum.core.type :as t] + [quantum.core.type-old :as t] [quantum.core.collections.map-filter :refer [ffilteri last-filteri]] [quantum.untyped.core.data diff --git a/src/quantum/core/collections/generative.cljc b/src/quantum/core/collections/generative.cljc index 25c4ef72..059904ac 100644 --- a/src/quantum/core/collections/generative.cljc +++ b/src/quantum/core/collections/generative.cljc @@ -45,7 +45,7 @@ :refer [join]] [quantum.core.logic :refer [whenc->]] - [quantum.core.type :as type + [quantum.core.type-old :as type :refer [should-transientize?]] [quantum.core.loops :as loops :refer [for fortimes]] diff --git a/src/quantum/core/collections/logic.cljc b/src/quantum/core/collections/logic.cljc index ecf20f15..916fe22f 100644 --- a/src/quantum/core/collections/logic.cljc +++ b/src/quantum/core/collections/logic.cljc @@ -7,16 +7,13 @@ [quantum.core.fn :as fn :refer [rcomp]] [quantum.core.vars :as var - :refer [defalias]])) + :refer [defalias]] + [quantum.untyped.core.collections.logic :as u])) (defn seq-or "∃: A faster version of |some| using |reduce| instead of |seq|." ([xs] (seq-or identity xs)) - ([pred xs] - (transduce (fn ([] true) ; vacuously - ([ret] ret) - ([_ x] (and (pred x ) (reduced x))) - ([_ k v] (and (pred k v) (reduced [k v])))) xs))) + ([pred xs] (transduce (u/seq-or|rf pred) xs))) (defalias some seq-or) @@ -27,11 +24,7 @@ (defn seq-and "∀: A faster version of |every?| using |reduce| instead of |seq|." ([xs] (seq-and identity xs)) - ([pred xs] - (transduce (fn ([] true) ; vacuously - ([ret] ret) - ([_ x] (or (pred x ) (reduced false))) - ([_ k v] (or (pred k v) (reduced [k v])))) xs))) + ([pred xs] (transduce (u/seq-and|rf pred) xs))) (defalias every? seq-and) @@ -39,12 +32,9 @@ (defalias not-every? seq-nand) -(defn apply-and [xs] (seq-and xs)) -(defn apply-or [xs] (seq-or xs)) - -(defn seq-and-2 +(defn seq-and-pair "`seq-and` for pairwise comparisons." ([pred xs] (reduce (fn [a b] (or (pred a b) (reduced false))) (first xs) (rest xs)))) -(defalias every?-2 seq-and-2) +(defalias every?-pair seq-and-pair) diff --git a/src/quantum/core/collections/map_filter.cljc b/src/quantum/core/collections/map_filter.cljc index 1eb4c691..05485816 100644 --- a/src/quantum/core/collections/map_filter.cljc +++ b/src/quantum/core/collections/map_filter.cljc @@ -49,8 +49,8 @@ :refer[defnt]] [quantum.core.reducers :as red :refer[indexed+ join' reduce defeager]] - [quantum.core.type :as type] - [quantum.core.loops :as loops + [quantum.core.type-old :as type] + [quantum.core.loops :as loop :refer [reducei doseqi lfor]] [quantum.core.vars :as var :refer [defalias defaliases]])) @@ -98,9 +98,9 @@ :out [4 "4"]} ([^indexed? xs pred] (->> xs rseq (ffilteri pred) - (<- update 0 (partial - (lasti xs))))) + (<- (update 0 (partial - (lasti xs)))))) ([xs pred] - (loops/reducei + (loop/reducei (fn [ret elem-n index-n] (if (pred elem-n) (map-entry index-n elem-n) diff --git a/src/quantum/core/collections/selective.cljc b/src/quantum/core/collections/selective.cljc index f764617b..4120022d 100644 --- a/src/quantum/core/collections/selective.cljc +++ b/src/quantum/core/collections/selective.cljc @@ -97,7 +97,7 @@ ; ; index-of-from [o val index-from] - index-of, starting at index-from ; (defn contains-or? [coll elems] -; (apply-or (map (partial contains? coll) elems))) +; (seq-or (map (partial contains? coll) elems))) (defn get-keys {:attribution "alexandergunnarson"} [m obj] diff --git a/src/quantum/core/collections/sociative.cljc b/src/quantum/core/collections/sociative.cljc index 37238ca3..331b3886 100644 --- a/src/quantum/core/collections/sociative.cljc +++ b/src/quantum/core/collections/sociative.cljc @@ -54,7 +54,7 @@ :refer [defnt]] [quantum.core.reducers :as red :refer [join partition-all+]] - [quantum.core.type :as type + [quantum.core.type-old :as type :refer [transient? editable?]] [quantum.core.loops :as loops :refer [reduce-pair reduce]])) diff --git a/src/quantum/core/collections_typed.cljc b/src/quantum/core/collections_typed.cljc new file mode 100644 index 00000000..ad54c978 --- /dev/null +++ b/src/quantum/core/collections_typed.cljc @@ -0,0 +1,431 @@ +(ns quantum.core.collections-typed + (:refer-clojure :exclude + [chunk-first chunk-rest count empty? first get next nth reduce]) + (:require + [quantum.core.data.array :as arr] + [quantum.core.data.async :as dasync] + [quantum.core.data.collections :as dc] + [quantum.core.data.compare :as dcomp] + [quantum.core.data.identifiers :as id] + [quantum.core.data.map :as map] + [quantum.core.data.numeric :as dn] + [quantum.core.data.primitive :as p] + [quantum.core.data.string :as dstr] + [quantum.core.data.vector :as vec] + [quantum.core.data.tuple :as tup] + [quantum.core.fn :as fn] + [quantum.core.numeric + :refer [inc*]] + [quantum.core.type :as t] + [quantum.core.vars :as var])) + +#_" +- TODO be informed by https://www.researchgate.net/publication/313820944_Empirical_Study_of_Usage_and_Performance_of_Java_Collections +- TODO incorporate FastUtil + - FastUtil is the fastest collections library according to http://java-performance.info/hashmap-overview-jdk-fastutil-goldman-sachs-hppc-koloboke-trove-january-2015/ +- TODO notify of changes to: + - https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/RT.java + - https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/Util.java + - https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/Numbers.java +- TODO queues need support +- TODO implement all these using wagjo/data-cljs + - split-at [o index] - clojure.core/split-at + - splice [o index n val] - fast remove and insert in one go + - splice-arr [o index n val-arr] - fast remove and insert in one go + - insert-before [o index val] - insert one item inside coll + - insert-before-arr [o index val] - insert array of items inside coll + - remove-at [o index] - remove one item from index pos + - remove-n [o index n] - remove n items starting at index pos + - rip [o index] - rips coll and returns [pre-coll item-at suf-coll] + - sew [pre-coll item-arr suf-coll] - opposite of rip, but with arr +- TODO `pcount` +- TODO `transducei` ? +- TODO `(rreduce [f init o]) - like reduce but in reverse order = Equivalent to Scheme's `foldr` +" + +;; TODO move or excise +(def transformer? (t/isa? quantum.untyped.core.reducers.Transformer)) + +;; ===== Access functions ===== ;; + +;; TODO for CLJS we should do !+vector +;; TODO TYPED +(t/defn get + "Retrieve the value in `xs` associated with the key `k`. + + The expectation, which is not enforced, is that this retrieval will take place in sublinear time. + O(1) is best; O(log32(n)) is common; and O(log(n)) is acceptable." + {:todo {0 "Need to excise non-O(1) `nth`"} + :incorporated #{'clojure.lang.RT/get}} + #?(:clj ([^clojure.lang.ILookup x k ] (.valAt x k))) + #?(:clj ([^clojure.lang.ILookup x k if-not-found] (.valAt x k if-not-found))) + #?(:clj ([#{java.util.Map clojure.lang.IPersistentSet} + x k ] (.get x k))) + #?(:clj ([#{!map|byte->any?} x ^byte k ] (.get x k))) + #?(:clj ([#{!map|char->any?} x ^char k ] (.get x k))) + #?(:clj ([#{!map|short->any?} x ^short k ] (.get x k))) + #?(:clj ([#{!map|int->any?} x ^int k ] (.get x k))) + #?(:clj ([#{!map|long->any?} x ^long k ] (.get x k))) + #?(:clj ([#{!map|float->ref?} x ^float k ] (.get x k))) + #?(:clj ([#{!map|double->ref?} x ^double k ] (.get x k))) + ([^string? x ^nat-long? i if-not-found] (if (>= i (count x)) if-not-found (.charAt x i))) + #?(:clj ([^!array-list? x ^nat-long? i if-not-found] (if (>= i (count x)) if-not-found (.get x i)))) + ([#{string? #?(:clj !array-list?)} x ^nat-long? i ] (get x i nil)) + + ([^array-1d? x #?(:clj #{int}) i1] + (#?(:clj Array/get + :cljs core/aget) x i1)) + #?(:clj ([#{array-2d? array-3d? array-4d? array-5d? array-6d? array-7d? array-8d? array-9d? array-10d?} x + ^int i1] + (Array/get x i1))) + ([^tuple? x ^nat-long? i ] (get (.-vs x) i)) + ([^seq? x i ] (core/nth x i nil )) + ([^seq? x i if-not-found] (core/nth x i if-not-found)) + ; TODO look at clojure.lang.RT/get for how to handle these edge cases efficiently + #?(:cljs ([^nil? x i ] (core/get x i nil ))) + #?(:cljs ([^nil? x i ] (core/get x i nil ))) + #?(:cljs ([^nil? x i if-not-found] (core/get x i if-not-found))) + ([^default x i ] + (if (nil? x) + nil + (throw (ex-info "`get` not supported on" {:type (type x)})))) + #_([ x i if-not-found] (core/get x i if-not-found))) + +;; TODO implement +(t/defn nth + "Retrieve the element from `xs` at the index `i`. + + In contrast to `get`, this may or may not happen in sublinear time, but it is expected (though + not enforced) that a type-specialization of `nth` will provide the most efficient implementation + possible. + + Prefer to `get` when retrieving elements at indices unless expectations of sublinear time are + necessary." + ...) + +;; ===== Iterators ===== ;; + +(t/defn ^:inline >iterator [x (t/isa?|direct #?(:clj java.lang.Iterable :cljs cljs.core/IIterable))] + #?(:clj (.iterator x) + :cljs (cljs.core/-iterator ^not-native x))) + +;; ===== Sequences ===== ;; + +;; TODO use `core/sequence` implementation to produce whatever is `reducible?` but not currently +;; `seqable?` +(t/defn ^:inline >seq + {:incorporated '{clojure.lang.RT/seq "9/26/2018" + clojure.core/seq "9/26/2018" + cljs.core/seq "9/26/2018"}} + > (t/? dc/iseq?) + ([x p/nil?] nil) + ([xs dc/iseq?] x) + ([xs dc/iseqable?] (#?(:clj .seq :cljs cljs.core/-seq) x)) +#?(:clj ([xs dc/iterable?] (-> x >iterator clojure.lang.RT/chunkIteratorSeq))) +#?(:clj ([xs dstr/char-seq?] (clojure.lang.StringSeq/create x)) + :cljs ([xs dstr/string?] (when-not (num/zero? (count xs)) ; TODO use `empty?` instead + (cljs.core/IndexedSeq. xs 0 nil)))) +#?(:clj ([xs dc/java-map?] (-> x .entrySet >seq))) + ;; NOTE `ArraySeq/createFromObject` is the slow path but has to be that way because the + ;; specialized ArraySeq constructors are private + ([xs arr/array?] + #?(:clj (clojure.lang.ArraySeq/createFromObject xs) + :cljs (when-not (num/zero? (count xs)) ; TODO use `empty?` instead + (cljs.core/IndexedSeq. xs 0 nil))))) + +;; ----- Chunking ----- ;; + +(t/defn >chunk-buffer > chunk-buffer? [capacity num/numerically-int?] + #?(:clj (clojure.lang.ChunkBuffer. (p/>int capacity)) + ;; TODO TYPED need to define `make-array` ahead of time + :clj (cljs.core/ChunkBuffer. (?/make-array capacity) 0))) + +(t/defn ^:inline chunk + "For CLJS, it's a little unsafe to assume that a `dc/chunk?` is output but we accept the risk." + [b dc/chunk-buffer? > #?(:clj dc/chunk? :cljs (t/assume dc/chunk?))] (.chunk b)) + +(t/defn ^:inline chunk-append + "For CLJS, it's a little unsafe to assume that a `dc/chunk?` is output but we accept the risk." + [b dc/chunk-buffer?, x p/ref? > #?(:clj dc/chunk? :cljs (t/assume dc/chunk?))] (.add b x)) + +(t/defn ^:inline chunk-first + "For CLJS, it's a little unsafe to assume that a `dc/chunk?` is output but we accept the risk." + [xs dc/chunked-seq? > #?(:clj dc/chunk? :cljs (t/assume dc/chunk?))] + (#?(:clj .chunkedFirst :cljs -chunked-first) xs)) + +(t/defn ^:inline chunk-rest + "For CLJS, it's a little unsafe to assume that a `dc/chunk?` is output but we accept the risk." + [xs dc/chunked-seq? > #?(:clj dc/chunk? :cljs (t/assume dc/chunk?))] + (#?(:clj .chunkedMore :cljs -chunked-rest) xs)) + +(t/defn ^:inline chunk-next + "For CLJS, it's a little unsafe to assume that a `dc/chunk?` is output but we accept the risk." +#?(:cljs ([xs dc/chunked-next? > #?(:clj dc/chunk? :cljs (t/assume dc/chunk?))] + (cljs.core/-chunked-next xs))) + ([xs dc/chunked-seq? > #?(:clj dc/chunk? :cljs (t/assume dc/chunk?))] + #?(:clj (.chunkedNext xs) + :cljs (-> xs chunk-rest >seq)))) + +(t/defn chunk-cons > chunked-cons? [chunk dc/chunk?, the-rest dc/iseq?] + (if (num/zero? (count chunk)) ;; TODO TYPED replace this condition with `empty` + the-rest + #?(:clj (clojure.lang.ChunkedCons. chunk the-rest) + :cljs (cljs.core/ChunkedCons. chunk the-rest nil nil)))) + +;; ===== Reductive functions ===== ;; + +;; TODO TYPED conditionally optional arities etc. for t/fn +(var/def rf? "Reducing function" + (t/ftype "seed arity" [] + "completing arity" [t/any?] + "reducing arity" [t/any? t/any?] + "reducing arity for kvs" [t/any? t/any? t/any?])) + +#?(:clj +(t/defn reduce-chunked + "Made public in case future specializations want to use it." + [rf rf?, init t/any?, xs dc/chunked-seq?] + (loop [ret init, xs' xs] + (let [ret' (.reduce (chunk-first xs') rf init)] + (if (dc/reduced? ret') + (ref/deref ret') + (recur ret' (chunk-next xs'))))))) + +#?(:clj +(t/defn reduce-indexed + "Made public in case future specializations want to use it." + {:incorporated '{cljs.core/ci-reduce "9/25/2018"}} + ([rf rf?, init t/any?, xs (t/or dstr/string? vec/!+vector? arr/array?), i0 t/numerically-integer?] + (let [ct (count xs)] + (loop [i (p/>int i0), ret init] + (if (comp/< i ct) + (let [ret' (rf ret (get xs i))] + (if (dc/reduced? ret') + (ref/deref ret') + ;; TODO TYPED automatically figure out that `inc` will never go out of bounds here + (recur (inc* i) ret'))) + v)))))) + +(t/defn reduce-iter + "Made public in case future specializations want to use it." + [rf rf?, init t/any?, xs dc/iterable?] + (let [iter (>iterator xs)] + (loop [ret init] + (if #?(:clj (.hasNext iter) :cljs ^boolean (.hasNext iter)) + (let [ret' (rf ret (.next iter))] + (if (dc/reduced? ret') + (ref/deref ret') + (recur ret'))) + ret)))) + +(t/defn reduce-seq + "Reduces a seq, ignoring any opportunities to switch to a more specialized implementation. + + Made public in case future specializations want to use it." + [rf rf?, init t/any?, xs dc/iseq?] + (loop [xs' xs, ret init] + (if (nil? xs') + ret + (let [ret' (rf ret (first xs'))] + (if (dc/reduced? ret') + (ref/deref ret') + (recur (next xs') ret')))))) + +;; TODO TYPED do type inference based on the rf's. We can sometimes figure out what gets returned +;; based on what is passed in +(t/defn reduce + "Prefer `transduce` to calling only `reduce`, as otherwise the completing arity of the reducing + function will not get called, which for certain transducers yields unexpected results. + + Like `core/reduce` except: + - When init is not provided, (f) is used. + - Maps are reduced as if with `reduce-kv`. + + Equivalent to Scheme's `foldl`. + + We would specialize on `clojure.lang.Range` and `clojure.lang.LongRange` but they do not expose + their `step` field so we have to use their implementation of `reduce`." + :incorporated '{clojure.core/reduce "9/25/2018" + clojure.core/reduce-kv "9/25/2018" + clojure.core.protocols "9/25/2018" + cljs.core/reduce "9/26/2018" + cljs.core/reduce-kv "9/25/2018" + cljs.core/array-reduce "9/25/2018" + cljs.core/iter-reduce "9/26/2018" + cljs.core/seq-reduce "9/26/2018"}} + (^:inline [rf rf?, xs ?] (reduce rf (rf) xs)) + (^:inline [rf rf?, init t/any?, xs p/nil?] init) + ;; - Adapted from `areduce` + ;; - `!+vector?` included because they aren't reducible or seqable by default + (^:inline [rf rf?, init t/any?, xs (t/or dstr/string? vec/!+vector? arr/array?)] + (reduce-indexed rf init xs 0)) +#?(:clj (^:inline [rf rf?, init t/any?, xs dc/string-seq?] + (reduce-indexed rf init ^:val (.s xs) (.index xs)))) +#?(:clj (^:inline [rf rf?, init t/any?, xs dc/array-seq?] + (reduce-indexed rf init (.array xs) (.index xs)))) + ;; Vector's chunked seq is faster than its iterator +#?(:clj (^:inline [rf rf?, init t/any? + xs (t/or (t/isa? clojure.lang.PersistentVector) chunked-seq?)] + (reduce-chunked rf init xs))) + ([rf rf?, init t/any?, n dn/numerically-integer?] + (loop [i 0, ret init] + (if (comp/< i n) + (let [ret' (rf ret i)] + (if (dc/reduced? ret') + (ref/deref ret') + ;; TODO TYPED automatically figure out that `inc` will never go out of bounds + ;; depending on the type of `n` + (recur (inc i) ret'))) + ret))) + ;; TODO refine + (^:inline [f init ^transformer? x] + (let [rf ((.-xf x) f)] + (rf (reduce* (.-prev x) rf init)))) + ([rf rf?, init t/any?, x dasync/read-chan?] + (async/go-loop [ret init] + (let [v (async/seq xs), ret init] + (if (dcomp/== (class xs') c) + (let [ret' (rf ret (first xs'))] + (if (dc/reduced? ret') + (ref/deref ret') + (recur (next xs') ret'))) + ;; TODO TYPED automatically figure out that: + ;; - `(not (dcomp/== (class xs') (class xs)))` + ;; - What the possible types of xs' are as a result + (reduce rf init xs')))))) + ;; NOTE There's something about CLJS impl such that `cljs.core/reduce` suggests that the + ;; class will never change in the middle of the seq as it might in CLJ +#?(:cljs (^:inline [rf rf?, init t/any?, xs dc/iseq?] (reduce-seq rf init xs))) + (^:inline [rf rf?, init t/any?, xs dc/iseqable?] (reduce rf init (>seq xs))) + (^:inline [rf rf?, init t/any?, xs dc/iterable?] (reduce-iter rf init xs))) + +(var/def rfi? "Reducing function, indexed" + (t/ftype "seed arity" [] + "completing arity" [t/any?] + "reducing arity" [t/any? t/any? t/any?] + "reducing arity for kvs" [t/any? t/any? t/any? t/any?])) + +(t/defn reducei + "`reduce`, indexed. + Uses an unsynchronized mutable counter internally, but this cannot cause race conditions if + `reduce` is implemented correctly (this includes single-threadedness)." + [rf rfi?, init t/any?, xs dc/reducible?] + (let [^:inline rf' + (let [!i (ref/! -1)] + (fn/aritoid rf' rf' + (t/fn ([ret ?, x ?] + (rf ret x (ref/reset! !i (num/inc* (ref/deref !i)))))) + (t/fn ([ret ?, k ?, v ?] + (rf ret k v (ref/reset! !i (num/inc* (ref/deref !i))))))))] + (reduce rf' init xs))) + +(var/def xf? "Transforming function (for transducers)" + (t/ftype [rf? :> rf?])) + +(t/defn ^:inline educe + "A blending of `transduce` and `reduce`. + Like `reduce`, does not have a notion of a transforming function (unlike `transduce`). Like + `transduce`, uses the seed (0-arity) and completing (1-arity) arities of the reducing function + `rf` when performing a reduction (unlike `reduce`)." + ([rf rf?, xs (t/input reduce [:_ :_ :?])] (educe rf (rf) xs)) + ([rf rf?, init t/any?, x dasync/read-chan?] (async/go (rf (async/ dn/std-integer? + {:todo #{"handle persistent maps"} + :incorporated '{clojure.lang.RT/count "9/2018" + clojure.lang.RT/countFrom "9/2018" + clojure.core/count "9/2018" + cljs.core/count "9/26/2018"}} + ;; Counted + ([x p/nil? > #?(:clj p/long? :cljs dn/std-fixint?)] 0) +#?(:cljs ([xs dstr/string? > (t/assume dn/std-fixint?)] (.-length xs))) +#?(:cljs ([xs dstr/!string? > (t/assume dn/std-fixint?)] (.getLength xs))) + ([xs dc/icounted? > #?(:clj p/int? :cljs (t/run dn/std-fixint?))] + (#?(:clj .count :cljs cljs.core/-count) xs)) +#?(:clj ([xs dstr/char-seq? > p/int?] (.length xs))) + ([xs tup/tuple? > #?(:clj p/int? :cljs (t/assume dn/std-fixint?))] + (-> xs .-vs count)) + ([xs dasync/m2m-chan? > #?(:clj p/int? :cljs dn/std-fixint?)] + (-> xs #?(:clj .buf :cljs .-buf) count)) +#?(:clj ([xs tup/map-entry? > p/long?] 2)) + ([xs arr/std-array? > #?(:clj p/int? :cljs (t/assume dn/std-fixint?))] + (#?(:clj Array/count :cljs .-length) xs)) +#?(:clj ([xs arr/array? > p/int?] (java.lang.reflect.Array/getLength xs))) + ;; Possibly counted + ;; TODO figure out whether there are certain non-counted `java-coll?`s in here that would + ;; have increased performance from an eduction rather than a `.size` +#?(:clj ([xs dc/java-coll? > p/int?] (.size xs))) +#?(:clj ([xs dc/java-map? > p/int?] (.size xs))) + ;; Not counted + ([xs (t/input educe [:_ :_ :?])] (educe count|rf xs))) + +(t/defn ^:inline gen-bounded-count|rf [n dn/std-integer?] + (t/fn {:inline true} + ([] 0) + ([ct ?] ct) + ([ct ?, _ ?] (if (dcomp/< ct n) (num/inc ct) (?/reduced ct))))) + +(t/defn ^:inline bounded-count > dn/std-integer? + ([n dn/std-integer?, xs dc/counted?] (count xs)) + ([n dn/std-integer?, xs (t/input educe [:_ :_ :?])] (educe (gen-bounded-count|rf n) xs))) + +(t/def ^:inline empty?|rf + (fn/aritoid + (t/fn [] true) + fn/identity + (t/fn [ret _, x _] (dc/reduced false)) + (t/fn [ret _, k _, v _] (dc/reduced false)))) + +(t/defn ^:inline empty? > p/boolean? + ([x p/nil?] true) + ([xs dc/counted?] (-> xs count num/zero?)) + ([xs (t/input educe [:_ :_ :?])] (educe empty?|rf x))) diff --git a/src/quantum/core/compare.cljc b/src/quantum/core/compare.cljc index a479e34c..3d72c04d 100644 --- a/src/quantum/core/compare.cljc +++ b/src/quantum/core/compare.cljc @@ -1,16 +1,18 @@ (ns quantum.core.compare (:refer-clojure :exclude + ;; TODO enable + #_[= == compare] + ;; TODO clean up [= not= < > <= >= max min max-key min-key neg? pos? zero? - -' + inc compare reduce, transduce, first]) (:require [clojure.core :as core] + [goog.array :as garray] [quantum.core.log :as log :refer [prl!]] [quantum.core.collections.core :as ccoll :refer [conj?! ?persistent! ?transient!, first, join]] [quantum.core.compare.core :as ccomp] - [quantum.core.convert.primitive :as pconv - :refer [->boxed ->boolean ->long]] [quantum.core.error :as err :refer [TODO]] [quantum.core.fn :as fn @@ -23,11 +25,13 @@ :refer [- -' + abs inc div:natural]] [quantum.core.numeric.predicates :as pred :refer [neg? pos? zero?]] - [quantum.core.numeric.types :as ntypes] + [quantum.core.data.numeric :as dn] + [quantum.core.data.time :as dtime] [quantum.core.reducers :as red :refer [reduce, transduce]] [quantum.core.vars - :refer [defalias defaliases]]) + :refer [defalias defaliases]] + [quantum.untyped.core.compare :as ucomp]) #?(:cljs (:require-macros [quantum.core.compare :as self :refer [< > <= >=]])) @@ -35,12 +39,55 @@ (:import clojure.lang.BigInt quantum.core.Numeric))) +(def compare ccomp/compare) + +;; TODO TYPED define variadic arity +(t/extend-defn! compare +#?(:cljs ([a js/Date , b js/Date] (compare (dtime/date>value a) (dtime/date>value b)))) + ([a arr/array-1d?, b arr/array-1d?] (compare-1d-arrays-lexicographically a b))) + +;; TODO TYPED define variadic arity +;; TODO move this to the appropriate place +(t/extend-defn! = +#?(:cljs ([a js/Date , b js/Date] (= (dtime/date>value o) (dtime/date>value other)))) +#?(:cljs ([a js/Date , b t/any?] false)) +#?(:cljs ([a ??/array? , b ??/array?] (TODO))) +#?(:cljs ([a ??/array? , b t/any?] false)) + ;; We intentionally ignore the case of `new String(...)`. +#?(:cljs ([a ??/string?, b ??/string?] (== a b))) +#?(:cljs ([a ??/string?, b t/any?] false)) +#?(:clj ([a (t/isa? IPersistentCollection) b t/any?] (TODO Util.pcequiv))) +#?(:clj ([a t/any? b (t/isa? IPersistentCollection)] (TODO Util.pcequiv))) +) + + +;; TODO TYPED; also incorporate `core/fn->comparator` +(defn fn->comparator [f] + #?(:clj (cast java.util.Comparator f) + :cljs (core/fn->comparator f))) + +#?(:clj +(defnt' ^int compare-1d-arrays-lexicographically ; TODO reflection + "Arrays are not `Comparable`, so we need a custom + comparator which we can pass to `sort`." + {:from "clojure.tools.nrepl.bencode" + :adapted-by "Alex Gunnarson"} + ([^array-1d? a ^array-1d? b] + (let [alen (alength a) + blen (alength b) + len (core/min alen blen)] + (loop [i 0] + (if (== i len) ; TODO = ? + (- alen blen) + (let [x (p/>long (- (->num (aget a i)) (->num (aget b i))))] ; TODO remove protocol + (if (zero? x) + (recur (core/inc i)) + x)))))))) + (defaliases ccomp - compare min-key first-min-key second-min-key max-key first-max-key second-max-key - #?@(:clj [compare-1d-arrays-lexicographically - = =& not= not=& + #?@(:clj [= =& not= not=& < <& comp< comp<& <= <=& comp<= comp<=& > >& comp> comp>& @@ -115,28 +162,8 @@ (defn reduce-comp-keys [ compf kf xs] (transduce (gen-comp-keys-into:rf vector compf kf ) xs)) ; TODO use this/> (defn reduce-comp-keys-into [initf compf kf xs] (transduce (gen-comp-keys-into:rf initf compf kf ) xs)) ; TODO use this/> -(defn rcompare - "Reverse comparator." - {:attribution "taoensso.encore, possibly via weavejester.medley"} - [x y] (compare y x)) - -(defn greatest - "Returns the 'greatest' element in coll in O(n) time." - {:attribution "taoensso.encore, possibly via weavejester.medley"} - [coll & [?comparator]] - (let [comparator (or ?comparator rcompare)] - (reduce - (fn ([] nil) ([a b] (if (pos? (comparator a b)) b a))) - coll))) - -(defn least - "Returns the 'least' element in coll in O(n) time." - {:attribution "taoensso.encore, possibly via weavejester.medley"} - [coll & [?comparator]] - (let [comparator (or ?comparator rcompare)] - (reduce - (fn ([] nil) ([a b] (if (neg? (comparator a b)) b a))) - coll))) + +(defaliases ucomp greatest least rcompare) (defn unsorted-by "Returns which elements are unsorted, as by `kf` and `comparef`." @@ -145,11 +172,11 @@ ([kf xs] (unsorted-by kf core/compare xs)) ([kf comparef xs] (let [xs' (transient []) - comparef (ccomp/fn->comparator comparef)] + comparef (fn->comparator comparef)] (red/reducei-sentinel (fn [a b i] (when-not (neg? (#?@(:clj [.compare ^java.util.Comparator comparef] - :cljs [comparef]) + :cljs [comparef]) (kf a) (kf b))) (conj! xs' [i b])) b) xs) diff --git a/src/quantum/core/compare/core.cljc b/src/quantum/core/compare/core.cljc index 13385150..96396a24 100644 --- a/src/quantum/core/compare/core.cljc +++ b/src/quantum/core/compare/core.cljc @@ -1,357 +1,197 @@ (ns quantum.core.compare.core - (:refer-clojure :exclude - [= not= < > <= >= max min max-key min-key neg? pos? zero? - -' + inc compare]) - (:require - [clojure.core :as core] - [quantum.core.error :as err - :refer [TODO]] - [quantum.core.fn - :refer [fn&2]] - [quantum.core.macros - :refer [defnt #?@(:clj [defnt' variadic-proxy variadic-predicate-proxy])]] - [quantum.core.vars - :refer [defalias]] - [quantum.core.numeric.operators :as op - :refer [- -' + abs inc div:natural]] - [quantum.core.numeric.predicates :as pred - :refer [neg? pos? zero?]] - [quantum.core.numeric.convert - :refer [->num ->num&]] - [quantum.core.convert.primitive :as pconv - :refer [->boxed ->boolean ->long]] - [quantum.core.numeric.types :as ntypes]) -#?(:cljs - (:require-macros - [quantum.core.compare.core :as self - :refer [< > <= >=]])) -#?(:clj - (:import - clojure.lang.BigInt quantum.core.Numeric))) - -; Some of the ideas here adapted from gfredericks/compare -; TODO include diffing -; TODO use -compare in CLJS -; TODO do `defnt` `compare` for different types -; TODO = vs. == vs. RT/equiv vs. etc. -; TODO bring in from clojure.lang.RT -; TODO comp< vs. <; comp< should include arrays -; `=` <- `==`, `=`: permissive -; `='` <- `=`: strict like `core/=` with numbers -; `==` <- `identical?` -; `hash=` - -; ===== `compare` ===== ; - -(defn fn->comparator [f] - #?(:clj (cast java.util.Comparator f) - :cljs (core/fn->comparator f))) - -#?(:clj -(defnt' ^int compare-1d-arrays-lexicographically ; TODO reflection - "Arrays are not `Comparable`, so we need a custom - comparator which we can pass to `sort`." - {:from "clojure.tools.nrepl.bencode" - :adapted-by "Alex Gunnarson"} - ([^array-1d? a ^array-1d? b] - (let [alen (alength a) - blen (alength b) - len (core/min alen blen)] - (loop [i 0] - (if (== i len) ; TODO = ? - (- alen blen) - (let [x (pconv/->long-protocol (- (->num (aget a i)) (->num (aget b i))))] ; TODO remove protocol - (if (zero? x) - (recur (core/inc i)) - x)))))))) - -#?(:clj (defnt' ^int compare - {:todo #{"Handle nil values"}} - ([^Comparable a ^Comparable b] (int (.compareTo a b))) - ([^Comparable a ^prim? b] (int (.compareTo a b))) - ([^prim? a ^Comparable b] (int (.compareTo (->boxed a) b))) - ([^array-1d? a ^array-1d? b] (compare-1d-arrays-lexicographically a b))) - :cljs (defalias compare core/compare)) - -; ===== `=`, `not=` ===== ; - -#?(:clj (defnt' ^boolean =-bin - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (Numeric/eq x y)) - ([^boolean x ^boolean y] (Numeric/eq x y)) - ([^boolean x #{byte char short int long float double} y] (->boolean false)) - ([#{byte char short int long float double} x ^boolean y] (->boolean false)) - ([ x y] (.equals ^Object x y)) - ([ x ^prim? y] (.equals ^Object x y)) - ([^prim? x y] (.equals ^Object y x))) - :cljs (defn =-bin - ([x] true) - ([x y] (TODO "fix") (core/zero? (ntypes/-compare x y))))) - -#?(:clj (variadic-predicate-proxy = =-bin )) -#?(:clj (variadic-predicate-proxy =& =-bin&)) - -#?(:clj (defnt' ^boolean not=-bin - ([#{#_Object prim?} x #{#_Object prim?} y] (Numeric/not (=-bin& x y)))) ; TODO make this one operation; TODO can only work with inline - :cljs (defn not=-bin - ([x] false) - ([x y] (TODO "fix") (not (core/zero? (ntypes/-compare x y)))))) - -#?(:clj (variadic-predicate-proxy not= not=-bin )) -#?(:clj (variadic-predicate-proxy not=& not=-bin&)) - -; ===== `<` ===== ; - -#?(:clj (defnt' ^boolean <-bin - ([#{byte char short int long float double} x] (->boolean true)) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (Numeric/lt x y)) - ; TODO numbers, but not nil - ) - :cljs (defn <-bin ([x] true) ([x y] (core/< x y)))) - -#?(:clj (variadic-predicate-proxy < <-bin)) -#?(:clj (variadic-predicate-proxy <& <-bin&)) - -; ----- `comp<` ----- ; - -#?(:clj (defnt' ^boolean comp<-bin - ([^comparable? x] (->boolean true)) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (< x y)) - ([^boolean x ^boolean y] (< (->num& x) (->num& y))) - ([^Comparable x ^Comparable y] (< (compare x y) 0)) - ([^Comparable x ^prim? y] (< (compare x y) 0)) - ([^prim? x ^Comparable y] (< (compare x y) 0)) - ; TODO numbers and nil - ) - :cljs (defn comp<-bin ([x] true) ([x y] (< (compare x y) 0)))) - -#?(:clj (variadic-predicate-proxy - ^{:doc "Returns true if args are in monotonically increasing order - according to `compare`, otherwise false."} - comp< comp<-bin)) -#?(:clj (variadic-predicate-proxy comp<& comp<-bin&)) - -; ===== `<=` ===== ; - -#?(:clj (defnt' ^boolean <=-bin - ([#{byte char short int long float double} x] (->boolean true)) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (Numeric/lte x y)) - ; TODO numbers, but not nil - ) - :cljs (defn <=-bin ([x] true) ([x y] (core/<= x y)))) - -#?(:clj (variadic-predicate-proxy <= <=-bin)) -#?(:clj (variadic-predicate-proxy <=& <=-bin&)) - -; ----- `comp<=` ----- ; - -#?(:clj (defnt' ^boolean comp<=-bin - ([^comparable? x] (->boolean true)) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (<= x y)) - ([^boolean x ^boolean y] (<= (->num& x) (->num& y))) - ([^Comparable x ^Comparable y] (<= (compare x y) 0)) - ([^Comparable x ^prim? y] (<= (compare x y) 0)) - ([^prim? x ^Comparable y] (<= (compare x y) 0)) - ; TODO numbers and nil - ) - :cljs (defn comp<=-bin ([x] true) ([x y] (<= (compare x y) 0)))) ; TODO rest - -#?(:clj (variadic-predicate-proxy - ^{:doc "Returns true if args are in monotonically non-decreasing order - according to `compare`, otherwise false."} - comp<= comp<=-bin)) -#?(:clj (variadic-predicate-proxy comp<=& comp<=-bin&)) - -; ===== `>` ===== ; - -#?(:clj (defnt' ^boolean >-bin - ([#{byte char short int long float double} x] (->boolean true)) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (Numeric/gt x y)) - ; TODO numbers, but not nil - ) - :cljs (defn >-bin ([x] true) ([x y] (core/> x y)))) - -#?(:clj (variadic-predicate-proxy > >-bin)) -#?(:clj (variadic-predicate-proxy >& >-bin&)) - -; ----- `comp>` ----- ; - -#?(:clj (defnt' ^boolean comp>-bin - ([^comparable? x] (->boolean true)) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (> x y)) - ([^boolean x ^boolean y] (> (->num& x) (->num& y))) - ([^Comparable x ^Comparable y] (> (compare x y) 0)) - ([^Comparable x ^prim? y] (> (compare x y) 0)) - ([^prim? x ^Comparable y] (> (compare x y) 0)) - ; TODO numbers and nil - ) - :cljs (defn comp>-bin ([x] true) ([x y] (> (compare x y) 0)))) ; TODO rest - -#?(:clj (variadic-predicate-proxy - ^{:doc "Returns true if args are in monotonically decreasing order - according to `compare`, otherwise false."} - comp> comp>-bin)) -#?(:clj (variadic-predicate-proxy comp>& comp>-bin&)) - -; ===== `>=` ===== ; - -#?(:clj (defnt' ^boolean >=-bin - ([#{byte char short int long float double} x] (->boolean true)) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (Numeric/gte x y)) - ; TODO numbers, but not nil - ) - :cljs (defn >=-bin ([x] true) ([x y] (core/>= x y)))) - -#?(:clj (variadic-predicate-proxy >= >=-bin)) -#?(:clj (variadic-predicate-proxy >=& >=-bin&)) - -; ----- `comp>=` ----- ; - -#?(:clj (defnt' ^boolean comp>=-bin - ([^comparable? x] (->boolean true)) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (>= x y)) - ([^boolean x ^boolean y] (>= (->num& x) (->num& y))) - ([^Comparable x ^Comparable y] (>= (compare x y) 0)) - ([^Comparable x ^prim? y] (>= (compare x y) 0)) - ([^prim? x ^Comparable y] (>= (compare x y) 0)) - ; TODO numbers and nil - ) - :cljs (defn >=-bin ([x] true) ([x y] (core/>= (compare x y) 0)))) ; TODO defnt - -#?(:clj (variadic-predicate-proxy - ^{:doc "Returns true if args are in monotonically non-increasing order - according to `compare`, otherwise false."} - comp>= comp>=-bin)) -#?(:clj (variadic-predicate-proxy comp>=& comp>=-bin&)) - -; ===== `min` ===== ; - -#?(:clj (defnt' min-bin - ([] Double/NEGATIVE_INFINITY) ; the thing less than which there is nothing - ([#{byte char short int long float double} x] x) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (Numeric/min x y)) - ; TODO numbers, but not nil - ) - :cljs (defn min-bin ([x] x) ([x y] (if (< x y) x y)))) ; TODO defnt - -#?(:clj (variadic-proxy min min-bin)) -#?(:clj (variadic-proxy min& min-bin&)) - -; ----- `comp-min` ----- ; - -#?(:clj (defnt' comp-min-bin - ([] Double/NEGATIVE_INFINITY) ; the thing less than which there is nothing - ([^comparable? x] x) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (min x y)) - ([#{boolean Comparable} x #{boolean Comparable} y] (if (comp< x y) x y)) - ; TODO numbers and nil - ) - :cljs (defn comp-min-bin ([x] x) ([x y] (if (comp< x y) x y)))) ; TODO defnt - -#?(:clj (variadic-proxy - ^{:doc "Returns the least of the arguments according to - `compare`, preferring later values."} - comp-min comp-min-bin)) -#?(:clj (variadic-proxy comp-min& comp-min-bin&)) - -; ===== `max` ===== ; - -#?(:clj (defnt' max-bin - ([] Double/POSITIVE_INFINITY) ; the thing greater than which there is nothing - ([#{byte char short int long float double} x] x) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (Numeric/max x y)) - ; TODO numbers, but not nil - ) - :cljs (defn max-bin ([x] x) ([x y] (if (> x y) x y)))) ; TODO defnt - -#?(:clj (variadic-proxy max max-bin)) -#?(:clj (variadic-proxy max& max-bin&)) - -; ----- `comp-max` ----- ; - -#?(:clj (defnt' comp-max-bin - ([] Double/POSITIVE_INFINITY) ; the thing greater than which there is nothing - ([^comparable? x] x) - ([#{byte char short int long float double} x - #{byte char short int long float double} y] (max x y)) - ([#{boolean Comparable} x #{boolean Comparable} y] (if (comp> x y) x y)) - ; TODO numbers and nil - ) - :cljs (defn comp-max-bin ([x] x) ([x y] (if (comp> x y) x y)))) ; TODO defnt - -#?(:clj (variadic-proxy - ^{:doc "Returns the greatest of the arguments according to - `compare`, preferring later values."} - comp-max comp-max-bin)) -#?(:clj (variadic-proxy comp-max& comp-max-bin&)) - -; ----- `comp-max` ----- ; - -; ===== PRIMITIVE `max`|`min` ===== ; - -#?(:clj (defnt' ^byte min-byte ([] Byte/MIN_VALUE ) ([^byte a] a) ([^byte a ^byte b] (min a b)))) -#?(:clj (defnt' ^byte max-byte ([] Byte/MAX_VALUE ) ([^byte a] a) ([^byte a ^byte b] (max a b)))) -#?(:clj (defnt' ^char min-char ([] Character/MIN_VALUE ) ([^char a] a) ([^char a ^char b] (min a b)))) -#?(:clj (defnt' ^char max-char ([] Character/MAX_VALUE ) ([^char a] a) ([^char a ^char b] (max a b)))) -#?(:clj (defnt' ^short min-short ([] Short/MIN_VALUE ) ([^short a] a) ([^short a ^short b] (min a b)))) -#?(:clj (defnt' ^short max-short ([] Short/MAX_VALUE ) ([^short a] a) ([^short a ^short b] (max a b)))) -#?(:clj (defnt' ^int min-int ([] Integer/MIN_VALUE ) ([^int a] a) ([^int a ^int b] (min a b)))) -#?(:clj (defnt' ^int max-int ([] Integer/MAX_VALUE ) ([^int a] a) ([^int a ^int b] (max a b)))) -#?(:clj (defnt' ^long min-long ([] Long/MIN_VALUE ) ([^long a] a) ([^long a ^long b] (min a b)))) -#?(:clj (defnt' ^long max-long ([] Long/MAX_VALUE ) ([^long a] a) ([^long a ^long b] (max a b)))) -#?(:clj (defnt' ^float min-float ([] Float/NEGATIVE_INFINITY ) ([^float a] a) ([^float a ^float b] (min a b)))) -#?(:clj (defnt' ^float max-float ([] Float/POSITIVE_INFINITY ) ([^float a] a) ([^float a ^float b] (max a b)))) -#?(:clj (defnt' ^double min-double ([] Double/NEGATIVE_INFINITY) ([^double a] a) ([^double a ^double b] (min a b)))) -#?(:clj (defnt' ^double max-double ([] Double/POSITIVE_INFINITY) ([^double a] a) ([^double a ^double b] (max a b)))) - -; ===== extreme-`key` ===== ; - -#?(:clj -(defmacro gen-extremum-key-fn [sym base-sym] - `(defn ~sym - ([kf#] nil) ; TODO really, the min of whatever it is; maybe gen via `(kf)` ? - ([kf# x#] x#) - ([kf# x# y#] (if (~base-sym (kf# x#) (kf# y#)) x# y#)) ; TODO can terminate early here with e.g. <=, <, etc. - ([kf# x# y# & more#] - (reduce #(~sym kf# %1 %2) (~sym kf# x# y#) more#))))) - -(defn first-min-temp ([x] x) ([x y] (if (core/<= x y) x y))) -(defalias second-min-temp core/min) -(defalias min-temp second-min-temp) - -(defn first-max-temp ([x] x) ([x y] (if (core/>= x y) x y))) -(defalias second-max-temp core/max) -(defalias max-temp second-max-temp) - -(defn comp<-temp [x y] (core/< (core/compare x y) 0)) -(defn comp<=-temp [x y] (core/<= (core/compare x y) 0)) -(defn comp>-temp [x y] (core/> (core/compare x y) 0)) -(defn comp>=-temp [x y] (core/>= (core/compare x y) 0)) - -; TODO don't need to generate these once type inference is done -; `first-min-key` means `min-key`, but returns the first argument when comparison is ambiguous -(gen-extremum-key-fn first-min-key core/<=) ; TODO use comp/ version -(gen-extremum-key-fn second-min-key core/< ) ; TODO use comp/ version -(defalias min-key second-min-key) - -(gen-extremum-key-fn first-comp-min-key comp<=-temp) ; TODO use comp/ version -(gen-extremum-key-fn second-comp-min-key comp<-temp ) ; TODO use comp/ version -(defalias comp-min-key second-comp-min-key) - -(gen-extremum-key-fn first-max-key core/>=) ; TODO use comp/ version -(gen-extremum-key-fn second-max-key core/> ) ; TODO use comp/ version -(defalias max-key second-max-key) - -(gen-extremum-key-fn first-comp-max-key comp>=-temp) ; TODO use comp/ version -(gen-extremum-key-fn second-comp-max-key comp>-temp ) ; TODO use comp/ version -(defalias comp-max-key second-comp-max-key) + "Defines fundamental comparison operators but does not necessarily provide definitions for all + type overloads. + + A complete (w.r.t. the `quantum.core.data.*` namespaces) set of definitions for type overloads is + found in `quantum.core.compare`." + (:refer-clojure :exclude + [< <= = not= == > >= compare max max-key min min-key]) + (:require + [clojure.core :as core] + [quantum.core.type :as t] + ;; TODO TYPED excise + [quantum.untyped.core.logic + :refer [ifs]] + [quantum.untyped.core.type :as ut] + ;; TODO TYPED excise + [quantum.untyped.core.vars :as var]) +#?(:clj (:import + [quantum.core Numeric]))) + +;; Some of the ideas here adapted from gfredericks/compare +;; TODO include diffing +;; TODO comp< vs. < on numbers +;; TODO `hash=` + +; ===== `==`, `=`, `not=` ===== ; + +;; TODO add variadic arity +(t/defn ^:inline == + "Tests identity-equality." + {:incorporated '{clojure.lang.Util/identical "9/27/2018" + clojure.core/identical? "9/27/2018" + cljs.core/identical? "9/27/2018"}} + > ut/boolean? + ;; Everything is self-identical (except, implementationally, NaN and Infinity) + ([x t/any?] true) +#?(:clj ([a t/ref?, b t/ref?] (clojure.lang.Util/identical a b)) + :cljs ([a t/any?, b t/any?] (cljs.core/identical? a b)))) + +;; TODO add variadic arity +(t/defn ^:inline not== + "Tests identity-inequality." + > ut/boolean? + ;; Nothing is self-non-identical (except, implementationally, NaN and Infinity) + ([x t/any?] false) +#?(:clj ([a t/ref?, b t/ref?] (Numeric/nonIdentical a b)) + :cljs ([a t/any?, b t/any?] (js* "(~{} !== ~{})" a b)))) + +;; TODO add variadic arity +(t/defn ^:inline = + "Tests value-equality. Same as Java's `x.equals(y)`, except it also works for nil, and compares + numbers and collections in a type-independent manner. For numbers, it works like `core/==`." + {:incorporated '{clojure.lang.Numbers/equals "10/14/2018" + clojure.lang.Numbers/equiv "10/14/2018" + clojure.lang.Util/equiv "9/27/2018" + clojure.core/= "9/27/2018" + cljs.core/= "9/27/2018"}} + > ut/boolean? + ;; Everything is self-equal (except, implementationally, NaN and Infinity) + ([x t/any?] true) + ([a t/nil? , b t/nil?] true) + ([a t/nil? , b (t/ref ut/val?)] false) + ([a (t/ref ut/val?), b t/nil?] false) + ;; The fallback overload; collections (in CLJ) and protocol-native objects (in CLJS) will have a + ;; more specific equivalence check as defined later on + ([a (t/ref ut/val?), b (t/ref ut/val?)] + (or (== a b) + #?(:clj (.equals a b) + :cljs (-equiv ^non-native a b))))) + +;; TODO add variadic arity +(t/defn ^:inline not= + "Tests value-inequality." + {:incorporated '{clojure.core/not= "9/27/2018" + cljs.core/not= "9/27/2018"}} + > ut/boolean? + ;; Nothing is self-unequal (except, implementationally, NaN and Infinity) + ([x t/any?] false)) + +;; ===== `<` ===== ;; + +;; TODO add variadic arity +(t/defn ^:inline < + "Numeric less-than comparison." + {:incorporated '{clojure.lang.Numbers/lt "10/14/2018" + clojure.core/< "10/14/2018" + cljs.core/< "10/14/2018"}} + > ut/boolean?) + +;; ===== `<=` ===== ;; + +;; TODO add variadic arity +(t/defn ^:inline <= + "Numeric less-than-or-value-equal comparison." + {:incorporated '{clojure.lang.Numbers/lte "10/14/2018" + clojure.core/<= "10/14/2018" + cljs.core/<= "10/14/2018"}} + > ut/boolean?) + +;; ===== `>` ===== ;; + +;; TODO add variadic arity +(t/defn ^:inline > + "Numeric greater-than comparison." + {:incorporated '{clojure.lang.Numbers/gt "10/14/2018" + clojure.core/> "10/14/2018" + cljs.core/> "10/14/2018"}} + > ut/boolean?) + +;; ===== `>=` ===== ;; + +;; TODO add variadic arity +(t/defn ^:inline >= + "Numeric greater-than-or-value-equal comparison." + {:incorporated '{clojure.lang.Numbers/gte "10/14/2018" + clojure.core/>= "10/14/2018" + cljs.core/>= "10/14/2018"}} + > ut/boolean?) + +;; ===== `compare` ===== ;; + +(var/def icomparable? + "That which implements the interface marking comparability to its own 'concrete type' (i.e. + class)." + #?(:clj (t/isa? java.lang.Comparable) + :cljs (t/isa|direct? cljs.core/IComparable))) + +(def comparison? #?(:clj ut/int? :cljs ut/double?)) + +(t/def comparator? (t/ftype comparison? [t/any? t/any?])) +(t/def boolean-comparator? (t/ftype ut/boolean? [t/any? t/any?])) + +(t/defn ^:inline compare + "Logical (not exclusively numeric) comparison. + + When ->`a` is logically 'less than' ->`b`, outputs a negative number. + When ->`a` is logically 'equal to' ->`b`, outputs zero. + When ->`a` is logically 'greater than' ->`b`, outputs a positive number." + {:incorporated '{clojure.lang.Util/compare "9/27/2018" + clojure.core/compare "9/27/2018" + cljs.core/compare "9/27/2018"}} + > comparison? + ([a ut/nil? , b ut/nil?] (int 0)) + ([a ut/nil? , b ut/val?] (int -1)) + ([a ut/val? , b ut/nil?] (int 1)) + ;; Fallbacks + ([a (t/ref icomparable?), b (t/ref icomparable?)] + (if (== a b) + (int 0) + #?(:clj (.compareTo a b) + :cljs (core/-compare ^not-native a b))))) + +;; ----- `comp`-comparison ----- ;; + +(t/defn ^:inline comp< + "Returns true if args are in monotonically increasing order according to `compare`, + otherwise false." + > ut/boolean?) + +(t/defn ^:inline comp<= + "Returns true if args are in monotonically non-decreasing order according to `compare`, + otherwise false." + > ut/boolean?) + +(t/defn ^:inline comp= + "Returns true if args are equally ordered according to `compare`, otherwise false." + > ut/boolean?) + +(t/defn ^:inline comp>= + "Returns true if args are in monotonically non-increasing order according to `compare`, + otherwise false." + > ut/boolean?) + +(t/defn ^:inline comp> + "Returns true if args are in monotonically decreasing order according to `compare`, + otherwise false." + > ut/boolean?) + +;; ----- Extrema ----- ;; + +(t/defn ^:inline min + {:incorporated {'js/Math.min #inst "2018-10-17" + 'cljs.core/min #inst "2018-10-17"}}) + +(t/defn ^:inline max + {:incorporated {'js/Math.max #inst "2018-10-17" + 'cljs.core/max #inst "2018-10-17"}}) + +(t/defn ^:inline min-key) + +(t/defn ^:inline max-key) + +(t/defn comp-min + "Returns the least of the arguments according to `compare`, preferring later values.") + +(t/defn comp-max + "Returns the greatest of the arguments according to `compare`, preferring later values.") diff --git a/src/quantum/core/convert.cljc b/src/quantum/core/convert.cljc index 771989b5..bd064879 100644 --- a/src/quantum/core/convert.cljc +++ b/src/quantum/core/convert.cljc @@ -1,45 +1,48 @@ (ns quantum.core.convert ; perhaps coerce? (:require - [clojure.core :as core] - [cognitect.transit :as t] + [clojure.core :as core] + [cognitect.transit :as t] #?@(:clj [[clojure.tools.emitter.jvm] - [clojure.java.io :as io] - [manifold.stream :as s] - [manifold.deferred :as d] - [byte-streams :as streams] - [byte-streams.graph :as g] - [byte-streams.protocols :as proto] - [byte-streams.pushback-stream :as ps] - [byte-streams.char-sequence :as cs]] + [clojure.java.io :as io] + [manifold.stream :as s] + [manifold.deferred :as d] + [byte-streams :as streams] + [byte-streams.graph :as g] + [byte-streams.protocols :as proto] + [byte-streams.pushback-stream :as ps] + [byte-streams.char-sequence :as cs]] :cljs - [[cljs.reader :as core-r] - [goog.crypt.base64 :as base64]]) - [clojure.tools.reader :as r] - [clojure.tools.reader.edn :as r-edn] - [clojure.core.async :as async] - [datascript.transit :as dt] + [[cljs.reader :as core-r] + [goog.crypt.base64 :as base64]]) + [clojure.tools.reader :as r] + [clojure.tools.reader.edn :as r-edn] + [clojure.core.async :as async] + [datascript.transit :as dt] ; CompilerException java.lang.NoClassDefFoundError: IllegalName: compile__stub.gloss.data.bytes.core.gloss.data.bytes.core/MultiBufferSequence, compiling:(gloss/data/bytes/core.clj:78:1) ; [gloss.core.formats :as gforms] - [quantum.core.data.array :as arr] - [quantum.core.error :as err + [quantum.core.data.array :as arr] + [quantum.core.data.primitive :as p] + [quantum.core.error :as err :refer [TODO]] - [quantum.core.numeric :as num] - [quantum.core.string :as str] + [quantum.core.numeric :as num] + [quantum.core.string :as str] [quantum.core.collections.core :refer [lasti]] - [quantum.core.convert.core :as conv] - [quantum.core.convert.primitive :as pconv] - [quantum.core.data.complex.json :as json] - [quantum.core.macros :as macros + [quantum.core.convert.core :as conv] + [quantum.core.data.complex.json :as json] + [quantum.core.macros :as macros :refer [defnt #?(:clj defnt')]] - [quantum.core.paths :as path] - [quantum.core.fn :as fn] - [quantum.core.vars :as var + [quantum.core.paths :as path] + [quantum.core.fn :as fn] + [quantum.core.vars :as var :refer [defalias defaliases]] - [quantum.core.log :as log] - [quantum.core.type - :refer [static-cast]]) + [quantum.core.log :as log] + [quantum.untyped.core.form.evaluate + :refer [case-env]] + [quantum.untyped.core.form.type-hint + :refer [static-cast]] + [quantum.untyped.core.identifiers :as uident]) #?(:cljs (:require-macros [quantum.core.convert :as self])) @@ -86,16 +89,17 @@ (log/this-ns) #?(:clj -(defaliases pconv - ->boolean - ->byte* ->byte - ->char* ->short - ->int* ->int - ->long* ->long - ->float* ->float - ->double* ->double - ->boxed ->unboxed ->unsigned - ubyte->byte ushort->short uint->int ulong->long)) +(defaliases p + >boolean + >byte* >byte + >short* >short + >char* >char + >int* >int + >long* >long + >float* >float + >double* >double + box unbox >unsigned + ubyte>byte ushort>short uint>int ulong>long)) (defalias utf8-string conv/utf8-string ) (defalias base64-encode conv/base64-encode) @@ -288,7 +292,7 @@ in protocol __GT_uuidProtocol must take at least one arg'" [& args] (if (empty? args) - `(java.util.UUID/randomUUID) + `(uident/>uuid) `(->uuid* ~@args)))) #?(:clj (defalias ->file path/->file)) diff --git a/src/quantum/core/convert/core.cljc b/src/quantum/core/convert/core.cljc index 7d872919..1eee990c 100644 --- a/src/quantum/core/convert/core.cljc +++ b/src/quantum/core/convert/core.cljc @@ -76,6 +76,6 @@ "Returns @s as a Base64 decoded string." [^String s] (when s - #?(:clj (->> s (<- .getBytes java.nio.charset.StandardCharsets/ISO_8859_1) + #?(:clj (->> s (<- (.getBytes java.nio.charset.StandardCharsets/ISO_8859_1)) (.decode (java.util.Base64/getDecoder))) :cljs (base64/decodeString s false)))) diff --git a/src/quantum/core/convert/primitive.cljc b/src/quantum/core/convert/primitive.cljc deleted file mode 100644 index ce0a7398..00000000 --- a/src/quantum/core/convert/primitive.cljc +++ /dev/null @@ -1,256 +0,0 @@ -(ns quantum.core.convert.primitive - (:require - #_(:cljs [com.gfredericks.goog.math.Integer :as int]) - [clojure.core :as core] - [quantum.core.data.bits :as bits - :refer [&&]] - [quantum.core.error :as err - :refer [>ex-info]] - [quantum.core.macros :as macros - :refer [defnt #?@(:clj [defnt'])]] - [quantum.core.vars :as var - :refer [defalias]]) -#?(:cljs - (:require-macros - [quantum.core.convert.primitive])) -#?(:clj - (:import - java.nio.ByteBuffer - [quantum.core Numeric Primitive]))) - -; TODO go back over these — there are inconsistencies - -;_____________________________________________________________________ -;==================={ LONG }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -#?(:clj -(defmacro long-out-of-range [x] - `(throw (>ex-info :illegal-argument (str "Value out of range for long: " ~x))))) - -#?(:clj -(defnt ^long ->long* - {:source "clojure.lang.RT.uncheckedLongCast"} - ([^Number x] (.longValue x)) - ([#{byte char short int long float double} x] (Primitive/uncheckedLongCast x)))) - -#?(:clj - (defnt ^long ->long - {:source "clojure.lang.RT.longCast"} - ([^clojure.lang.BigInt x] - (if (nil? (.bipart x)) - (.lpart x) - (long-out-of-range x))) - ([^java.math.BigInteger x] - (if (< (.bitLength x) 64) - (.longValue x) - (long-out-of-range x))) - ([^clojure.lang.Ratio x] (->long (.bigIntegerValue x))) - ([#{char byte short int long} x] (->long* x)) - ([#{float} x] (clojure.lang.RT/longCast x)) ; Because primitive casting in Clojure is not supported ; TODO fix - ([#{double} x] (clojure.lang.RT/longCast x)) ; TODO fix - ([#{boolean} x] (if x 1 0)) - ([^string? x] (-> x Long/parseLong ->long)) - ([^string? x radix] (Long/parseLong x radix))) - :cljs - (defnt ->long - ([^number? x] (js/Math.trunc x)) - ([^string? x] (-> x int/fromString ->long)) - ([^boolean? x] (if x 1 0)))) - -#?(:clj -(defmacro cast-via-long [class- x] - `(let [n# (->long ~x)] - (if (or (< n# ~(list '. class- 'MIN_VALUE)) (> n# ~(list '. class- 'MAX_VALUE))) - (throw (>ex-info :illegal-argument (str ~(str "value out of range for " (name class-) ": ") ~x))) - n#)))) -;_____________________________________________________________________ -;==================={ BOOLEAN }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -#?(:clj - (defnt ^boolean ->boolean - {:source "clojure.lang.RT.booleanCast"} - ([^boolean x] x) - ([#{byte char short int long float double Object} x] (.booleanValue (not= x nil)))) ; TODO #{(- prim? boolean) Object} - :cljs (defalias ->boolean core/boolean)) -;_____________________________________________________________________ -;==================={ BYTE }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -#?(:clj - (defnt ^byte ->byte - {:source "clojure.lang.RT.byteCast"} - ([^byte x] x) - ([#{short int long float double} x] (clojure.lang.RT/byteCast x)) - ([#{boolean} x] (-> x ->long ->byte)) - ; TODO do other numbers - ([ x] (clojure.lang.RT/byteCast x))) - :cljs (defalias ->byte core/byte)) - -#?(:clj -(defnt ^byte ->byte* - {:source "clojure.lang.RT.uncheckedByteCast"} - ([^Number x] (.byteValue x)) - ([#{byte short int long float double} x] (Primitive/uncheckedByteCast x)))) -;_____________________________________________________________________ -;==================={ CHAR }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -; TODO reflection issues -; (defnt ^char ->char -; {:source "clojure.lang.RT.charCast"} -; ([^char x] x) -; ([^Character x] (.charValue x)) -; ([#{byte short int long float double} x] (clojure.lang.RT/shortCast x)) -; ([:else x] (cast-via-long Character x))) -#?(:clj (defalias ->char core/char)) - -#?(:clj -(defnt ^char ->char* - {:source "clojure.lang.RT.uncheckedCharCast"} - ([^Number x] (->char* (.longValue x))) - ([#{byte short char int long float double} x] (Primitive/uncheckedCharCast x)) - ([^string? x] (if (->> x .length (= 1)) - (.charAt x 0) - (throw (>ex-info "Cannot cast non-singleton string to char." x)))))) -;_____________________________________________________________________ -;==================={ SHORT }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -#?(:clj -(defnt ^short ->short* - {:source "clojure.lang.RT.uncheckedShortCast"} - ([^Number x] (.shortValue x)) - ([#{byte short int long float double} x] (Primitive/uncheckedShortCast x)))) - -#?(:clj - (defnt ^short ->short - {:source "clojure.lang.RT.shortCast"} - ([#{byte short} x] (->short* x)) - ([#{int long float double} x] (clojure.lang.RT/shortCast x)) - ([^string? x] (-> x Short/parseShort ->short)) - ([#{boolean} x] (-> x ->long ->short))) - :cljs (defalias ->short core/short)) -;_____________________________________________________________________ -;==================={ INT }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -#?(:clj -(defnt ^int ->int* - {:source "clojure.lang.RT.uncheckedIntCast"} - ([^Number x] (.intValue x)) - ([#{byte short char int long float double} x] (Primitive/uncheckedIntCast x)))) - -; (defnt' ->IntExact -; (^int [^long x] (Math/toIntExact x))) - -#?(:clj - (defnt ^int ->int - {:source "clojure.lang.RT.intCast"} - ([#{char byte short int} x] (->int* x)) - ([#{long double} x] (clojure.lang.RT/intCast x)) - ([^float x] (Float/floatToRawIntBits x)) - ([^string? x] (-> x #?(:clj Integer/parseInt :cljs js/parseInt) ->int)) - ([^string? x radix] (#?(:clj Integer/parseInt :cljs int/fromString) x radix))) - :cljs (defalias ->int core/int)) - -; js/Math.trunc for CLJS -;_____________________________________________________________________ -;==================={ FLOAT }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° - -#?(:clj -(defnt ^float ->float* - {:source "clojure.lang.RT/uncheckedFloatCast"} - ([^Number x] (.floatValue x)) - ([#{byte short int long float double} x] (Primitive/uncheckedFloatCast x)) - ([^string? x] (Float/parseFloat x)))) - -#?(:clj -(defnt ^float ->float - {:source "clojure.lang.RT/floatCast"} - ([#{byte short int float long} x] (->float* x)) - ([^string? x] (Float/parseFloat #_->float* x)))) ; TODO fix this - -; round to float: (js.Math/fround x) - -#?(:clj (defalias ->float core/float)) -;_____________________________________________________________________ -;==================={ DOUBLE }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -#?(:clj -(defnt ^double ->double* - {:source "clojure.lang.RT/uncheckedDoubleCast"} - ([^Number x] (.doubleValue x)) - ([^double x] x) - ([#{byte short int long float} x] (Primitive/uncheckedDoubleCast x)) - ([ x] (clojure.lang.RT/uncheckedDoubleCast x)))) - -#?(:clj - (defnt ^double ->double - {:source "clojure.lang.RT/doubleCast" - :todo #{"Check for overflow}"}} - ([^Number x] (.doubleValue x)) - ([^double x] x) - ([#{byte short int float} x] (->double* x)) - ([^long x] (->double* x)) ; Double/longBitsToDouble is bad - ([^string? x] (-> x Double/parseDouble ->double))) - :cljs (defalias ->double core/double)) - -#?(:clj -(defnt' ->boxed - (^Boolean ^:intrinsic [^boolean x] (Boolean/valueOf x)) - (^Byte ^:intrinsic [^byte x] (Byte/valueOf x)) - (^Character ^:intrinsic [^char x] (Character/valueOf x)) - (^Short ^:intrinsic [^short x] (Short/valueOf x)) - (^Integer ^:intrinsic [^int x] (Integer/valueOf x)) - (^Long ^:intrinsic [^long x] (Long/valueOf x)) - (^Float ^:intrinsic [^float x] (Float/valueOf x)) - (^Double ^:intrinsic [^double x] (Double/valueOf x)))) - -#?(:clj -(defnt' ->unboxed - (^boolean ^:intrinsic [^Boolean x] (.booleanValue x)) - (^byte ^:intrinsic [^Byte x] (.byteValue x)) - (^char ^:intrinsic [^Character x] (.charValue x)) - (^short ^:intrinsic [^Short x] (.shortValue x)) - (^int ^:intrinsic [^Integer x] (.intValue x)) - (^long ^:intrinsic [^Long x] (.longValue x)) - (^float ^:intrinsic [^Float x] (.floatValue x)) - (^double ^:intrinsic [^Double x] (.doubleValue x)))) -;_____________________________________________________________________ -;==================={ UNSIGNED }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -#?(:clj (def ^:const bytes2 (->short 0xFF))) -#?(:clj (def ^:const bytes4 (->int 0xFFFF))) -#?(:clj (def ^:const bytes8 (->long 0xFFFFFFFF))) - -; (quantum.core.Numeric/bitAnd (->short' bytes2) (->byte 1)) -#?(:clj -(defnt' ->unsigned - {:attribution ["ztellman/primitive-math" "gloss.data.primitives"] - :contributors {"Alex Gunnarson" "defnt-ed"} - :todo #{"change to unchecked-bit-and after making sure it won't overflow"}} - ([^byte x] (&& (->short* bytes2) x)) - ([^short x] (&& (->int* bytes4) x)) - ([^int x] (&& (->long* bytes8) x)) - ([^long x] - (BigInteger. 1 (-> (ByteBuffer/allocate 8) (.putLong x) .array))))) ; TODO reflection - -#?(:clj -(defn ubyte->byte - {:inline (fn [x] `(byte (long ~x)))} - ^long [^long x] - (long (byte x)))) - -#?(:clj -(defn ushort->short - {:inline (fn [x] `(short (long ~x)))} - ^long [^long x] - (long (short x)))) - -#?(:clj -(defn uint->int - {:inline (fn [x] `(int (long ~x)))} - ^long [^long x] - (long (int x)))) - -#?(:clj -(defn ulong->long - ^long [x] - (.longValue ^clojure.lang.BigInt (bigint x)))) diff --git a/src/quantum/core/core.cljc b/src/quantum/core/core.cljc deleted file mode 100644 index c281e9b4..00000000 --- a/src/quantum/core/core.cljc +++ /dev/null @@ -1,48 +0,0 @@ -(ns quantum.core.core - (:refer-clojure :exclude [get set]) - (:require [clojure.core :as core] - [clojure.spec.alpha :as s] - #?(:clj [clojure.core.specs.alpha :as ss]) - [cuerdas.core :as str+] - #?(:clj [environ.core :as env]) - [quantum.untyped.core.core :as u] - [quantum.untyped.core.vars - :refer [defalias defaliases]])) - -;; ===== Environment ===== ;; - -(defaliases u lang #?(:clj pid)) - -;; ===== Compilation ===== ;; - -(defalias u/externs?) - -;; ===== quantum.core.system ===== ;; - -(defalias u/*registered-components) - -;; ===== Miscellaneous ===== ;; - -(defaliases u >sentinel >object) - -(def has? (comp not empty?)) ; TODO fix this performance-wise - -(def unchecked-inc-long - #?(:clj (fn [^long x] (unchecked-inc x)) - :cljs inc)) - -(defprotocol IValue - (get [this]) - (set [this newv])) - -#?(:clj -(defmacro with - "Evaluates @expr, then @body, then returns @expr. - For side effects." - [expr & body] - `(let [expr# ~expr] - ~@body - expr#))) - -;; Nested |let-mutable| : - ;; ClassCastException java.lang.Long cannot be cast to proteus.Containers$L diff --git a/src/quantum/core/data/array.cljc b/src/quantum/core/data/array.cljc index be140a8c..e32f6716 100644 --- a/src/quantum/core/data/array.cljc +++ b/src/quantum/core/data/array.cljc @@ -1,47 +1,156 @@ -(ns - ^{:doc "Useful array functions. Array creation, joining, reversal, etc." - :attribution "alexandergunnarson" - :todo ["Incorporate amap, areduce, etc."]} - quantum.core.data.array +(ns quantum.core.data.array + "Useful array functions. Array creation, joining, reversal, etc. + Arrays are Sequential, Associative (specifically, whose keys are sequential, dense integer + values), and not extensible." (:refer-clojure :exclude - [== reverse boolean-array byte-array char-array short-array - int-array long-array float-array double-array - empty count get doseq assoc!]) + [== reverse boolean-array byte-array char-array short-array int-array long-array float-array + double-array]) (:require - [clojure.core :as core] + [clojure.core :as core] + #_(:clj [loom.alg-generic :as alg]) ; temporarily + #_[quantum.core.type.core :as tcore] + #_[quantum.core.macros.type-hint :as th] + #_[quantum.core.compare :as comp] + #_[quantum.core.numeric :as num] + [quantum.core.data.identifiers :as id] + [quantum.core.type :as t + :refer [defnt]] + [quantum.core.vars :as var + :refer [defalias]] + ;; TODO TYPED (?) + [quantum.untyped.core.form.generate :as ufgen] + [quantum.untyped.core.log :as ulog] + [quantum.untyped.core.system :as usys]) +#?(:clj (:import + [quantum.core.data Array] + [java.io File FileInputStream BufferedInputStream InputStream ByteArrayOutputStream] + [java.nio ByteBuffer] + [java.util ArrayList]))) + +(ulog/this-ns) + +;; TODO add `c?/compare` support +;; Note that in CLJS you can directly `<` arrays but it's not sufficient because it does `<` comparisons on its contents which might not be expected + +(def typed-arrays-supported? (p/val? (aget usys/global "ArrayBuffer"))) + +;; A polyfill for the `.slice` prototype method missing in Safari and some mobile browser versions +;; Adapted from `thi.ng.typedarrays.core` +(when typed-arrays-supported? + (->> ["Int8Array" "Uint8Array" "Uint8ClampedArray" "Int16Array" "Uint16Array" + "Int32Array" "Uint32Array" "Float32Array" "Float64Array"] + (run! + (fn [type-str] + (when-not (-> usys/global (aget type-str) .-prototype .-slice) + (set! (-> usys/global (aget type-str) .-prototype .-slice) + (fn [from to] + (this-as this + (let [from (if (neg? from) + (int (unchecked-add (.-length this) from)) + (int from)) + to (if (goog/isNumber to) + (if (neg? to) + (int (unchecked-add (.-length this) to)) + (js/Math.min to (.-length this))) + (.-length this)) + len (js/Math.max (unchecked-subtract to from) 0) + ctor (.-constructor this) + dest (js* "new ~{}(~{})" ctor len)] + (loop [i 0] + (when (< i len) + (aset dest i (aget this (unchecked-add from i))) + (recur (unchecked-inc i)))) + dest))))))))) + #?(:clj - [loom.alg-generic :as alg]) ; temporarily - [quantum.core.collections.core :as ccoll - :refer [empty count get assoc!]] - [quantum.core.type.core :as tcore] - [quantum.core.fn :as fn - :refer [<- fn->]] - [quantum.core.log :as log] - [quantum.core.logic :as logic - :refer [whenc whenc->]] - [quantum.core.error - :refer [TODO]] - [quantum.core.loops :as loops - :refer [doseqi doseq]] - [quantum.core.macros :as macros - :refer [defnt defnt']] - [quantum.core.macros.type-hint :as th] - [quantum.core.compare :as comp] - [quantum.core.numeric :as num] - [quantum.core.type - :refer [static-cast]] - [quantum.core.vars :as var - :refer [defalias]]) -#?(:cljs - (:require-macros - [quantum.core.data.array :as self])) +(defnt >array-nd-type [kind id/symbol?, n num/pos-int? > t/class-type?] + (let [prefix (apply >str (repeat n \[)) + letter (case kind + boolean "Z" + byte "B" + char "C" + short "S" + int "I" + long "J" + float "F" + double "D" + object "Ljava.lang.Object;")] + (t/isa? (Class/forName (str prefix letter)))))) + #?(:clj - (:import - [java.io File FileInputStream BufferedInputStream InputStream ByteArrayOutputStream] - [java.nio ByteBuffer] - java.util.ArrayList))) +(defnt >array-nd-types [n num/pos-int? > t/type?] + (->> '[boolean byte char short int long float double object] + (map #(>array-nd-type % n)) + (apply or)))) + +(def booleans? #?(:clj (>array-nd-type 'boolean 1) :cljs t/none?)) +(def bytes? #?(:clj (>array-nd-type 'byte 1) :cljs (t/isa? js/Int8Array))) +(def ubytes? #?(:clj t/none? :cljs (t/isa? js/Uint8Array))) +(def ubytes-clamped? #?(:clj t/none? :cljs (t/isa? js/Uint8ClampedArray))) +(def chars? #?(:clj (>array-nd-type 'char 1) :cljs (t/isa? js/Uint16Array))) ; kind of +(def shorts? #?(:clj (>array-nd-type 'short 1) :cljs (t/isa? js/Int16Array))) +(def ushorts? #?(:clj t/none? :cljs (t/isa? js/Uint16Array))) +(def ints? #?(:clj (>array-nd-type 'int 1) :cljs (t/isa? js/Int32Array))) +(def uints? #?(:clj t/none? :cljs (t/isa? js/Uint32Array))) +(def longs? #?(:clj (>array-nd-type 'long 1) :cljs t/none?)) +(def floats? #?(:clj (>array-nd-type 'float 1) :cljs (t/isa? js/Float32Array))) +(def doubles? #?(:clj (>array-nd-type 'double 1) :cljs (t/isa? js/Float64Array))) +(def objects? #?(:clj (>array-nd-type 'object 1) :cljs (t/isa? js/Array))) + +(def numeric-1d? (t/or bytes? ubytes? ubytes-clamped? + chars? + shorts? ushorts? ints? uints? longs? + floats? doubles?)) + +(def array-1d? (t/or booleans? bytes? ubytes? ubytes-clamped? + chars? + shorts? ushorts? ints? uints? longs? + floats? doubles? objects?)) + +#?(:clj (def booleans-2d? (>array-nd-type 'boolean 2))) +#?(:clj (def bytes-2d? (>array-nd-type 'byte 2))) +#?(:clj (def chars-2d? (>array-nd-type 'char 2))) +#?(:clj (def shorts-2d? (>array-nd-type 'short 2))) +#?(:clj (def ints-2d? (>array-nd-type 'int 2))) +#?(:clj (def longs-2d? (>array-nd-type 'long 2))) +#?(:clj (def floats-2d? (>array-nd-type 'float 2))) +#?(:clj (def doubles-2d? (>array-nd-type 'double 2))) +#?(:clj (def objects-2d? (>array-nd-type 'object 2))) -(log/this-ns) +#?(:clj (def numeric-2d? (t/or bytes-2d? + chars-2d? + shorts-2d? ints-2d? longs-2d? + floats-2d? doubles-2d?))) + +#?(:clj (def array-2d? (>array-nd-types 2 ))) + +#?(:clj (def array-3d? (>array-nd-types 3 ))) +#?(:clj (def array-4d? (>array-nd-types 4 ))) +#?(:clj (def array-5d? (>array-nd-types 5 ))) +#?(:clj (def array-6d? (>array-nd-types 6 ))) +#?(:clj (def array-7d? (>array-nd-types 7 ))) +#?(:clj (def array-8d? (>array-nd-types 8 ))) +#?(:clj (def array-9d? (>array-nd-types 9 ))) +#?(:clj (def array-10d? (>array-nd-types 10))) + + ;; TODO differentiate between "all supported n-D arrays" and "all n-D arrays" + (def objects-nd? (t/or objects? + #?@(:clj [(>array-nd-type 'object 2) + (>array-nd-type 'object 3) + (>array-nd-type 'object 4) + (>array-nd-type 'object 5) + (>array-nd-type 'object 6) + (>array-nd-type 'object 7) + (>array-nd-type 'object 8) + (>array-nd-type 'object 9) + (>array-nd-type 'object 10)]))) + + (def std-array? (t/or array-1d? + #?@(:clj [array-2d? array-3d? array-4d? array-5d? + array-6d? array-7d? array-8d? array-9d? array-10d?]))) + + ;; TODO differentiate between "all supported n-D arrays" and "all n-D arrays" + (def array? (t/or std-array? #?(:clj (t/fn [x p/val?] (-> x ?/>class .isArray))))) ; TODO look at http://fastutil.di.unimi.it to complete this namespace ; TODO `fill!` <~> `Arrays/fill`, `lodash/fill` @@ -67,110 +176,91 @@ n-sym (-> 'n gensym (th/with-type-hint 'nat-int?))] `(defnt ~fn-sym ([~n-sym] (core-sym ~n-sym))))))) -; ----- BOOLEAN ARRAY ----- ; +; TODO: `newUninitializeddArray` +; TODO boolean array doesn't work... ? #?(:clj -(defnt boolean-array [^int n] - (if (> n Integer/MAX_VALUE) - (it.unimi.dsi.fastutil.booleans.BooleanBigArrays/newBigArray 1) - (core/boolean-array n)))) +(defmacro gen-arr<> [] + `(defnt' ~'arr<> + "Creates a 1-D array" + ~@(for [arglength (range 1 11) + kind '#{boolean byte char short int long float double Object}] + (let [arglist (vec (repeatedly arglength gensym)) + hints (vec (repeat arglength kind ))] + `(~(ufth/hint-arglist-with arglist hints) + (. quantum.core.data.Array ~(symbol (str "new1dArray")) ~@arglist))))))) -; ----- BYTE ARRAY ----- ; - -#?(:clj (defalias byte-array core/byte-array) - :cljs (defn byte-array [length] (js/Int8Array. length))) +#?(:clj (gen-arr<>)) #?(:clj - (defn ^"[B" - byte-array+ - "Like /byte-array/ but allows for array initializers a la Java: - byte[] arr = byte[]{12, 8, 10}" - {:attribution "alexandergunnarson" - :todo ["Make less repetitive via macro"]} - ([size] - (byte-array (long size))) - ([size & args] - (let [^"[B" arr (byte-array (long size))] - (doseqi [arg args n] - (assoc! arr n (-> arg first byte))) - arr)))) - -; ----- INT ARRAY ----- ; +(defmacro gen-array-nd [] + `(do ~@(for [kind '#{boolean byte char short int long float double object}] + `(defnt ~(symbol (str "->" kind "s-nd")) + ~(str "Creates an n-D " kind " array with the provided dims") + ~@(for [dim (range 1 11)] + (let [arglist (vec (repeatedly dim gensym)) + hints (apply core/vector 'long (repeat (dec dim) 'int))] ; first one should be long for protocol dispatch purposes + `(~(ufth/hint-arglist-with arglist hints) + (. quantum.core.data.Array + ~(symbol (str "newInitializedNd" (str/capitalize kind) "Array")) + ~@arglist))))))))) + +#?(:clj (gen-array-nd)) + +;; ----- Booleans ----- ;; #?(:clj - (defn ^ints int-array+ - "Like /int-array/ but allows for array initializers a la Java: - int[] arr = int[]{12, 8, 10}" - {:attribution "alexandergunnarson" - :todo ["Make less repetitive via macro"]} - ([size] - (core/int-array (long size))) - ([size & args] - (let [^ints arr (core/int-array (long size))] - (doseqi [arg args n] - (assoc! arr (long n) (-> arg first int))) - arr)))) - -; TODO: Use a macro for this +(defnt ^:inline >boolean-array + ([n num/numerically-int? > booleans?] (Array/newUninitialized1dBooleanArray (>int n))) + ([n num/numerically-long? > big-booleans?] + (it.unimi.dsi.fastutil.booleans.BooleanBigArrays/newBigArray (>long n))))) + +;; ----- Bytes ----- ;; + +(defnt ^:inline >byte-array + ([n num/numerically-int? > bytes?] + (#?(:clj Array/newUninitialized1dByteArray :cljs js/Int8Array.) (>int n))) + #?(:clj ([n num/numerically-long? > big-bytes?] + (it.unimi.dsi.fastutil.bytes.ByteBigArrays/newBigArray (>long n))))) + +;; ----- Shorts ----- ;; + +;; TODO + +;; ----- Chars ----- ;; + +;; TODO + +;; ----- Ints ----- ;; + +;; TODO + +;; ----- Longs ----- ;; + +;; TODO + +;; ----- Floats ----- ;; + +;; TODO + +;; ----- Doubles ----- ;; + +;; TODO + +;; ----- Objects ----- ;; + #?(:clj - (defn long-array-of - "Creates a long array with the specified values." - {:attribution "mikera.cljutils.arrays"} - (^longs [] (core/long-array 0)) - (^longs [a] - (let [arr (core/long-array 1)] - (assoc! arr 0 (long a)) - arr)) - ([a b] - (let [arr (core/long-array 2)] - (assoc! arr 0 (long a)) - (assoc! arr 1 (long b)) - arr)) - ; ([a b & more] - ; (let [arr (long-array (+ 2 (count more)))] - ; (assoc! arr 0 (long a)) - ; (assoc! arr 1 (long b)) - ; (doseqi [x more i] (assoc! arr (+ 2 i) (long x))) - ; arr)) - )) - -; ----- OBJECT ARRAY ----- ; - -; TODO: Use a macro for this -#_(:clj - (defn object-array-of - "Creates an object array with the specified values." - {:attribution "mikera.cljutils.arrays"} - ([] (ccoll/->object-array 0)) - ([a] - (let [arr (ccoll/->object-array 1)] - (assoc! arr 0 a) - arr)) - ([a b] - (let [arr (ccoll/->object-array 2)] - (assoc! arr 0 a) - (assoc! arr 1 b) - arr)) - ([a b c] - (let [arr (ccoll/->object-array 3)] - (assoc! arr 0 a) - (assoc! arr 1 b) - (assoc! arr 2 c) - arr)) - ([a b c d] - (let [arr (ccoll/->object-array 4)] - (assoc! arr 0 a) - (assoc! arr 1 b) - (assoc! arr 2 c) - (assoc! arr 3 d) - arr)) - ; ([a b & more] - ; (let [arr (object-array (+ 2 (count more)))] - ; (assoc! arr 0 a) - ; (assoc! arr 1 b) - ; (doseqi [x more i] (assoc! arr (+ 2 i) x)) - ; arr)) - )) +(defmacro gen-object<> [] + `(defnt ~'object<> + "Creates a 1-D object array from the provided arguments" + ~'> objects? + ~@(for [arglength (range 0 1)] + (let [arglist (ufgen/gen-args 0 arglength "x" symbol)] + `(~arglist (. Array ~'new1dObjectArray ~@arglist))))))) + + + +(gen-object<>) ; ===== BITMAPS ===== ; diff --git a/src/quantum/core/data/async.cljc b/src/quantum/core/data/async.cljc new file mode 100644 index 00000000..c4f958b0 --- /dev/null +++ b/src/quantum/core/data/async.cljc @@ -0,0 +1,15 @@ +(ns quantum.core.data.async + (:require + [quantum.core.type :as t])) + +(def closeable-chan? (t/isa? #?(:clj clojure.core.async.impl.protocols/Channel + :cljs cljs.core.async.impl.protocols/Channel))) + +(def readable-chan? (t/isa? #?(:clj clojure.core.async.impl.protocols/ReadPort + :cljs cljs.core.async.impl.protocols/ReadPort))) + +(def writable-chan? (t/isa? #?(:clj clojure.core.async.impl.protocols/WritePort + :cljs cljs.core.async.impl.protocols/WritePort))) + +(def m2m-chan? (t/isa? #?(:clj clojure.core.async.impl.channels.ManyToManyChannel + :cljs cljs.core.async.impl.channels/ManyToManyChannel))) diff --git a/src/quantum/core/data/bits.cljc b/src/quantum/core/data/bits.cljc index 90df4f36..ccf90863 100644 --- a/src/quantum/core/data/bits.cljc +++ b/src/quantum/core/data/bits.cljc @@ -1,156 +1,419 @@ -(ns - ^{:doc "Useful bit/binary operations." - :attribution "alexandergunnarson"} - quantum.core.data.bits - (:refer-clojure :exclude - [unsigned-bit-shift-right bit-shift-left bit-shift-right - bit-or bit-and bit-xor bit-not]) - (:require - [clojure.core :as core ] - [quantum.core.macros :as macros - :refer [defnt]] - [quantum.core.vars :as var - :refer [defalias]]) - #?(:clj (:import #_[quantum.core Numeric] - java.nio.ByteBuffer))) - -; Because "cannot resolve symbol 'import'" -#?(:clj -(doseq [sym '[reverse - true? false? nil?]] - (ns-unmap 'quantum.core.data.bits sym))) - -; TODO -; bit-clear -; bit-and-not -; bit-test -; bit-flip -; bit-set - -; TODO ExceptionInInitializerError somewhere over here... -; TODO move namespace -#_(defnt ^boolean nil? - ([^Object x] (quantum.core.Numeric/isNil x)) - ([:else x] false)) - -#?(:clj (defalias nil? core/nil?)) - -#_(defnt ^boolean not' - ([^boolean? x] (Numeric/not x)) - ([x] (if (nil? x) true))) ; Lisp nil punning - -#_(defnt ^boolean true? - ([^boolean? x] x) - ([:else x] false)) - -#?(:clj (defalias true? core/true?)) - -#_(defnt ^boolean false? - ([^boolean? x] (not' x)) - ([:else x] false)) - -#?(:clj (defalias false? core/false?)) - -#_(defmacro bit-not [x] `(Numeric/bitNot ~x)) -#_(macros/variadic-proxy bit-and quantum.core.Numeric/bitAnd) ; & -#_(macros/variadic-proxy bit-or quantum.core.Numeric/bitOr) ; | -#_(macros/variadic-proxy bit-xor quantum.core.Numeric/bitXor) -#_(macros/variadic-proxy bool-and quantum.core.Numeric/and) ; && -#_(macros/variadic-proxy bool-or quantum.core.Numeric/or) ; || -#_(macros/variadic-proxy bool-xor quantum.core.Numeric/xor) - -(defalias bit-not core/bit-not) -(defalias bit-and core/bit-and) -(defalias && bit-and) ; tried to do `& but, "No method in multimethod 'parse' for dispatch value: &" -(defalias bit-or core/bit-or) -(defalias | bit-or) -(defalias bit-xor core/bit-xor) - -;; ===== SHIFTS ===== ;; - -#?(:clj (defalias bit-shift-left core/bit-shift-left) - #_(defmacro bit-shift-left [n bits] - `(Numeric/shiftLeft ~n ~bits)) - :cljs (defalias bit-shift-left core/bit-shift-left)) -(defalias << bit-shift-left) - -#?(:clj (defalias bit-shift-right core/bit-shift-right) - #_(defmacro bit-shift-right [n bits] - `(Numeric/shiftRight ~n ~bits)) - :cljs (defalias bit-shift-right core/bit-shift-right)) -(defalias >> bit-shift-right) - -#?(:clj (defalias unsigned-bit-shift-right core/unsigned-bit-shift-right) - #_(defmacro unsigned-bit-shift-right - "Bit shift right, replace with zeros" - [n bits] - `(Numeric/unsignedShiftRight ~n ~bits)) - :cljs (defalias unsigned-bit-shift-right core/unsigned-bit-shift-right)) - -(defalias >>> unsigned-bit-shift-right) - -;; ===== ROTATIONS ===== ;; - -(defn int-rotate-left +(ns quantum.core.data.bits + "Useful bit/binary operations. + + Note that bitwise operators on CLJS doubles behave differently than on CLJ doubles: the bitwise + operators `<<`, `>>`, `&`, `|` and `~` are defined in terms of operations on 32-bit integers. + Doing a bitwise operation converts the number to a 32-bit signed int, losing any fractions and + higher-place bits than 32, before doing the calculation and then converting back to Number." + {:todo #{"Port http://graphics.stanford.edu/~seander/bithacks.html"}} + (:refer-clojure :exclude + [and conj contains? empty not or]) + (:require + [clojure.core :as core] + [quantum.core.data.numeric :as dnum + :refer [std-fixint?]] + [quantum.core.data.primitive :as p + :refer [>long]] + [quantum.core.type :as t] + [quantum.core.vars :as var + :refer [defalias]]) +#?(:clj (:import + [clojure.lang Numbers] + [quantum.core Numeric]))) + +;; TODO make sure that for all bit ops here, there's a checked and unchecked version Because +;; currently the CLJS version just truncates the input without warning + +(def bit-false 0) +(def bit-true 1) + +;; ===== Decremented bit sizes of types ===== ;; +;; For bit-manipulation purposes + +(var/def dec-boolean-bits (core/dec p/boolean-bits)) +(var/def dec-byte-bits (core/dec p/byte-bits))) +(var/def dec-short-bits (core/dec p/short-bits))) +(var/def dec-int-bits (core/dec p/int-bits))) +(var/def dec-long-bits (core/dec p/long-bits))) +(var/def dec-float-bits (core/dec p/float-bits))) +(var/def dec-double-bits (core/dec p/double-bits))) + +(t/defn ^:inline dec-bits-of ; > dnum/fixint? ; TODO TYPED + "For bit manipulation purposes" + ([x p/boolean? > p/long?] dec-boolean-bits) +#?(:clj ([x p/byte? > p/long?] dec-byte-bits)) +#?(:clj ([x p/short? > p/long?] dec-short-bits)) +#?(:clj ([x p/int? > p/long?] dec-int-bits)) +#?(:clj ([x p/long? > p/long?] dec-long-bits)) +#?(:clj ([x p/float? > p/long?] dec-float-bits)) + ([x p/double? > p/long?] dec-double-bits)) + +;; ===== Logical bit-operations ===== ;; +;; NOTE: we won't be supporting `clojure.core/and-not` + +(t/defn ^:inline not + "Bitwise `not`." + {:incorporated {'clojure.core/bit-not #inst "2018-10-11" + 'cljs.core/bit-not #inst "2018-10-11"}} + #?@(:clj [([x p/primitive? > (t/type x)] (Numeric/bitNot x))] + :cljs [([x p/boolean? > (t/type x)] (if x false true)) + ([x p/double? > (t/assume numerically-int?)] (core/bit-not x))])) + +;; TODO make variadic +;; TODO TYPED we can shorten this by having dependent types +(t/defn ^:inline and + "Bitwise `and`." + {:incorporated {'clojure.core/bit-and #inst "2018-10-11" + 'cljs.core/bit-and #inst "2018-10-11"}} +#?@(:clj [#_([a p/boolean?, b p/boolean? > ?] (Numeric/bitAnd a b)) + #_([a (t/- p/primitive? p/boolean?) + b (t/- p/primitive? p/boolean?) > ?] (Numeric/bitAnd a b)) + ( [a p/boolean?, b p/boolean? > p/boolean?] (Numeric/bitAnd a b)) + ( [a p/byte? , b p/byte? > p/byte?] (Numeric/bitAnd a b)) + ( [a p/byte? , b p/short? > p/short?] (Numeric/bitAnd a b)) + ( [a p/byte? , b (t/or p/char? p/int?) > p/int?] (Numeric/bitAnd a b)) + ( [a p/byte? , b p/long? > p/long?] (Numeric/bitAnd a b)) + ( [a p/byte? , b p/float? > p/float?] (Numeric/bitAnd a b)) + ( [a p/byte? , b p/double? > p/double?] (Numeric/bitAnd a b)) + ( [a p/short? , b (t/or p/byte? p/short?) > p/short?] (Numeric/bitAnd a b)) + ( [a p/short? , b (t/or p/char? p/int?) > p/int?] (Numeric/bitAnd a b)) + ( [a p/short? , b p/long? > p/long?] (Numeric/bitAnd a b)) + ( [a p/short? , b p/float? > p/float?] (Numeric/bitAnd a b)) + ( [a p/short? , b p/double? > p/double?] (Numeric/bitAnd a b)) + ( [a p/char? , b (t/or p/byte? p/short?) > p/int?] (Numeric/bitAnd a b)) + ( [a p/char? , b p/char? > p/char?] (Numeric/bitAnd a b)) + ( [a p/char? , b p/int? > p/int?] (Numeric/bitAnd a b)) + ( [a p/char? , b p/long? > p/long?] (Numeric/bitAnd a b)) + ( [a p/char? , b p/float? > p/float?] (Numeric/bitAnd a b)) + ( [a p/char? , b p/double? > p/double?] (Numeric/bitAnd a b)) + ( [a p/int? , b (t/or p/byte? p/short? p/char? + p/int?) > p/int?] (Numeric/bitAnd a b)) + ( [a p/int? , b p/long? > p/long?] (Numeric/bitAnd a b)) + ( [a p/int? , b p/float? > p/float?] (Numeric/bitAnd a b)) + ( [a p/int? , b p/double? > p/double?] (Numeric/bitAnd a b)) + ( [a p/long? , b (t/or p/byte? p/short? p/char? + p/int?) > p/long?] (Numeric/bitAnd a b)) + (^:in [a p/long? , b long? > p/long?] (Numbers/and a b)) + ( [a p/long? , b (t/or p/float? p/double?) > p/double?] (Numeric/bitAnd a b)) + ( [a p/float? , b (t/or p/byte? p/short? p/char? + p/int? p/float?) > p/float?] (Numeric/bitAnd a b)) + ( [a p/float? , b (t/or p/long? p/double?) > p/double?] (Numeric/bitAnd a b)) + ( [a p/double? , b (t/- p/primitive? p/boolean?) > p/double?] (Numeric/bitAnd a b))] + :cljs [( [a p/boolean?, b p/boolean? > p/boolean?] (core/and a b)) + ( [a p/double? , b p/double? > (t/assume numerically-int?)] + (core/bit-and a b))])) + +;; TODO make variadic +;; TODO TYPED we can shorten this by having dependent types +(t/defn ^:inline or + "Bitwise `or`." + {:incorporated {'clojure.core/bit-or #inst "2018-10-11" + 'cljs.core/bit-or #inst "2018-10-11"}} +#?@(:clj [#_([a p/boolean?, b p/boolean? > ?] (Numeric/bitOr a b)) + #_([a (t/- p/primitive? p/boolean?) + b (t/- p/primitive? p/boolean?) > ?] (Numeric/bitOr a b)) + ( [a p/boolean?, b p/boolean? > p/boolean?] (Numeric/bitOr a b)) + ( [a p/byte? , b p/byte? > p/byte?] (Numeric/bitOr a b)) + ( [a p/byte? , b p/short? > p/short?] (Numeric/bitOr a b)) + ( [a p/byte? , b (t/or p/char? p/int?) > p/int?] (Numeric/bitOr a b)) + ( [a p/byte? , b p/long? > p/long?] (Numeric/bitOr a b)) + ( [a p/byte? , b p/float? > p/float?] (Numeric/bitOr a b)) + ( [a p/byte? , b p/double? > p/double?] (Numeric/bitOr a b)) + ( [a p/short? , b (t/or p/byte? p/short?) > p/short?] (Numeric/bitOr a b)) + ( [a p/short? , b (t/or p/char? p/int?) > p/int?] (Numeric/bitOr a b)) + ( [a p/short? , b p/long? > p/long?] (Numeric/bitOr a b)) + ( [a p/short? , b p/float? > p/float?] (Numeric/bitOr a b)) + ( [a p/short? , b p/double? > p/double?] (Numeric/bitOr a b)) + ( [a p/char? , b (t/or p/byte? p/short?) > p/int?] (Numeric/bitOr a b)) + ( [a p/char? , b p/char? > p/char?] (Numeric/bitOr a b)) + ( [a p/char? , b p/int? > p/int?] (Numeric/bitOr a b)) + ( [a p/char? , b p/long? > p/long?] (Numeric/bitOr a b)) + ( [a p/char? , b p/float? > p/float?] (Numeric/bitOr a b)) + ( [a p/char? , b p/double? > p/double?] (Numeric/bitOr a b)) + ( [a p/int? , b (t/or p/byte? p/short? p/char? + p/int?) > p/int?] (Numeric/bitOr a b)) + ( [a p/int? , b p/long? > p/long?] (Numeric/bitOr a b)) + ( [a p/int? , b p/float? > p/float?] (Numeric/bitOr a b)) + ( [a p/int? , b p/double? > p/double?] (Numeric/bitOr a b)) + ( [a p/long? , b (t/or p/byte? p/short? p/char? + p/int?) > p/long?] (Numeric/bitOr a b)) + (^:in [a p/long? , b long? > p/long?] (Numbers/or a b)) + ( [a p/long? , b (t/or p/float? p/double?) > p/double?] (Numeric/bitOr a b)) + ( [a p/float? , b (t/or p/byte? p/short? p/char? + p/int? p/float?) > p/float?] (Numeric/bitOr a b)) + ( [a p/float? , b (t/or p/long? p/double?) > p/double?] (Numeric/bitOr a b)) + ( [a p/double? , b (t/- p/primitive? p/boolean?) > p/double?] (Numeric/bitOr a b))] + :cljs [( [a p/boolean?, b p/boolean? > p/boolean?] (core/or a b)) + ( [a p/double? , b p/double? > (t/assume numerically-int?)] + (core/bit-or a b))])) + +;; TODO make variadic +;; TODO TYPED we can shorten this by having dependent types +(t/defn ^:inline xor + "Bitwise `xor`." + {:incorporated {'clojure.core/bit-xor #inst "2018-10-11" + 'cljs.core/bit-xor #inst "2018-10-11"}} +#?@(:clj [#_([a p/boolean?, b p/boolean? > ?] (Numeric/bitXOr a b)) + #_([a (t/- p/primitive? p/boolean?) + b (t/- p/primitive? p/boolean?) > ?] (Numeric/bitXOr a b)) + ( [a p/boolean?, b p/boolean? > p/boolean?] (Numeric/bitXOr a b)) + ( [a p/byte? , b p/byte? > p/byte?] (Numeric/bitXOr a b)) + ( [a p/byte? , b p/short? > p/short?] (Numeric/bitXOr a b)) + ( [a p/byte? , b (t/or p/char? p/int?) > p/int?] (Numeric/bitXOr a b)) + ( [a p/byte? , b p/long? > p/long?] (Numeric/bitXOr a b)) + ( [a p/byte? , b p/float? > p/float?] (Numeric/bitXOr a b)) + ( [a p/byte? , b p/double? > p/double?] (Numeric/bitXOr a b)) + ( [a p/short? , b (t/or p/byte? p/short?) > p/short?] (Numeric/bitXOr a b)) + ( [a p/short? , b (t/or p/char? p/int?) > p/int?] (Numeric/bitXOr a b)) + ( [a p/short? , b p/long? > p/long?] (Numeric/bitXOr a b)) + ( [a p/short? , b p/float? > p/float?] (Numeric/bitXOr a b)) + ( [a p/short? , b p/double? > p/double?] (Numeric/bitXOr a b)) + ( [a p/char? , b (t/or p/byte? p/short?) > p/int?] (Numeric/bitXOr a b)) + ( [a p/char? , b p/char? > p/char?] (Numeric/bitXOr a b)) + ( [a p/char? , b p/int? > p/int?] (Numeric/bitXOr a b)) + ( [a p/char? , b p/long? > p/long?] (Numeric/bitXOr a b)) + ( [a p/char? , b p/float? > p/float?] (Numeric/bitXOr a b)) + ( [a p/char? , b p/double? > p/double?] (Numeric/bitXOr a b)) + ( [a p/int? , b (t/or p/byte? p/short? p/char? + p/int?) > p/int?] (Numeric/bitXOr a b)) + ( [a p/int? , b p/long? > p/long?] (Numeric/bitXOr a b)) + ( [a p/int? , b p/float? > p/float?] (Numeric/bitXOr a b)) + ( [a p/int? , b p/double? > p/double?] (Numeric/bitXOr a b)) + ( [a p/long? , b (t/or p/byte? p/short? p/char? + p/int?) > p/long?] (Numeric/bitXOr a b)) + (^:in [a p/long? , b long? > p/long?] (Numbers/xor a b)) + ( [a p/long? , b (t/or p/float? p/double?) > p/double?] (Numeric/bitXOr a b)) + ( [a p/float? , b (t/or p/byte? p/short? p/char? + p/int? p/float?) > p/float?] (Numeric/bitXOr a b)) + ( [a p/float? , b (t/or p/long? p/double?) > p/double?] (Numeric/bitXOr a b)) + ( [a p/double? , b (t/- p/primitive? p/boolean?) > p/double?] (Numeric/bitXOr a b))] + :cljs [( [a p/boolean?, b p/boolean? > p/boolean?] + (js* "(~{} !== ~{})" a b)) + ( [a p/double? , b p/double? > (t/assume numerically-int?)] + (core/bit-xor a b))])) + +;; ===== Bit-shifts ===== ;; + +;; ----- Logical bit-shifts ---- ;; + +;; TODO make variadic +(t/defn ^:inline <<< + "Unsigned (logical) bitwise shift left" +#?(:clj (^:in [x p/int? , n p/int? > (t/type x)] (Numbers/shiftRightInt x n))) +#?(:clj (^:in [x p/long?, n p/long? > (t/type x)] (Numbers/shiftRight x n))) +#?(:clj ;; TODO implement the `char` op correctly because it likely isn't correct just to do + ;; the straight bit op in Java + ( [x (t/- p/primitive? p/boolean? p/int? p/long?), n p/integral? > (t/type x)] + (Numeric/shiftRight x n))) +#?(:clj ( [x p/int? , n (t/- p/integral? p/int?) > (t/type x)] (Numeric/shiftRight x n))) +#?(:clj ( [x p/long? , n (t/- p/integral? p/long?) > (t/type x)] (Numeric/shiftRight x n))) +#?(:cljs ( [x p/double?, n std-fixint? > (t/assume numerically-int?)] + (core/bit-shift-right x n)))) + +;; TODO make variadic +(t/defn ^:inline >>> + "Unsigned (logical) bitwise shift right" + {:incorporated {'clojure.core/unsigned-bit-shift-right #inst "2018-10-11" + 'cljs.core/unsigned-bit-shift-right #inst "2018-10-11"}} +#?(:clj (^:in [x p/int? , n p/int? > (t/type x)] (Numbers/unsignedShiftRightInt x n))) +#?(:clj (^:in [x p/long?, n p/long? > (t/type x)] (Numbers/unsignedShiftRight x n))) +#?(:clj ;; TODO implement the `char` op correctly because it likely isn't correct just to do + ;; the straight bit op in Java + ( [x (t/- p/primitive? p/boolean? p/int? p/long?), n p/integral? > (t/type x)] + (Numeric/uShiftRight x n))) +#?(:clj ( [x p/int? , n (t/- p/integral? p/int?) > (t/type x)] (Numeric/uShiftRight x n))) +#?(:clj ( [x p/long? , n (t/- p/integral? p/long?) > (t/type x)] (Numeric/uShiftRight x n))) +#?(:cljs ([x p/double?, n std-fixint? > (t/assume numerically-int?)] + (core/unsigned-bit-shift-right x n)))) + +;; ----- Arithmetic bit-shifts ----- ;; + +;; TODO make variadic +(t/defn ^:inline << + "Arithmetic bitwise shift left" + {:incorporated {'clojure.core/bit-shift-left #inst "2018-10-11" + 'cljs.core/bit-shift-left #inst "2018-10-11"}} +#?(:clj (^:in [x p/int? , n p/int? > (t/type x)] (Numbers/shiftLeftInt x n))) +#?(:clj (^:in [x p/long?, n p/long? > (t/type x)] (Numbers/shiftLeft x n))) +#?(:clj ;; TODO implement the `char` op correctly because it likely isn't correct just to do + ;; the straight bit op in Java + ( [x (t/- p/primitive? p/boolean? p/int? p/long?), n p/integral? > (t/type x)] + (Numeric/shiftLeft x n))) +#?(:clj ( [x p/int? , n (t/- p/integral? p/int?) > (t/type x)] (Numeric/shiftLeft x n))) +#?(:clj ( [x p/long? , n (t/- p/integral? p/long?) > (t/type x)] (Numeric/shiftLeft x n))) +#?(:cljs ( [x p/double?, n std-fixint? > (t/assume numerically-int?)] + (core/bit-shift-left x n)))) + +;; TODO make variadic +;; TODO TYPED `t/numerically-int?` +(t/defn ^:inline >> + "Arithmetic bitwise shift right" + {:incorporated {'clojure.core/bit-shift-right #inst "2018-10-11" + 'cljs.core/bit-shift-right #inst "2018-10-11"}} +#?(:clj (^:in [x p/int? , n p/int? > (t/type x)] (Numbers/shiftRightInt x n))) +#?(:clj (^:in [x p/long?, n p/long? > (t/type x)] (Numbers/shiftRight x n))) +#?(:clj ;; TODO implement the `char` op correctly because it likely isn't correct just to do + ;; the straight bit op in Java + ( [x (t/- p/primitive? p/boolean? p/int? p/long?), n p/integral? > (t/type x)] + (Numeric/shiftRight x n))) +#?(:clj ( [x p/int? , n (t/- p/integral? p/int?) > (t/type x)] (Numeric/shiftRight x n))) +#?(:clj ( [x p/long? , n (t/- p/integral? p/long?) > (t/type x)] (Numeric/shiftRight x n))) +#?(:cljs ( [x p/double?, n std-fixint? > (t/assume numerically-int?)] + (core/bit-shift-right x n)))) + +;; ===== Single-bit operations ===== ;; + +;; TODO add bit operations with checked indices + +(t/defn ^:inline bit-set-false* + "Makes the bit at the provided index ->`i` `bit-false`. + Unchecked w.r.t. the bit index. + Equivalent to `clojure.core/bit-clear`." + {:incorporated {'clojure.core/bit-clear #inst "2018-10-11" + 'cljs.core/bit-clear #inst "2018-10-11"} + :todo #{"Extend index to non-longs" + "Extend usage to non-primitives"}} +#?(:clj ([x (t/- p/primitive? p/boolean?), i p/long? > (t/type x)] (Numeric/bitClear x i)) + :cljs ([x p/double?, i std-fixint? > (t/assume numerically-int?)] (core/bit-clear x i)))) + +(t/defn ^:inline bit-set-true* + "Makes the bit at the provided index ->`i` `bit-true`. + Unchecked w.r.t. the bit index. + Equivalent to `clojure.core/bit-set`." + {:incorporated {'clojure.core/bit-set #inst "2018-10-11" + 'cljs.core/bit-set #inst "2018-10-11"} + :todo #{"Extend index to non-longs" + "Extend usage to non-primitives"}} +#?(:clj ([x (t/- p/primitive? p/boolean?), i p/long? > (t/type x)] (Numeric/bitSet x i)) + :cljs ([x p/double?, i std/fixint? > (t/assume numerically-int?)] (core/bit-set x i)))) + +(t/defn ^:inline bit-not* + "Applies `not` to the bit at the provided index ->`i`. + Unchecked w.r.t. the bit index. + Equivalent to `clojure.core/bit-flip`." + {:incorporated {'clojure.core/bit-flip #inst "2018-10-11" + 'cljs.core/bit-flip #inst "2018-10-11"} + :todo #{"Extend index to non-longs" + "Extend usage to non-primitives"}} +#?(:clj ([x (t/- p/primitive? p/boolean?), i p/long? > (t/type x)] (Numeric/bitFlip x i)) + :cljs ([x p/double?, i std-fixint? > (t/assume numerically-int?)] (core/bit-flip x i)))) + +(t/defn ^:inline bit-true?* + "Outputs whether the bit at the provided index ->`i` is `bit-true`. + Unchecked w.r.t. the bit index. + Equivalent to `clojure.core/bit-test`." + {:incorporated {'clojure.core/bit-test #inst "2018-10-11" + 'cljs.core/bit-test #inst "2018-10-11"} + :todo #{"Extend index to non-longs" + "Extend usage to non-primitives"}} +#?(:clj ([x (t/- p/primitive? p/boolean?), i p/long? > p/boolean?] (Numeric/bitTest x i)) + :cljs ([x p/double? , i std-fixint? > p/boolean?] (core/bit-test x i)))) + +(defalias ? test*) + +;; ===== Rotations ===== ;; + +;; TODO TYPED +#_(defnt rotate-left {:from "http://hg.openjdk.java.net/jdk7u/jdk7u6/jdk/file/8c2c5d63a17e/src/share/classes/java/lang/Integer.java"} - [x n] - (bit-or - (bit-shift-left x n) - (unsigned-bit-shift-right x (- n)))) + [x ???, n ???] (or (<< x n) (>>> x (- n)))) +;; TODO extend to CLJ +;; TODO can use e.g. java.lang.Integer/bitCount for the purpose +;; TODO TYPED +#_(:cljs (defn bit-count "Counts the number of bits set in n" {:from 'cljs.core} [v] - (let [v (- v (bit-and (bit-shift-right v 1) 0x55555555)) - v (+ (bit-and v 0x33333333) (bit-and (bit-shift-right v 2) 0x33333333))] - (bit-shift-right (* (bit-and (+ v (bit-shift-right v 4)) 0xF0F0F0F) 0x1010101) 24))) - -(declare bits) + (let [v (- v (and (>> v 1) 0x55555555)) + v (+ (and v 0x33333333) (and (>> v 2) 0x33333333))] + (>> (* (and (+ v (>> v 4)) 0xF0F0F0F) 0x1010101) 24)))) -(defalias ? core/bit-test) +;; ===== Bulk bit-operations ===== ;; -; ===== BULK BIT OPERATIONS ===== ; - -(defn ?-coll - "Returns true or false for the bit at the given index of the collection." - [bits i] - (? (bits (>> i 6)) (&& i 0x3f))) - -(defn bits - "The bits of x, aggregated into a vector and truncated/extended to length n." +;; TODO TYPED +#_(defnt >bits + "The bits of ->`x`, aggregated into a vector and truncated/extended to length ->`n`." {:adapted-from 'gloss.data.primitives} - [x n] - (mapv #(if (pos? (&& (<< 1 %) x)) 1 0) (range n))) + [x , n length?] + (->> (range n) + (mapv (t/fn [] (if (pos? (and (<< 1 %) x)) + bit-true + bit-false))))) -(bits 1 64) +;; TODO TYPED +#_(defnt test*-coll + "Returns true or false for the bit at the given index ->`i` of ->`xs`." + [xs (t/of bit-like?), i index?] + (? (>bits (>> i 6)) (and i 0x3f))) -(defn truncate - "Truncates x to the specified number of bits." +;; TODO TYPED +#_(defn truncate + "Truncates ->`x` to the specified number of bits." {:adapted-from 'bigml.sketchy.murmur} [#?(:clj ^long x :cljs x) #?(:clj ^long n :cljs n)] - (&& x (unchecked-dec (<< 1 n)))) + (and x (unchecked-dec (<< 1 n)))) -; ====== ENDIANNESS REVERSAL ======= +;; ====== Endianness reversal ====== ;; -; TODO DEPS +;; TODO implement based on https://github.com/ztellman/primitive-math/blob/master/src/primitive_math/Primitives.java #_(:clj -(defnt reverse - (^short [^short x] (Numeric/reverseShort x)) - (^int [^int x] (Numeric/reverseInt x)) - (^long [^long x] (Numeric/reverseLong x)))) +(defnt reverse [x p/primitive? > (t/type x)] ...)) + +;; TODO implement `reverse-bytes` (see related methods in e.g. `Integer` and `Long` classes) + +#?(:clj +(defnt bytes>long + "Combines safely-byte-coercible values into a long value." + {:todo #{"Move" + "Implement for CLJS" + "Awaiting `bit/or` variadicity to make slightly cleaner" + "Support anything safely-byte-coercible, not just direct bytes"}} + > p/long? + [b7 p/byte?, b6 p/byte?, b5 p/byte?, b4 p/byte? + b3 p/byte?, b2 p/byte?, b1 p/byte?, b0 p/byte?] + (-> (<< (>long b7) 56) + (or (<< (and (>long b6) 0xff) 48)) + (or (<< (and (>long b5) 0xff) 40)) + (or (<< (and (>long b4) 0xff) 32)) + (or (<< (and (>long b3) 0xff) 24)) + (or (<< (and (>long b2) 0xff) 16)) + (or (<< (and (>long b1) 0xff) 8)) + (or (and (>long b0) 0xff))))) +;; ===== Bit sets ===== ;; +;; May be thought of as a map from bit-index / non-negative integer to boolean, or as a set of +;; bit-indices / non-negative integers. + +(def bit-set? #?(:clj p/integral? :cljs p/double?)) + +(var/def empty + "For bit set purposes. + We choose the default bit set size to be `long` in CLJ and `number` (i.e. `double`) in CLJS to + give it the maximum size possible for a primitive bit set." + 0) + +;; TODO TYPED variadic, expressions #_(:clj -(defnt' make-long - "Combines byte values into a long value." - [^byte b7 ^byte b6 ^byte b5 ^byte b4 - ^byte b3 ^byte b2 ^byte b1 ^byte b0] - (bit-or (<< (long b7) 56) - (<< (bit-and (long b6) 0xff) 48) - (<< (bit-and (long b5) 0xff) 40) - (<< (bit-and (long b4) 0xff) 32) - (<< (bit-and (long b3) 0xff) 24) - (<< (bit-and (long b2) 0xff) 16) - (<< (bit-and (long b1) 0xff) 8) - (bit-and (long b0) 0xff)))) +(defnt conj + "For bit set purposes." + {:todo #{"Implement variadic arity" + "Implement for CLJS" + ""}} + ([] empty) + ([v #?(:clj p/long? :cljs p/double?)] (conj empty v)) + ([xs bit-set?, v0 bit-set-value?] (bit-set-true* xs v0)) + ([xs bit-set?, v0 bit-set-value?, v1 bit-set-value?] (-> xs (conj v0) (conj v1))) +#_([xs bit-set?, v0 bit-set-value?, v1 bit-set-value? & vs (t/of bit-set-value?)] ...))) + +;; TODO TYPED `numerically-integer?`, expressions +#_(defnt contains? + "Tests if the bit set ->`xs` contains the value ->`v`." + > p/boolean? + ([xs p/byte? , v (t/and t/numerically-integer? (<= 0 % (>bit-size ...))] (bit-true?* xs v)) + ([xs p/short?, v (t/and t/numerically-integer? (<= 0 % (>bit-size ...)))] (bit-true?* xs v)) + ([xs p/char? , v (t/and t/numerically-integer? (<= 0 % (>bit-size ...)))] (bit-true?* xs v)) + ([xs p/int? , v (t/and t/numerically-integer? (<= 0 % (>bit-size ...)))] (bit-true?* xs v)) + ([xs p/long? , v (t/and t/numerically-integer? (<= 0 % (>bit-size ...)))] (bit-true?* xs v))) diff --git a/src/quantum/core/data/bytes.cljc b/src/quantum/core/data/bytes.cljc index ffd025b6..89c0d4cf 100644 --- a/src/quantum/core/data/bytes.cljc +++ b/src/quantum/core/data/bytes.cljc @@ -14,7 +14,7 @@ :refer [&& >>>]] [quantum.core.fn :as fn :refer [fn1]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]]) #?(:clj (:import java.util.Arrays))) diff --git a/src/quantum/core/data/collections.cljc b/src/quantum/core/data/collections.cljc new file mode 100644 index 00000000..f75a4415 --- /dev/null +++ b/src/quantum/core/data/collections.cljc @@ -0,0 +1,251 @@ +(ns quantum.core.data.collections + (:refer-clojure :exclude + [associative? indexed? list? reduced? sequential?]) + (:require + [quantum.core.data.array :as arr] + [quantum.core.data.map :as map] + [quantum.core.data.set :as set] + [quantum.core.data.string :as dstr] + [quantum.core.data.tuple :as tup] + [quantum.core.data.vector :as vec] + [quantum.core.type :as t] + [quantum.core.vars :as var] + ;; TODO TYPED excise + [quantum.untyped.core.type :as ut])) + +;; TODO move to `quantum.core.data.sequence` +;; ===== Sequences and sequence-wrappers ===== ;; +;; Sequential (generally not `lookup?`) +;; Note that lists and seqs are not fundamentally different and so we don't distinguish between them +;; here. + + +(def iseqable? (t/isa?|direct #?(:clj clojure.lang.Seqable :cljs cljs.core/ISeqable))) + +(def iseq? (t/isa?|direct #?(:clj clojure.lang.ISeq :cljs cljs.core/ISeq))) + +#?(:clj (def aseq? (t/isa? clojure.lang.ASeq))) + +(def lseq? (t/isa? #?(:clj clojure.lang.LazySeq :cljs cljs.core/LazySeq))) + +(def cons? (t/isa? #?(:clj clojure.lang.Cons :cljs cljs.core/Cons))) + +;; TODO CLJS +#?(:clj +(def array-seq? + (t/or (t/isa? clojure.lang.ArraySeq) + (t/isa? clojure.lang.ArraySeq$ArraySeq_byte) + (t/isa? clojure.lang.ArraySeq$ArraySeq_short) + (t/isa? clojure.lang.ArraySeq$ArraySeq_char) + (t/isa? clojure.lang.ArraySeq$ArraySeq_int) + (t/isa? clojure.lang.ArraySeq$ArraySeq_long) + (t/isa? clojure.lang.ArraySeq$ArraySeq_float) + (t/isa? clojure.lang.ArraySeq$ArraySeq_double)))) + +;; TODO CLJS +#?(:clj +(def string-seq? (t/isa? clojure.lang.StringSeq))) + +(def chunk-buffer? (t/isa? #?(:clj clojure.lang.ChunkBuffer :cljs cljs.core/ChunkBuffer))) + +(def chunk? (t/isa?|direct #?(:clj clojure.lang.IChunk :cljs cljs.core/IChunk))) + +(def chunked-cons? (t/isa? #?(:clj clojure.lang.ChunkedCons :cljs cljs.core/ChunkedCons))) + +(var/def chunked-seq? + "Note that `cljs.core/IChunkedSeq` has no interface for `chunked-next`, unliked + `clojure.lang.IChunkedSeq`." + (t/isa?|direct #?(:clj clojure.lang.IChunkedSeq :cljs cljs.core/IChunkedSeq))) + +#?(:cljs (def chunked-next? (t/isa?|direct #?(:cljs cljs.core/IChunkedNext)))) + +(def indexed-seq? (t/isa? #?(:clj clojure.lang.IndexedSeq :cljs cljs.core/IndexedSeq))) + +(def key-seq? (t/isa? #?(:clj clojure.lang.APersistentMap$KeySeq :cljs cljs.core/KeySeq))) + +(def val-seq? (t/isa? #?(:clj clojure.lang.APersistentMap$ValSeq :cljs cljs.core/ValSeq))) + +;; TODO CLJS +#?(:clj +(def range? (t/or (t/isa? clojure.lang.Range) (t/isa? clojure.lang.LongRange)))) + +;; TODO excise — this is used later on elsewhere +(def misc-seq? (t/or chunked-seq? indexed-seq? key-seq? val-seq?)) + +(var/defalias ut/+list|built-in?) + +(def cdseq? t/none? #_(:clj (t/or (t/isa? clojure.data.finger_tree.CountedDoubleList) + (t/isa? quantum.core.data.finger_tree.CountedDoubleList)) + :cljs (t/isa? quantum.core.data.finger-tree/CountedDoubleList))) +(def dseq? t/none? #_(:clj (t/or (t/isa? clojure.data.finger_tree.CountedDoubleList) + (t/isa? quantum.core.data.finger_tree.CountedDoubleList)) + :cljs (t/isa? quantum.core.data.finger-tree/CountedDoubleList))) + +(def +list? (t/isa? #?(:clj clojure.lang.IPersistentList :cljs cljs.core/IList))) + +(def !seq? #?(:clj (t/isa? java.util.LinkedList) :cljs t/none?)) + +;; ===== End sequences ===== ;; + +(def transient? (t/isa?|direct #?(:clj clojure.lang.ITransientCollection + :cljs cljs.core/ITransientCollection))) + +(def editable? (t/isa?|direct #?(:clj clojure.lang.IEditableCollection + :cljs cljs.core/IEditableCollection))) + +(def record? (t/isa?|direct #?(:clj clojure.lang.IRecord :cljs cljs.core/IRecord))) + +(var/def comparator-ordered? + "Something that guarantees the invariant that its elements will always be ordered by some + comparator." + (t/or (t/isa?|direct #?(:clj clojure.lang.Sorted :cljs cljs.core/ISorted)) + #?@(:clj [(t/isa? java.util.SortedMap) + (t/isa? java.util.SortedSet)] + :cljs [(t/isa? goog.structs.AvlTree)]))) + +(var/def sorted? + "Something that is either (necessarily) `comparator-ordered?` or contingently comparator-ordered + (i.e. whose elements happen to be in monotonically decreasing or increasing order by `compare`)." + (t/or comparator-ordered? + ; TODO implement — it means monotonically <= or >= + monotonic?)) + +(def iindexed? (t/isa?|direct #?(:clj clojure.lang.Indexed :cljs cljs.core/IIndexed))) + +(var/def indexed? + "Indicates efficient lookup by (`dn/integer?`) index (via `get`), and that its indices are dense. + Thus indicates a collection that maintains a one-to-one mapping from `dn/integer?` keys to + values. + + An `indexed?` is distinct from a non-`indexed?` `lookup?` whose keys densely satisfy `integer?` + in that when traversed sequentially, the former will behave as sequence of (unindexed) elements + while the latter will behave as a sequence of key-value pairs." + (t/or iindexed? + ;; Doesn't guarantee `java.util.List` is implemented, except by convention + #?(:clj (t/isa? java.util.RandomAccess)) + #?(:clj dstr/char-seq? :cljs dstr/string?) + arr/array?)) + +(def ilookup? (t/isa?|direct #?(:clj clojure.lang.Lookup :cljs cljs.core/ILookup))) + +(var/def lookup? + "Indicates efficient lookup by key (via `get`), and thus a collection that maintains a one-to-one + mapping from keys to values. Technically, anything that is able to be the first input to `get`. + + Distinct from `map?` in that a `map?` is effectively + `(t/- (t/and associative? lookup?) indexed?)`. + + A `lookup?` whose keys densely satisfy `integer?` is distinct from an `indexed?` in that when + traversed sequentially, the former will behave as a sequence of key-value pairs while the latter + will behave as a sequence of (unindexed) elements." + (t/or ilookup? indexed?)) + +(var/def sequentially-ordered? + "Collections defined by the fact that their elements must appear in a particular order, + specifically due to the criterion of 'nextness' rather than e.g. a value-comparator or insertion + order." + (t/or (t/isa|direct? #?(:clj clojure.lang.Sequential :cljs cljs.core/ISequential)) + iseq? + #?(:clj (t/isa? java.util.List)) + +list? + indexed? + ;; These four are insertion-ordered maps but when re-`assoc`ing (map) or re-`conj`ing (set), + ;; the original sequence is retained, so really they're sequentially ordered and not purely + ;; insertion-ordered. + #?(:clj (t/isa? flatland.ordered.map.OrderedMap)) + #?(:clj (t/isa? flatland.ordered.set.OrderedSet)) + (t/isa? linked.map.LinkedMap) + (t/isa? linked.set.LinkedSet))) + +(var/def ordered? + "Collections defined by the fact that their elements must appear in a particular order. Note: + - `sequentially-ordered?` (even if non-`indexed?`) implies `ordered?`, as the ordering criterion + can be thought of as each element's implicit sequential designator / index. + - `indexed?` implies `ordered?`, as the ordering criterion can be thought of as each element's + explicit sequential designator / index. + - `comparator-ordered?` implies `ordered?` while `sorted?` does not necessarily, as while a + collection may happen to be sorted, this does not imply that order is one of its defining + aspects. + - While all good hashing algorithms are deterministic, order is not (generally) guaranteed for + hash-ordered collections." + (t/or sequentially-ordered? + comparator-ordered?)) + +(def +associative? (t/isa?|direct #?(:clj clojure.lang.Associative + :cljs cljs.core/IAssociative))) + +(def !+associative? (t/isa?|direct #?(:clj clojure.lang.ITransientAssociative + :cljs cljs.core/ITransientAssociative))) + +(var/def associative? + "Collections that can associate a (potentially new) key with a new value. Technically, anything + that is able to be the first input to `assoc?!`." + (t/or +associative? !+associative? (t/or map/map? indexed?))) + +(def icounted? (t/isa?|direct #?(:clj clojure.lang.Counted :cljs cljs.core/ICounted))) + +(var/def counted? "Objects guaranteed to implement a constant-time `count`." + (t/or icounted? + ;; It's not guaranteed that `char-seq?`s have constant-time `.length`/`count` but it's very + ;; reasonable to assume. + #?(:clj dstr/char-seq? :cljs (t/or dstr/string? dstr/!string?)) + tup/tuple? + ;; This kind of chan has a buffer which is countable + dasync/m2m-chan? + #?(:clj tup/map-entry?) + ;; All enumerated vector types are all known to implement constant-time `count`. + vec/vector? + ;; It's not guaranteed that all `java.util.Map`s have constant-time `.size`/`count` but it's + ;; about as reasonable to assume so as with `char-seq?`s. + map/map? + ;; It's not guaranteed that all `java.util.Set`s have constant-time `.size`/`count` but it's + ;; about as reasonable to assume so as with `java.util.Map`s. + set/set? + arr/array?)) + +(def iterable? (t/isa?|direct #?(:clj java.lang.Iterable :cljs cljs.core/IIterable))) + +#?(:clj (def java-coll? (t/isa? java.util.Collection))) + +(var/def coll? + "An object that represents a grouping/collection of other objects (individually called elements)." + (t/or #?(:clj java-coll?) + #?@(:clj [(t/isa? clojure.lang.IPersistentCollection) + (t/isa? clojure.lang.ITransientCollection)] + :cljs (t/isa|direct? cljs.core/ICollection)) + ordered? lookup? associative?)) + +(def reduced? (t/isa? #?(:clj clojure.lang.Reduced :cljs cljs.core/Reduced))) + +;; TODO non-boxing `>reduced` +(t/defn >reduced + "Wraps ->`x` in a way such that a `reduce` will terminate with the value ->`x`." + > reduced? + [x t/ref?] (#?(:clj clojure.lang.Reduced. :cljs cljs.core/Reduced.) x)) + +(var/def reducible? + "An object that is able to be reduced by some means. Technically, anything that is able to be the + first input to `reduce`. + + All collection are reducible, but not all reducibles are collections (e.g. `nil?`, `numerically-integer?`, `dasync/read-chan?`, etc.)." + (t/or p/nil? dstr/string? vec/!+vector? arr/array? dn/numerically-integer? + ;; TODO what about `transformer?` + dasync/read-chan? + (t/isa? fast_zip.core.ZipperLocation) + #?(:clj (t/isa? clojure.lang.IKVReduce)) + #?(:clj (t/isa? clojure.lang.IReduceInit)) + ;; We're ignoring indirect implementation for reasons noted in the `reduce` impl + (t/isa?|direct #?(:clj clojure.core.protocols/IKVReduce + :cljs cljs.core/IKVReduce)) + ;; We're ignoring indirect implementation for reasons noted in the `reduce` impl + (t/isa?|direct #?(:clj clojure.core.protocols/CollReduce + :cljs cljs.core/IReduce)) + iseq? + iseqable? + iterable?)) + +(var/def seqable? + "Whatever is `seqable?` is `reducible?`, and whatever is `reducible?` is `seqable?`. + Since reduction is preferred to 'manual' `first`/`next` seq traversal for performance and + conceptual reasons, we prefer `reducible?` to `seqable?` as the base type." + reducible?) diff --git a/src/quantum/core/data/complex/json.cljc b/src/quantum/core/data/complex/json.cljc index dfa9048b..c89f4bcb 100644 --- a/src/quantum/core/data/complex/json.cljc +++ b/src/quantum/core/data/complex/json.cljc @@ -12,7 +12,7 @@ :refer [<- fn1]] [quantum.core.logic :refer [whenp]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]])) ; 2.888831 ms for Cheshire (on what?) vs. clojure.data.json : 7.036831 ms @@ -28,8 +28,8 @@ :cljs (when-not (empty? x) (->> x (transit/read (transit/reader :json)) - (<- whenp (val? key-fn) - (fn1 coll/apply-to-keys key-fn))))))) + (<- (whenp (val? key-fn) + (fn1 coll/apply-to-keys key-fn)))))))) (defn json->-with-start "Decodes a JSON-encoded string `s` starting at index `start-i`, inclusive." diff --git a/src/quantum/core/data/finger_tree.cljc b/src/quantum/core/data/finger_tree.cljc index 1c0a5c1d..ef3ceecb 100644 --- a/src/quantum/core/data/finger_tree.cljc +++ b/src/quantum/core/data/finger_tree.cljc @@ -4,10 +4,10 @@ quantum.core.data.finger-tree (:refer-clojure :exclude [macroexpand-1]) (:require - [quantum.core.data.map :as map + [quantum.core.data.map :as map :refer [map-entry]] [quantum.core.macros.deftype :as deftype] - [quantum.core.core + [quantum.untyped.core.collections :refer [seq=]] #?@(:clj [[quantum.core.data.finger-tree.macros @@ -119,8 +119,10 @@ (v (+ (int 2) i))))))))))) (deftype/deftype EmptyTree [meter-obj] - {?Seqable - {seq ([_] nil)} + {?Equals + {= ([_ x] false)} ; TBD + ?Seqable + {seq ([_] nil)} ?Sequential true ?Seq {first ([_] nil ) @@ -133,7 +135,6 @@ {rseq ([_] nil )} ?Collection {empty ([this] this) - equiv ([_ x] false) ; TBD conj ([_ b] (newSingleTree meter-obj b))} ?Counted {count ([_ ] 0 )} ; not needed? @@ -164,7 +165,9 @@ (->> t getMeter idElem (split t p))) (deftype/deftype DelayedTree [tree-ref mval] - {?Seqable + {?Equals + {= ([_ x] false)} ; TBD + ?Seqable {seq ([this] this)} ?Sequential true ?Seq @@ -180,7 +183,6 @@ {count ([_])} ; not needed? ?Collection {empty ([_] (empty @tree-ref)) - equals ([_ x] false) ; TBD cons ([_ b] (conj @tree-ref b))} ConjL {conjl ([_ a] (conjl @tree-ref a))} @@ -219,7 +221,9 @@ (app3 t1 nil t2)) (deftype/deftype SingleTree [meter-obj x] - {?Seqable + {?Equals + {= ([_ x] false)} ; TBD + ?Seqable {seq ([this] this)} ?Sequential true ?Seq @@ -235,7 +239,6 @@ {count ([_])}; not needed? ?Collection {empty ([_] (EmptyTree. meter-obj)) ; not needed? - equals ([_ x] false) ; TBD conj ([_ b] (deep (digit meter-obj x) (EmptyTree. (finger-meter meter-obj)) (digit meter-obj b)))} @@ -266,7 +269,9 @@ (measured suf)))) (deftype/deftype DeepTree [meter-obj pre mid suf mval] - {?Seqable + {?Equals + {= ([_ x] false)} ; TBD + ?Seqable {seq ([this] this)} ?Sequential true ?Seq @@ -282,7 +287,6 @@ {count ([_])} ; not needed? ?Collection {empty ([_] (newEmptyTree meter-obj)) - equals ([_ x] false) ; TBD conj ([_ a] (if (< (count suf) 4) (deep pre mid (conj suf a)) @@ -341,11 +345,11 @@ (op (measured pre) (measured suf)))))))) (deftype/deftype CountedDoubleList [tree mdata] - {?Object - {equals ([_ x] (seq= tree x)) - hash ([this] (hashcode (map identity this)))} - ?HashEq - {hash-eq ([this] (hash-ordered this))} + {?Equals + {= ([_ x] (seq= tree x))} + ?Hash + {hash ([this] (hash-ordered this)) + hash-code ([this] (hashcode (map identity this)))} ?Meta {meta ([_] mdata) with-meta ([_ mdata] (CountedDoubleList. tree mdata))} @@ -365,7 +369,6 @@ {count ([_] (measured tree))} ?Collection {empty ([_] (CountedDoubleList. (empty tree) mdata)) - equiv ([_ x] (seq= tree x)) ; TBD conj ([_ x] (CountedDoubleList. (conj tree x) mdata))} ?Associative {assoc ([this k v] diff --git a/src/quantum/core/data/heap.cljc b/src/quantum/core/data/heap.cljc new file mode 100644 index 00000000..0225502c --- /dev/null +++ b/src/quantum/core/data/heap.cljc @@ -0,0 +1,2 @@ +(ns quantum.core.data.heap + {:todo "Incorporate https://github.com/thi-ng/dstruct/blob/master/src/heap.org"}) diff --git a/src/quantum/core/data/hex.cljc b/src/quantum/core/data/hex.cljc index d30a8640..ef437aa6 100644 --- a/src/quantum/core/data/hex.cljc +++ b/src/quantum/core/data/hex.cljc @@ -3,10 +3,10 @@ :attribution "alexandergunnarson"} quantum.core.data.hex (:require + [quantum.core.data.primitive + :refer [>int]] [quantum.core.macros :as macros :refer [defnt]] - [quantum.core.convert.primitive :as pconvert - :refer [->int ->byte*]] [quantum.core.string :as str])) (defnt ^String ->hex-string @@ -16,7 +16,7 @@ #?(:cljs ([^pnumber? x] (.toString x 16))) #?(:clj ([^int? x] (Integer/toHexString x))) #?(:clj ([^char? x] - (let [^String s (->hex-string (->int x))] + (let [^String s (->hex-string (>int x))] (.substring s 0 4)))) #?(:clj ([^byte? x] (let [^String hs (->hex-string (+ 256 (long x))) @@ -27,7 +27,7 @@ #?(:clj ([^bytes? bs] (->hex-string bs " "))) #?(:clj ([^bytes? bs separator] - (str/join separator (map (fn [x] (->hex-string (->byte* ^Byte x))) bs)))) + (str/join separator (map (fn [x] (->hex-string (>byte x))) bs)))) #_([:else n zero-pad-length] (text/pad-left (->hex-string n) zero-pad-length "0"))) @@ -45,4 +45,3 @@ (bit-and 0x0F (long (Character/getNumericValue (.charAt x (int (+ (* 2 i) 1)))))))))) res) :cljs (-> x js/goog.crypt.hexToByteArray js/Uint8Array.)))) - diff --git a/src/quantum/core/data/identifiers.cljc b/src/quantum/core/data/identifiers.cljc new file mode 100644 index 00000000..25658f8e --- /dev/null +++ b/src/quantum/core/data/identifiers.cljc @@ -0,0 +1,201 @@ +(ns quantum.core.data.identifiers + "Functions related to variable identifiers/names (`name`, `namespace`, etc.) and qualification / + unqualification of nameables." + (:refer-clojure :exclude + [keyword? symbol?]) + (:require + [quantum.core.data.meta + :refer [>meta]] + [quantum.core.data.string :as dstr + :refer [>string]] + [quantum.core.type :as t] + [quantum.untyped.core.core :as ucore])) + +(ucore/log-this-ns) + +;; ===== Standard identifiers ===== ;; + +(def keyword? (t/isa? #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword))) + +(def symbol? (t/isa? #?(:clj clojure.lang.Symbol :cljs cljs.core/Symbol))) + +(def ident? (t/or keyword? symbol?)) + +;; ===== Nameability ===== ;; + +(def named? (t/isa?|direct #?(:clj clojure.lang.Named :cljs cljs.core/INamed))) + +(t/defn demunged>namespace [s dstr/string?] TODO TYPED #_(subs s 0 (.lastIndexOf s "/"))) +(t/defn demunged>name [s dstr/string?] TODO TYPED #_(subs s (inc (.lastIndexOf s "/")))) + +(defn... ?ns>name [?ns] + (name #?(:clj (if (namespace? ?ns) + (ns-name ?ns) + ?ns) + :cljs ?ns))) + +(t/defn >name + "Computes the nilable name (the unqualified string identifier) of `x`." + > (t/? dstr/string?) + (^:inline [x (t/or t/nil? dstr/string?)] x) + (^:inline [x named?] #?(:clj (.getName x) :cljs (cljs.core/-name x))) +#?(:clj (^:inline [x ??/class?] (.getName x))) + ( [x ??/fn?] + #?(:clj (or (some-> (-> >meta :name) >name) + (-> x ??/>class >name clojure.lang.Compiler/demunge demunged>name)) + :cljs (when-not (-> x .-name ???str/blank?) + (-> x .-name ??/demunge-str demunged>name))))) + +(t/defn >namespace + "Computes the nilable identifier-namespace (the string identifier-qualifier) of `x`." + > (t/? dstr/string?) + (^:inline [x (t/or t/nil? dstr/string? #?(:clj ??/class?) #?(:clj ??/namespace?))] nil) + (^:inline [x named?] #?(:clj (.getNamespace x) :cljs (cljs.core/-namespace x))) + ( [x ??/fn?] + #?(:clj (or (some-> (-> x >meta :ns) >name) + (-> x ??/>class .getName clojure.lang.Compiler/demunge demunged>namespace)) + :cljs (when-not (-> x .-name ???str/blank?) + (-> x .-name ??/demunge-str demunged>namespace))))) + +;; ===== Qualification ===== ;; + +(t/defn qualify > symbol? +#?(:clj ([sym symbol?] (qualify *ns* sym))) + ([ns-sym symbol? sym symbol?] (>symbol (>name ns-sym) (>name sym))) +#?(:clj ([ns-val ??/namespace? sym symbol?] (>symbol (>name ns-val) (>name sym))))) + +(t/defn qualify|dot > symbol? [sym symbol? ns-val ??/namespace?] + (>symbol (>str (?ns>name ns-val) "." (>name sym)))) + +#?(:clj (defn... qualify|class [sym] (symbol (str (-> *ns* ns-name name munge) "." sym)))) + +(t/defn unqualify > symbol? [sym symbol?] (-> sym >name >symbol)) + +(t/defn unqualified? [x (t/input >namespace [:?])] (-> x >namespace t/nil?)) +(t/defn qualified? [x (t/input >namespace [:?])] (-> x >namespace t/val?)) + +(def unqualified-keyword? (t/and keyword? unqualified?)) +(def qualified-keyword? (t/and keyword? qualified?)) +(def unqualified-symbol? (t/and symbol? unqualified?)) +(def qualified-symbol? (t/and symbol? qualified?)) +(def unqualified-ident? (t/and symbol? unqualified?)) +(def qualified-ident? (t/and symbol? qualified?)) + +#?(:clj +(defn... collapse-symbol + ([sym symbol?] (collapse-symbol sym true)) + ([sym symbol? extra-slash? p/boolean?] + (>symbol + (when-let [n (>namespace sym)] + (when-not (= n (-> *ns* ns-name name)) + (if-let [alias- (do #?(:clj (??/ns-name>alias *ns* (>symbol n)) :cljs false))] + (str alias- (when extra-slash? "/")) + n))) (name sym))))) + +;; ===== Standard identifiers ===== ;; + +(t/defn >keyword + "Outputs a keyword with the given (optional) namespace and name. + Do not use `:` in keyword strings; it will be added automatically." + > keyword? + ([x keyword?] x) + ([x symbol?] #?(:clj (clojure.lang.Keyword/intern x) + :cljs (cljs.core/Keyword. (>namespace x) (>name x) (.-str x) nil))) + ([x dstr/string?] #?(:clj (clojure.lang.Keyword/intern x) + ;; TODO TYPED below + :cljs (let [parts (.split x "/")] + (if (== (alength parts) 2) + (cljs.core/Keyword. (aget parts 0) (aget parts 1) x nil) + (cljs.core/Keyword. nil (aget parts 0) x nil))))) + ([ns-str t/nil?, name-str dstr/string?] + #?(:clj (clojure.lang.Keyword/intern ns-str name-str) + :cljs (cljs.core/Keyword. ns-str name-str name-str nil))) + ([ns-str dstr/string?, name-str dstr/string?] + #?(:clj (clojure.lang.Keyword/intern ns-str name-str) + :cljs (cljs.core/Keyword. ns-str name-str (>str ns-str "/" name-str) nil)))) + +(t/defn >symbol + "Outputs a symbol (possibly qualified, meta-able identifier)." + > symbol? + ([x symbol?] x) + ([x dstr/string?] #?(:clj (clojure.lang.Symbol/intern x) + ;; TODO TYPED below + :cljs (let [i (.indexOf x "/")] + (if (< i 1) + (>symbol nil x) + (>symbol (.substring x 0 i) + (.substring x (inc i) (.-length x))))))) + ([x keyword?] (>symbol (>namespace x) (>name x))) + ([ns-str t/nil?, name-str dstr/string?] + #?(:clj (clojure.lang.Symbol/intern ns-str name-str) + :cljs (cljs.core/Symbol. ns-str name-str name-str nil nil))) + ([ns-str dstr/string?, name-str dstr/string?] + #?(:clj (clojure.lang.Symbol/intern ns-str name-str) + :cljs (cljs.core/Symbol. ns-str name-str (>str ns-str "/" name-str) nil nil))) + +;; TODO TYPED incorporate this into `>symbol` + (cond +#?@(:clj [(class? x) (-> x >name symbol) + (namespace? x) (ns-name x)]) + (fn? x) #?(:clj (or (when-let [ns- (-> x >meta :ns)] + (symbol (>name ns-) (-> x >meta :name >name))) + (-> x class .getName clojure.lang.Compiler/demunge recur)) + :cljs (when-not (-> x .-name str/blank?) + (-> x .-name demunge-str recur))) + :else (-> x str recur))) + +;; ===== UUIDs ===== ;; + +(def uuid? (t/isa?|direct #?(:clj java.util.UUID :cljs cljs.core/UUID))) + +(t/defn >uuid > uuid? + ([] + #?(:clj (java.util.UUID/randomUUID) + ;; TODO TYPED below + :cljs (letfn [(hex [] (.toString (rand-int 16) 16))] + (let [rhex (.toString (bit-or 0x8 (bit-and 0x3 (rand-int 16))) 16)] + (>uuid + (str (hex) (hex) (hex) (hex) + (hex) (hex) (hex) (hex) "-" + (hex) (hex) (hex) (hex) "-" + "4" (hex) (hex) (hex) "-" + rhex (hex) (hex) (hex) "-" + (hex) (hex) (hex) (hex) + (hex) (hex) (hex) (hex) + (hex) (hex) (hex) (hex))))))) + #?(:cljs ([x dstr/string?] (cljs.core/UUID. (.toLowerCase s) nil)))) + +;; ===== Delimited identifiers ===== ;; + +;; TODO TYPED `t/defrecord` +(defrecord + ^{:doc "A delimited identifier. + Defaults to delimiting all qualifiers by the pipe symbol instead of slashes or dots."} + DelimitedIdent [qualifiers #_(t/of (t/and dstr/string? (t/not (fn1 contains? \|))))] + fipp.ednize/IOverride + fipp.ednize/IEdn + (-edn [this] (tagged-literal '| (>symbol (??str/join "|" qualifiers))))) + +(def delim-ident? (t/isa? DelimitedIdent)) + +(t/defn >delim-ident + "Computes the delimited identifier of `x`." + ([x delim-ident?] x) + ([x dstr/string?] (-> x (??str/split #"\.|\||/") (DelimitedIdent.))) + ([x named?] (DelimitedIdent. + (??/concat (some-> (>namespace x) (??str/split #"\.|\||/")) + (-> x >name (??str/split #"\.|\||/"))))) +#?(:clj ([x ??/class?] (-> x >name >delim-ident))) + ([x t/val?] (-> x >str >delim-ident))) + +;; TODO TYPED incorporate into `>delim-ident` +(namespace? x) (-> x >name >delim-ident) +(var? x) (DelimitedIdent. + (concat (-> x >namespace (str/split #"\.|\||/")) + (-> x >name (str/split #"\.|\||/")))) +(fn? x) (DelimitedIdent. + #?(:clj (or (some-> (-> x >meta :name) >name (str/split #"\.|\||/")) + (-> x class .getName clojure.lang.Compiler/demunge (str/split #"\.|\||/"))) + :cljs (if (-> x .-name str/blank?) + [""] + (-> x .-name demunge-str (str/split #"\.|\||/"))))) diff --git a/src/quantum/core/data/map.cljc b/src/quantum/core/data/map.cljc index b851089b..37a2cde0 100644 --- a/src/quantum/core/data/map.cljc +++ b/src/quantum/core/data/map.cljc @@ -1,27 +1,1539 @@ -(ns - ^{:doc "Useful map functions. |map-entry|, a better merge, sorted-maps, etc." - :attribution "alexandergunnarson"} +(ns ^{:attribution "alexandergunnarson"} quantum.core.data.map + "Useful map functions. |map-entry|, a better merge, sorted-maps, etc." + {:todo #{"Explore the possibility of 64-bit `PersistentHashMap`s"}} (:refer-clojure :exclude - [split-at, merge, sorted-map sorted-map-by, array-map, hash-map]) + [split-at, map?, merge, sorted-map sorted-map-by]) (:require - [quantum.untyped.core.data.map :as u] - [quantum.untyped.core.vars - :refer [defaliases]])) + #?(:clj [clojure.data.int-map]) + ;; TODO TYPED + #_[quantum.core.reducers :as r + :refer [reduce-pair]] + [quantum.core.type :as t] + [quantum.untyped.core.data.map :as umap] + ;; TODO TYPED + [quantum.untyped.core.defnt + :refer [defns-]] + [quantum.untyped.core.type :as ut] + ;; TODO TYPED + [quantum.untyped.core.vars :as uvar + :refer [defalias def- defmacro-]]) + (:import +#?@(:clj [[java.util HashMap IdentityHashMap LinkedHashMap TreeMap] + [it.unimi.dsi.fastutil.ints Int2ReferenceOpenHashMap] + [it.unimi.dsi.fastutil.longs Long2LongOpenHashMap + Long2ReferenceOpenHashMap] + [it.unimi.dsi.fastutil.doubles Double2ReferenceOpenHashMap] + [it.unimi.dsi.fastutil.objects Reference2LongOpenHashMap]] + :cljs [[goog.structs AvlTree LinkedMap]]))) -(defaliases u - #?@(:clj [int-map hash-map:long->ref]) - array-map hash-map ordered-map om #?(:clj !ordered-map) #?(:clj kw-omap) +;; TODO make a wrapper fn/type for associative data structures such that it maintains a +;; bidirectional mapping/index between keys and values + +;; TO EXPLORE +;; - Optimizing Hash-Array Mapped Tries for Fast and Lean Immutable JVM Collections +;; - Actual usable implementation: https://github.com/usethesource/capsule +;; - http://michael.steindorfer.name/publications/oopsla15.pdf +;; - Overall significantly faster on what they've chosen to measure. +;; - Alex Miller: "We have seen it and will probably investigate some of these ideas after 1.8." +;; ======================= + +(def- basic-type-syms-for-maps '[boolean byte short char int long float double ref]) + +#?(:clj +(defns- >v-sym [prefix symbol?, kind symbol? > symbol?] + (symbol (str prefix "|" kind "?")))) + +#?(:clj +(defns- >kv-sym [prefix symbol?, from-type symbol?, to-type symbol? > symbol?] + (symbol (str prefix "|" from-type "->" to-type "?")))) + +#?(:clj +(defmacro- def-preds|map|same-types [prefix #_symbol?] + `(do ~@(for [kind (conj basic-type-syms-for-maps 'any)] + (list 'def (>v-sym prefix kind) (>kv-sym prefix kind kind)))))) + +#?(:clj +(defmacro- def-preds|map|any [prefix #_symbol?] + (let [anys (->> (for [kind basic-type-syms-for-maps] + [(list 'def (>kv-sym prefix kind 'any) + (->> basic-type-syms-for-maps + (map #(>kv-sym prefix kind %)) + (list* `t/or))) + (list 'def (>kv-sym prefix 'any kind) + (->> basic-type-syms-for-maps + (map #(>kv-sym prefix % kind)) + (list* `t/or)))]) + (apply concat)) + any->any (list 'def (>kv-sym prefix 'any 'any) + (->> basic-type-syms-for-maps + (map #(vector (>kv-sym prefix 'any %) (>kv-sym prefix % 'any))) + (apply concat) + (list* `t/or)))] + `(do ~@(concat anys [any->any]))))) + +;; ===== Map entries ===== ;; + +(def +map-entry? (t/isa? #?(:clj clojure.lang.MapEntry :cljs cljs.core.MapEntry))) + +(t/defn ^:inline >map-entry + "A performant replacement for creating 2-tuples (vectors), e.g., as return values + in a `kv-reduce` function. + + Now overshadowed by ztellman's unrolled vectors in 1.8.0. + + Time to create 100000000 2-tuples: + new tuple-vector 55.816415 ms + map-entry 37.542442 ms + + However, insertion into maps is faster with map-entry: + + (def vs [[1 2] [3 4]]) + (def ms [(>map-entry 1 2) (>map-entry 3 4)]) + (def m0 {}) + 508.122831 ms (dotimes [n 1000000] (into m0 vs)) + 310.335998 ms (dotimes [n 1000000] (into m0 ms))" + {:attribution "alexandergunnarson"} + > +map-entry? + [k t/ref?, v t/ref?] + #?(:clj (clojure.lang.MapEntry. k v) + :cljs (cljs.core.MapEntry. k v nil))) + +;; ===== Unordered identity-semantic (identity-based equality) maps ===== ;; + + (def !identity-map|ref->ref? + #?(:clj (t/isa? java.util.IdentityHashMap) :cljs (t/isa? js/Map))) + + (def !identity-map? !identity-map|ref->ref?) + +#?(:clj (def !!identity-map? t/none?)) + + (def identity-map? (t/or !identity-map? #?(:clj !!identity-map?))) + +;; TODO generate this via macro? +(t/defn >!identity-map + "Creates a single-threaded, mutable identity map. + On the JVM, this is a `java.util.IdentityHashMap`. + On JS, this is a `js/Map` (ECMAScript 6 Map)." + > !identity-map? + ([] #?(:clj (IdentityHashMap.) :cljs (js/Map.))) + ([k0 t/ref?, v0 t/ref?] + (doto #?(:clj (IdentityHashMap.) :cljs (js/Map.)) + (#?(:clj .put :cljs .set) k0 v0))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?] + (doto #?(:clj (IdentityHashMap.) :cljs (js/Map.)) + (#?(:clj .put :cljs .set) k0 v0) + (#?(:clj .put :cljs .set) k1 v1))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?] + (doto #?(:clj (IdentityHashMap.) :cljs (js/Map.)) + (#?(:clj .put :cljs .set) k0 v0) + (#?(:clj .put :cljs .set) k1 v1) + (#?(:clj .put :cljs .set) k2 v2))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref?] + (doto #?(:clj (IdentityHashMap.) :cljs (js/Map.)) + (#?(:clj .put :cljs .set) k0 v0) + (#?(:clj .put :cljs .set) k1 v1) + (#?(:clj .put :cljs .set) k2 v2) + (#?(:clj .put :cljs .set) k3 v3))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?] + (doto #?(:clj (IdentityHashMap.) :cljs (js/Map.)) + (#?(:clj .put :cljs .set) k0 v0) + (#?(:clj .put :cljs .set) k1 v1) + (#?(:clj .put :cljs .set) k2 v2) + (#?(:clj .put :cljs .set) k3 v3) + (#?(:clj .put :cljs .set) k4 v4))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?, k5 t/ref?, v5 t/ref?] + (doto #?(:clj (IdentityHashMap.) :cljs (js/Map.)) + (#?(:clj .put :cljs .set) k0 v0) + (#?(:clj .put :cljs .set) k1 v1) + (#?(:clj .put :cljs .set) k2 v2) + (#?(:clj .put :cljs .set) k3 v3) + (#?(:clj .put :cljs .set) k4 v4) + (#?(:clj .put :cljs .set) k5 v5))) + ;; TODO TYPED handle varargs +#_([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?, k5 t/ref?, v5 t/ref?, k6 t/ref?, v6 t/ref? & kvs _] + (reduce-pair + (fn [#?(:clj ^IdentityHashMap m :cljs m) k v] (doto m (#?(:clj .put :cljs .set) k v))) + (doto #?(:clj (IdentityHashMap.) :cljs (js/Map.)) + (#?(:clj .put :cljs .set) k0 v0) + (#?(:clj .put :cljs .set) k1 v1) + (#?(:clj .put :cljs .set) k2 v2) + (#?(:clj .put :cljs .set) k3 v3) + (#?(:clj .put :cljs .set) k4 v4) + (#?(:clj .put :cljs .set) k5 v5) + (#?(:clj .put :cljs .set) k6 v6)) + kvs))) + +;; ===== Unordered value-semantic (value-based equality) maps ===== ;; + +;; ----- Array maps ----- ;; + +(def +array-map? (t/isa? #?(:clj clojure.lang.PersistentArrayMap + :cljs cljs.core/PersistentArrayMap))) + +(def !+array-map? (t/isa? #?(:clj clojure.lang.PersistentArrayMap$TransientArrayMap + :cljs cljs.core/TransientArrayMap))) + +(def ?!+array-map? (t/or !+array-map? +array-map?)) + +(def !array-map|boolean->boolean? t/none?) +(def !array-map|boolean->byte? t/none?) +(def !array-map|boolean->short? t/none?) +(def !array-map|boolean->char? t/none?) +(def !array-map|boolean->int? t/none?) +(def !array-map|boolean->long? t/none?) +(def !array-map|boolean->float? t/none?) +(def !array-map|boolean->double? t/none?) +(def !array-map|boolean->ref? t/none?) + +(def !array-map|byte->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2BooleanArrayMap) :cljs t/none?)) +(def !array-map|byte->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ByteArrayMap) :cljs t/none?)) +(def !array-map|byte->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ShortArrayMap) :cljs t/none?)) +(def !array-map|byte->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2CharArrayMap) :cljs t/none?)) +(def !array-map|byte->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2IntArrayMap) :cljs t/none?)) +(def !array-map|byte->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2LongArrayMap) :cljs t/none?)) +(def !array-map|byte->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2FloatArrayMap) :cljs t/none?)) +(def !array-map|byte->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2DoubleArrayMap) :cljs t/none?)) +(def !array-map|byte->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ReferenceArrayMap) :cljs t/none?)) + +(def !array-map|short->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2BooleanArrayMap) :cljs t/none?)) +(def !array-map|short->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2ByteArrayMap) :cljs t/none?)) +(def !array-map|short->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2ShortArrayMap) :cljs t/none?)) +(def !array-map|short->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2CharArrayMap) :cljs t/none?)) +(def !array-map|short->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2IntArrayMap) :cljs t/none?)) +(def !array-map|short->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2LongArrayMap) :cljs t/none?)) +(def !array-map|short->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2FloatArrayMap) :cljs t/none?)) +(def !array-map|short->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2DoubleArrayMap) :cljs t/none?)) +(def !array-map|short->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2ReferenceArrayMap) :cljs t/none?)) + +(def !array-map|char->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2ReferenceArrayMap) :cljs t/none?)) +(def !array-map|char->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2BooleanArrayMap) :cljs t/none?)) +(def !array-map|char->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2ByteArrayMap) :cljs t/none?)) +(def !array-map|char->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2ShortArrayMap) :cljs t/none?)) +(def !array-map|char->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2CharArrayMap) :cljs t/none?)) +(def !array-map|char->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2IntArrayMap) :cljs t/none?)) +(def !array-map|char->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2LongArrayMap) :cljs t/none?)) +(def !array-map|char->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2FloatArrayMap) :cljs t/none?)) +(def !array-map|char->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2DoubleArrayMap) :cljs t/none?)) + +(def !array-map|int->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2BooleanArrayMap) :cljs t/none?)) +(def !array-map|int->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2ByteArrayMap) :cljs t/none?)) +(def !array-map|int->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2ShortArrayMap) :cljs t/none?)) +(def !array-map|int->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2CharArrayMap) :cljs t/none?)) +(def !array-map|int->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2IntArrayMap) :cljs t/none?)) +(def !array-map|int->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2LongArrayMap) :cljs t/none?)) +(def !array-map|int->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2FloatArrayMap) :cljs t/none?)) +(def !array-map|int->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2DoubleArrayMap) :cljs t/none?)) +(def !array-map|int->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2ReferenceArrayMap) :cljs t/none?)) + +(def !array-map|long->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2BooleanArrayMap) :cljs t/none?)) +(def !array-map|long->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2ByteArrayMap) :cljs t/none?)) +(def !array-map|long->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2ShortArrayMap) :cljs t/none?)) +(def !array-map|long->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2CharArrayMap) :cljs t/none?)) +(def !array-map|long->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2IntArrayMap) :cljs t/none?)) +(def !array-map|long->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2LongArrayMap) :cljs t/none?)) +(def !array-map|long->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2FloatArrayMap) :cljs t/none?)) +(def !array-map|long->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2DoubleArrayMap) :cljs t/none?)) +(def !array-map|long->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2ReferenceArrayMap) :cljs t/none?)) + +(def !array-map|float->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2BooleanArrayMap) :cljs t/none?)) +(def !array-map|float->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2ByteArrayMap) :cljs t/none?)) +(def !array-map|float->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2ShortArrayMap) :cljs t/none?)) +(def !array-map|float->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2CharArrayMap) :cljs t/none?)) +(def !array-map|float->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2IntArrayMap) :cljs t/none?)) +(def !array-map|float->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2LongArrayMap) :cljs t/none?)) +(def !array-map|float->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2FloatArrayMap) :cljs t/none?)) +(def !array-map|float->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2DoubleArrayMap) :cljs t/none?)) +(def !array-map|float->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2ReferenceArrayMap) :cljs t/none?)) + +(def !array-map|double->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2BooleanArrayMap) :cljs t/none?)) +(def !array-map|double->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2ByteArrayMap) :cljs t/none?)) +(def !array-map|double->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2ShortArrayMap) :cljs t/none?)) +(def !array-map|double->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2CharArrayMap) :cljs t/none?)) +(def !array-map|double->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2IntArrayMap) :cljs t/none?)) +(def !array-map|double->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2LongArrayMap) :cljs t/none?)) +(def !array-map|double->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2FloatArrayMap) :cljs t/none?)) +(def !array-map|double->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2DoubleArrayMap) :cljs t/none?)) +(def !array-map|double->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2ReferenceArrayMap) :cljs t/none?)) + +(def !array-map|ref->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2BooleanArrayMap) :cljs t/none?)) +(def !array-map|ref->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2ByteArrayMap) :cljs t/none?)) +(def !array-map|ref->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2ShortArrayMap) :cljs t/none?)) +(def !array-map|ref->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2CharArrayMap) :cljs t/none?)) +(def !array-map|ref->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2IntArrayMap) :cljs t/none?)) +(def !array-map|ref->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2LongArrayMap) :cljs t/none?)) +(def !array-map|ref->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2FloatArrayMap) :cljs t/none?)) +(def !array-map|ref->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2DoubleArrayMap) :cljs t/none?)) +(def !array-map|ref->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2ReferenceArrayMap) :cljs t/none?)) + + (def-preds|map|any !array-map) + + (def-preds|map|same-types !array-map) + + (def !array-map? !array-map|any?) + +#?(:clj (def !!array-map? t/none?)) + + (def array-map? (t/or ?!+array-map? !array-map? #?(:clj !!array-map?))) + +(t/defn >array-map + "Creates a persistent array map. If any keys are equal, they are handled as if by repeated + applications of `assoc`." + > +array-map? + ([] ^:val (. clojure.lang.PersistentArrayMap EMPTY)) + ;; TODO TYPED handle varargs +#_([& kvs] + (clojure.lang.PersistentArrayMap/createAsIfByAssoc (to-array kvs)))) + +;; ----- Hash maps ----- ;; + +(def +hash-map? (t/isa? #?(:clj clojure.lang.PersistentHashMap + :cljs cljs.core/PersistentHashMap))) + +(def !+hash-map? (t/isa? #?(:clj clojure.lang.PersistentHashMap$TransientHashMap + :cljs cljs.core/TransientHashMap))) + +(def ?!+hash-map? (t/or !+hash-map? +hash-map?)) + +(t/defn >hash-map + "Creates a persistent hash map. If any keys are equal, they are handled as if by repeated + applications of `assoc`. + + `(->> pairs (apply concat) (apply >hash-map))` <~> `lodash/fromPairs`" + > +hash-map? + ([] ^:val (. clojure.lang.PersistentHashMap EMPTY)) + ;; TODO TYPED handle varargs +#_([& kvs] + (clojure.lang.PersistentHashMap/create kvs))) + +(def !hash-map|boolean->boolean? t/none?) +(def !hash-map|boolean->byte? t/none?) +(def !hash-map|boolean->short? t/none?) +(def !hash-map|boolean->char? t/none?) +(def !hash-map|boolean->int? t/none?) +(def !hash-map|boolean->long? t/none?) +(def !hash-map|boolean->float? t/none?) +(def !hash-map|boolean->double? t/none?) +(def !hash-map|boolean->ref? t/none?) + +(def !hash-map|byte->boolean? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.bytes.Byte2BooleanOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.bytes.Byte2BooleanOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|byte->byte? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ByteOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ByteOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|byte->short? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ShortOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ShortOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|byte->char? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.bytes.Byte2CharOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.bytes.Byte2CharOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|byte->int? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.bytes.Byte2IntOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.bytes.Byte2IntOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|byte->long? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.bytes.Byte2LongOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.bytes.Byte2LongOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|byte->float? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.bytes.Byte2FloatOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.bytes.Byte2FloatOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|byte->double? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.bytes.Byte2DoubleOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.bytes.Byte2DoubleOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|byte->ref? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ReferenceOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ReferenceOpenCustomHashMap)) + :cljs t/none?)) + +(def !hash-map|short->boolean? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.shorts.Short2BooleanOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.shorts.Short2BooleanOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|short->byte? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.shorts.Short2ByteOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.shorts.Short2ByteOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|short->short? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.shorts.Short2ShortOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.shorts.Short2ShortOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|short->char? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.shorts.Short2CharOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.shorts.Short2CharOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|short->int? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.shorts.Short2IntOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.shorts.Short2IntOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|short->long? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.shorts.Short2LongOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.shorts.Short2LongOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|short->float? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.shorts.Short2FloatOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.shorts.Short2FloatOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|short->double? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.shorts.Short2DoubleOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.shorts.Short2DoubleOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|short->ref? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.shorts.Short2ReferenceOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.shorts.Short2ReferenceOpenCustomHashMap)) + :cljs t/none?)) + +(def !hash-map|char->ref? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.chars.Char2ReferenceOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.chars.Char2ReferenceOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|char->boolean? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.chars.Char2BooleanOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.chars.Char2BooleanOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|char->byte? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.chars.Char2ByteOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.chars.Char2ByteOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|char->short? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.chars.Char2ShortOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.chars.Char2ShortOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|char->char? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.chars.Char2CharOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.chars.Char2CharOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|char->int? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.chars.Char2IntOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.chars.Char2IntOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|char->long? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.chars.Char2LongOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.chars.Char2LongOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|char->float? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.chars.Char2FloatOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.chars.Char2FloatOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|char->double? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.chars.Char2DoubleOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.chars.Char2DoubleOpenCustomHashMap)) + :cljs t/none?)) + +(def !hash-map|int->boolean? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.ints.Int2BooleanOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.ints.Int2BooleanOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|int->byte? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.ints.Int2ByteOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.ints.Int2ByteOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|int->short? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.ints.Int2ShortOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.ints.Int2ShortOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|int->char? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.ints.Int2CharOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.ints.Int2CharOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|int->int? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.ints.Int2IntOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.ints.Int2IntOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|int->long? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.ints.Int2LongOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.ints.Int2LongOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|int->float? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.ints.Int2FloatOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.ints.Int2FloatOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|int->double? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.ints.Int2DoubleOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.ints.Int2DoubleOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|int->ref? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.ints.Int2ReferenceOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.ints.Int2ReferenceOpenCustomHashMap)) + :cljs t/none?)) + +(def !hash-map|long->boolean? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.longs.Long2BooleanOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.longs.Long2BooleanOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|long->byte? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.longs.Long2ByteOpenCustomHashMap) + (t/isa? it.unimi.dsi.fastutil.longs.Long2ByteOpenHashMap)) + :cljs t/none?)) +(def !hash-map|long->short? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.longs.Long2ShortOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.longs.Long2ShortOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|long->char? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.longs.Long2CharOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.longs.Long2CharOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|long->int? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.longs.Long2IntOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.longs.Long2IntOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|long->long? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.longs.Long2LongOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.longs.Long2LongOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|long->float? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.longs.Long2FloatOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.longs.Long2FloatOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|long->double? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.longs.Long2DoubleOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.longs.Long2DoubleOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|long->ref? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.longs.Long2ReferenceOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.longs.Long2ReferenceOpenCustomHashMap)) + :cljs t/none?)) + +(def !hash-map|float->boolean? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.floats.Float2BooleanOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.floats.Float2BooleanOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|float->byte? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.floats.Float2ByteOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.floats.Float2ByteOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|float->short? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.floats.Float2ShortOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.floats.Float2ShortOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|float->char? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.floats.Float2CharOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.floats.Float2CharOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|float->int? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.floats.Float2IntOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.floats.Float2IntOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|float->long? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.floats.Float2LongOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.floats.Float2LongOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|float->float? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.floats.Float2FloatOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.floats.Float2FloatOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|float->double? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.floats.Float2DoubleOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.floats.Float2DoubleOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|float->ref? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.floats.Float2ReferenceOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.floats.Float2ReferenceOpenCustomHashMap)) + :cljs t/none?)) + +(def !hash-map|double->boolean? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.doubles.Double2BooleanOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.doubles.Double2BooleanOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|double->byte? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.doubles.Double2ByteOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.doubles.Double2ByteOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|double->short? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.doubles.Double2ShortOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.doubles.Double2ShortOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|double->char? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.doubles.Double2CharOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.doubles.Double2CharOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|double->int? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.doubles.Double2IntOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.doubles.Double2IntOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|double->long? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.doubles.Double2LongOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.doubles.Double2LongOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|double->float? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.doubles.Double2FloatOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.doubles.Double2FloatOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|double->double? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.doubles.Double2DoubleOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.doubles.Double2DoubleOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|double->ref? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.doubles.Double2ReferenceOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.doubles.Double2ReferenceOpenCustomHashMap)) + :cljs t/none?)) + +(def !hash-map|ref->boolean? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.objects.Reference2BooleanOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2BooleanOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|ref->byte? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.objects.Reference2ByteOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2ByteOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|ref->short? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.objects.Reference2ShortOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2ShortOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|ref->char? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.objects.Reference2CharOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2CharOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|ref->int? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.objects.Reference2IntOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2IntOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|ref->long? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.objects.Reference2LongOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2LongOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|ref->float? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.objects.Reference2FloatOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2FloatOpenCustomHashMap)) + :cljs t/none?)) +(def !hash-map|ref->double? + #?(:clj (t/or (t/isa? it.unimi.dsi.fastutil.objects.Reference2DoubleOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2DoubleOpenCustomHashMap)) + :cljs t/none?)) + +(def !hash-map|ref->ref? + (t/or #?@(:clj [(t/isa? java.util.HashMap) + ;; Because this has different semantics + #_(t/isa? java.util.IdentityHashMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2ReferenceOpenHashMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2ReferenceOpenCustomHashMap)] + :cljs [umap/MutableHashMap]))) + +(def-preds|map|any !hash-map) + +(def-preds|map|same-types !hash-map) + + (def !hash-map? !hash-map|any?) + +#?(:clj (def !!hash-map? (t/isa? java.util.concurrent.ConcurrentHashMap))) + (def hash-map? (t/or ?!+hash-map? !hash-map? #?(:clj !!hash-map?))) + +;; TODO generate this function via macro? +(t/defn >!hash-map + "Creates a single-threaded, mutable hash map. + On the JVM, this is a `java.util.HashMap`. + On JS, this is a `quantum.untyped.core.data.map.HashMap`." + > !hash-map? + ([] #?(:clj (HashMap.) :cljs (umap/MutableHashMap. nil 0 (js/Map.) false nil nil))) + ([k0 t/ref?, v0 t/ref?] + (doto #?(:clj (HashMap.) :cljs (>!hash-map)) + (#?(:clj .put :cljs assoc!) k0 v0))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?] + (doto #?(:clj (HashMap.) :cljs (>!hash-map)) + (#?(:clj .put :cljs assoc!) k0 v0) + (#?(:clj .put :cljs assoc!) k1 v1))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?] + (doto #?(:clj (HashMap.) :cljs (>!hash-map)) + (#?(:clj .put :cljs assoc!) k0 v0) + (#?(:clj .put :cljs assoc!) k1 v1) + (#?(:clj .put :cljs assoc!) k2 v2))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref?] + (doto #?(:clj (HashMap.) :cljs (>!hash-map)) + (#?(:clj .put :cljs assoc!) k0 v0) + (#?(:clj .put :cljs assoc!) k1 v1) + (#?(:clj .put :cljs assoc!) k2 v2) + (#?(:clj .put :cljs assoc!) k3 v3))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?] + (doto #?(:clj (HashMap.) :cljs (>!hash-map)) + (#?(:clj .put :cljs assoc!) k0 v0) + (#?(:clj .put :cljs assoc!) k1 v1) + (#?(:clj .put :cljs assoc!) k2 v2) + (#?(:clj .put :cljs assoc!) k3 v3) + (#?(:clj .put :cljs assoc!) k4 v4))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?, k5 t/ref?, v5 t/ref?] + (doto #?(:clj (HashMap.) :cljs (>!hash-map)) + (#?(:clj .put :cljs assoc!) k0 v0) + (#?(:clj .put :cljs assoc!) k1 v1) + (#?(:clj .put :cljs assoc!) k2 v2) + (#?(:clj .put :cljs assoc!) k3 v3) + (#?(:clj .put :cljs assoc!) k4 v4) + (#?(:clj .put :cljs assoc!) k5 v5))) + ;; TODO TYPED variadic support +#_([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?, k5 t/ref?, v5 t/ref?, k6 t/ref?, v6 t/ref?, & kvs] + (reduce-pair + (fn [^HashMap m k v] (doto m (#?(:clj .put :cljs assoc!) k v))) + (doto #?(:clj (HashMap.) :cljs (>!hash-map)) + (#?(:clj .put :cljs assoc!) k0 v0) + (#?(:clj .put :cljs assoc!) k1 v1) + (#?(:clj .put :cljs assoc!) k2 v2) + (#?(:clj .put :cljs assoc!) k3 v3) + (#?(:clj .put :cljs assoc!) k4 v4) + (#?(:clj .put :cljs assoc!) k5 v5) + (#?(:clj .put :cljs assoc!) k6 v6)) + kvs))) + +;; TODO generate these functions via macros +;; TODO this is incomplete +#?(:clj (t/defn >!hash-map|int->ref > !hash-map|int->ref? [] (Int2ReferenceOpenHashMap.))) +#?(:clj (t/defn >!hash-map|long->long > !hash-map|long->long? [] (Long2LongOpenHashMap.))) +#?(:clj (t/defn >!hash-map|long->ref > !hash-map|long->ref? [] (Long2ReferenceOpenHashMap.))) +#?(:clj (t/defn >!hash-map|double->ref > !hash-map|double->ref? [] (Double2ReferenceOpenHashMap.))) +#?(:clj (t/defn >!hash-map|ref->long > !hash-map|ref->long? [] (Reference2LongOpenHashMap.))) + +;; ----- Unsorted Maps ----- ;; TODO Perhaps the concept of unsortedness is `(- map sorted?)`? + +#?(:clj (def +unsorted-map|long->ref? (t/isa? clojure.data.int_map.PersistentIntMap))) + + (def +unsorted-map? (t/or +hash-map? +array-map? +unsorted-map|long->ref?)) + (def !+unsorted-map? (t/or !+hash-map? !+array-map?)) + (def ?!+unsorted-map? (t/or ?!+hash-map? ?!+array-map?)) + +(def !unsorted-map|boolean->boolean? + (t/or !hash-map|boolean->boolean? !array-map|boolean->boolean?)) +(def !unsorted-map|boolean->byte? + (t/or !hash-map|boolean->byte? !array-map|boolean->byte?)) +(def !unsorted-map|boolean->short? + (t/or !hash-map|boolean->short? !array-map|boolean->short?)) +(def !unsorted-map|boolean->char? + (t/or !hash-map|boolean->char? !array-map|boolean->char?)) +(def !unsorted-map|boolean->int? + (t/or !hash-map|boolean->int? !array-map|boolean->int?)) +(def !unsorted-map|boolean->long? + (t/or !hash-map|boolean->long? !array-map|boolean->long?)) +(def !unsorted-map|boolean->float? + (t/or !hash-map|boolean->float? !array-map|boolean->float?)) +(def !unsorted-map|boolean->double? + (t/or !hash-map|boolean->double? !array-map|boolean->double?)) +(def !unsorted-map|boolean->ref? + (t/or !hash-map|boolean->ref? !array-map|boolean->ref?)) + +(def !unsorted-map|byte->boolean? + (t/or !hash-map|byte->boolean? !array-map|byte->boolean?)) +(def !unsorted-map|byte->byte? + (t/or !hash-map|byte->byte? !array-map|byte->byte?)) +(def !unsorted-map|byte->short? + (t/or !hash-map|byte->short? !array-map|byte->short?)) +(def !unsorted-map|byte->char? + (t/or !hash-map|byte->char? !array-map|byte->char?)) +(def !unsorted-map|byte->int? + (t/or !hash-map|byte->int? !array-map|byte->int?)) +(def !unsorted-map|byte->long? + (t/or !hash-map|byte->long? !array-map|byte->long?)) +(def !unsorted-map|byte->float? + (t/or !hash-map|byte->float? !array-map|byte->float?)) +(def !unsorted-map|byte->double? + (t/or !hash-map|byte->double? !array-map|byte->double?)) +(def !unsorted-map|byte->ref? + (t/or !hash-map|byte->ref? !array-map|byte->ref?)) + +(def !unsorted-map|short->boolean? + (t/or !hash-map|short->boolean? !array-map|short->boolean?)) +(def !unsorted-map|short->byte? + (t/or !hash-map|short->byte? !array-map|short->byte?)) +(def !unsorted-map|short->short? + (t/or !hash-map|short->short? !array-map|short->short?)) +(def !unsorted-map|short->char? + (t/or !hash-map|short->char? !array-map|short->char?)) +(def !unsorted-map|short->int? + (t/or !hash-map|short->int? !array-map|short->int?)) +(def !unsorted-map|short->long? + (t/or !hash-map|short->long? !array-map|short->long?)) +(def !unsorted-map|short->float? + (t/or !hash-map|short->float? !array-map|short->float?)) +(def !unsorted-map|short->double? + (t/or !hash-map|short->double? !array-map|short->double?)) +(def !unsorted-map|short->ref? + (t/or !hash-map|short->ref? !array-map|short->ref?)) + +(def !unsorted-map|char->boolean? + (t/or !hash-map|char->boolean? !array-map|char->boolean?)) +(def !unsorted-map|char->byte? + (t/or !hash-map|char->byte? !array-map|char->byte?)) +(def !unsorted-map|char->short? + (t/or !hash-map|char->short? !array-map|char->short?)) +(def !unsorted-map|char->char? + (t/or !hash-map|char->char? !array-map|char->char?)) +(def !unsorted-map|char->int? + (t/or !hash-map|char->int? !array-map|char->int?)) +(def !unsorted-map|char->long? + (t/or !hash-map|char->long? !array-map|char->long?)) +(def !unsorted-map|char->float? + (t/or !hash-map|char->float? !array-map|char->float?)) +(def !unsorted-map|char->double? + (t/or !hash-map|char->double? !array-map|char->double?)) +(def !unsorted-map|char->ref? + (t/or !hash-map|char->ref? !array-map|char->ref?)) + +(def !unsorted-map|int->boolean? + (t/or !hash-map|int->boolean? !array-map|int->boolean?)) +(def !unsorted-map|int->byte? + (t/or !hash-map|int->byte? !array-map|int->byte?)) +(def !unsorted-map|int->short? + (t/or !hash-map|int->short? !array-map|int->short?)) +(def !unsorted-map|int->char? + (t/or !hash-map|int->char? !array-map|int->char?)) +(def !unsorted-map|int->int? + (t/or !hash-map|int->int? !array-map|int->int?)) +(def !unsorted-map|int->long? + (t/or !hash-map|int->long? !array-map|int->long?)) +(def !unsorted-map|int->float? + (t/or !hash-map|int->float? !array-map|int->float?)) +(def !unsorted-map|int->double? + (t/or !hash-map|int->double? !array-map|int->double?)) +(def !unsorted-map|int->ref? + (t/or !hash-map|int->ref? !array-map|int->ref?)) + +(def !unsorted-map|long->boolean? + (t/or !hash-map|long->boolean? !array-map|long->boolean?)) +(def !unsorted-map|long->byte? + (t/or !hash-map|long->byte? !array-map|long->byte?)) +(def !unsorted-map|long->short? + (t/or !hash-map|long->short? !array-map|long->short?)) +(def !unsorted-map|long->char? + (t/or !hash-map|long->char? !array-map|long->char?)) +(def !unsorted-map|long->int? + (t/or !hash-map|long->int? !array-map|long->int?)) +(def !unsorted-map|long->long? + (t/or !hash-map|long->long? !array-map|long->long?)) +(def !unsorted-map|long->float? + (t/or !hash-map|long->float? !array-map|long->float?)) +(def !unsorted-map|long->double? + (t/or !hash-map|long->double? !array-map|long->double?)) +(def !unsorted-map|long->ref? + (t/or !hash-map|long->ref? !array-map|long->ref?)) + +(def !unsorted-map|float->boolean? + (t/or !hash-map|float->boolean? !array-map|float->boolean?)) +(def !unsorted-map|float->byte? + (t/or !hash-map|float->byte? !array-map|float->byte?)) +(def !unsorted-map|float->short? + (t/or !hash-map|float->short? !array-map|float->short?)) +(def !unsorted-map|float->char? + (t/or !hash-map|float->char? !array-map|float->char?)) +(def !unsorted-map|float->int? + (t/or !hash-map|float->int? !array-map|float->int?)) +(def !unsorted-map|float->long? + (t/or !hash-map|float->long? !array-map|float->long?)) +(def !unsorted-map|float->float? + (t/or !hash-map|float->float? !array-map|float->float?)) +(def !unsorted-map|float->double? + (t/or !hash-map|float->double? !array-map|float->double?)) +(def !unsorted-map|float->ref? + (t/or !hash-map|float->ref? !array-map|float->ref?)) + +(def !unsorted-map|double->boolean? + (t/or !hash-map|double->boolean? !array-map|double->boolean?)) +(def !unsorted-map|double->byte? + (t/or !hash-map|double->byte? !array-map|double->byte?)) +(def !unsorted-map|double->short? + (t/or !hash-map|double->short? !array-map|double->short?)) +(def !unsorted-map|double->char? + (t/or !hash-map|double->char? !array-map|double->char?)) +(def !unsorted-map|double->int? + (t/or !hash-map|double->int? !array-map|double->int?)) +(def !unsorted-map|double->long? + (t/or !hash-map|double->long? !array-map|double->long?)) +(def !unsorted-map|double->float? + (t/or !hash-map|double->float? !array-map|double->float?)) +(def !unsorted-map|double->double? + (t/or !hash-map|double->double? !array-map|double->double?)) +(def !unsorted-map|double->ref? + (t/or !hash-map|double->ref? !array-map|double->ref?)) + +(def !unsorted-map|ref->boolean? + (t/or !hash-map|ref->boolean? !array-map|ref->boolean?)) +(def !unsorted-map|ref->byte? + (t/or !hash-map|ref->byte? !array-map|ref->byte?)) +(def !unsorted-map|ref->short? + (t/or !hash-map|ref->short? !array-map|ref->short?)) +(def !unsorted-map|ref->char? + (t/or !hash-map|ref->char? !array-map|ref->char?)) +(def !unsorted-map|ref->int? + (t/or !hash-map|ref->int? !array-map|ref->int?)) +(def !unsorted-map|ref->long? + (t/or !hash-map|ref->long? !array-map|ref->long?)) +(def !unsorted-map|ref->float? + (t/or !hash-map|ref->float? !array-map|ref->float?)) +(def !unsorted-map|ref->double? + (t/or !hash-map|ref->double? !array-map|ref->double?)) +(def !unsorted-map|ref->ref? + (t/or !identity-map|ref->ref? !hash-map|ref->ref? !array-map|ref->ref?)) + + (def-preds|map|any !unsorted-map) + + (def-preds|map|same-types !unsorted-map) + + (def !unsorted-map? !unsorted-map|any?) + +#?(:clj (def !!unsorted-map? (t/or !!hash-map? !!array-map?))) + (def unsorted-map? (t/or ?!+unsorted-map? !unsorted-map? #?(:clj !!unsorted-map?))) + +#?(:clj +(t/defn >unsorted-map|long->ref + "Creates a persistent integer map that can only have non-negative integers as keys." + > +unsorted-map|long->ref? + ([] (clojure.data.int_map.PersistentIntMap. clojure.data.int_map.Nodes$Empty/EMPTY 0 nil)) + ;; TODO TYPED handle varargs + ;; TODO TYPED `assoc`, `t/nneg-int?` +#_([k t/nneg-int? v t/ref?] (assoc (>unsorted-map|long->ref) k v)) + ;; TODO TYPED handle calling other typed fns +#_([kv & kvs] (apply assoc (>hash-map|long->ref) k v kvs)))) + +#?(:clj (defalias >map|long->ref >unsorted-map|long->ref)) + +;; ===== Ordered value-semantic maps ===== ;; + +;; ----- Insertion-ordered ----- ;; + + (def +insertion-ordered-map? (t/or (t/isa? linked.map.LinkedMap) + ;; This is true, but we have replaced OrderedMap + ;; with LinkedMap + #_(:clj (t/isa? flatland.ordered.map.OrderedMap)))) + + (def !+insertion-ordered-map? t/none? + ;; This is true, but we have replaced OrderedMap with + ;; LinkedMap + #_(t/isa? flatland.ordered.map.TransientOrderedMap)) + + (def ?!+insertion-ordered-map? (t/or +insertion-ordered-map? !+insertion-ordered-map?)) + + (def !insertion-ordered-map? (t/isa? #?(:clj java.util.LinkedHashMap :cljs LinkedMap))) + + ;; See https://github.com/ben-manes/concurrentlinkedhashmap (and links therefrom) for good implementation +#?(:clj (def !!insertion-ordered-map? t/none?)) + + (def insertion-ordered-map? (t/or ?!+insertion-ordered-map? + !insertion-ordered-map? + #?(:clj !!insertion-ordered-map?))) + +;; TODO generate this function via macro +(t/defn >!insertion-ordered-map + "Creates a single-threaded, mutable insertion-ordered map. + On the JVM, this is a `java.util.LinkedHashMap`. + On JS, this is a `goog.structs.LinkedMap`." + > !insertion-ordered-map? + ([] #?(:clj (LinkedHashMap.) :cljs (LinkedMap.))) + ([k0 t/ref?, v0 t/ref?] + (doto #?(:clj (LinkedHashMap.) :cljs (LinkedMap.)) + (#?(:clj .put :cljs .add) k0 v0))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?] + (doto #?(:clj (LinkedHashMap.) :cljs (LinkedMap.)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?] + (doto #?(:clj (LinkedHashMap.) :cljs (LinkedMap.)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1) + (#?(:clj .put :cljs .add) k2 v2))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref?] + (doto #?(:clj (LinkedHashMap.) :cljs (LinkedMap.)) + (#?(:clj .put :cl .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1) + (#?(:clj .put :cljs .add) k2 v2) + (#?(:clj .put :cljs .add) k3 v3))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?] + (doto #?(:clj (LinkedHashMap.) :cljs (LinkedMap.)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1) + (#?(:clj .put :cljs .add) k2 v2) + (#?(:clj .put :cljs .add) k3 v3) + (#?(:clj .put :cljs .add) k4 v4))) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?, k5 t/ref?, v5 t/ref?] + (doto #?(:clj (LinkedHashMap.) :cljs (LinkedMap.)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1) + (#?(:clj .put :cljs .add) k2 v2) + (#?(:clj .put :cljs .add) k3 v3) + (#?(:clj .put :cljs .add) k4 v4) + (#?(:clj .put :cljs .add) k5 v5))) + ;; TODO TYPED `reduce-pair` and variadic + #_([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?, k5 t/ref?, v5 t/ref?, k6 t/ref?, v6 & kvs] + (reduce-pair + (fn [#?(:clj ^LinkedHashMap m :cljs m) k v] (doto m (#?(:clj .put :cljs .add) k v))) + (doto #?(:clj (LinkedHashMap.) :cljs (LinkedMap.)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1) + (#?(:clj .put :cljs .add) k2 v2) + (#?(:clj .put :cljs .add) k3 v3) + (#?(:clj .put :cljs .add) k4 v4) + (#?(:clj .put :cljs .add) k5 v5) + (#?(:clj .put :cljs .add) k6 v6)) + kvs))) + +;; ----- Comparison-ordered (sorted) ----- ;; + +;; Forward declaration +(def +map? (t/isa? #?(:clj clojure.lang.IPersistentMap + :cljs cljs.core/IMap))) +;; Forward declaration +(def !+map? (t/isa? #?(:clj clojure.lang.ITransientMap + :cljs cljs.core/ITransientMap))) + +(def +sorted-map? (t/and (t/isa? #?(:clj clojure.lang.Sorted :cljs cljs.core/ISorted)) + +map?)) +(def !+sorted-map? (t/and (t/isa? #?(:clj clojure.lang.Sorted :cljs cljs.core/ISorted)) + !+map?)) +(def ?!+sorted-map? t/none? #_(t/or +sorted-map? !+sorted-map?)) ; TODO re-enable when `or` implemented properly + +(def !sorted-map|boolean->boolean? t/none?) +(def !sorted-map|boolean->byte? t/none?) +(def !sorted-map|boolean->char? t/none?) +(def !sorted-map|boolean->short? t/none?) +(def !sorted-map|boolean->int? t/none?) +(def !sorted-map|boolean->long? t/none?) +(def !sorted-map|boolean->float? t/none?) +(def !sorted-map|boolean->double? t/none?) +(def !sorted-map|boolean->ref? t/none?) + +(def !sorted-map|byte->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2BooleanSortedMap) :cljs t/none?)) +(def !sorted-map|byte->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ByteSortedMap) :cljs t/none?)) +(def !sorted-map|byte->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ShortSortedMap) :cljs t/none?)) +(def !sorted-map|byte->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2CharSortedMap) :cljs t/none?)) +(def !sorted-map|byte->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2IntSortedMap) :cljs t/none?)) +(def !sorted-map|byte->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2LongSortedMap) :cljs t/none?)) +(def !sorted-map|byte->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2FloatSortedMap) :cljs t/none?)) +(def !sorted-map|byte->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2DoubleSortedMap) :cljs t/none?)) +(def !sorted-map|byte->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ReferenceSortedMap) :cljs t/none?)) + +(def !sorted-map|short->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2BooleanSortedMap) :cljs t/none?)) +(def !sorted-map|short->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2ByteSortedMap) :cljs t/none?)) +(def !sorted-map|short->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2ShortSortedMap) :cljs t/none?)) +(def !sorted-map|short->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2CharSortedMap) :cljs t/none?)) +(def !sorted-map|short->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2IntSortedMap) :cljs t/none?)) +(def !sorted-map|short->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2LongSortedMap) :cljs t/none?)) +(def !sorted-map|short->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2FloatSortedMap) :cljs t/none?)) +(def !sorted-map|short->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2DoubleSortedMap) :cljs t/none?)) +(def !sorted-map|short->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2ReferenceSortedMap) :cljs t/none?)) + +(def !sorted-map|char->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2ReferenceSortedMap) :cljs t/none?)) +(def !sorted-map|char->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2BooleanSortedMap) :cljs t/none?)) +(def !sorted-map|char->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2ByteSortedMap) :cljs t/none?)) +(def !sorted-map|char->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2ShortSortedMap) :cljs t/none?)) +(def !sorted-map|char->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2CharSortedMap) :cljs t/none?)) +(def !sorted-map|char->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2IntSortedMap) :cljs t/none?)) +(def !sorted-map|char->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2LongSortedMap) :cljs t/none?)) +(def !sorted-map|char->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2FloatSortedMap) :cljs t/none?)) +(def !sorted-map|char->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2DoubleSortedMap) :cljs t/none?)) + +(def !sorted-map|int->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2BooleanSortedMap) :cljs t/none?)) +(def !sorted-map|int->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2ByteSortedMap) :cljs t/none?)) +(def !sorted-map|int->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2ShortSortedMap) :cljs t/none?)) +(def !sorted-map|int->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2CharSortedMap) :cljs t/none?)) +(def !sorted-map|int->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2IntSortedMap) :cljs t/none?)) +(def !sorted-map|int->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2LongSortedMap) :cljs t/none?)) +(def !sorted-map|int->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2FloatSortedMap) :cljs t/none?)) +(def !sorted-map|int->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2DoubleSortedMap) :cljs t/none?)) +(def !sorted-map|int->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2ReferenceSortedMap) :cljs t/none?)) + +(def !sorted-map|long->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2BooleanSortedMap) :cljs t/none?)) +(def !sorted-map|long->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2ByteSortedMap) :cljs t/none?)) +(def !sorted-map|long->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2ShortSortedMap) :cljs t/none?)) +(def !sorted-map|long->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2CharSortedMap) :cljs t/none?)) +(def !sorted-map|long->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2IntSortedMap) :cljs t/none?)) +(def !sorted-map|long->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2LongSortedMap) :cljs t/none?)) +(def !sorted-map|long->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2FloatSortedMap) :cljs t/none?)) +(def !sorted-map|long->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2DoubleSortedMap) :cljs t/none?)) +(def !sorted-map|long->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2ReferenceSortedMap) :cljs t/none?)) + +(def !sorted-map|float->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2BooleanSortedMap) :cljs t/none?)) +(def !sorted-map|float->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2ByteSortedMap) :cljs t/none?)) +(def !sorted-map|float->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2ShortSortedMap) :cljs t/none?)) +(def !sorted-map|float->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2CharSortedMap) :cljs t/none?)) +(def !sorted-map|float->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2IntSortedMap) :cljs t/none?)) +(def !sorted-map|float->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2LongSortedMap) :cljs t/none?)) +(def !sorted-map|float->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2FloatSortedMap) :cljs t/none?)) +(def !sorted-map|float->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2DoubleSortedMap) :cljs t/none?)) +(def !sorted-map|float->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2ReferenceSortedMap) :cljs t/none?)) + +(def !sorted-map|double->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2BooleanSortedMap) :cljs t/none?)) +(def !sorted-map|double->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2ByteSortedMap) :cljs t/none?)) +(def !sorted-map|double->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2ShortSortedMap) :cljs t/none?)) +(def !sorted-map|double->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2CharSortedMap) :cljs t/none?)) +(def !sorted-map|double->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2IntSortedMap) :cljs t/none?)) +(def !sorted-map|double->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2LongSortedMap) :cljs t/none?)) +(def !sorted-map|double->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2FloatSortedMap) :cljs t/none?)) +(def !sorted-map|double->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2DoubleSortedMap) :cljs t/none?)) +(def !sorted-map|double->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2ReferenceSortedMap) :cljs t/none?)) + +(def !sorted-map|ref->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2BooleanSortedMap) :cljs t/none?)) +(def !sorted-map|ref->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2ByteSortedMap) :cljs t/none?)) +(def !sorted-map|ref->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2ShortSortedMap) :cljs t/none?)) +(def !sorted-map|ref->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2CharSortedMap) :cljs t/none?)) +(def !sorted-map|ref->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2IntSortedMap) :cljs t/none?)) +(def !sorted-map|ref->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2LongSortedMap) :cljs t/none?)) +(def !sorted-map|ref->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2FloatSortedMap) :cljs t/none?)) +(def !sorted-map|ref->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2DoubleSortedMap) :cljs t/none?)) +(def !sorted-map|ref->ref? + (t/or #?@(:clj [(t/isa? java.util.TreeMap) + (t/isa? it.unimi.dsi.fastutil.objects.Reference2ReferenceSortedMap)] + :cljs [(t/isa? goog.structs.AvlTree)]))) + +(def-preds|map|any !sorted-map) + +(def-preds|map|same-types !sorted-map) + + (def !sorted-map? !sorted-map|any?) + +#?(:clj (def !!sorted-map? (t/isa? java.util.concurrent.ConcurrentNavigableMap))) + (def sorted-map? (t/or ?!+sorted-map? + #?@(:clj [!!sorted-map? + (t/isa? java.util.SortedMap)]) + !sorted-map?)) + +;; TODO generate this function via macro +;; TODO TYPED replaced `t/fn?` with a more specific `(t/fn [...])` named as e.g. `fn/comparator?` +;; TODO somehow the `TreeMap` constructor is not right, probably because expecting a `Comparator` +(t/defn >!sorted-map-by + "Creates a single-threaded, mutable sorted map with the specified comparator. + On the JVM, this is a `java.util.TreeMap`. + On JS, this is a `goog.structs.AvlTree`." + > !sorted-map|ref->ref? + ([compf t/fn?] #?(:clj (TreeMap. compf) :cljs (AvlTree. compf))) + ([compf t/fn?, k0 t/ref?, v0 t/ref?] + (doto #?(:clj (TreeMap. compf) :cljs (AvlTree. compf)) + (#?(:clj .put :cljs .add) k0 v0))) + ([compf t/fn?, k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?] + (doto #?(:clj (TreeMap. compf) :cljs (AvlTree. compf)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1))) + ([compf t/fn?, k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?] + (doto #?(:clj (TreeMap. compf) :cljs (AvlTree. compf)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1) + (#?(:clj .put :cljs .add) k2 v2))) + ([compf t/fn?, k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref? + k3 t/ref?, v3 t/ref?] + (doto #?(:clj (TreeMap. compf) :cljs (AvlTree. compf)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1) + (#?(:clj .put :cljs .add) k2 v2) + (#?(:clj .put :cljs .add) k3 v3))) + ([compf t/fn?, k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref? + k3 t/ref?, v3 t/ref?, k4 t/ref?, v4 t/ref?] + (doto #?(:clj (TreeMap. compf) :cljs (AvlTree. compf)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1) + (#?(:clj .put :cljs .add) k2 v2) + (#?(:clj .put :cljs .add) k3 v3) + (#?(:clj .put :cljs .add) k4 v4))) + ([compf t/fn?, k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref? + k3 t/ref?, v3 t/ref?, k4 t/ref?, v4 t/ref?, k5 t/ref?, v5 t/ref?] + (doto #?(:clj (TreeMap. compf) :cljs (AvlTree. compf)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1) + (#?(:clj .put :cljs .add) k2 v2) + (#?(:clj .put :cljs .add) k3 v3) + (#?(:clj .put :cljs .add) k4 v4) + (#?(:clj .put :cljs .add) k5 v5))) + ;; TODO TYPED `reduce-pair`, variadic +#_([compf t/fn?, k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref? + k3 t/ref?, v3 t/ref?, k4 t/ref?, v4 t/ref?, k5 t/ref?, v5 t/ref?, k6 t/ref?, v6 t/ref? & kvs] + (reduce-pair + (fn [#?(:clj ^TreeMap m :cljs m) k v] (doto m (#?(:clj .put :cljs .add) k v))) + (doto #?(:clj (TreeMap. compf) :cljs (AvlTree. compf)) + (#?(:clj .put :cljs .add) k0 v0) + (#?(:clj .put :cljs .add) k1 v1) + (#?(:clj .put :cljs .add) k2 v2) + (#?(:clj .put :cljs .add) k3 v3) + (#?(:clj .put :cljs .add) k4 v4) + (#?(:clj .put :cljs .add) k5 v5) + (#?(:clj .put :cljs .add) k6 v6)) + kvs))) + +;; TODO generate this function via macro +;; TODO TYPED replace `compare` with typed version +(t/defn >!sorted-map + "Creates a single-threaded, mutable sorted map. + On the JVM, this is a `java.util.TreeMap`. + On JS, this is a `goog.structs.AvlTree`." + > !sorted-map|ref->ref? + ([] (>!sorted-map-by compare)) + ([k0 t/ref?, v0 t/ref?] + (>!sorted-map-by compare k0 v0)) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?] + (>!sorted-map-by compare k0 v0 k1 v1)) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?] + (>!sorted-map-by compare k0 v0 k1 v1 k2 v2)) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref?] + (>!sorted-map-by compare k0 v0 k1 v1 k2 v2 k3 v3)) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?] + (>!sorted-map-by compare k0 v0 k1 v1 k2 v2 k3 v3 k4 v4)) + ([k0 t/ref?, v0 t/ref?, k1 t/ref?, v1 t/ref?, k2 t/ref?, v2 t/ref?, k3 t/ref?, v3 t/ref? + k4 t/ref?, v4 t/ref?, k5 t/ref?, v5 t/ref?] + (>!sorted-map-by compare k0 v0 k1 v1 k2 v2 k3 v3 k4 v4 k5 v5)) + ;; TODO TYPED `apply`, `compare`, variadic +#_([k0 v0 k1 v1 k2 v2 k3 v3 k4 v4 k5 v5 k6 v6 & kvs] + (apply >!sorted-map-by compare k0 v0 k1 v1 k2 v2 k3 v3 k4 v4 k5 v5 k6 v6 kvs))) + +;; TODO TYPED `apply`, variadic +#_(t/defn !sorted-map-by-val > !sorted-map|ref->ref? [m & kvs] + (apply !sorted-map-by (gen-compare-by-val m) kvs)) + +;; ----- General Maps ----- ;; + +(defalias ut/+map|built-in?) + +;; `+map?` and `!+map?` defined above +(def ?!+map? (t/or !+map? +map?)) + +(def !map|boolean->boolean? t/none?) +(def !map|boolean->byte? t/none?) +(def !map|boolean->short? t/none?) +(def !map|boolean->char? t/none?) +(def !map|boolean->int? t/none?) +(def !map|boolean->long? t/none?) +(def !map|boolean->float? t/none?) +(def !map|boolean->double? t/none?) +(def !map|boolean->ref? t/none?) + +(def !map|byte->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2BooleanMap) :cljs t/none?)) +(def !map|byte->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ByteMap) :cljs t/none?)) +(def !map|byte->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ShortMap) :cljs t/none?)) +(def !map|byte->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2CharMap) :cljs t/none?)) +(def !map|byte->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2IntMap) :cljs t/none?)) +(def !map|byte->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2LongMap) :cljs t/none?)) +(def !map|byte->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2FloatMap) :cljs t/none?)) +(def !map|byte->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2DoubleMap) :cljs t/none?)) +(def !map|byte->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.Byte2ReferenceMap) :cljs t/none?)) + +(def !map|short->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2BooleanMap) :cljs t/none?)) +(def !map|short->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2ByteMap) :cljs t/none?)) +(def !map|short->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2ShortMap) :cljs t/none?)) +(def !map|short->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2CharMap) :cljs t/none?)) +(def !map|short->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2IntMap) :cljs t/none?)) +(def !map|short->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2LongMap) :cljs t/none?)) +(def !map|short->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2FloatMap) :cljs t/none?)) +(def !map|short->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2DoubleMap) :cljs t/none?)) +(def !map|short->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.Short2ReferenceMap) :cljs t/none?)) + +(def !map|char->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2ReferenceMap) :cljs t/none?)) +(def !map|char->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2BooleanMap) :cljs t/none?)) +(def !map|char->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2ByteMap) :cljs t/none?)) +(def !map|char->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2ShortMap) :cljs t/none?)) +(def !map|char->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2CharMap) :cljs t/none?)) +(def !map|char->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2IntMap) :cljs t/none?)) +(def !map|char->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2LongMap) :cljs t/none?)) +(def !map|char->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2FloatMap) :cljs t/none?)) +(def !map|char->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.Char2DoubleMap) :cljs t/none?)) + +(def !map|int->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2BooleanMap) :cljs t/none?)) +(def !map|int->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2ByteMap) :cljs t/none?)) +(def !map|int->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2ShortMap) :cljs t/none?)) +(def !map|int->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2CharMap) :cljs t/none?)) +(def !map|int->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2IntMap) :cljs t/none?)) +(def !map|int->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2LongMap) :cljs t/none?)) +(def !map|int->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2FloatMap) :cljs t/none?)) +(def !map|int->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2DoubleMap) :cljs t/none?)) +(def !map|int->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.Int2ReferenceMap) :cljs t/none?)) + +(def !map|long->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2BooleanMap) :cljs t/none?)) +(def !map|long->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2ByteMap) :cljs t/none?)) +(def !map|long->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2ShortMap) :cljs t/none?)) +(def !map|long->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2CharMap) :cljs t/none?)) +(def !map|long->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2IntMap) :cljs t/none?)) +(def !map|long->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2LongMap) :cljs t/none?)) +(def !map|long->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2FloatMap) :cljs t/none?)) +(def !map|long->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2DoubleMap) :cljs t/none?)) +(def !map|long->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.Long2ReferenceMap) :cljs t/none?)) + +(def !map|float->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2BooleanMap) :cljs t/none?)) +(def !map|float->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2ByteMap) :cljs t/none?)) +(def !map|float->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2ShortMap) :cljs t/none?)) +(def !map|float->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2CharMap) :cljs t/none?)) +(def !map|float->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2IntMap) :cljs t/none?)) +(def !map|float->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2LongMap) :cljs t/none?)) +(def !map|float->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2FloatMap) :cljs t/none?)) +(def !map|float->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2DoubleMap) :cljs t/none?)) +(def !map|float->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.Float2ReferenceMap) :cljs t/none?)) + +(def !map|double->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2BooleanMap) :cljs t/none?)) +(def !map|double->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2ByteMap) :cljs t/none?)) +(def !map|double->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2ShortMap) :cljs t/none?)) +(def !map|double->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2CharMap) :cljs t/none?)) +(def !map|double->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2IntMap) :cljs t/none?)) +(def !map|double->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2LongMap) :cljs t/none?)) +(def !map|double->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2FloatMap) :cljs t/none?)) +(def !map|double->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2DoubleMap) :cljs t/none?)) +(def !map|double->ref? + #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.Double2ReferenceMap) :cljs t/none?)) + +(def !map|ref->boolean? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2BooleanMap) :cljs t/none?)) +(def !map|ref->byte? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2ByteMap) :cljs t/none?)) +(def !map|ref->short? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2ShortMap) :cljs t/none?)) +(def !map|ref->char? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2CharMap) :cljs t/none?)) +(def !map|ref->int? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2IntMap) :cljs t/none?)) +(def !map|ref->long? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2LongMap) :cljs t/none?)) +(def !map|ref->float? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2FloatMap) :cljs t/none?)) +(def !map|ref->double? + #?(:clj (t/isa? it.unimi.dsi.fastutil.objects.Reference2DoubleMap) :cljs t/none?)) + +(def !map|ref->ref? + (t/or #?@(:clj [;; perhaps just `(- !map? )` ? + !unsorted-map|ref->ref? + !sorted-map|ref->ref? + (t/isa? it.unimi.dsi.fastutil.objects.Reference2ReferenceMap)] + :cljs [(t/isa? goog.structs.AvlTree)]))) + +(def-preds|map|any !map) + +(def-preds|map|same-types !map) + + (def !map? !map|any?) + +#?(:clj (def !!map? (t/or !!unsorted-map? !!sorted-map?))) + + (uvar/def map? + "A `map?` is in some sense anything that satisfies `dc/lookup?` — i.e., a collection + maintaining a one-to-one mapping from keys to values. However, while we define `map?` + as being effectively `(t/- (t/and associative? lookup?) indexed?)`, in practice we + limit to an enumerated set of concrete types." + (t/or ?!+map? !map? #?@(:clj [!!map? (t/isa? java.util.Map)]))) + + + + + + +#_(defaliases umap + map-entry-seq + ordered-map om #?(:clj !ordered-map) #?(:clj kw-omap) sorted-map sorted-map-by sorted-map-by-val sorted-rank-map sorted-rank-map-by nearest rank-of subrange split-key split-at - map-entry map-entry-seq - #?(:clj hash-map?) merge #?(:clj pmerge) !hash-map - #?@(:clj [!hash-map:int->ref !hash-map:int->object - !hash-map:long->long !hash-map:long - !hash-map:long->ref !hash-map:long->object - !hash-map:double->ref !hash-map:double->object - !hash-map:ref->long !hash-map:object->long]) + #?@(:clj [!hash-map|int->ref !hash-map|int->object + !hash-map|long->long !hash-map|long + !hash-map|long->ref !hash-map|long->object + !hash-map|double->ref !hash-map|double->object + !hash-map|ref->long !hash-map|object->long]) bubble-max-key difference-by-key union-by-key intersection-by-key) diff --git a/src/quantum/core/data/meta.cljc b/src/quantum/core/data/meta.cljc new file mode 100644 index 00000000..b3469661 --- /dev/null +++ b/src/quantum/core/data/meta.cljc @@ -0,0 +1,53 @@ +(ns quantum.core.data.meta + "Functions related to metadata." + (:refer-clojure :exclude + [reset-meta! with-meta]) + (:require + [quantum.core.data.map :as map] + [quantum.core.type :as t])) + +(def meta? (t/? map/+map?)) +(def metable? (t/isa?|direct #?(:clj clojure.lang.IMeta :cljs cljs.core/IMeta))) +(def with-metable? (t/isa?|direct #?(:clj clojure.lang.IObj :cljs cljs.core/IWithMeta))) + +(t/defn ^:inline >meta + "Returns the (possibly nil) metadata of ->`x`." + > meta? + ([x metable?] (#?(:clj .meta :cljs cljs.core/-meta) x)) + ([x t/any?] nil)) + +(t/defn ^:inline with-meta + "Returns an object of the same type and value as ->`x`, with ->`meta'` as its metadata." + > with-metable? + ([x with-metable?, meta' meta? > (t/run with-metable?) #_(TODO TYPED (t/value-of x))] + (#?(:clj .withMeta :cljs cljs.core/-with-meta) x meta')) + #?(:cljs ([x (t/isa? js/Function), meta' meta?] + (cljs.core/MetaFn. x meta')))) + +(t/defn ^:inline reset-meta! + "Atomically resets ->`x`'s metadata to be ->`meta'`." + > meta? + [x (t/isa? #?(:clj clojure.lang.IReference :cljs (TODO))) meta' meta?] + (#?(:clj .resetMeta :cljs (set! (.-meta x) m)) x meta')) + +;; TODO TYPED +#_(t/defn update-meta + "Returns an object of the same type and value as ->`x`, with its metadata updated by ->`f`." + ;; TODO `f` should more specifically be able to handle the args arity and specs + {:incorporated '{clojure.core/vary-meta "9/2018" + cljs.core/vary-meta "9/2018"}} + [x (t/and with-metable? metable?) f (t/fn meta? [& (t/type args)]) & args _] + (with-meta x (apply f (meta x) args))) + +;; TODO TYPED +#_(t/defn merge-meta + {:incorporated #{'cljs.tools.reader/merge-meta}} + [x (t/and with-metable? metable?) meta- meta? > (t/value-of x)] + (update-meta x merge meta-)) + +;; TODO TYPED +#_(t/defn merge-meta-from [to (t/and with-metable? metable?), from metable?] + (update-meta to merge (>meta from))) + +(t/defn replace-meta-from > with-metable? [to with-metable?, from metable?] + (with-meta to (>meta from))) diff --git a/src/quantum/core/data/numeric.cljc b/src/quantum/core/data/numeric.cljc new file mode 100644 index 00000000..d4cdc9aa --- /dev/null +++ b/src/quantum/core/data/numeric.cljc @@ -0,0 +1,723 @@ +(ns quantum.core.data.numeric + "Better `bigint?` for CLJ: + - There are almost certainly faster ones but whether they will be as correct is unknown + + Better `bigdec?` for CLJ: + - There are almost certainly faster ones + + `bigint?` for CLJS: + - `BigInt` is a built-in JS object in Chrome as of 5/2018. It's faster than bn.js. https://developers.google.com/web/updates/2018/05/bigint + - As of 5/2018, the best current substitute for `BigInt` is bn.js, but there apparently is a + polyfill available for BigInt so maybe that's better. + + `bigdec?` for CLJS: + - decimal.js is the best contender as of 9/27/2018. https://github.com/MikeMcl/decimal.js + + `ratio?` for CLJS: + - Fraction.js is the best contender as of 9/27/2018. https://github.com/infusion/Fraction.js" + (:refer-clojure :exclude ; otherwise `Unable to resolve symbol: eval` + [decimal? denominator integer? number? numerator ratio? zero?]) + (:require + [clojure.core :as core] + [clojure.string :as str] + #?(:cljs goog.math.Integer) + #?(:cljs goog.math.Long) + [quantum.core.compare.core :as c?] + [quantum.core.data.primitive :as p] + #_[quantum.core.logic + :refer [whenf fn-not fn=]] + [quantum.core.type :as t] + ;; TODO TYPED excise reference + [quantum.untyped.core.vars :as var + :refer [defalias]]) +#?(:clj (:import + [clojure.lang BigInt Numbers Ratio] + [java.math BigInteger] + [quantum.core Numeric Primitive]))) + +;; ===== Types ===== ;; + +;; ----- Integers ----- ;; + +;; Incorporated `clojure.core/int?` +;; Incorporated `cljs.core/int?` +(t/def fixint? "The set of all fixed-precision (though not necessarily primitive) integers." + (t/or #?@(:clj [p/byte? p/short?]) p/int? p/long?)) + +#?(:clj (t/def java-bigint? (t/isa? java.math.BigInteger))) +#?(:clj (t/def clj-bigint? (t/isa? clojure.lang.BigInt))) + +(t/def bigint? "The set of all 'big' (arbitrary-precision) integers." + #?(:clj ;; TODO bring in a better implementation per the ns docstring? + (t/or clj-bigint? java-bigint?) + ;; TODO bring in implementation per the ns docstring + :cljs t/none?)) + +;; Incorporated `clojure.lang.Util/isInteger` +;; Incorporated `clojure.core/integer?` +;; Incorporated `cljs.core/integer?` +(t/def integer? (t/or fixint? bigint?)) + +;; ----- Decimals ----- ;; + +(t/defn ^:inline nan? + "`Float/NaN`, `Double/NaN`, and `js/NaN` are all non-self-identical. `js/NaN` is not a + `js/Number` (sensibly so), but `Float/NaN` is a `Float` and `Double/NaN` is a `Double`." + > p/boolean? + #?(:cljs ([x t/any? > (t/assume p/boolean?)] (js/isNaN x))) + #?(:clj ([x p/float?] (Float/isNaN x))) + #?(:clj ([x p/double?] (Double/isNaN x))) + ;; TODO TYPED `(t/- t/any? p/float? p/double?)` + #?(:clj ([x (t/- p/primitive? p/float? p/double?)] false)) + #?(:clj ([x t/ref?] false))) + +;; Incorporated `clojure.core/float?` +;; Incorporated `cljs.core/float?` +(t/def fixdec? "The set of all fixed-precision decimals." + (t/or #?(:clj p/float?) p/double?)) + +;; Incorporated `clojure.core/decimal?` +(t/def bigdec? "The set of all 'big' (arbitrary-precision) decimals." + #?(:clj ;; TODO bring in a better implementation per the ns docstring? + (t/isa? BigDecimal) + ;; TODO bring in implementation per the ns docstring + :cljs t/none?)) + +(t/def decimal? (t/or fixdec? bigdec?)) + +;; ----- Precision ----- ;; + +(t/def fixnum? "The set of all fixed-precision numbers." + (t/or fixint? fixdec?)) + +(t/def fixed-numeric? + "The set of all fixed-precision numeric things. Something 'numeric' is something that may be + treated as a number but may not actually *be* one." + (t/or fixnum? p/char?)) + +(t/def bignum? "The set of all 'big' (arbitrary-precision) numbers." + (t/or fixint? fixdec?)) + +;; ----- Ratios ----- ;; + +(t/def ratio? #?(:clj (t/isa? clojure.lang.Ratio) + ;; TODO bring in implementation per the ns docstring + :cljs t/none?)) + +;; ----- General ----- ;; + +(t/def exact? (t/or integer? ratio?)) + +(t/def number? (t/or #?@(:clj [(t/isa? java.lang.Number)] + :cljs [integer? decimal? ratio?]))) + +(t/def numeric? + "Something 'numeric' is something that may be treated as a number but may not actually *be* one." + (t/or number? #?(:clj p/char?))) + +;; ===== Arbitrary-precision conversions (needed for comparisons) ===== ;; + +;; Forward declaration so bigint conversions can use it +;; TODO figure out how to use with CLJS, including goog.math.Integer/Long +#?(:clj +(t/defn ^:inline >long* + "May involve non-out-of-range truncation." + > p/long? + ( [x p/long?] x) + ( [x p/char?] (Primitive/uncheckedLongCast x)) + (^:in [x (t/- p/primitive? p/long? p/boolean? p/char?)] (clojure.lang.RT/uncheckedLongCast x)) + ( [x (t/ref number?)] (.longValue x)))) + +;; TODO figure out how to use with goog.math.Integer/Long +(t/defn ^:inline >double* + "May involve non-out-of-range truncation." + > p/double? + ( [x p/double?] x) + ( [x p/char?] (Primitive/uncheckedDoubleCast x)) +#?(:clj (^:in [x (t/- p/primitive? p/boolean? p/char? p/double?)] + (clojure.lang.RT/uncheckedDoubleCast x)))) + +#?(:clj +(t/defn ^:inline >java-bigint > java-bigint? + ([x fixed-numeric? > (t/assume java-bigint?)] (-> x >long* BigInteger/valueOf)) + ([x java-bigint?] x) + ([x clj-bigint? > (t/assume java-bigint?)] (.toBigInteger x)) + ;; Truncates the decimal portion + ;; TODO should this overload be part of `>java-bigint*`? + ([x bigdec? > (t/assume java-bigint?)] (.toBigInteger x)) + ;; Truncates the decimal portion + ;; TODO should this overload be part of `>java-bigint*`? + ([x ratio? > (t/assume java-bigint?)] (.bigIntegerValue x)))) + +#?(:clj +(t/defn ^:inline >clj-bigint > clj-bigint? + ([x fixed-numeric? > (t/assume clj-bigint?)] (-> x >long* BigInt/fromLong)) + ([x java-bigint? > (t/assume clj-bigint?)] (BigInt/fromBigInteger x)) + ([x clj-bigint?] x) + ;; Truncates the decimal portion + ;; TODO should this overload be part of `>clj-bigint*`? + ([x bigdec?] (-> x >java-bigint >clj-bigint)) + ;; Truncates the decimal portion + ;; TODO should this overload be part of `>clj-bigint*`? + ([x ratio?] (-> x >java-bigint >clj-bigint)))) + +#?(:clj +(t/defn ^:inline >bigdec > bigdec? + ([x (t/or fixint? p/char?) > (t/assume bigdec?)] (-> x >long* BigDecimal/valueOf)) + ([x fixdec? > (t/assume bigdec?)] (-> x >double* BigDecimal/valueOf)) + ([x java-bigint?] (BigDecimal. x)) + ([x clj-bigint? > (t/assume bigdec?)] (.toBigDecimal x)) + ([x bigdec?] x) + ([x ratio? > (t/assume bigdec?)] (.divide (-> x ^:val (.numerator) >bigdec) + (-> x ^:val (.denominator) >bigdec))))) + +#?(:clj +(t/defn ^:inline >ratio > ratio? + ([x (t/or fixed-numeric? bigint?)] (Ratio. (>java-bigint x) BigInteger/ONE)) + ([x bigdec?] (let [v ^:val (.unscaledValue x) + scale (.scale x)] + (if (c?/< scale 0) + (Ratio. (.multiply v (.pow ^:val (. BigInteger TEN) + (Numbers/unchecked_int_negate scale))) + ^:val (. BigInteger ONE)) + (Ratio. v (.pow ^:val (. BigInteger TEN) scale))))) + ([x ratio?] x))) + +;; ===== Comparison extensions ===== ;; + +(t/extend-defn! c?/= + ;; `.equals` takes into account precision even if they're numerically equivalent + ;; `core/=` uses `.equals` for `BigDecimal`s +#?(:clj ([a bigdec? + b bigdec?] (c?/comp= a b))) +#?(:clj ([a bigdec? + b (t/- (t/input >bigdec :?) bigdec? java-bigint? clj-bigint? ratio?)] + (c?/= a (>bigdec b)))) +#?(:clj ([a (t/- (t/input >bigdec :?) bigdec? java-bigint? clj-bigint? ratio?) + b bigdec?] (c?/= (>bigdec a) b))) +#?(:clj ([a java-bigint? + b java-bigint?] (.equals a b))) +#?(:clj ([a java-bigint? + b (t/- (t/input >java-bigint :?) java-bigint? clj-bigint? ratio?)] + (c?/= a (>java-bigint b)))) +#?(:clj ([a (t/- (t/input >java-bigint :?) java-bigint? clj-bigint? ratio?) + b java-bigint?] (c?/= (>java-bigint a) b))) +#?(:clj ([a clj-bigint? + b clj-bigint?] (.equals a b))) +#?(:clj ([a clj-bigint? + b (t/- (t/input >clj-bigint :?) clj-bigint? ratio?)] (c?/= a (>clj-bigint b)))) +#?(:clj ([a (t/- (t/input >clj-bigint :?) clj-bigint? ratio?) + b clj-bigint?] (c?/= (>clj-bigint a) b))) +#?(:clj ([a ratio? + b ratio?] (and (c?/= ^:val (.numerator a) ^:val (.numerator b)) + (c?/= ^:val (.denominator a) ^:val (.denominator b))))) +#?(:clj ([a ratio? + b (t/- (t/input >ratio :?) ratio?)] (c?/= a (>ratio b)))) +#?(:clj ([a (t/- (t/input >ratio :?) ratio?) + b ratio?] (c?/= (>ratio a) b)))) + +(t/def numeric-comparator? (t/ftype p/boolean? [numeric? numeric?])) + +(t/defn ^:inline numeric-compare > p/boolean? + ([x numeric?] true) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a bigdec? + b bigdec?] (compf a b))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a bigdec? + b (t/- (t/input >bigdec :?) bigdec? java-bigint? clj-bigint? ratio?)] + (numeric-compf a (>bigdec b)))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a (t/- (t/input >bigdec :?) bigdec? java-bigint? clj-bigint? ratio?) + b bigdec?] (numeric-compf (>bigdec a) b))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a java-bigint? + b java-bigint?] (compf a b))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a java-bigint? + b (t/- (t/input >java-bigint :?) java-bigint? clj-bigint? ratio?)] + (numeric-compf a (>java-bigint b)))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a (t/- (t/input >java-bigint :?) java-bigint? clj-bigint? ratio?) + b java-bigint?] (numeric-compf (>java-bigint a) b))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a clj-bigint? + b clj-bigint?] (if (and (p/nil? (.bipart a)) (p/nil? (.bipart b))) + (numeric-compf (.lpart a) (.lpart b)) + (compf (>java-bigint a) (>java-bigint b))))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a clj-bigint? + b (t/- (t/input >clj-bigint :?) clj-bigint? ratio?)] + (numeric-compf a (>clj-bigint b)))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a (t/- (t/input >clj-bigint :?) clj-bigint? ratio?) + b clj-bigint?] (numeric-compf (>clj-bigint a) b))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a ratio? + b ratio?] (numeric-compf + ^:val (.multiply ^:val (.numerator a) ^:val (.numerator b)) + ^:val (.multiply ^:val (.denominator a) ^:val (.denominator b))))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a ratio? + b (t/- (t/input >ratio :?) ratio?)] (numeric-compf a (>ratio b)))) +#?(:clj ([numeric-compf numeric-comparator?, compf c?/boolean-comparator? + a (t/- (t/input >ratio :?) ratio?) + b ratio?] (numeric-compf (>ratio a) b)))) + +(t/extend-defn! c?/< + ([x (t/input numeric-compare :?)] (numeric-compare x)) + ([a (t/input numeric-compare :_ :_ :? :_) + b (t/input numeric-compare :_ :_ [= (t/type a)] :?)] + (numeric-compare c?/< c?/comp< a b))) + +(t/extend-defn! c?/<= + ([x (t/input numeric-compare :?)] (numeric-compare x)) + ([a (t/input numeric-compare :_ :_ :? :_) + b (t/input numeric-compare :_ :_ [= (t/type a)] :?)] + (numeric-compare c?/<= c?/comp<= a b))) + +(t/extend-defn! c?/> + ([x (t/input numeric-compare :?)] (numeric-compae x)) + ([a (t/input numeric-compare :_ :_ :? :_) + b (t/input numeric-compare :_ :_ [= (t/type a)] :?)] + (numeric-compare c?/> c?/comp> a b))) + +(t/extend-defn! c?/>= + ([x (t/input numeric-compare :?)] (numeric-compare x)) + ([a (t/input numeric-compare :_ :_ :? :_) + b (t/input numeric-compare :_ :_ [= (t/type a)] :?)] + (numeric-compare c?/>= c?/comp>= a b))) + +;; TODO `c?/compare` + +;; ===== Comparisons to constants (e.g. to 0 or 1) ===== ;; + +(t/defn ^:inline >zero-of-type #_> #_zero? +#?(:clj ([x p/byte? > (t/type x)] Numeric/byte0)) +#?(:clj ([x p/short? > (t/type x)] Numeric/short0)) +#?(:clj ([x p/char? > (t/type x)] Numeric/char0)) + ([x p/int? > #?(:clj (t/type x) :cljs (t/assume (t/type x)))] + #?(:clj Numeric/int0 :cljs goog.math.Integer/ZERO)) + ([x p/long? > #?(:clj (t/type x) :cljs (t/assume (t/type x)))] + #?(:clj 0 :cljs goog.math.Long/ZERO)) +#?(:clj ([x p/float? > (t/type x)] Numeric/float0)) + ([x p/double? > (t/type x)] 0.0) +#?(:clj ([x java-bigint? > (t/assume (t/type x))] java.math.BigInteger/ZERO)) +#?(:clj ([x clj-bigint? > (t/assume (t/type x))] clojure.lang.BigInt/ZERO)) +#?(:clj ([x bigdec? > (t/assume (t/type x))] java.math.BigDecimal/ZERO))) + +(t/defn ^:inline zero? > p/boolean? +#?(:clj (^:in [x (t/or p/long? p/double?)] (Numbers/isZero x))) +#?(:clj ( [x (t/- p/numeric? p/long? p/double?)] (Numeric/isZero x))) +#?(:clj ( [x clj-bigint?] (if (p/nil? (.bipart x)) + (-> x (.lpart) zero?) + (-> x ^:val (.bipart) zero?)))) +#?(:clj ( [x (t/or java-bigint? bigdec?)] (-> x .signum zero?))) +#?(:clj ( [x ratio?] (-> x ^:val (.numerator) zero?))) + ( [x #?(:clj (t/ref number?) :cljs numeric?)] (c?/= x 0))) + +(t/defn ^:inline >one-of-type #_> #_one? +#?(:clj ([x p/byte? > (t/type x)] Numeric/byte1)) +#?(:clj ([x p/short? > (t/type x)] Numeric/short1)) +#?(:clj ([x p/char? > (t/type x)] Numeric/char1)) + ([x p/int? > #?(:clj (type x) :cljs (t/assume (t/type x)))] + #?(:clj Numeric/int1 :cljs goog.math.Integer/ONE)) + ([x p/long? > #?(:clj (type x) :cljs (t/assume (t/type x)))] + #?(:clj 1 :cljs goog.math.Long/ONE)) +#?(:clj ([x p/float? > (t/type x)] Numeric/float1)) + ([x p/double? > (t/type x)] 1.0) +#?(:clj ([x java-bigint? > (t/assume (t/type x))] java.math.BigInteger/ONE)) +#?(:clj ([x clj-bigint? > (t/assume (t/type x))] clojure.lang.BigInt/ONE)) +#?(:clj ([x bigdec? > (t/assume (t/type x))] java.math.BigDecimal/ONE))) + +(t/defn ^:inline one? > p/boolean? +#?(:clj ([x p/numeric?] (c?/= x (>one-of-type x)))) + ([x #?(:clj (t/ref number?) :cljs numeric?)] (c?/= x 1))) + +(t/defn ^:inline neg? > p/boolean? +#?(:clj (^:in [x (t/or p/long? p/double?)] (Numbers/isNeg x))) +#?(:clj ( [x (t/- p/numeric? p/long? p/double?)] (Numeric/isNeg x))) +#?(:clj ( [x clj-bigint?] (if (p/nil? (.bipart x)) + (-> x .lpart neg?) + (-> x .bipart neg?)))) +#?(:clj ( [x (t/or java-bigint? bigdec?)] (-> x .signum neg?))) +#?(:clj ( [x ratio?] (-> x .numerator neg?))) + ( [x #?(:clj (t/ref number?) :clj numeric?)] (c?/< x 0))) ; TODO dispatch not present + +;; TODO TYPED this should realize that we're negating a `<` and change the operator to `<=` +(t/def nneg? (fn/comp ?/not neg?)) + +(t/defn ^:inline pos? > p/boolean? +#?(:clj (^:in [x (t/or p/long? p/double?)] (Numbers/isPos x))) +#?(:clj ( [x (t/- p/numeric? p/long? p/double?)] (Numeric/isPos x))) +#?(:clj ( [x clj-bigint?] (if (?/nil? (.bipart x)) + (-> x .lpart pos?) + (-> x .bipart pos?)))) +#?(:clj ( [x (t/or java-bigint? bigdec?)] (-> x .signum pos?))) +#?(:clj ( [x ratio?] (-> x .numerator pos?))) + ( [x #?(:clj (t/ref number?) :clj numeric?)] (c?/> x 0))) ; TODO dispatch not present + +;; TODO TYPED this should realize that we're negating a `<` and change the operator to `<=` +(t/def npos? (fn/comp ?/not pos?)) + +(t/def pos-int? (fn/and integer? pos?)) +(t/def neg-int? (fn/and integer? neg?)) +(t/def npos-int? (fn/and integer? npos?)) +(t/def nneg-int? (fn/and integer? nneg?)) + +(t/defn ^:inline infinite? + "`Float/NEGATIVE_INFINITY`, `Float/POSITIVE_INFINITY`, `Double/NEGATIVE_INFINITY`, and + `Double/POSITIVE_INFINITY` are all non-self-identical. `js/Number.NEGATIVE_INFINITY` and + `js/Number.POSITIVE_INFINITY` are self-identical, but neither of them are `js/Number`s. By + contrast, the `Float` and `Double` infinities are instances of `Float` and `Double`, + respectively." +#?(:cljs ([x t/any? > (t/assume p/boolean?)] (??/not (js/isFinite x)))) +#?(:clj ([x p/float?] (Float/isInfinite x))) +#?(:clj ([x p/double?] (Double/isInfinite x))) +#?(:clj ([x (t/- p/numeric? p/float? p/double?)] false)) + ;; This leaves room for other numbers to be infinite +#?(:clj ([x (t/ref number?)] false))) + +;; ===== Likenesses ===== ;; + +(t/defn numerically-integer? ; TODO turn it into a type + {:adapted-from + '#{com.google.common.math.DoubleMath/isMathematicalInteger + "https://stackoverflow.com/questions/1078953/check-if-bigdecimal-is-integer-value"}} + > p/boolean? + ( [x integer?] true) +#?(:cljs (^:in [x p/double? > (t/assume p/boolean?)] (js/Number.isInteger x))) +#?(:clj ( [x (t/or p/float? p/double?)] (c?/= x (>long* x)))) +#?(:clj ( [x bigdec?] (or (zero? (.signum x)) + (-> x .scale npos?) + (-> x .stripTrailingZeros .scale npos?)))) +#?(:clj ( [x (t/ref number?)] false))) + +#_(def numerically-byte? + (and numerically-integer? (>expr (c/fn [x] (c/<= -128 x 127))))) + +#_(def numerically-short? + (and numerically-integer? (>expr (c/fn [x] (c/<= -32768 x 32767))))) + +#_(def numerically-char? + (and numerically-integer? (>expr (c/fn [x] (c/<= 0 x 65535))))) + +#_(def numerically-unsigned-short? numerically-char?) + +#_(def numerically-int? + (and numerically-integer? (>expr (c/fn [x] (c/<= -2147483648 x 2147483647))))) + +#_(def numerically-long? + (and numerically-integer? (>expr (c/fn [x] (c/<= -9223372036854775808 x 9223372036854775807))))) + +#_(def numerically-float? + (and number? + (>expr (c/fn [x] (c/<= -3.4028235E38 x 3.4028235E38))) + (>expr (c/fn [x] (-> x #?(:clj clojure.lang.RT/floatCast :cljs c/float) (c/== x)))))) + +#_(def numerically-double? + (and number? + (>expr (c/fn [x] (c/<= -1.7976931348623157E308 x 1.7976931348623157E308))) + (>expr (c/fn [x] (-> x clojure.lang.RT/doubleCast (c/== x)))))) + +#_(-def int-like? (and numerically-integer? numerically-int?)) + +#_(defn numerically + [t] + (assert (utr/class-type? t)) + (let [c (.-c ^ClassType t)] + (case (.getName ^Class c) + "java.lang.Byte" numerically-byte? + "java.lang.Short" numerically-short? + "java.lang.Character" numerically-char? + "java.lang.Integer" numerically-int? + "java.lang.Long" numerically-long? + "java.lang.Float" numerically-float? + ;; TODO fix + ;;"java.lang.Double" numerically-double? + (err! "Could not find numerical range type for class" {:c c})))) + + +(def primitive-number? (t/or #?@(:clj [p/short? p/int? p/long? p/float?]) p/double?)) + +(def numeric-primitive? p/numeric?) + +(def numerically-integer-double? (t/and p/double? numerically-integer?)) + +(def numerically-integer-primitive? (t/and p/primitive? numerically-integer?)) + +(def numerically-int-double? (t/and p/double? numerically-int?)) +(def ni-double? numerically-int-double?) + +;; TODO excise? +(def std-integer? (t/or integer? #?(:cljs numerically-integer-double?))) + +(def std-fixint? #?(:clj p/long? :cljs numerically-integer-double?)) + +;; ===== Conversion ===== ;; +;; Note that numeric-primitive conversions go here because they take as inputs and produce outputs +;; things that are within a numeric range. + +;; TODO evaluate +(defnt ->num + (^long [^boolean x] (if x 1 0)) + ([#{number? byte char} x] x)) + +;; TODO evaluate +(defn ->boolean-num [x] (if x 1 0)) + +;; TODO evaluate +#?(:clj +(defnt exactly + ([#{decimal?} x] + (-> x rationalize exactly)) + ([#{int? long?} x] (->bigint x)) + ([#{bigint? ratio?} x] x))) + + + +;; ----- Byte ----- ;; + +;; TODO figure out how to use with CLJS +#?(:clj +(t/defn ^:inline >byte* + "May involve non-out-of-range truncation." + > p/byte? + ([x p/byte?] x) + ([x (t/- p/primitive? p/byte? p/boolean?)] (Primitive/uncheckedByteCast x)))) + +;; TODO TYPED `numerically` +;; TODO figure out how to use with goog.math.Integer/Long +(t/defn ^:inline >byte > #?(:clj p/byte? :cljs numerically-byte?) + "Does not involve truncation or rounding." + ([x #?(:clj p/byte? :cljs numerically-byte?)] x) +#?(:clj ([x (t/and (t/- p/primitive? p/byte? p/boolean?) numerically-byte?)] (>byte* x)) + :cljs ([x (t/and p/double? numerically-byte?)] x)) +#?(:clj ([x (t/and (t/isa? clojure.lang.BigInt) numerically-byte?)] (>byte* (.lpart x)))) +#?(:clj ([x (t/and (t/isa? java.math.BigInteger) numerically-byte?)] (.byteValue x))) +#?(:clj ([x (t/and ratio? numerically-byte?)] (-> x .bigIntegerValue .byteValue)))) + +;; ----- Char ----- ;; + +;; TODO figure out how to use with CLJS +#?(:clj +(t/defn ^:inline >char* + "May involve non-out-of-range truncation." + > char? + ([x char?] x) + ([x (t/- primitive? char? boolean?)] (Primitive/uncheckedCharCast x)))) + +;; TODO TYPED `numerically` +;; TODO figure out how to use with goog.math.Integer/Long +(t/defn ^:inline >char > #?(:clj char? :cljs numerically-char?) + "Does not involve truncation or rounding. + For CLJS, returns not a String of length 1 but a numerically-char Number." + ([x #?(:clj char? :cljs numerically-char?)] x) +#?(:clj ([x (t/and (t/- primitive? char? boolean?) numerically-char?)] (>char* x)) + :cljs ([x (t/and double? numerically-char?)] x)) + ([x boolean?] (if x #?(:clj (char 1) :cljs 1) #?(:clj (char 0) :cljs 0))) +#?(:clj ([x (t/and (t/isa? clojure.lang.BigInt) numerically-char?)] (>char* (.lpart x)))) +#?(:clj ([x (t/and (t/isa? java.math.BigInteger) numerically-char?)] (.charValue x))) +#?(:clj ([x (t/and ratio? numerically-char?)] (-> x .bigIntegerValue .charValue)))) + +;; ----- Short ----- ;; + +;; TODO figure out how to use with CLJS +#?(:clj +(t/defn ^:inline >short* + "May involve non-out-of-range truncation." + > short? + ([x short?] x) + ([x (t/- primitive? short? boolean?)] (Primitive/uncheckedShortCast x)))) + +;; TODO TYPED `numerically` +;; TODO figure out how to use with goog.math.Integer/Long +(t/defn ^:inline >short > #?(:clj short? :cljs numerically-short?) + "Does not involve truncation or rounding." + ([x #?(:clj short? :cljs numerically-short?)] x) +#?(:clj ([x (t/and (t/- primitive? short? boolean?) numerically-short?)] (>short* x)) + :cljs ([x (t/and double? numerically-short?)] x)) + ([x boolean?] (if x #?(:clj (short 1) :cljs 1) #?(:clj (short 0) :cljs 0))) +#?(:clj ([x (t/and (t/isa? clojure.lang.BigInt) numerically-short?)] (>short* (.lpart x)))) +#?(:clj ([x (t/and (t/isa? java.math.BigInteger) numerically-short?)] (.shortValue x))) +#?(:clj ([x (t/and ratio? numerically-short?)] (-> x .bigIntegerValue .shortValue)))) + +;; ----- Int ----- ;; + +;; TODO figure out how to use with goog.math.Integer/Long +#?(:clj +(t/defn ^:inline >int* + "May involve non-out-of-range truncation." + > int? + ( [x int?] x) + (^:in [x (t/- primitive? int? boolean?)] (clojure.lang.RT/uncheckedIntCast x)))) + +;; TODO TYPED `numerically` +;; TODO figure out how to use with goog.math.Integer/Long +(t/defn ^:inline >int + "Does not involve truncation or rounding." + > int? + ([x int?] x) +#?(:clj ([x (t/and (t/- primitive? int? boolean?) numerically-int?)] (>int* x)) + :cljs ([x (t/and double? numerically-int?)] x)) + ([x boolean?] (if x #?(:clj (int 1) :cljs 1) #?(:clj (int 0) :cljs 0))) +#?(:clj ([x (t/and (t/isa? clojure.lang.BigInt) numerically-int?)] (>int* (.lpart x)))) +#?(:clj ([x (t/and (t/isa? java.math.BigInteger) numerically-int?)] (.intValue x))) +#?(:clj ([x (t/and ratio? numerically-int?)] (-> x .bigIntegerValue .intValue)))) + +;; ----- Long ----- ;; + +;; TODO TYPED `numerically` +;; TODO figure out how to use with goog.math.Integer/Long +(t/defn ^:inline >long + "Does not involve truncation or rounding." + > #?(:clj long? :cljs numerically-long?) + ([x #?(:clj long? :cljs numerically-long?)] x) +#?(:clj ([x (t/and (t/- primitive? long? boolean?) numerically-long?)] (>long* x)) + :cljs ([x (t/and double? numerically-long?)] x)) + ([x boolean?] (if x 1 0)) +#?(:clj ([x (t/and (t/isa? clojure.lang.BigInt) + numerically-long? + ;; TODO This might be faster than `numerically-long?` + #_(t/fn [x ?] (nil? (.bipart x))))] (.lpart x))) +#?(:clj ([x (t/and (t/isa? java.math.BigInteger) + numerically-long? + ;; TODO This might be faster than `numerically-long?` + #_(t/fn [x ?] (< (.bitLength x) 64)))] (.longValue x))) +#?(:clj ([x (t/and ratio? numerically-long?)] (-> x .bigIntegerValue .longValue)))) + +;; ----- Float ----- ;; + +;; TODO figure out how to use with CLJS +#?(:clj +(t/defn ^:inline >float* + "May involve non-out-of-range truncation." + > float? + ([x float?] x) + ([x (t/- primitive? float? boolean?)] (Primitive/uncheckedFloatCast x)))) + +;; TODO TYPED `numerically` +;; TODO figure out how to use with goog.math.Integer/Long +(t/defn ^:inline >float > #?(:clj float? :cljs numerically-float?) + "Does not involve truncation or rounding." + ([x #?(:clj float? :cljs numerically-float?)] x) +#?(:clj ([x (t/and (t/- primitive? float? boolean?) numerically-float?)] (>float* x)) + :cljs ([x (t/and double? numerically-float?)] x)) + ([x boolean?] (if x #?(:clj (float 1) :cljs 1) #?(:clj (float 0) :cljs 0))) +#?(:clj ([x (t/and (t/isa? clojure.lang.BigInt) numerically-float?)] (>float* (.lpart x)))) +#?(:clj ([x (t/and (t/isa? java.math.BigInteger) numerically-float?)] (.floatValue x))) +#?(:clj ([x (t/and ratio? numerically-float?)] (-> x .bigIntegerValue .floatValue)))) + +;; ----- Double ----- ;; + +;; TODO TYPED `numerically` +;; TODO figure out how to use with goog.math.Integer/Long +(t/defn ^:inline >double > double? + "Does not involve truncation or rounding." + ([x double?] x) +#?(:clj ([x (t/and (t/- primitive? double? boolean?) numerically-double?)] (>double* x))) + ([x boolean?] (if x #?(:clj 1.0 :cljs 1) #?(:clj 1.0 :cljs 0))) +#?(:clj ([x (t/and (t/isa? clojure.lang.BigInt) numerically-double?)] (>double* (.lpart x)))) +#?(:clj ([x (t/and (t/isa? java.math.BigInteger) numerically-double?)] (.doubleValue x))) +#?(:clj ([x (t/and ratio? numerically-double?)] (-> x .bigIntegerValue .doubleValue)))) + +;; ----- Unsigned ----- ;; + +#?(:clj +(t/defn >unsigned + {:adapted-from #{'ztellman/primitive-math 'gloss.data.primitives}} + ([x p/byte?] (Numeric/bitAnd (short 0xFF) x)) + ([x p/short?] (Numeric/bitAnd (int 0xFFFF) x)) + ([x p/int?] (Numeric/bitAnd (long 0xFFFFFFFF) x)) + ([x p/long?] (java.math.BigInteger. (int 1) + (-> ^:val (ByteBuffer/allocate (int 8)) + ^:val (.putLong x) + .array))))) + +;; TODO TYPED awaiting `>long` +#_(:clj (t/defn ubyte>byte [x long? > long?] (-> x >byte >long))) +#_(:clj (t/defn ushort>short [x long? > long?] (-> x >short >long))) +#_(:clj (t/defn uint>int [x long? > long?] (-> x >int >long))) +#_(:clj (t/defn ulong>long [x bigint? > long?] (-> x >bigint >long))) + + +;; ----- Ratios ----- ;; + +;; TODO TYPED >double +#_(:clj +(t/defn rationalize + "Outputs the rational value of `n`." + {:incorporated {'clojure.lang.Numbers/rationalize "9/2018"}} + > (t/isa? java.lang.Number) + ([x (t/or p/float? p/double?)] + (rationalize (BigDecimal/valueOf (p/>double x)))) + ([x (t/isa? BigDecimal)] + (let [bv (.unscaledValue x) + scale (.scale x)] + (if (< scale 0) + (BigInt/fromBigInteger (.multiply bv (.pow BigInteger.TEN (- scale)))) + (Numbers/divide bv (.pow BigInteger.TEN scale))))) + ([x (t/isa? java.lang.Number)] x))) + +;; TODO TYPED finish +#_(t/defn >ratio > ratio? + #?(:clj ([x ??] (>ratio x 1))) + #?(:clj ([x ??, y ??] + (whenf (rationalize (/ x y)) + (fn-not core/ratio?) + #(clojure.lang.Ratio. (->big-integer %) java.math.BigInteger/ONE))))) + + +;; ===== General ===== ;; + +(t/defn ^:inline numerator > numerically-integer? + ([x numerically-integer? > (t/type x)] x) +#?(:clj ([x ratio? > (t/assume java-bigint?)] (.numerator x)))) + +(t/defn ^:inline denominator > numerically-integer? + ([x numerically-integer? > (t/type x)] (>one-of-type x)) +#?(:clj ([x ratio? > (t/assume java-bigint?)] (.denominator x)))) + + + + +(t/defn >std-fixint + "Converts input to a `std-fixint?` in a way that may involve truncation or rounding." + > std-fixint? +#?(:cljs ([x double? > (t/assume std-fixint?)] (js/Math.round x)))) + +;; TODO TYPED +(t/defn read-rational + "Create cross-platform literal rational numbers from decimal, without intermediate inexact + (e.g. float/double) representation. + + Example: + #r 2.712 -> (rationalize 2.712M)" + {:todo #{"Support exponent notation e.g. 2.313E7 | 2.313e7"}} + [r string?] + (let [r-str (cond (string? r) + r + (symbol? r) + (do (assert (-> r namespace nil?)) + (assert (-> r name first (= \r))) + (->> r name rest (apply str)))) + minus-ct (->> r-str (filter #(= % \-)) count) + _ (assert (#{0 1} minus-ct)) + r-str (case minus-ct + 0 r-str + 1 (do (assert (-> r-str first (= \-))) + (->> r-str rest (apply str)))) + [integral-str decimal-str :as split] (str/split r-str #"\.") + _ (when (-> split count (> 2)) + (throw (ex-info "Number cannot have more than one decimal point" {:num r-str}))) + _ (doseq [s split] + (when-not (every? #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9} s) + (throw (ex-info "Number must have only numeric characters" {:num s})))) + integral (read-string integral-str) ; TODO we should just pass the raw string to the ratio + decimal (read-string decimal-str) ; TODO we should just pass the raw string to the ratio + scale (if decimal + (#?(:clj Math/pow :cljs js/Math.pow) 10 (count decimal-str)) + 1)] + (* (if (= minus-ct 1) -1 1) + (>ratio (+ (* scale integral) (or decimal 0)) + scale)))) diff --git a/src/quantum/core/data/primitive.cljc b/src/quantum/core/data/primitive.cljc index ef7bc432..5cfaef8d 100644 --- a/src/quantum/core/data/primitive.cljc +++ b/src/quantum/core/data/primitive.cljc @@ -1,35 +1,510 @@ (ns quantum.core.data.primitive - (:require - [quantum.core.macros :refer [defnt]])) - -(defnt ->min-magnitude - #?(:clj ([^byte x] (byte 0))) - #?(:clj ([^char x] (char 0))) - #?(:clj ([^short x] (short 0))) - #?(:clj ([^int x] (int 0))) - #?(:clj ([^long x] (long 0))) - #?(:clj ([^float x] Float/MIN_VALUE )) - ([^double x] #?(:clj Double/MIN_VALUE - :cljs js/Number.MIN_VALUE))) - -#?(:clj (def ^:const min-float (- Float/MAX_VALUE))) - (def ^:const min-double (- #?(:clj Double/MAX_VALUE :cljs js/Number.MAX_VALUE))) - -(defnt ->min-value - #?(:clj ([^byte x] Byte/MIN_VALUE )) - #?(:clj ([^char x] Character/MIN_VALUE)) - #?(:clj ([^short x] Short/MIN_VALUE )) - #?(:clj ([^int x] Integer/MIN_VALUE )) - #?(:clj ([^long x] Long/MIN_VALUE )) - #?(:clj ([^float x] min-float )) - ([^double x] min-double )) - -(defnt ->max-value - #?(:clj ([^byte x] Byte/MAX_VALUE )) - #?(:clj ([^char x] Character/MAX_VALUE)) - #?(:clj ([^short x] Short/MAX_VALUE )) - #?(:clj ([^int x] Integer/MAX_VALUE )) - #?(:clj ([^long x] Long/MAX_VALUE )) - #?(:clj ([^float x] Float/MAX_VALUE )) - ([^double x] #?(:clj Double/MAX_VALUE - :cljs js/Number.MAX_VALUE))) + (:refer-clojure :exclude + [boolean? char? comparable? decimal? double? false? float? int? integer? true?]) + (:require + #?(:cljs [com.gfredericks.goog.math.Integer :as int]) + #?(:cljs goog.math.Integer) + #?(:cljs goog.math.Long) + [quantum.core.compare.core :as c?] + [quantum.core.type :as t] + [quantum.untyped.core.logic + :refer [ifs]] + [quantum.untyped.core.numeric :as unum] + [quantum.untyped.core.type :as ut] + ;; TODO TYPED excise reference + [quantum.untyped.core.vars :as var + :refer [defaliases]]) +#?(:clj (:import + [clojure.lang Numbers Util] + [java.nio ByteBuffer] + [quantum.core Numeric Primitive]))) + +;; TODO for CLJS nil/val, we need to check via `js/==` not `js/===` +(t/def nil? ut/nil?) +(t/def val? ut/val?) + +;; ===== Predicates ===== ;; + +#?(:clj (t/def boolean? (t/isa? #?(:clj Boolean :cljs js/Boolean)))) + +#?(:clj (t/def byte? (t/isa? Byte))) + +#?(:clj (t/def short? (t/isa? Short))) + +#?(:clj (t/def char? (t/isa? Character))) + + (t/def int? + "For CLJS, `int?` is not primitive even though it mimics the boxed version of the Java + `int` primitive. It is included in this namespace merely for cohesion." + (t/isa? #?(:clj Integer :cljs goog.math.Integer))) + + (t/def long? + "For CLJS, `long?` is not primitive even though it mimics the boxed version of the Java + `long` primitive. It is included in this namespace merely for cohesion." + (t/isa? #?(:clj Long :cljs goog.math.Long))) + +#?(:clj (t/def float? (t/isa? Float))) + + (t/def double? (t/isa? #?(:clj Double :cljs js/Number))) + + (t/def primitive? + "For CLJS, `int?` and `long?` are not primitive even though they mimic Java primitives. + For CLJS, does not include built-in platform types like js/String that are considered + 'primitive' in some contexts." + (t/or boolean? #?@(:clj [byte? short? char? int? long? float?]) double?)) + + (t/def primitive-type? + (t/or (t/value boolean?) + #?@(:clj [(t/value byte?) (t/value short?) (t/value char?) (t/value int?) (t/value long?) + (t/value float?)]) (t/value double?))) + + (t/def integer? "Specifically primitive integers." + (t/or #?@(:clj [byte? short? int? long?]))) + + (t/def decimal? "Specifically primitive decimals." + (t/or #?(:clj float?) double?)) + + (t/def numeric? + "Specifically primitive numeric things. + Something 'numeric' is something that may be treated as a number but may not actually *be* one." + (t/- primitive? boolean?)) + + (t/def numeric-type? (t/- primitive-type? (t/value boolean?))) + + (defaliases ut true? false?) + +;; ===== Boxing/unboxing ===== ;; + +#?(:clj +(t/def unboxed-class->boxed-class + {Boolean/TYPE Boolean + Byte/TYPE Byte + Character/TYPE Character + Long/TYPE Long + Double/TYPE Double + Short/TYPE Short + Integer/TYPE Integer + Float/TYPE Float})) + +#?(:clj +(t/def boxed-class->unboxed-class + {Integer Integer/TYPE + Long Long/TYPE + Float Float/TYPE + Short Short/TYPE + Boolean Boolean/TYPE + Byte Byte/TYPE + Character Character/TYPE + Double Double/TYPE + Void Void/TYPE})) + +#?(:clj +(t/defn ^:inline box + (^:intrinsic [x boolean? > (t/assume (t/ref (t/type x)))] (Boolean/valueOf x)) + (^:intrinsic [x byte? > (t/assume (t/ref (t/type x)))] (Byte/valueOf x)) + (^:intrinsic [x char? > (t/assume (t/ref (t/type x)))] (Character/valueOf x)) + (^:intrinsic [x short? > (t/assume (t/ref (t/type x)))] (Short/valueOf x)) + (^:intrinsic [x int? > (t/assume (t/ref (t/type x)))] (Integer/valueOf x)) + (^:intrinsic [x long? > (t/assume (t/ref (t/type x)))] (Long/valueOf x)) + (^:intrinsic [x float? > (t/assume (t/ref (t/type x)))] (Float/valueOf x)) + (^:intrinsic [x double? > (t/assume (t/ref (t/type x)))] (Double/valueOf x)) + ( [x t/ref?] x))) + +#?(:clj +(t/defn ^:inline unbox + (^:intrinsic [x (t/ref boolean?) > (t/unref (t/type x))] (.booleanValue x)) + (^:intrinsic [x (t/ref byte?) > (t/unref (t/type x))] (.byteValue x)) + (^:intrinsic [x (t/ref char?) > (t/unref (t/type x))] (.charValue x)) + (^:intrinsic [x (t/ref short?) > (t/unref (t/type x))] (.shortValue x)) + (^:intrinsic [x (t/ref int?) > (t/unref (t/type x))] (.intValue x)) + (^:intrinsic [x (t/ref long?) > (t/unref (t/type x))] (.longValue x)) + (^:intrinsic [x (t/ref float?) > (t/unref (t/type x))] (.floatValue x)) + (^:intrinsic [x (t/ref double?) > (t/unref (t/type x))] (.doubleValue x)))) + +(t/defn ^:inline >type > t/type? + ([x (t/or boolean? (t/value boolean?))] boolean?) + ([x (t/or byte? (t/value byte?))] byte?) + ([x (t/or char? (t/value char?))] char?) + ([x (t/or short? (t/value short?))] short?) + ([x (t/or int? (t/value int?))] int?) + ([x (t/or long? (t/value long?))] long?) + ([x (t/or float? (t/value float?))] float?) + ([x (t/or double? (t/value double?))] double?)) + +;; ===== Bit lengths ===== ;; + +(t/def boolean-bits "Implementationally might not be bit-manipulable but logically 1 bit" 1) +(t/def byte-bits 8) +(t/def short-bits 16) +(t/def char-bits 16) +(t/def int-bits 32) +(t/def long-bits 64) +(t/def float-bits 32) +(t/def double-bits 64) + +;; ===== Extreme magnitudes and values ===== ;; + +(t/defn ^:inline >min-magnitude +#?(:clj ([x (t/or byte? (t/value byte?)) > byte?] (byte 0))) +#?(:clj ([x (t/or short? (t/value short?)) > short?] (short 0))) +#?(:clj ([x (t/or char? (t/value char?)) > char?] (char 0))) +#?(:clj ([x (t/or int? (t/value int?)) > int?] (int 0))) +#?(:clj ([x (t/or long? (t/value long?)) > long?] (long 0))) +#?(:clj ([x (t/or float? (t/value float?)) > float?] Float/MIN_VALUE)) + ([x (t/or double? (t/value double?)) > double?] + #?(:clj Double/MIN_VALUE :cljs js/Number.MIN_VALUE))) + +#?(:clj (t/def- min-float (Numeric/negate Float/MAX_VALUE))) + (t/def- min-double (- #?(:clj Double/MAX_VALUE :cljs js/Number.MAX_VALUE))) + +(t/defn ^:inline >min-value +#?(:clj ([x (t/or byte? (t/value byte?)) > byte?] Byte/MIN_VALUE)) +#?(:clj ([x (t/or short? (t/value short?)) > short?] Short/MIN_VALUE)) +#?(:clj ([x (t/or char? (t/value char?)) > char?] Character/MIN_VALUE)) +#?(:clj ([x (t/or int? (t/value int?)) > int?] Integer/MIN_VALUE)) +#?(:clj ([x (t/or long? (t/value long?)) > long?] Long/MIN_VALUE)) +#?(:clj ([x (t/or float? (t/value float?)) > float?] min-float)) + ([x (t/or double? (t/value double?)) > double?] min-double)) + +(t/defn ^:inline >max-value +#?@(:clj [([x (t/or byte? (t/value byte?)) > byte?] Byte/MAX_VALUE) + ([x (t/or short? (t/value short?)) > short?] Short/MAX_VALUE) + ([x (t/or char? (t/value char?)) > char?] Character/MAX_VALUE) + ([x (t/or int? (t/value int?)) > int?] Integer/MAX_VALUE) + ([x (t/or long? (t/value long?)) > long?] Long/MAX_VALUE) + ([x (t/or float? (t/value float?)) > float?] Float/MAX_VALUE)]) + ([x (t/or double? (t/value double?)) > double?] + #?(:clj Double/MAX_VALUE :cljs js/Number.MAX_VALUE))) + +(t/defn ^:inline >min-safe-integer-value +#?@(:clj [([x (t/or byte? (t/value byte?)) > byte?] (>min-value x)) + ([x (t/or short? (t/value short?)) > short?] (>min-value x)) + ([x (t/or char? (t/value char?)) > char?] (>min-value x)) + ([x (t/or int? (t/value int?)) > int?] (>min-value x)) + ([x (t/or long? (t/value long?)) > long?] (>min-value x)) + ;; [2 ^ ( + 1)] - 1 + ([x (t/or float? (t/value float?)) > float?] (unchecked-float -16777216.0))]) + ([x (t/or double? (t/value double?)) > double?] -9007199254740991.0)) + +(t/defn ^:inline >max-safe-integer-value +#?@(:clj [([x (t/or byte? (t/value byte?)) > byte?] (>max-value x)) + ([x (t/or short? (t/value short?)) > short?] (>max-value x)) + ([x (t/or char? (t/value char?)) > char?] (>max-value x)) + ([x (t/or int? (t/value int?)) > int?] (>max-value x)) + ([x (t/or long? (t/value long?)) > long?] (>max-value x)) + ;; [2 ^ ( + 1)] - 1 + ([x (t/or float? (t/value float?)) > float?] (unchecked-float 16777216.0))]) + ([x (t/or double? (t/value double?)) > double?] 9007199254740991.0)) + +;; ===== Primitive type properties ===== ;; + +(t/defn ^:inline signed? + ([x (t/or char? (t/value Character) (t/value char?))] false) +#?@(:clj [([x (t/or byte? (t/value Byte) (t/value byte?) + short? (t/value Short) (t/value short?) + int? (t/value Integer) (t/value int?) + long? (t/value Long) (t/value long?) + float? (t/value Float) (t/value float?) + double? (t/value #?(:clj Double :cljs js/Number)) (t/value double?))] true)])) + +;; TODO TYPED `t/numerically-integer?` +(t/defn ^:inline >bit-size ; > t/numerically-integer? + ([x (t/or boolean? (t/value #?(:clj Boolean :cljs js/Boolean)) (t/value boolean?))] + boolean-bits) +#?@(:clj [([x (t/or byte? (t/value Byte) (t/value byte?))] byte-bits) + ([x (t/or short? (t/value Short) (t/value short?))] short-bits) + ([x (t/or char? (t/value Character) (t/value char?))] char-bits) + ([x (t/or int? (t/value Integer) (t/value int?))] int-bits) + ([x (t/or long? (t/value Long) (t/value long?))] long-bits) + ([x (t/or float? (t/value Float) (t/value float?))] float-bits)]) + ([x (t/or double? (t/value #?(:clj Double :cljs js/Number)) (t/value double?))] + double-bits)) + +;; ===== Conversion ===== ;; +;; Note that numeric-primitive conversions do not go here (but may be found in +;; `quantum.core.data.numeric`) because they take as inputs and produce outputs things that are +;; within a numeric range. + +;; ----- Boolean ----- ;; + +;; TODO CLJS +;; TODO rethink — is everything that's a 0 false and everything that's a 1 a true? Or is it just +;; 0's that are false? Etc. +(t/defn ^:inline >boolean + "Converts input to a boolean. + Differs from asking whether something is truthy/falsey." + > boolean? + ([x boolean?] x) ;; For purposes of Clojure intrinsics +#?(:clj ([x (t/or long? double?)] (-> x clojure.lang.Numbers/isZero Numeric/not))) +#?(:clj ([x (t/- primitive? boolean? long? double?)] (-> x Numeric/isZero Numeric/not)))) + +;; ===== Extensions ===== ;; + +#?(:clj +(t/extend-defn! c?/== + (^:in [a boolean? , b boolean?] (Util/equiv a b)) + ( [a boolean? , b (t/- primitive? boolean?)] false) + ( [a (t/- primitive? boolean?) , b boolean?] false) + (^:in [a long? , b long?] (Numbers/equiv a b)) + ( [a long? , b (t/- numeric? double? long?)] (Numeric/eq a b)) + ( [a (t/- numeric? long?) , b long?] (Numeric/eq a b)) + (^:in [a double? , b double?] (Numbers/equiv a b)) + ( [a double? , b (t/- numeric? double? long?)] (Numeric/eq a b)) + ( [a (t/- numeric? double?) , b double?] (Numeric/eq a b)) + ( [a (t/- numeric? double? long?), b (t/- numeric? double? long?)] (Numeric/eq a b)))) + +#?(:clj +(t/extend-defn! c?/not== + ([a boolean? , b boolean?] (Numeric/neq a b)) + ([a boolean? , b (t/- primitive? boolean?)] false) + ([a (t/- primitive? boolean?), b boolean?] false) + ([a numeric? , b numeric?] (Numeric/neq a b)))) + +(t/extend-defn! c?/= + ([a primitive?, b primitive?] (c?/== a b)) +#?(:cljs ([a primitive?, b t/any?] false))) + +(t/extend-defn! c?/not= + ([a primitive?, b primitive?] (c?/not== a b))) + +(t/extend-defn! c?/< +#?(:clj (^:in [a long? , b long?] (Numbers/lt a b))) +#?(:clj ( [a long? , b (t/- numeric? double? long?)] (Numeric/lt a b))) +#?(:clj ( [a (t/- numeric? long?) , b long?] (Numeric/lt a b))) +#?(:clj (^:in [a double? , b double?] (Numbers/lt a b))) +#?(:clj ( [a double? , b (t/- numeric? double? long?)] (Numeric/lt a b))) +#?(:clj ( [a (t/- numeric? double?) , b double?] (Numeric/lt a b))) +#?(:clj ( [a (t/- numeric? double? long?), b (t/- numeric? double? long?)] (Numeric/lt a b))) +#?(:cljs ( [a numeric? , b numeric?] (cljs.core/< a b))) +) + +(t/extend-defn! c?/<= +#?(:clj (^:in [a long? , b long?] (Numbers/lte a b))) +#?(:clj ( [a long? , b (t/- numeric? double? long?)] (Numeric/lte a b))) +#?(:clj ( [a (t/- numeric? long?) , b long?] (Numeric/lte a b))) +#?(:clj (^:in [a double? , b double?] (Numbers/lte a b))) +#?(:clj ( [a double? , b (t/- numeric? double? long?)] (Numeric/lte a b))) +#?(:clj ( [a (t/- numeric? double?) , b double?] (Numeric/lte a b))) +#?(:clj ( [a (t/- numeric? double? long?), b (t/- numeric? double? long?)] (Numeric/lte a b))) +#?(:cljs ( [a numeric? , b numeric?] (cljs.core/<= a b))) +) + +(t/extend-defn! c?/> +#?(:clj (^:in [a long? , b long?] (Numbers/gt a b))) +#?(:clj ( [a long? , b (t/- numeric? double? long?)] (Numeric/gt a b))) +#?(:clj ( [a (t/- numeric? long?) , b long?] (Numeric/gt a b))) +#?(:clj (^:in [a double? , b double?] (Numbers/gt a b))) +#?(:clj ( [a double? , b (t/- numeric? double? long?)] (Numeric/gt a b))) +#?(:clj ( [a (t/- numeric? double?) , b double?] (Numeric/gt a b))) +#?(:clj ( [a (t/- numeric? double? long?), b (t/- numeric? double? long?)] (Numeric/gt a b))) +#?(:cljs ( [a numeric? , b numeric?] (cljs.core/> a b))) +) + +(t/extend-defn! c?/>= +#?(:clj (^:in [a long? , b long?] (Numbers/gte a b))) +#?(:clj ( [a long? , b (t/- numeric? double? long?)] (Numeric/gte a b))) +#?(:clj ( [a (t/- numeric? long?) , b long?] (Numeric/gte a b))) +#?(:clj (^:in [a double? , b double?] (Numbers/gte a b))) +#?(:clj ( [a double? , b (t/- numeric? double? long?)] (Numeric/gte a b))) +#?(:clj ( [a (t/- numeric? double?) , b double?] (Numeric/gte a b))) +#?(:clj ( [a (t/- numeric? double? long?), b (t/- numeric? double? long?)] (Numeric/gte a b))) +#?(:cljs ( [a numeric? , b numeric?] (cljs.core/>= a b))) +) + +(t/extend-defn! c?/compare + ([a false? , b false?] (int 0)) + ([a false? , b true?] (int -1)) + ([a true? , b false?] (int 1)) + ([a true? , b true?] (int 0)) + #_([a boolean? , b boolean?] + (if a (if b (int 0) (int 1)) (if b (int -1) (int 0)))) + ([a numeric? , b numeric?] + (ifs (c?/< a b) (int -1) (c?/> a b) (int 1) (int 0))) +#?(:clj ([a (t/ref c?/icomparable?), b numeric?] (.compareTo a b))) +#?(:clj ([a numeric? , b (t/ref c?/icomparable?)] (.compareTo (box a) b)))) + +(t/extend-defn! c?/comp< + ([a (t/input c?/compare :? :_), b (t/input c?/compare [= (t/type a)] :?)] + (c?/< (c?/compare a b) 0))) + +(t/extend-defn! c?/comp<= + ([a (t/input c?/compare :? :_), b (t/input c?/compare [= (t/type a)] :?)] + (c?/<= (c?/compare a b) 0))) + +(t/extend-defn! c?/comp= + ([a (t/input c?/compare :? :_), b (t/input c?/compare [= (t/type a)] :?)] + (c?/= (c?/compare a b) 0))) + +(t/extend-defn! c?/comp>= + ([a (t/input c?/compare :? :_), b (t/input c?/compare [= (t/type a)] :?)] + (c?/>= (c?/compare a b) 0))) + +(t/extend-defn! c?/comp> + ([a (t/input c?/compare :? :_), b (t/input c?/compare [= (t/type a)] :?)] + (c?/> (c?/compare a b) 0))) + +;; TODO come back to this +;; Use interval tree? +#_(t/defn promote-type + "Based on max/min safe integer value." + ;; TODO Write it all out and compress later + ([t|max (t/value byte?)] t|max (t/value short?)] t|>max) + ([t|max (t/value char?)] int?) + ([t|max (t/value int?)] t|>max) + ([t|max (t/value long?)] t|>max) + ([t|max (t/value float?)] t|>max) + ([t|max (t/value double?)] t|>max)) + +;; TODO come back to this +#_(t/defn narrowest + "Based on max/min safe integer value." + > t/type? + ([t0 (t/and (t/input >min-safe-integer-value [:? t/>= t/type?]) + (t/input >max-safe-integer-value [:? t/>= t/type?])) + t1 (t/and (t/input >min-safe-integer-value [:? t/>= t/type?]) + (t/input >max-safe-integer-value [:? t/>= t/type?]))] + (let [t0-min (>min-safe-integer-value t0) + t1-min (>min-safe-integer-value t1) + t0-max (>max-safe-integer-value t0) + t1-max (>max-safe-integer-value t1)] + ;; TODO this provides great room for auto-optimization + (ifs (c?/= t0-min t1-min) + (ifs (c?/= t0-max t1-max) t0 + (c?/< t0-max t1-max) t1 + t0) + (c?/< t0-min t1-min) + (ifs (c?/< t0-max t1-max) (promote-type t0 t1) + (c?/= t0-max t1-max) t0 + t0) + (ifs (c?/> t0-max t1-max) (promote-type t1 t0) + (c?/= t0-max t1-max) t1 + t1))))) + +;; TODO maybe use `> (narrowest (t/type a) (t/type b))` for `min` and `max` +(t/extend-defn! c?/min +#?(:clj ( [a (t/- numeric? int? float? double?) + b (t/- numeric? int? float? double?)] (if (c?/< a b) a b))) +#?(:clj ( [a int? , b (t/- numeric? int?)] (if (c?/< a b) a b))) +#?(:clj ( [a (t/- numeric? int?) , b int?] (if (c?/< a b) a b))) +#?(:clj (^:in [a int? , b int?] (Math/min a b))) +#?(:clj ( [a float? , b (t/- numeric? int? float?)] (if (c?/< a b) a b))) +#?(:clj ( [a (t/- numeric? int? float?), b float?] (if (c?/< a b) a b))) +#?(:clj ( [a float? , b float?] (Math/min a b))) +#?(:clj ( [a double? + b (t/- numeric? int? float? double?)] (if (c?/< a b) a b))) +#?(:clj ( [a (t/- numeric? int? float? double?) + b double?] (if (c?/< a b) a b))) +#?(:clj ( [a double? , b double?] (Math/min a b))) +#?(:cljs ( [a double? , b double? > (t/assume double?)] (js/Math.min a b)))) + +(t/extend-defn! c?/max +#?(:clj ( [a (t/- numeric? int? float? double?) + b (t/- numeric? int? float? double?)] (if (c?/> a b) a b))) +#?(:clj ( [a int? , b (t/- numeric? int?)] (if (c?/> a b) a b))) +#?(:clj ( [a (t/- numeric? int?) , b int?] (if (c?/> a b) a b))) +#?(:clj (^:in [a int? , b int?] (Math/max a b))) +#?(:clj ( [a float? , b (t/- numeric? int? float?)] (if (c?/> a b) a b))) +#?(:clj ( [a (t/- numeric? int? float?), b float?] (if (c?/> a b) a b))) +#?(:clj ( [a float? , b float?] (Math/max a b))) +#?(:clj ( [a double? + b (t/- numeric? int? float? double?)] (if (c?/> a b) a b))) +#?(:clj ( [a (t/- numeric? int? float? double?) + b double?] (if (c?/> a b) a b))) +#?(:clj ( [a double? , b double?] (Math/max a b))) +#?(:cljs ( [a double? , b double? > (t/assume double?)] (js/Math.max a b)))) + +;; ===== Readers ===== ;; + +(t/defn read-byte + "Used for the `#b` literal. Only a literal long, double, or char may be converted to a byte, as + long as it is in the numeric range of a byte, as with `num/>byte`. + + Using e.g. `#b 1` outside of a typed context results in a runtime call to + `RT.readString(\"#=(java.lang.Byte. \\\"1\\\")\")` which is undesirable with respect to + performance." + ([x (t/or #?(:clj char?) #?(:clj long?) double?)] + (if-not (and (c?/>= x -128) (c?/<= x 127) (unum/integer-value? x)) + (throw (new #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + "Form input to `#b` is not in the numeric range of a byte" {:form x} nil)) + (#?(:clj Primitive/uncheckedByteCast :cljs unchecked-byte) x)))) + +(t/defn read-short + "Used for the `#s` literal. Only a literal long, double, or char may be converted to a short, as + long as it is in the numeric range of a short, as with `num/>short`. + + Using e.g. `#s 1` outside of a typed context results in a runtime call to + `RT.readString(\"#=(java.lang.Short. \\\"1\\\")\")` which is undesirable with respect to + performance." + ([x (t/or #?(:clj char?) #?(:clj long?) double?)] + (if-not (and (c?/>= x -32768) (c?/<= x 32767) (unum/integer-value? x)) + (throw (new #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + "Form input to `#s` is not in the numeric range of a short" {:form x} nil)) + (#?(:clj Primitive/uncheckedShortCast :cljs unchecked-short) x)))) + +(t/defn read-char + "Used for the `#c` literal. Only a literal long, double, or char may be converted to a char, as + long as it is in the numeric range of a char, as with `num/>char`. + + Using e.g. `#c 1` outside of a typed context results in a runtime call to + `RT.readString(\"#=(java.lang.Character. \\\"1\\\")\")` which is undesirable with respect to + performance." +#?(:clj ([x char?] x)) + ([x (t/or #?(:clj long?) double?)] + (if-not (and (c?/>= x 0) (c?/<= x 65535) (unum/integer-value? x)) + (throw (new #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + "Form input to `#c` is not in the numeric range of a char" {:form x} nil)) + (unchecked-char x)))) + +(t/defn read-int + "Used for the `#i` literal. Only a literal long, double, or char may be converted to an int, as + long as it is in the numeric range of a int, as with `num/>int`. + + Using e.g. `#i 1` outside of a typed context results in a runtime call to + `RT.readString(\"#=(java.lang.Integer. \\\"1\\\")\")` which is undesirable with respect to + performance." +#?(:clj ([x char?] (Primitive/uncheckedIntCast x))) + ([x (t/or #?(:clj long?) double?)] + (if-not (and (c?/>= x -2147483648) (c?/<= x 2147483647) (unum/integer-value? x)) + (throw (new #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + "Form input to `#i` is not in the numeric range of a int" {:form x} nil)) + (unchecked-int x)))) + +(t/defn read-long + "Used for the `#l` literal. Only a literal long, double, or char may be converted to a long, as + long as it is in the numeric range of a long, as with `num/>long`." +#?(:clj ([x char?] (Primitive/uncheckedLongCast x))) +#?(:clj ([x long?] x)) + ([x double?] + (if-not (and (c?/>= x (>min-safe-integer-value double?)) + (c?/<= x (>max-safe-integer-value double?)) + (unum/integer-value? x)) + (throw (new #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + "Form input to `#l` is not in the numeric range of a long" {:form x} nil)) + (unchecked-long x)))) + +(t/defn read-float + "Used for the `#f` literal. Only a literal long, double, or char may be converted to a float, as + long as it is in the numeric range of a float, as with `num/>float`. + + Using e.g. `#f 1` outside of a typed context results in a runtime call to + `RT.readString(\"#=(java.lang.Float. \\\"1\\\")\")` which is undesirable with respect to + performance." +#?(:clj ([x char?] (Primitive/uncheckedFloatCast x))) + ([x (t/or #?(:clj long?) double?)] + (if-not (and (c?/>= x -3.4028235e+38) (c?/<= x 3.4028235e+38) (unum/integer-value? x)) + (throw (new #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + "Form input to `#f` is not in the numeric range of a float" {:form x} nil)) + (unchecked-float x)))) + +(t/defn read-double + "Used for the `#d` literal. Only a literal long, double, or char may be converted to a double, as + long as it is in the numeric range of a double, as with `num/>double`." +#?(:clj ([x char?] (Primitive/uncheckedDoubleCast x))) +#?(:clj ([x long?] + (if-not (and (c?/>= x (>min-safe-integer-value double?)) + (c?/<= x (>max-safe-integer-value double?))) + (throw (new #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + "Form input to `#d` is not in the numeric range of a double" {:form x} nil)) + (unchecked-double x)))) + ([x double?] x)) diff --git a/src/quantum/core/data/queue.cljc b/src/quantum/core/data/queue.cljc index a49f1094..e8abaf4a 100644 --- a/src/quantum/core/data/queue.cljc +++ b/src/quantum/core/data/queue.cljc @@ -1,22 +1,35 @@ -(ns - ^{:doc "Incorporates the semi-obscure clojure.lang.PersistentQueue into the - quantum library." - :attribution "alexandergunnarson"} - quantum.core.data.queue) +(ns quantum.core.data.queue + "Queues, particularly FIFO queues, as LIFO = stack = any vector. -; QUEUES -; https://github.com/michalmarczyk/jumping-queues + To investigate: + - https://github.com/michalmarczyk/jumping-queues" + (:require + [clojure.core :as core] + [quantum.core.type :as t])) -(defn queue - "Creates an empty persistent queue, or one populated with a collection." - {:attribution "weavejester.medley"} - ([] #?(:clj (clojure.lang.PersistentQueue/EMPTY) - :cljs (.-EMPTY cljs.core/PersistentQueue))) - ([coll] (into (queue) coll))) +(def +queue? (t/isa? #?(:clj clojure.lang.PersistentQueue + :cljs cljs.core/PersistentQueue))) +(def !+queue? t/none?) +(def ?!+queue? (t/or +queue? !+queue?)) + +#?(:clj (def !!queue? (t/or (t/isa? java.util.concurrent.BlockingQueue) + (t/isa? java.util.concurrent.TransferQueue) + (t/isa? java.util.concurrent.ConcurrentLinkedQueue)))) + +(def !queue? #?(:clj ;; Considered single-threaded mutable unless otherwise noted + ;; TODO TYPED re-enable one `t/-` works properly + #_(t/- (t/isa? java.util.Queue) (t/or ?!+queue? !!queue?)) + t/none? + :cljs (t/isa? goog.structs.Queue))) + +(def queue? (t/or ?!+queue? !queue? #?(:clj !!queue?))) + +(t/defn >queue > +queue? + ([] #?(:clj clojure.lang.PersistentQueue/EMPTY + :cljs (.-EMPTY cljs.core/PersistentQueue)))) #?(:clj - (defmethod print-method clojure.lang.PersistentQueue - [q w] - (print-method '<- w) - (print-method (seq q) w) - (print-method '-< w))) +(defmethod print-method clojure.lang.PersistentQueue [q w] + (print-method '<- w) + (print-method (core/seq q) w) + (print-method '-< w))) diff --git a/src/quantum/core/data/reactive.cljc b/src/quantum/core/data/reactive.cljc new file mode 100644 index 00000000..63d6e8c0 --- /dev/null +++ b/src/quantum/core/data/reactive.cljc @@ -0,0 +1 @@ +(ns quantum.core.data.reactive) diff --git a/src/quantum/core/data/set.cljc b/src/quantum/core/data/set.cljc index edc561cd..dec4fff4 100644 --- a/src/quantum/core/data/set.cljc +++ b/src/quantum/core/data/set.cljc @@ -1,38 +1,207 @@ -(ns - ^{:doc "Useful set-related functions. Includes a dispatch function, |xset?|, - from which |subset|, |superset|, |proper-subset?|, and so on may be called." - :attribution "alexandergunnarson"} - quantum.core.data.set - (:refer-clojure :exclude - [+ - and or not split-at hash-set]) - (:require - [clojure.core :as core] - [clojure.set :as set] - [clojure.data.avl :as avl] - [quantum.core.vars :as var - :refer [defalias]] - [quantum.core.error :as err - :refer [>ex-info TODO]] - [quantum.core.fn :as fn] - [quantum.untyped.core.data.set :as uset] -#?@(:clj - [[clojure.data.finger-tree :as ftree] - [flatland.ordered.set :as oset] - [seqspert.hash-set] - [clojure.data.int-map :as imap]])) - (:import -#?@(:clj - [java.util.HashSet - [it.unimi.dsi.fastutil.ints IntOpenHashSet] - [it.unimi.dsi.fastutil.longs LongOpenHashSet] - [it.unimi.dsi.fastutil.doubles DoubleOpenHashSet]] - :cljs - [goog.structs.Set]))) +(ns quantum.core.data.set + "A set may be thought of as a special type of Map whose keys and vals are identical." + {:todo #{"Explore the possibility of 64-bit `PersistentHashSet`s"}} + (:refer-clojure :exclude + [+ -, and or not, compare, split-at hash-set]) + (:require + ;; TODO TYPED excise + [clojure.core :as core] + #?(:clj [clojure.data.finger-tree :as ftree]) + #?(:clj [clojure.data.int-map :as imap]) + ;; TODO TYPED excise + [clojure.set :as set] + ;; TODO TYPED excise + [clojure.data.avl :as avl] + [linked.core :as linked] + [quantum.core.vars :as var + :refer [defalias defaliases]] + ;; TODO TYPED excise + [quantum.untyped.core.data.set :as uset] + ;; TODO TYPED excise + [quantum.untyped.core.error :as uerr] + #?(:clj [seqspert.hash-set])) +#?(:clj (:import + [it.unimi.dsi.fastutil.doubles DoubleOpenHashSet] + [it.unimi.dsi.fastutil.ints IntOpenHashSet] + [it.unimi.dsi.fastutil.longs LongOpenHashSet] + [java.util HashSet]))) + +;; ===== Sets ===== ;; + +#?(:clj (def java-set? (t/isa? java.util.Set))) + +;; ----- Identity Sets (identity-based equality) ----- ;; + + (def +identity-set? t/none?) + (def !+identity-set? t/none?) + (def ?!+identity-set? (t/or +identity-set? !+identity-set?)) + + (var/def !identity-set? + "`java.util.IdentityHashSet` doesn't exist." + #?(:clj t/none? :cljs (t/isa? js/Set))) + +#?(:clj (def !!identity-set? t/none?)) + + (def identity-set? (t/or ?!+identity-set? !identity-set? #?(:cljs !!identity-set?))) + +;; ----- Hash Sets (value-based equality) ----- ;; + +(def +hash-set? (t/isa? #?(:clj clojure.lang.PersistentHashSet + :cljs cljs.core/PersistentHashSet))) +(def !+hash-set? (t/isa? #?(:clj clojure.lang.PersistentHashSet$TransientHashSet + :cljs cljs.core/TransientHashSet))) +(def ?!+hash-set? (t/or +hash-set? !+hash-set?)) + +(def !hash-set|byte? #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.ByteOpenHashSet) + :cljs t/none?)) +(def !hash-set|char? #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.CharOpenHashSet) + :cljs t/none?)) +(def !hash-set|short? #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.ShortOpenHashSet) + :cljs t/none?)) +(def !hash-set|int? #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.IntOpenHashSet) + :cljs t/none?)) +(def !hash-set|long? #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.LongOpenHashSet) + :cljs t/none?)) +(def !hash-set|float? #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.FloatOpenHashSet) + :cljs t/none?)) +(def !hash-set|double? #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.DoubleOpenHashSet) + :cljs t/none?)) + +(def !hash-set|ref? #?(:clj (t/or (t/isa? java.util.HashSet) + (t/isa? it.unimi.dsi.fastutil.objects.ReferenceOpenHashSet)) + :cljs t/none?)) + +(def !hash-set? + (t/or !hash-set|ref? + !hash-set|byte? !hash-set|short? !hash-set|char? !hash-set|int? !hash-set|long? + !hash-set|float? !hash-set|double?)) + +#?(:clj +(var/def !!hash-set? + "CLJ technically can have a `!!hash-set?` via `java.util.concurrent.ConcurrentHashMap` with same + KVs but this hasn't been implemented yet." + t/none?)) + +(def hash-set? (t/or ?!+hash-set? !hash-set? #?(:clj !!hash-set?))) + +;; ----- Unsorted Sets ----- ;; + +(def +unsorted-set? +hash-set?) +(def !+unsorted-set? !+hash-set?) +(def ?!+unsorted-set? ?!+hash-set?) + +(def !unsorted-set|byte? !hash-set|byte?) +(def !unsorted-set|short? !hash-set|char?) +(def !unsorted-set|char? !hash-set|short?) +(def !unsorted-set|int? !hash-set|int?) +(def !unsorted-set|long? !hash-set|long?) +(def !unsorted-set|float? !hash-set|float?) +(def !unsorted-set|double? !hash-set|double?) +(def !unsorted-set|ref? !hash-set|ref?) + +(def !unsorted-set? + (t/or !unsorted-set|ref? + !unsorted-set|byte? !unsorted-set|short? !unsorted-set|char? + !unsorted-set|int? !unsorted-set|long? + !unsorted-set|float? !unsorted-set|double?)) + +#?(:clj (def !!unsorted-set? !!hash-set?)) + (def unsorted-set? hash-set?) + +;; ----- Sorted Sets ----- ;; + +(def +sorted-set? (t/isa? #?(:clj clojure.lang.PersistentTreeSet + :cljs cljs.core/PersistentTreeSet))) +(def !+sorted-set? t/none?) +(def ?!+sorted-set? (t/or +sorted-set? !+sorted-set?)) + +(def !sorted-set|byte? #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.ByteSortedSet) + :cljs t/none?)) +(def !sorted-set|short? #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.ShortSortedSet) + :cljs t/none?)) +(def !sorted-set|char? #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.CharSortedSet) + :cljs t/none?)) +(def !sorted-set|int? #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.IntSortedSet) + :cljs t/none?)) +(def !sorted-set|long? #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.LongSortedSet) + :cljs t/none?)) +(def !sorted-set|float? #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.FloatSortedSet) + :cljs t/none?)) +(def !sorted-set|double? #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.DoubleSortedSet) + :cljs t/none?)) + +(var/def !sorted-set|ref? + "CLJS technically can have a `!sorted-set|ref?` via `goog.structs.AVLTree` with same KVs but this + hasn't been implemented yet." + #?(:clj (t/isa? java.util.TreeSet) :cljs t/none?)) + +(def !sorted-set? + (t/or !sorted-set|ref? + !sorted-set|byte? !sorted-set|short? !sorted-set|char? !sorted-set|int? !sorted-set|long? + !sorted-set|float? !sorted-set|double?)) + +#?(:clj +(var/def !!sorted-set? + "CLJ technically can have a `!!sorted-set?` via a `java.util.concurrent.ConcurrentSkipListMap` + with same KVs but this hasn't been implemented yet." + t/none?)) + +(def sorted-set? + (t/or ?!+sorted-set? !sorted-set? #?@(:clj [!!sorted-set? (t/isa? java.util.SortedSet)]))) + +;; ----- Other Sets ----- ;; + +(def +insertion-ordered-set? (or (isa? linked.set.LinkedSet) + ;; This is true, but we have replaced OrderedSet with LinkedSet + #_(:clj (isa? flatland.ordered.set.OrderedSet)))) +(def !+insertion-ordered-set? t/none? + ;; This is true, but we have replaced OrderedSet with LinkedSet + #_(t/isa? flatland.ordered.set.TransientOrderedSet)) +(def ?!+insertion-ordered-set? (t/or +insertion-ordered-set? !+insertion-ordered-set?)) + +(def !insertion-ordered-set? #?(:clj (t/isa? java.util.LinkedHashSet) :cljs t/none?)) + +#?(:clj +(var/def !!insertion-ordered-set? + "CLJ technically can have this via a `java.util.concurrent.ConcurrentLinkedHashMap with same KVs + but this hasn't been implemented yet." + t/none?)) + +(def insertion-ordered-set? + (t/or ?!+insertion-ordered-set? !insertion-ordered-set? #?(:clj !!insertion-ordered-set?))) + +;; ----- General Sets ----- ;; + +(def !+set? (t/isa? #?(:clj clojure.lang.ITransientSet + :cljs cljs.core/ITransientSet))) + +(var/defalias ut/+set|built-in?) + +(def +set? (t/isa? #?(:clj clojure.lang.IPersistentSet + :cljs cljs.core/ISet))) + +(def ?!+set? (t/or !+set? +set?)) + +(def !set|byte? #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.ByteSet) :cljs t/none?)) +(def !set|short? #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.ShortSet) :cljs t/none?)) +(def !set|char? #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.CharSet) :cljs t/none?)) +(def !set|int? #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.IntSet) :cljs t/none?)) +(def !set|long? #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.LongSet) :cljs t/none?)) +(def !set|float? #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.FloatSet) :cljs t/none?)) +(def !set|double? #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.DoubleSet) :cljs t/none?)) +(def !set|ref? (t/or !unsorted-set|ref? !sorted-set|ref?)) + +(def !set? (t/or !set|ref? + !set|byte? !set|short? !set|char? !set|int? !set|long? + !set|float? !set|double?)) + +#?(:clj (def !!set? (t/or !!unsorted-set? !!sorted-set?))) + (def set? (t/or ?!+set? !set? #?@(:clj [!!set? (t/isa? java.util.Set)]))) ; ============ STRUCTURES ============ -#?(:clj (defalias ordered-set oset/ordered-set)) ; insertion-ordered set -#?(:clj (defalias oset ordered-set)) + (defalias ordered-set linked/set) ; insertion-ordered set + (defalias oset ordered-set) #?(:clj (defalias c-sorted-set ftree/counted-sorted-set)) ; sorted set that provides log-n nth (defalias sorted-rank-set avl/sorted-set ) (defalias sorted-rank-set-by avl/sorted-set-by) @@ -43,18 +212,18 @@ (defalias split-at avl/split-at ) #?(:clj (defalias long-set imap/int-set)) -#?(:clj (defalias set:long long-set)) +#?(:clj (defalias set|long long-set)) (defalias hash-set core/hash-set) -#?(:clj (defalias hash-set:long set:long)) +#?(:clj (defalias hash-set|long set|long)) #?(:clj (defalias dense-long-set imap/dense-int-set)) -#?(:clj (defalias set:long:dense dense-long-set)) -#?(:clj (defalias hash-set:long:dense set:long:dense)) +#?(:clj (defalias set|long|dense dense-long-set)) +#?(:clj (defalias hash-set|long|dense set|long|dense)) #?(:clj (defalias hash-set? uset/hash-set?)) (defn ->set "Like `clojure.core/set`" - [xs] (TODO)) + [xs] (uerr/TODO)) #?(:clj (defn !bit-set @@ -63,38 +232,21 @@ - has a rigid `logicalSize`|capacity - attempts to `get`, `set` or `clear` bits at indices exceeding the size cause an `IndexOutOfBoundsException`" - [& args] (TODO))) + [& args] (uerr/TODO))) #?(:clj (defn !bit-set-frame {:see-also "net/openhft/chronicle/algo/bitset/SingleThreadedFlatBitSetFrame"} - [& args] (TODO))) + [& args] (uerr/TODO))) #?(:clj (defn !!bit-set-frame {:see-also "net/openhft/chronicle/algo/bitset/ConcurrentFlatBitSetFrame"} - [& args] (TODO))) - -; ============ PREDICATES ============ - -(defn xset? - {:attribution "alexandergunnarson" - :todo ["A cool idea... but improve performance"]} - [fn-key set1 set2] - (let [funcs - (case fn-key - :sub {:eq <= :fn #(vector (partial contains? %2) %1)} - :super {:eq >= :fn #(vector (partial contains? %1) %2)} - :proper-sub {:eq < :fn #(vector %2 %1)} - :proper-super {:eq > :fn #(vector %1 %2)})] - (core/and ((:eq funcs) (count set1) (count set2)) - (apply every? ((:fn funcs) set1 set2))))) - -#_(def subset? #(xset? :sub %1 %2)) -(defalias subset? set/subset?) -(def superset? #(xset? :super %1 %2)) -(def proper-subset? #(xset? :proper-sub %1 %2)) -(def proper-superset? #(xset? :proper-super %1 %2)) + [& args] (uerr/TODO))) + +;; ===== Comparison ===== ;; + +(defaliases u compare < proper-subset? <= subset? >= superset? > proper-superset?) ; ============ OPERATIONS ============ @@ -122,7 +274,7 @@ (core/and (hash-set? s0) (hash-set? s1)) (#?(:clj seqspert.hash-set/parallel-splice-hash-sets :cljs seqspert.hash-set/sequential-splice-hash-sets) s0 s1) - :else (throw (>ex-info "Could not perform parallel union; can try sequential.")))) + :else (throw (ex-info "Could not perform parallel union; can try sequential." {})))) ([s0 s1 & ss] (reduce punion (punion s0 s1) ss)))) @@ -133,10 +285,7 @@ (defalias and intersection ) ; (and a (not b)) -(defalias difference set/difference ) -(defalias - difference ) -(defalias relative-complement difference ) -(defalias differencel difference ) +(defaliases u - relative-complement differencel) (def differencer (fn/reversea differencel)) @@ -158,36 +307,35 @@ "Creates a single-threaded, mutable hash set. On the JVM, this is a java.util.HashSet. - On JS, this is a goog.structs.Set." - {:todo #{"Compare performance on CLJS with ECMAScript 6 Set"}} - ([] #?(:clj (HashSet.) :cljs (Set.))) + On JS, this is a ECMAScript 6 Set (`js/Set`)." + ([] #?(:clj (HashSet.) :cljs (js/Set.))) ([v0] - (doto #?(:clj (HashSet.) :cljs (Set.)) + (doto #?(:clj (HashSet.) :cljs (js/Set.)) (.add v0))) ([v0 v1] - (doto #?(:clj (HashSet.) :cljs (Set.)) + (doto #?(:clj (HashSet.) :cljs (js/Set.)) (.add v0) (.add v1))) ([v0 v1 v2] - (doto #?(:clj (HashSet.) :cljs (Set.)) + (doto #?(:clj (HashSet.) :cljs (js/Set.)) (.add v0) (.add v1) (.add v2))) ([v0 v1 v2 v3] - (doto #?(:clj (HashSet.) :cljs (Set.)) + (doto #?(:clj (HashSet.) :cljs (js/Set.)) (.add v0) (.add v1) (.add v2) (.add v3))) ([v0 v1 v2 v3 v4] - (doto #?(:clj (HashSet.) :cljs (Set.)) + (doto #?(:clj (HashSet.) :cljs (js/Set.)) (.add v0) (.add v1) (.add v2) (.add v3) (.add v4))) ([v0 v1 v2 v3 v4 v5] - (doto #?(:clj (HashSet.) :cljs (Set.)) + (doto #?(:clj (HashSet.) :cljs (js/Set.)) (.add v0) (.add v1) (.add v2) @@ -197,7 +345,7 @@ ([v0 v1 v2 v3 v4 v5 v6 & vs] (reduce (fn [#?(:clj ^HashSet xs :cljs xs) v] (doto xs (.add v))) - (doto #?(:clj (HashSet.) :cljs (Set.)) + (doto #?(:clj (HashSet.) :cljs (js/Set.)) (.add v0) (.add v1) (.add v2) @@ -208,6 +356,6 @@ vs))) ; TODO generate these functions via macros -#?(:clj (defn ^IntOpenHashSet !hash-set:int [] (IntOpenHashSet. ))) -#?(:clj (defn ^LongOpenHashSet !hash-set:long [] (LongOpenHashSet. ))) -#?(:clj (defn ^DoubleOpenHashSet !hash-set:double [] (DoubleOpenHashSet.))) +#?(:clj (defn ^IntOpenHashSet !hash-set|int [] (IntOpenHashSet. ))) +#?(:clj (defn ^LongOpenHashSet !hash-set|long [] (LongOpenHashSet. ))) +#?(:clj (defn ^DoubleOpenHashSet !hash-set|double [] (DoubleOpenHashSet.))) diff --git a/src/quantum/core/data/string.cljc b/src/quantum/core/data/string.cljc index 7731bb15..30d563e7 100644 --- a/src/quantum/core/data/string.cljc +++ b/src/quantum/core/data/string.cljc @@ -1,24 +1,56 @@ (ns quantum.core.data.string - (:import #?(:clj com.carrotsearch.hppc.CharArrayDeque) - #?(:cljs goog.string.StringBuffer))) + "A String is a special wrapper for a char array where different encodings, etc. are possible." + (:refer-clojure :exclude + [string?]) + (:require + [quantum.core.compare.core :as c?] + [quantum.core.data.meta :as meta] + [quantum.core.data.numeric :as dn] + [quantum.core.data.primitive :as p] + [quantum.core.type :as t] + ;; TODO TYPED excise + [quantum.untyped.core.core :as ucore] + ;; TODO TYPED excise + [quantum.untyped.core.logic + :refer [ifs]]) + (:import +#?(:clj [com.carrotsearch.hppc CharArrayDeque]) +#?(:cljs [goog.string StringBuffer]))) -; TODO investigate http://ahmadsoft.org/ropes/ : A rope is a high performance replacement for Strings. The datastructure, described in detail in "Ropes: an Alternative to Strings", provides asymptotically better performance than both String and StringBuffer +(ucore/log-this-ns) -(defn !str +;; TODO investigate http://ahmadsoft.org/ropes/ : A rope is a high performance replacement for Strings. The datastructure, described in detail in "Ropes: an Alternative to Strings", provides asymptotically better performance than both String and StringBuffer +;; What about structural sharing with strings? +;; Wouldn't there have to be some sort of compact immutable bit map or something to diff it rather +;; than just making an entirely new string? + +;; ===== General string-like entities ===== ;; + +#?(:clj (def char-seq? (t/isa? java.lang.CharSequence))) + +;; ===== Mutable strings ===== ;; + +(def !string? (t/isa? #?(:clj java.lang.StringBuilder :cljs StringBuffer))) + +(t/defn ^:inline >!string "Creates a mutable string." - ([ ] #?(:clj (StringBuilder. ) :cljs (StringBuffer. ))) - ([a0] #?(:clj (StringBuilder. a0) :cljs (StringBuffer. a0)))) + > !string? + ([] #?(:clj (StringBuilder.) :cljs (StringBuffer.))) + ;; TODO TYPED + #_([x0] #?(:clj (StringBuilder. x0) :cljs (StringBuffer. x0)))) + +;; ----- Synchronously mutable strings ----- ;; + +#?(:clj (def !sync-string? (t/isa? java.lang.StringBuffer))) #?(:clj -(defn !sync-str +(t/defn ^:inline >!sync-string "Creates a synchronized mutable string." - [] - (StringBuffer.))) + {:todo #{"Do the same arity structure as >!string and >string"}} + > !sync-string? + ([] (StringBuffer.)))) -; What about structural sharing with strings? -; Wouldn't there have to be some sort of compact immutable bit -; map or something to diff it rather than just making -; an entirely new string? +;; ----- Mutable char deques ----- ;; ; TODO rework. Instead of |condf|, use records to represent ; parsed types and dispatch in |defnt| accordingly @@ -26,7 +58,7 @@ ; Currently only for strings #_(:clj (defn rreduce [f init ^String s] - (loop [ret init i (-> s lasti int)] ; int because charAt requires int, I think + (loop [ret init i (-> s lasti int)] ; int because charAt requires int (if (>= i 0) (recur (f ret (.charAt s i)) (unchecked-dec i)) ret)))) @@ -76,7 +108,6 @@ ;(conjl! "(") ;(conjl! "abc") - #_(:clj (defn sp+ [& args] (fn [sb] @@ -85,14 +116,129 @@ (when (< n (-> args count dec)) (conjl! sb " ")))))) +;; ===== Immutable strings ===== ;; + +(def string? (t/isa? #?(:clj java.lang.String :cljs js/String))) + +;; TODO TYPED — `str` macro in CLJS has some secrets +(t/defn >string + "Creates an immutable string." + {:incorporated '{clojure.core/str "9/27/2018" + cljs.core/str "9/27/2018"}} + > string? + ([] "") + ([x p/nil?] "") + ([x string?] x) +#?(:cljs ([x !string?] (.toString x))) +#?(:clj ([x p/boolean? > (t/assume string?)] (Boolean/toString x))) +#?(:clj ([x p/byte? > (t/assume string?)] (Byte/toString x))) +#?(:clj ([x p/short? > (t/assume string?)] (Short/toString x))) +#?(:clj ([x p/char? > (t/assume string?)] (Character/toString x))) +#?(:clj ([x p/int? > (t/assume string?)] (Integer/toString x))) +#?(:clj ([x p/long? > (t/assume string?)] (Long/toString x))) +#?(:clj ([x p/float? > (t/assume string?)] (Float/toString x))) +#?(:clj ([x p/double? > (t/assume string?)] (Double/toString x))) +#?(:clj ([x t/ref?] (-> x .toString >string)) + :cljs ([x t/any? > (t/assume string?)] (.join #js [x] ""))) + ;; TODO TYPED refine this + #_([x ? & xs ...] + (loop [sb (-> x >string >!string) more ys] + (if more + (recur (.append sb (str (first more))) (next more)) + (>string sb))))) + +;; TODO TYPED add t/fn +(def radix? + (t/fn [x integer?] + (comp/<= #?(:clj Character/MIN_RADIX :cljs 2) x #?(:clj Character/MAX_RADIX :cljs 36)))) + +(t/extend-defn! ?c/= + (^:in [a string?, b string?] (#?(:clj .equals :cljs ?c/==) a b))) + +(t/extend-defn! ?c/compare +#?(:clj (^:in [a string?, b string?] (.compareTo a b))) +#?(:cljs ( [a string?, b string?] + (ifs ^boolean (js* "(~{} < ~{})" a b) -1 + ^boolean (js* "(~{} > ~{})" a b) 1 + 0)))) + +(t/extend-defn! dn/>boolean + ([x (t/value "true")] true) + ([x (t/value "false")] false)) + +(t/extend-defn! dn/>byte + ([x string?] + #?(:clj (Byte/parseByte x) + ;; NOTE could use `js/parseInt` but it's very 'unsafe' + ;; TODO implement based on `Byte/parseByte` + :cljs (throw (ex-info "Parsing not implemented" {:string x})))) + ([x string?, radix radix?] + #?(:clj (Byte/parseByte x (>int radix)) + ;; NOTE could use `js/parseInt` but it's very 'unsafe' + ;; TODO implement based on `Byte/parseByte` + :cljs (throw (ex-info "Parsing not implemented" {:string x}))))) + +(t/extend-defn! dn/>short + ([x string?] + #?(:clj (Short/parseShort x) + ;; NOTE could use `js/parseInt` but it's very 'unsafe' + ;; TODO implement based on `Short/parseShort` + :cljs (throw (ex-info "Parsing not implemented" {:string x})))) + ([x string?, radix radix?] + #?(:clj (Short/parseShort x (>int radix)) + ;; NOTE could use `js/parseInt` but it's very 'unsafe' + ;; TODO implement based on `Short/parseShort` + :cljs (throw (ex-info "Parsing not implemented" {:string x}))))) + +(t/extend-defn! dn/>int + ([x string?] + #?(:clj (Integer/parseInteger x) + ;; NOTE could use `js/parseInt` but it's very 'unsafe' + ;; TODO implement based on `Integer/parseInteger` + :cljs (throw (ex-info "Parsing not implemented" {:string x})))) + ([x string?, radix radix?] + #?(:clj (Integer/parseInteger x (p/>int radix)) + ;; NOTE could use `js/parseInt` but it's very 'unsafe' + ;; TODO implement based on `Integer/parseInteger` + :cljs (throw (ex-info "Parsing not implemented" {:string x}))))) + +(t/extend-defn! dn/>long + ([x string?] + #?(:clj (Long/parseLong x) + ;; NOTE could use `js/parseInt` but it's very 'unsafe' + ;; TODO implement based on `Long/parseLong` + :cljs (throw (ex-info "Parsing not implemented" {:string x})))) + ([x string?, radix radix?] + #?(:clj (Long/parseLong x (>int radix)) + ;; NOTE could use `js/parseInt` but it's very 'unsafe' + ;; TODO implement based on `Long/parseLong` + :cljs (throw (ex-info "Parsing not implemented" {:string x}))))) + +(t/extend-defn! dn/>float + ([x string?] + #?(:clj (Float/parseFloat x) + ;; NOTE could use `js/parseFloat` but it's very 'unsafe' + ;; TODO implement based on `Float/parseFloat` + :cljs (throw (ex-info "Parsing not implemented" {:string x}))))) + +(t/extend-defn! dn/>double + ([x string?] + #?(:clj (Double/parseDouble x) + ;; NOTE could use `js/parseFloat` but it's very 'unsafe' + ;; TODO implement based on `Double/parseDouble` + :cljs (throw (ex-info "Parsing not implemented" {:string x}))))) + +;; ----- Metable immutable strings ----- ;; + +;; TODO TYPED `t/deftype` #?(:clj -(deftype StringWithMeta [^String s ^clojure.lang.IPersistentMap _meta] +(deftype MetableString [^String s ^clojure.lang.IPersistentMap _meta] clojure.lang.IObj (meta [this] _meta) - (withMeta [this meta'] (StringWithMeta. s meta')) + (withMeta [this meta'] (MetableString. s meta')) CharSequence - (charAt [this i] (get s i)) - (length [this] (count s)) + (charAt [this i] (.charAt s i)) + (length [this] (.length s)) (subSequence [this a b] (.subSequence s a b)) Object (toString [this] s) @@ -101,10 +247,13 @@ (-edn [this] s))) #?(:clj -(defmethod print-method StringWithMeta [^StringWithMeta x ^java.io.Writer w] +(defmethod print-method MetableString [^MetableString x ^java.io.Writer w] (print-method (.toString x) w))) -#?(:clj -(defn string-with-meta - ([s] #?(:clj (StringWithMeta. s nil) :cljs s)) - ([s meta'] #?(:clj (StringWithMeta. s meta') :cljs (with-meta s new-meta))))) +(def metable-string? #?(:clj (t/isa? MetableString) :cljs string?)) + +(t/defn >metable-string + > metable-string? + ([s string?] #?(:clj (MetableString. s nil) :cljs s)) + ([s string?, meta' meta/meta?] + #?(:clj (MetableString. s meta') :cljs (meta/with-meta s new-meta)))) diff --git a/src/quantum/core/data/time.cljc b/src/quantum/core/data/time.cljc new file mode 100644 index 00000000..0c74560d --- /dev/null +++ b/src/quantum/core/data/time.cljc @@ -0,0 +1,7 @@ +(ns quantum.core.data.time + (:require + [quantum.core.data.numeric :as dn] + [quantum.core.type :as t])) + +;; TODO is this the right place to put this? +#?(:cljs (t/defn date>millis [x js/Date > (t/assume dn/std-fixint?)] (.valueOf x))) diff --git a/src/quantum/core/data/tuple.cljc b/src/quantum/core/data/tuple.cljc index 87b3ed39..9544390f 100644 --- a/src/quantum/core/data/tuple.cljc +++ b/src/quantum/core/data/tuple.cljc @@ -1,7 +1,16 @@ (ns quantum.core.data.tuple + (:refer-clojure :exclude + [map-entry?]) (:require - [quantum.untyped.core.data.tuple :as u] - [quantum.untyped.core.vars - :refer [defalias]])) + [quantum.core.type :as t] + [quantum.core.vars + :refer [defalias]] + ;; TODO TYPED excise + [quantum.untyped.core.data.tuple :as u])) + +;; clojure.lang.Tuple was discontinued; we won't support it for now +(def tuple? (t/isa? quantum.untyped.core.data.tuple.Tuple)) + +(def map-entry? (t/isa?|direct #?(:clj java.util.Map$Entry :cljs cljs.core/IMapEntry))) #?(:clj (defalias u/tuple)) diff --git a/src/quantum/core/data/validated.cljc b/src/quantum/core/data/validated.cljc index eecabb7c..69e460b2 100644 --- a/src/quantum/core/data/validated.cljc +++ b/src/quantum/core/data/validated.cljc @@ -1,28 +1,29 @@ (ns quantum.core.data.validated (:refer-clojure :exclude [contains?]) (:require - [clojure.core :as core] - [quantum.core.data.set :as set] - [quantum.core.error :as err + [clojure.core :as core] + [quantum.core.data.set :as set] + [quantum.core.error :as err :refer [>ex-info TODO catch-all]] [quantum.core.macros.deftype :as deftype] [quantum.core.fn :refer [fn-> fn->> fn1 fnl <- fn']] [quantum.core.logic :refer [fn= fn-and fn-or whenf1 whenf whenp default]] - [quantum.core.log :as log + [quantum.core.log :as log :refer [prl]] [quantum.core.macros.defrecord :refer [defrecord+]] [quantum.core.macros.optimization :refer [identity*]] - [quantum.core.spec :as s + [quantum.core.refs :as ref] + [quantum.core.spec :as s :refer [validate]] - [quantum.untyped.core.collections :as ucoll + [quantum.untyped.core.collections :as ucoll :refer [contains?]] [quantum.untyped.core.collections.tree :as utree :refer [postwalk]] - [quantum.untyped.core.qualify :as uqual] + [quantum.untyped.core.identifiers :as uident] [quantum.untyped.core.form.evaluate :refer [case-env]]) #?(:cljs @@ -247,27 +248,29 @@ db-mode? (-> sym-0 meta :db?) kw-context (keyword (namespace sym-0) (name sym-0)) spec (->> spec-0 - (<- whenp db-mode? replace-value-types) - (<- whenf (fn-and (fn' db-mode?) - keyword? (fn-> namespace nil?)) - (fn1 dbify-keyword ns-name-str))) + (<- (whenp db-mode? replace-value-types)) + (<- (whenf (fn-and (fn' db-mode?) + keyword? (fn-> namespace nil?)) + (fn1 dbify-keyword ns-name-str)))) spec-base (gensym "spec-base") conformer-sym (gensym "conformer") constructor-sym (symbol (str "->" sym)) schema (when db-mode? (spec->schema sym-0 spec)) code `(do (def ~conformer-sym ~conformer) (deftype/deftype ~(with-meta sym {:no-factory? true}) ~'[v] - {~'?Object - {~'hash ([_#] (.hashCode ~'v)) - ~'equals ~(std-equals sym other '=)} - ~'?HashEq - {~'hash-eq ([_#] (int (bit-xor ~type-hash (~(case-env :clj '.hashEq :cljs '-hash) ~'v))))} + {~'?Equals + {~'= ~(std-equals sym other '=)} + ~'?Hash + {~'hash ([_#] (int (bit-xor ~type-hash + (~(case-env :clj '.hashEq + :cljs '-hash) ~'v)))) + ~'hash-code ([_#] (.hashCode ~'v))} ~'?Deref - {~'deref ([_#] ~'v)} - quantum.core.core/IValue - {~'get ([_#] ~'v) - ~'set ([_# v#] (new ~sym (-> v# ~(if-not conformer `identity* conformer-sym) - (s/validate ~spec-name))))}}) + {~'deref ([_#] ~'v)} + refs/IValue + {~'get ([_#] ~'v) + ~'set ([_# v#] (new ~sym (-> v# ~(if-not conformer `identity* conformer-sym) + (s/validate ~spec-name))))}}) (def ~spec-base ~spec) (s/def ~spec-name (s/conformer (fn [x#] (if (instance? ~sym x#) @@ -325,9 +328,9 @@ (concat req opt req-un opt-un) (s/coll-of qualified-keyword? :distinct true)) (let [{:keys [spec-name sym]} (sym->spec-name+sym sym-0 ns-name-str) schema (when db-mode? (spec->schema sym-0 nil)) ; TODO #4, #5 - qualified-sym (uqual/qualify|class sym) + qualified-sym (uident/qualify|class sym) req-record-sym (symbol (str (name sym) ":__required")) - qualified-record-sym (uqual/qualify|class req-record-sym) + qualified-record-sym (uident/qualify|class req-record-sym) un-record-sym (symbol (str (name sym) ":__un")) all-mod-record-sym (symbol (str (name sym) ":__all-mod")) all-record-sym (symbol (str (name sym) ":__all")) @@ -412,7 +415,6 @@ {~'empty ([_#] (~(case-env :clj '.empty :cljs '-empty) ~'v)) ~'empty! ([_#] (throw (UnsupportedOperationException.))) ~'empty? ([_#] (~(case-env :clj '.isEmpty :cljs nil ) ~'v)) - ~'equals ~(std-equals sym other (case-env :clj '.equiv :cljs '-equiv)) ~'conj ([_# [k0# v0#]] (let [~k-gen (or (get ~all-mod-keys-record k0#) (get ~un-ks-to-ks k0#) @@ -467,9 +469,8 @@ ~'find ([_# k#] #_(enforce-get ~empty-record ~sym ~spec-sym k#) (~(case-env :clj '.entryAt :cljs nil) ~'v k#))} - ~'?Object - {~'hash ([_#] (.hashCode ~'v)) - ~'equals ~(std-equals sym other (case-env :clj '.equiv :cljs '.equiv))} + ~'?Equals + {~'= ~(std-equals sym other (case-env :clj '.equiv :cljs '-equiv))} ~'?Iterable {~'iterator ([_#] (~(case-env :clj '.iterator :cljs '-iterator) ~'v))} ~'?Meta @@ -477,9 +478,10 @@ ~'with-meta ([_# new-meta#] (new ~sym (with-meta ~'v new-meta#)))} ~'?Print {~'pr ([_# w# opts#] (~'-pr-writer ~'v w# opts#))} - ~'?HashEq - {~'hash-eq ([_#] (int (bit-xor ~type-hash (~(case-env :clj '.hashEq :cljs '-hash) ~'v))))} - quantum.core.core/IValue + ~'?Hash + {~'hash ([_#] (int (bit-xor ~type-hash (~(case-env :clj '.hashEq :cljs '-hash) ~'v)))) + ~'hash-code ([_#] (.hashCode ~'v))} + refs/IValue {~'get ([_#] ~'v) ~'set ([_# v#] (if (instance? ~sym v#) v# (new ~sym (~create v#))))}}) (defn ~constructor-sym [m#] (new ~qualified-sym (~create m#))) diff --git a/src/quantum/core/data/vector.cljc b/src/quantum/core/data/vector.cljc index 0f07176c..cc360c0b 100644 --- a/src/quantum/core/data/vector.cljc +++ b/src/quantum/core/data/vector.cljc @@ -1,23 +1,25 @@ -(ns - ^{:doc "Vector operations. Includes relaxed radix-balanced vectors (RRB vectors) - my Michal Marczyk. Also includes |conjl| (for now)." - :attribution "alexandergunnarson"} - quantum.core.data.vector +(ns quantum.core.data.vector + "A vector is Sequential, Associative (specifically, whose keys are sequential, dense + integer values), and extensible." (:refer-clojure :exclude - [vector]) + [vector vector?]) (:require - [clojure.core :as core] - [clojure.core.rrb-vector :as svec] + ;; TODO TYPED excise + [clojure.core :as core] + [clojure.core.rrb-vector :as svec] #?@(:clj [[clojure.core.rrb-vector.protocols :refer [PSliceableVector slicev PSpliceableVector splicev]] [clojure.core.rrb-vector.rrbt :refer [AsRRBT as-rrbt]]]) - [quantum.core.fn + [quantum.core.type :as t] + [quantum.core.vars :as var + :refer [defalias]] + ;; TODO TYPED excise + [quantum.core.untyped.fn :refer [rcomp]] - [quantum.core.vars :as var - :refer [defalias]]) + [quantum.core.untyped.type :as ut]) #?(:clj (:import java.util.ArrayList @@ -35,11 +37,68 @@ ; - michalmarczyk/devec: double-ended vector ; ======================================= -(defalias vector core/vector) +(def !array-list? + #?(:clj (t/or (t/isa? java.util.ArrayList) + ;; indexed and associative, but not extensible + (t/isa? java.util.Arrays$ArrayList)) + :cljs (t/or ;; not used + #_(t/isa? cljs.core/ArrayList) + ;; because supports .push etc. + (t/isa? js/Array)))) + +(def svector? + "The set of spliceable vectors." + (t/isa? #?(:clj clojure.core.rrb_vector.rrbt.Vector + :cljs clojure.core.rrb-vector.rrbt.Vector))) + +(def +vector? (t/isa?|direct #?(:clj clojure.lang.IPersistentVector + :cljs cljs.core/IVector))) + +(defalias ut/+vector|built-in) + +(def !+vector? (t/isa?|direct #?(:clj clojure.lang.ITransientVector + :cljs cljs.core/ITransientVector))) + +(def ?!+vector? (t/or +vector? !+vector?)) + +(def !vector|byte? #?(:clj (t/isa? it.unimi.dsi.fastutil.bytes.ByteArrayList) :cljs t/none?)) +(def !vector|short? #?(:clj (t/isa? it.unimi.dsi.fastutil.shorts.ShortArrayList) :cljs t/none?)) +(def !vector|char? #?(:clj (t/isa? it.unimi.dsi.fastutil.chars.CharArrayList) :cljs t/none?)) +(def !vector|int? #?(:clj (t/isa? it.unimi.dsi.fastutil.ints.IntArrayList) :cljs t/none?)) +(def !vector|long? #?(:clj (t/isa? it.unimi.dsi.fastutil.longs.LongArrayList) :cljs t/none?)) +(def !vector|float? #?(:clj (t/isa? it.unimi.dsi.fastutil.floats.FloatArrayList) :cljs t/none?)) +(def !vector|double? #?(:clj (t/isa? it.unimi.dsi.fastutil.doubles.DoubleArrayList) :cljs t/none?)) + +(def !vector|ref? + #?(:clj (t/or (t/isa? java.util.ArrayList) + (t/isa? it.unimi.dsi.fastutil.objects.ReferenceArrayList)) + ;; because supports .push etc. + :cljs (t/isa? js/Array))) + +(def !vector? + (t/or !vector|ref? + !vector|byte? !vector|short? !vector|char? !vector|int? !vector|long? + !vector|float? !vector|double?)) + + ;; java.util.Vector is deprecated, because you can + ;; just create a synchronized wrapper over an ArrayList + ;; via java.util.Collections +#?(:clj (def !!vector? t/none?)) + +;; We could maybe duck-type as `(t/and (isa? java.util.RandomAccess) (isa? java.util.List))` but +;; it's not really sufficient as that doesn't really capture all the properties we want out of a +;; vector +(def vector? (t/or ?!+vector? !vector? #?(:clj !!vector?))) + + +;; TODO TYPED below + + +(defalias vector core/vector) (defalias +vector vector) (def !+vector (rcomp vector transient)) -(defn !+vector:sized [n] +(defn !+vector|sized [n] (let [xs (!+vector)] (dotimes [i n] (conj! xs nil)) xs)) @@ -89,11 +148,6 @@ _ (subsvec coll a b)))) -(def svector? - (partial instance? - #?(:clj clojure.core.rrb_vector.rrbt.Vector - :cljs clojure.core.rrb-vector.rrbt.Vector))) - #?(:clj (defalias ^{:doc "Creates a new vector capable of storing homogenous items of type t, @@ -168,4 +222,4 @@ #_DoubleArrayList #_ObjectArrayList -#?(:clj (defn ^LongArrayList !vector:long [] (LongArrayList.))) +#?(:clj (defn ^LongArrayList !vector|long [] (LongArrayList.))) diff --git a/src/quantum/core/error.cljc b/src/quantum/core/error.cljc index 786bf416..dbbb8a94 100644 --- a/src/quantum/core/error.cljc +++ b/src/quantum/core/error.cljc @@ -9,11 +9,12 @@ [quantum.core.data.map :as map] [quantum.core.fn :refer [fnl fn1 rcomp fn']] + [quantum.core.type :as t] + [quantum.core.vars :as var + :refer [defalias defaliases]] [quantum.untyped.core.core :as ucore] [quantum.untyped.core.form.evaluate :refer [case-env case-env*]] - [quantum.untyped.core.vars - :refer [defalias defaliases]] [quantum.untyped.core.error :as u])) (ucore/log-this-ns) @@ -21,6 +22,8 @@ (def ^{:todo {0 "Finish up `conditions` fork" 1 "look at cljs.stacktrace / clojure.stacktrace"}} annotations) +(defalias t/throwable?) + ;; ===== Config ===== ;; (defalias u/*pr-data-to-str?) diff --git a/src/quantum/core/fn.cljc b/src/quantum/core/fn.cljc index 5160371d..d8d689b6 100644 --- a/src/quantum/core/fn.cljc +++ b/src/quantum/core/fn.cljc @@ -1,19 +1,17 @@ -(ns - ^{:doc "Useful function-related functions (one could say 'metafunctions'). +(ns quantum.core.fn + "Function-related functions ('metafunctions'). - Higher-order functions, currying, monoids, reverse comp, arrow macros, inner partials, juxts, etc." - :attribution "alexandergunnarson"} - quantum.core.fn + Higher-order functions, currying, monoids, reversed comp, arrow macros, inner partials, juxts, etc." (:refer-clojure :exclude - [comp constantly, as->, trampoline]) + [comp constantly, as->, identity, trampoline]) (:require [clojure.core :as core] [clojure.walk] - [quantum.core.core :as qcore] + [quantum.core.type :as t] [quantum.untyped.core.form.evaluate :refer [case-env compile-if]] [quantum.untyped.core.form.generate - :refer [arity-builder gen-args max-positional-arity unify-gensyms]] + :refer [arity-builder max-positional-arity unify-gensyms]] [quantum.untyped.core.fn :as u] [quantum.untyped.core.print :as upr] [quantum.untyped.core.vars :as uvar @@ -24,9 +22,19 @@ :refer [aritoid gen-constantly gen-call gen-positional-nthas gen-ntha gen-conja gen-reversea gen-mapa]]))) +;; TODO TYPED move to `data.fn`? +(def multimethod? (t/isa? #?(:clj clojure.lang.MultiFn :cljs cljs.core/IMultiFn))) + +;; TODO TYPED `t/==` +(t/defn ^:inline identity [x t/any? #_> #_(t/== x)] x) + ;; ===== `fn`: Positional functions ===== ;; -#?(:clj (defaliases u fn0 fn1 fnl)) +#?(:clj (defmacro fn0 [& args] + `(t/fn fn0# [f# (t/ftype ~(mapv (fn [arg] `(t/type ~arg)) args))] (f# ~@args)))) + +#?(:clj (defmacro fn1 [f & args] `(t/fn fn1# [arg#] (~f arg# ~@args)))) ; analogous to -> +#?(:clj (defmacro fnl [f & args] `(t/fn fnl# [arg#] (~f ~@args arg#)))) ; analogous to ->> ;; ===== `fn&`: Partial functions ===== ;; @@ -72,42 +80,13 @@ (gen-call) -; ----- NTHA ----- ; - -(defn gen-positional-ntha [position] - `(~'defn ~(symbol (str "ntha-" position)) - ~(str "Accepts any number of arguments and returns the (n=" position ")th in O(1) time.") - ~@(arity-builder (fn [args] (nth args position)) - (fn [args vargs] (nth args position)) (inc position)))) - -#?(:clj -(defmacro gen-positional-nthas [] - `(do ~@(for [i (range 0 (:clj max-positional-arity))] (gen-positional-ntha i))))) - -(gen-positional-nthas) - -(defn ntha-& - "Accepts any number of arguments and returns the nth, variadically, in O(n) time." - [n] (fn [& args] (nth args n))) - -(defalias firsta ntha-0) -(defalias seconda ntha-1) -(defalias thirda ntha-2) - -#?(:clj -(defmacro gen-ntha [] - (let [n-sym (gensym "n")] - `(~'defn ~'ntha - "Accepts any number of arguments and returns the nth. - If n <= 18, returns in O(1) time; otherwise, in O(n) time via varargs." - [~(with-meta n-sym {:tag 'long})] - (case ~n-sym - ~@(apply concat - (for [i (range 0 (:clj max-positional-arity))] - [i (symbol (str "ntha-" i))])) - (ntha-& ~n-sym)))))) - -(gen-ntha) +(defaliases u + ntha + ntha-0 firsta + ntha-1 seconda + ntha-2 thirda + ntha-3 ntha-4 ntha-5 ntha-6 ntha-7 ntha-8 ntha-9 + ntha-10 ntha-11 ntha-12 ntha-13 ntha-14 ntha-15 ntha-16 ntha-17) #?(:clj (defmacro gen-conja @@ -253,7 +232,40 @@ ([arg1 arg2 arg3] (func (func arg1 arg2) arg3)) ([arg1 arg2 arg3 & args] (apply func (func (func arg1 arg2) arg3) args)))) -#?(:clj (defalias u/aritoid)) +;; TODO finish and generalize based off `u/aritoid` +(t/defn ^:inline aritoid + ;; TODO use `arity-builder` + "Combines fns as arity-callers." + {:equivalent `{(aritoid vector identity conj) + (fn ([] (vector)) + ([x0] (identity x0)) + ([x0 x1] (conj x0 x1)))}} + ([f0 (t/ftype [])] f0) + ([f0 (t/ftype []) + f1 (t/ftype [t/any?])] + (t/fn {:inline true} + ([] (f0)) + ([x0 (t/type-of f1 0)] (f1 x0)))) + ([f0 (t/ftype []) + f1 (t/ftype [t/any?]) + f2 (t/ftype [t/any? t/any?])] + (t/fn {:inline true} + ([] (f0)) + ([x0 (t/type-of f1 0)] (f1 x0)) + ([x0 (t/type-of f1 0) + x1 (t/type-of f1 1)] (f2 x0 x1)))) + ([f0 (t/ftype []) + f1 (t/ftype [t/any?]) + f2 (t/ftype [t/any? t/any?]) + f3 (t/ftype [t/any? t/any? t/any?])] + (t/fn {:inline true} + ([] (f0)) + ([x0 (t/type-of f1 0)] (f1 x0)) + ([x0 (t/type-of f1 0) + x1 (t/type-of f1 1)] (f2 x0 x1)) + ([x0 (t/type-of f2 0) + x1 (t/type-of f2 1) + x2 (t/type-of f2 2)] (f3 x0 x1 x2))))) (defn rf-fix "TODO remove when you figure out transduce vs. reduce" @@ -283,17 +295,8 @@ (defn call->> [& [func & args]] ((apply func (butlast args)) (last args))) ; --------------------------------------- -; ================ JUXTS ================ (possibly deprecate these?) +; ================ JUXTS ================ (deprecate these) ; --------------------------------------- - -; (defn juxtm* -; [map-type args] -; (if (-> args count even?) -; (fn [arg] (->> arg ((apply juxt args)) (apply map-type))) -; (throw (#+clj IllegalArgumentException. -; #+cljs js/Error. -; "juxtm requires an even number of arguments")))) - (defn juxtm* [map-type args] (if (-> args count even?) diff --git a/src/quantum/core/io/compress.cljc b/src/quantum/core/io/compress.cljc index 3b01f074..bbc694ac 100644 --- a/src/quantum/core/io/compress.cljc +++ b/src/quantum/core/io/compress.cljc @@ -42,7 +42,7 @@ org.apache.commons.io.FileUtils (java.nio.charset Charset CharsetEncoder CharacterCodingException) (java.nio CharBuffer ByteBuffer) - (quanta Packed12 ClassIntrospector)))) + (quantum.misc Packed12)))) (defrecord CompressionCodec [name extension algorithm speed compression implemented? doc ]) diff --git a/src/quantum/core/io/core.cljc b/src/quantum/core/io/core.cljc index 5f71f104..1d289a78 100644 --- a/src/quantum/core/io/core.cljc +++ b/src/quantum/core/io/core.cljc @@ -24,12 +24,13 @@ [quantum.core.paths :as p :refer [path]] [quantum.core.resources :as res] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [svector?]] [quantum.core.vars :as var :refer [defalias]] [quantum.core.spec :as s :refer [validate]] + [quantum.core.type :as t] [quantum.core.macros :as macros :refer [defnt]]) #?(:clj (:import @@ -39,6 +40,10 @@ FileInputStream FileOutputStream FileNotFoundException)))) + ;; TODO TYPED move? + ;; `js/File` isn't always available! Use an abstraction +#?(:clj (def file? (t/isa? java.io.File))) + (defonce clj-ext (atom :cljd)) ; Clojure data ; All this isn't just IO, it's persisting, which is a smallish subset diff --git a/src/quantum/core/io/filesystem.cljc b/src/quantum/core/io/filesystem.cljc index 261f0bb3..cad62e93 100644 --- a/src/quantum/core/io/filesystem.cljc +++ b/src/quantum/core/io/filesystem.cljc @@ -40,7 +40,7 @@ [{:as opts :keys [file] {:keys [modified]} :handlers} {:as thread-opts :keys [close-reqs]}] - (with-throw (type/atom? file) "File must be an atom.") + (with-throw (ref/atom? file) "File must be an atom.") (let [^File file-0 (-> @file convert/->file) _ (with-throw (type/file? file-0) "File must be a java.io.File.") timestamp-0 (.lastModified file-0) diff --git a/src/quantum/core/io/meta.cljc b/src/quantum/core/io/meta.cljc index cb8b564f..833ef291 100644 --- a/src/quantum/core/io/meta.cljc +++ b/src/quantum/core/io/meta.cljc @@ -45,7 +45,7 @@ [meta-] (let [section (volatile! nil)] (->> meta- - (<- str/split #"\n") + (<- (str/split #"\n")) (map+ (partial coll/split-remove-match ": ")) (reduce (fn [ret v-0] diff --git a/src/quantum/core/io/transcode.cljc b/src/quantum/core/io/transcode.cljc index d5ac1327..44af0583 100644 --- a/src/quantum/core/io/transcode.cljc +++ b/src/quantum/core/io/transcode.cljc @@ -87,7 +87,7 @@ AAC encoder available with ffmpeg") args (->> {:print-output :ffmpeg-convert} (merge-keep-left opts) - (<- assoc :read-streams? true)))))) + (<- (assoc :read-streams? true))))))) #_(:clj diff --git a/src/quantum/core/logic.cljc b/src/quantum/core/logic.cljc index f12cc206..fd90be48 100644 --- a/src/quantum/core/logic.cljc +++ b/src/quantum/core/logic.cljc @@ -5,7 +5,7 @@ :attribution "alexandergunnarson"} quantum.core.logic (:refer-clojure :exclude - [= and not or + [= and not or ifs if-let when-let]) (:require [clojure.core :as core] @@ -21,7 +21,6 @@ [quantum.core.logic :as self :refer [fn-not]]))) -; TODO: ; cond-not, for :pre ; Java `switch` is implemented using an array and then points to the code. ; Java String `switch` is implemented using a map8 @@ -47,6 +46,20 @@ xor xnor implies?])) +#?(:clj +(defmacro and* + "Like `clojure.core/and`, but avoids intermediate let bindings and only ever returns a boolean." + ([] true) + ([x] `(if ~x true false)) + ([x & xs] `(if ~x (and* ~@xs) false)))) + +#?(:clj +(defmacro or* + "Like `clojure.core/or`, but avoids intermediate let bindings and only ever returns a boolean." + ([] false) + ([x] `(if ~x true false)) + ([x & xs] `(if ~x true (or* ~@xs))))) + ;; ===== Function-logical operators ===== ;; #?(:clj @@ -116,7 +129,7 @@ ;; ===== `cond(f|c|p)` ===== ;; -#?(:clj (defaliases u condf condf1 condf& condfc is? condpc)) +#?(:clj (defaliases u ifs condf condf1 condf& condfc is? condpc)) ;; ===== `if(n|c|p)` ===== ;; @@ -134,62 +147,16 @@ whenc whenc-> whenc->> whenc1 whenp whenp-> whenp->> whenp1)) -; ======== CONDITIONAL LET BINDINGS ======== - -#?(:clj -(defmacro if-let-base - {:attribution "alexandergunnarson"} - ([cond-sym bindings then] - `(if-let-base ~cond-sym ~bindings ~then nil)) - ([cond-sym [bnd expr & more] then else] - `(let [temp# ~expr ~bnd temp#] - (~cond-sym temp# - ~(if (seq more) - `(if-let-base ~cond-sym [~@more] ~then ~else) - then) - ~else))))) - -#?(:clj -(defmacro if-let - "Like `if-let`, but multiple bindings can be used." - [& xs] `(if-let-base if ~@xs))) - -#?(:clj -(defmacro if-not-let - "if : if-let :: if-not : if-not-let. All conditions must be false." - [& xs] `(if-let-base if-not ~@xs))) - -#?(:clj -(defmacro when-let-base - {:attribution "alexandergunnarson"} - [cond-sym [bnd expr & more] & body] - `(let [temp# ~expr ~bnd temp#] - (~cond-sym temp# - ~(if (seq more) - `(when-let-base ~cond-sym [~@more] ~@body) - `(do ~@body)))))) - -#?(:clj -(defmacro when-let - "Like `when-let`, but multiple bindings can be used." - [& xs] `(if-let-base when ~@xs))) +;; ===== Conditional `let` bindings ===== ;; #?(:clj -(defmacro when-not-let - "when : when-let :: when-not : when-not-let. All conditions must be false." - [& xs] `(when-let-base when-not ~@xs))) - - -#?(:clj -(defmacro cond-let - "Transforms into a series of nested `if-let` statements." - {:attribution "alexandergunnarson"} - ([] nil) ; no else - ([else] else) - ([bindings then & more] - `(if-let ~bindings - ~then - (cond-let ~@more))))) +(defaliases u + if-let if-not-let + when-let when-not-let + ifs-let + and-let nand-let + or-let nor-let + xor-let xnor-let)) ;; ===== `coll-(or|and)` ===== ;; diff --git a/src/quantum/core/loops.cljc b/src/quantum/core/loops.cljc index b3b22ad9..28bd2253 100644 --- a/src/quantum/core/loops.cljc +++ b/src/quantum/core/loops.cljc @@ -25,7 +25,7 @@ :refer [map+]] [quantum.core.refs :as refs :refer [deref reset! !long]] - [quantum.core.type :as type] + [quantum.core.type-old :as type] [quantum.untyped.core.reducers :as ured] [quantum.core.vars :as var :refer [defalias]]) @@ -172,7 +172,7 @@ (assert-args (vector? bindings) "a vector for its bindings") `(->> ~(last bindings) - (<- red/transformer (core/map (rfn [~@(butlast bindings)] ~@body))) ; bootstrapping `map+` + (<- (red/transformer (core/map (rfn [~@(butlast bindings)] ~@body)))) ; bootstrapping `map+` ~joinf)) #?(:clj diff --git a/src/quantum/core/macros/defnt.cljc b/src/quantum/core/macros/defnt.cljc index 86deee4e..b42d1e17 100644 --- a/src/quantum/core/macros/defnt.cljc +++ b/src/quantum/core/macros/defnt.cljc @@ -16,7 +16,7 @@ [quantum.core.log :as log :refer [prl]] [quantum.core.logic :as logic - :refer [fn= fn-not fn-and fn-or whenc whenf whenf1 whenc1 ifn1 condf if-not-let cond-let]] + :refer [fn= fn-not fn-and fn-or whenc whenf whenf1 whenc1 ifn1 condf if-not-let ifs-let]] [quantum.core.macros.fn :as mfn] [quantum.core.analyze.clojure.core :as ana] [quantum.core.analyze.clojure.predicates :as anap] @@ -35,20 +35,20 @@ [quantum.untyped.core.collections :as ucoll :refer [contains? merge-call update-first update-val]] [quantum.untyped.core.collections.tree :as utree] - [quantum.untyped.core.convert :as uconv - :refer [>integer >name]] [quantum.untyped.core.data - :refer [kw-map]] + :refer [kw-map val?]] [quantum.untyped.core.form.evaluate :refer [case-env case-env*]] + [quantum.untyped.core.form.type-hint :as ufth] + [quantum.untyped.core.identifiers :as uident + :refer [>name]] + [quantum.untyped.core.numeric + :refer [>integer]] [quantum.untyped.core.numeric.combinatorics :as combo] - [quantum.untyped.core.qualify :as qual] [quantum.untyped.core.reducers :refer [reducei] :as ured] [quantum.untyped.core.string :as ustr] - [quantum.untyped.core.type :as t] - [quantum.untyped.core.type.predicates - :refer [val?]])) + [quantum.untyped.core.type :as t])) (defonce warn-on-strict-inexact-matches? (atom false)) (defonce warn-on-all-inexact-matches? (atom false)) @@ -86,7 +86,8 @@ (err! "Invalid `defnt` special keyword" {:k x})))) (def qualified-class-name-map - (->> (set/union tcore/primitive-types|unevaled #?(:clj tcore/primitive-array-types)) + (->> (set/union #_tcore/primitive-types|unevaled ; NOTE: commented this out knowing that this will break this old `defnt` + #?(:clj tcore/primitive-array-types)) (repeat 2) (apply zipmap))) @@ -110,10 +111,10 @@ (throw-unless ((fn-or symbol? keyword? string?) pred) (>ex-info "Type predicate must be a symbol, keyword, or string." {:pred pred})) (cond (and (symbol? pred) (anap/possible-type-predicate? pred)) - (->> tdef/types|unevaled - (<- get lang) - (<- get pred) - (<- validate contains?) + (->> #_tdef/types|unevaled ; NOTE: commented this out knowing that this will break this old `defnt` + (<- (get lang)) + (<- (get pred)) + (<- (validate contains?)) (into [])) :else [pred]))) @@ -131,17 +132,9 @@ ;nil? (fn' #{'Object}) #(throw (>ex-info "Not a type hint." %))))) -(defn hint-arglist-with - [arglist hints] - (reducei ; technically reduce-pair - (fn [arglist-f arg i] - (conj arglist-f (th/with-type-hint arg (get hints i)))) - [] - arglist)) - (def defnt-remove-hints (fn->> (into []) - (<- update 0 (fn->> (filter symbol?) (into []))))) + (<- (update 0 (fn->> (filter symbol?) (into [])))))) (defn defnt-arities {:out '[[[^string? x] (println "A string!")] @@ -212,7 +205,7 @@ (-> sym name ustr/camelcase (str "Interface") munge symbol) ns-qualified-interface-name (-> genned-interface-name - #?(:clj (qual/qualify|dot (namespace-munge *ns*)))) + #?(:clj (uident/qualify|dot (namespace-munge *ns*)))) gen-interface-code-header (list 'gen-interface :name ns-qualified-interface-name :methods) gen-interface-code-body-unexpanded @@ -228,7 +221,7 @@ (map (fn [type-arglist+return-type] (with-meta (into [genned-method-name] type-arglist+return-type) ; To preserve `^:default` or `^:nil?` (meta type-arglist+return-type)))) - (<- zipmap full-arities))] ; TODO ensure unique, don't just assume + (<- (zipmap full-arities)))] ; TODO ensure unique, don't just assume (log/ppr-hints :macro-expand "gen-interface-code-body-unexpanded" gen-interface-code-body-unexpanded) (assert (contains? gen-interface-code-body-unexpanded)) (kw-map genned-method-name @@ -344,7 +337,7 @@ (let [body (list* 'do body) hints (map (whenf1 string? symbol) hints) hints (hints->with-replace-special-kws (merge env (kw-map arglist hints))) - arglist-hinted (hint-arglist-with arglist hints) + arglist-hinted (ufth/hint-arglist-with arglist hints) ;_ (log/ppr-hints :macro-expand "TYPE HINTS FOR ARGLIST" (->> arglist-hinted (map type-hint))) explicit-ret-type (>explicit-ret-type (merge env (kw-map ret-type-0 hints arglist))) ; TODO cache the result of postwalking the body like this, for protocol purposes @@ -469,8 +462,8 @@ (defn hint-expr-embeddably [expr tag] (if (symbol? expr) - (th/with-type-hint expr (th/>body-embeddable-tag tag)) - (tcore/static-cast-code (th/>body-embeddable-tag tag) expr))) + (th/with-type-hint expr (th/>body-embeddable-tag tag)) + (ufth/static-cast|code (th/>body-embeddable-tag tag) expr))) #?(:clj (defn hint-expr-with-class [expr hint] @@ -513,7 +506,7 @@ (hint-expr-with-class arg expected-type) not-matchable) (.isPrimitive actual-type) - (cond-let + (ifs-let [c (get-in tcore/unboxed->convertible [actual-type expected-type])] ; cast unboxed primitive to compatible unboxed primitive via Clojure intrinsic (hint-expr-with-class `(~(symbol "clojure.core" (.getName ^Class c)) ~arg) c) @@ -524,7 +517,7 @@ (hint-expr-with-class `(new ~(symbol (.getName ^Class c)) ~arg) c) not-matchable) (tcore/boxed->unboxed actual-type) - (cond-let + (ifs-let [c (get-in tcore/unboxed->convertible [(tcore/boxed->unboxed actual-type) expected-type])] ; cast boxed primitive to compatible unboxed primitive via Clojure intrinsic (hint-expr-with-class `(~(symbol "clojure.core" (.getName ^Class c)) ~arg) c) @@ -564,7 +557,7 @@ (for [i (range (count match))] (let [t (expr->hint:class (get match i)) t' (expr->hint:class (get match' i))] - (t/compare|class|class t t'))) + (t/compare|class|class* t t'))) generality-score (->> generality-scores (remove nil?) (apply +))] (log/ppr-hints :macro-expand/params (kw-map generality-score match match')) (cond (neg? generality-score) [match] @@ -843,4 +836,3 @@ (let [lang :clj] (eval `(declare ~(th/with-sanitize-tag lang sym) ~(th/with-sanitize-tag lang (defnt-gen-protocol-name sym lang)))) ; To allow recursive analysis (defnt*-helper {:relaxed? true} lang *ns* sym nil nil nil body)))) - diff --git a/src/quantum/core/macros/fn.cljc b/src/quantum/core/macros/fn.cljc index 96e78835..dc1fec96 100644 --- a/src/quantum/core/macros/fn.cljc +++ b/src/quantum/core/macros/fn.cljc @@ -15,10 +15,10 @@ :refer [fn-or whenf1]] [quantum.core.macros.optimization :as opt :refer [extern?]] - [quantum.untyped.core.collections.tree :as utree - :refer [postwalk]] [quantum.core.vars :refer [defalias]] + [quantum.untyped.core.collections.tree :as utree + :refer [postwalk]] [quantum.untyped.core.form.evaluate :refer [case-env]] [quantum.untyped.core.form.generate :as ufgen])) diff --git a/src/quantum/core/macros/optimization.cljc b/src/quantum/core/macros/optimization.cljc index e7aeb1e3..889059b5 100644 --- a/src/quantum/core/macros/optimization.cljc +++ b/src/quantum/core/macros/optimization.cljc @@ -1,14 +1,14 @@ (ns ^{:doc "Helper functions for macros which provide optimization."} quantum.core.macros.optimization (:require - [quantum.core.core :as qcore] - [quantum.core.fn :as fn + [quantum.core.core :as qcore] + [quantum.core.fn :as fn :refer [fn->]] - [quantum.core.log :as log] - [quantum.core.logic :as logic + [quantum.core.log :as log] + [quantum.core.logic :as logic :refer [fn-and]] - [quantum.untyped.core.qualify :as qual] - [quantum.core.vars :as var])) + [quantum.core.vars :as var] + [quantum.untyped.core.identifiers :as uident])) ; ===== EXTERN ===== @@ -28,9 +28,9 @@ " because of error: |" e# "|")))))] (if (symbol? quoted-obj) quoted-obj - (do (intern ns- (qual/unqualify genned) obj-evaled) - (log/pr :macro-expand quoted-obj "EXTERNED AS" (qual/unqualify genned)) - (qual/unqualify genned))))) + (do (intern ns- (uident/unqualify genned) obj-evaled) + (log/pr :macro-expand quoted-obj "EXTERNED AS" (uident/unqualify genned)) + (uident/unqualify genned))))) quoted-obj))) #?(:clj diff --git a/src/quantum/core/macros/protocol.cljc b/src/quantum/core/macros/protocol.cljc index 662403e0..3ade0c4d 100644 --- a/src/quantum/core/macros/protocol.cljc +++ b/src/quantum/core/macros/protocol.cljc @@ -12,9 +12,7 @@ [quantum.untyped.core.collections :as ucoll :refer [contains? update-first]] [quantum.untyped.core.data - :refer [kw-map]] - [quantum.untyped.core.type.predicates - :refer [val?]])) + :refer [kw-map val?]])) (defn with-protocol-arglist-type-hint [sym lang arglist-ct] diff --git a/src/quantum/core/macros/reify.cljc b/src/quantum/core/macros/reify.cljc index 0a79a464..67e3689f 100644 --- a/src/quantum/core/macros/reify.cljc +++ b/src/quantum/core/macros/reify.cljc @@ -59,7 +59,7 @@ (mapv (fn-> th/type-hint (whenc nil? trans/default-hint))))))) (ucoll/frequencies-by first) (group-by val) - (<- dissoc 1)) + (<- (dissoc 1))) _ (when (contains? duplicate-methods) (log/pr :always "Duplicate methods for" sym ":") (log/ppr-hints :always duplicate-methods) diff --git a/src/quantum/core/macros/transform.cljc b/src/quantum/core/macros/transform.cljc index 973eb42f..d6f6603c 100644 --- a/src/quantum/core/macros/transform.cljc +++ b/src/quantum/core/macros/transform.cljc @@ -9,7 +9,7 @@ [quantum.core.error :as err :refer [>ex-info]] [quantum.core.fn :as fn - :refer [<- fn1 fn-> rcomp]] + :refer [fn1 fn-> rcomp]] [quantum.core.log :as log :refer [prl]] [quantum.core.logic :as logic @@ -19,10 +19,10 @@ :refer [default-zipper]] [quantum.untyped.core.collections.tree :as utree :refer [postwalk]] + [quantum.untyped.core.data + :refer [val?]] [quantum.untyped.core.reducers :as ured - :refer [zip-reduce*]] - [quantum.untyped.core.type.predicates - :refer [val?]])) + :refer [zip-reduce*]])) ; TODO should move (some of) these functions to core.analyze.clojure/transform? diff --git a/src/quantum/core/macros/type_hint.cljc b/src/quantum/core/macros/type_hint.cljc index 0ea3e3d6..a8bb49e3 100644 --- a/src/quantum/core/macros/type_hint.cljc +++ b/src/quantum/core/macros/type_hint.cljc @@ -10,5 +10,5 @@ #?@(:clj [?symbol->class ?tag->class tag->class class->str class->symbol]) #?(:clj type-hint|class) type-hint|sym fn-safe-type-hints-map - #?@(:clj [class->instance?-safe-tag|sym ->fn-arglist-tag with-fn-arglist-type-hint]) + #?@(:clj [class->instance?-safe-tag|sym >fn-arglist-tag with-fn-arglist-type-hint]) >body-embeddable-tag >arglist-embeddable-tag) diff --git a/src/quantum/core/match.cljc b/src/quantum/core/match.cljc index de6b69dc..d8e85f5e 100644 --- a/src/quantum/core/match.cljc +++ b/src/quantum/core/match.cljc @@ -2,21 +2,21 @@ (:refer-clojure :exclude [+ * cat]) (:require #?@(:clj - [[net.cgrand.seqexp :as se] - [clojure.core.match :as match]]) - [quantum.core.fn :as fn + [[net.cgrand.seqexp :as se] + [clojure.core.match :as match]]) + [quantum.core.fn :as fn :refer [<- fn-> fnl]] - [quantum.untyped.core.qualify :as qual] - [quantum.core.vars :as var + [quantum.core.vars :as var :refer [defalias]] [quantum.core.logic :refer [fn-not fn-and fn-or whenf1 condf1]] - [quantum.core.collections :as coll + [quantum.core.collections :as coll :refer [postwalk map-vals+ join]] [quantum.core.macros :refer [macroexpand-all]] - [quantum.core.collections.tree :as tree] - [quantum.core.collections.zippers :as zip])) + [quantum.core.collections.tree :as tree] + [quantum.core.collections.zippers :as zip] + [quantum.untyped.core.identifiers :as uident])) ; Regex seq matching @@ -47,7 +47,7 @@ (def defs (let [defs-syms '#{#_& ? | + * ?= ?! _}] (->> (zipmap defs-syms - (mapv (fnl qual/qualify 'quantum.core.match) defs-syms)) + (mapv (fnl uident/qualify 'quantum.core.match) defs-syms)) (apply concat) vec))) #?(:clj @@ -73,10 +73,10 @@ matched# (~f (let ~defs ~(replace-cats found expanded)) ~x) merged# (merge @~found matched#)] (->> merged# - (<- dissoc :rest :match) + (<- (dissoc :rest :match)) (map-vals+ first) (join {}) - (<- merge (select-keys merged# [:rest :match]))))))) + (<- (merge (select-keys merged# [:rest :match])))))))) #?(:clj (defmacro re-match [x preds] `(re-match-variant ~`re-match* ~x ~preds))) #?(:clj (defmacro re-match-whole [x preds] `(re-match-variant ~`re-match-whole* ~x ~preds))) diff --git a/src/quantum/core/meta/dev.cljc b/src/quantum/core/meta/dev.cljc index 6ccf43d2..ea058205 100644 --- a/src/quantum/core/meta/dev.cljc +++ b/src/quantum/core/meta/dev.cljc @@ -10,7 +10,7 @@ :refer [catch-all]] [quantum.core.macros :refer [defnt]] - [quantum.core.type :as t] + [quantum.core.type-old :as t] [quantum.core.collections :as coll :refer [map+ map-vals+ cat+ contains? filter+ filter-keys+ filter-vals+ remove+ keys+ join seq-and]])) diff --git a/src/quantum/core/meta/profile.cljc b/src/quantum/core/meta/profile.cljc index 47c9f337..d123fb6d 100644 --- a/src/quantum/core/meta/profile.cljc +++ b/src/quantum/core/meta/profile.cljc @@ -15,9 +15,9 @@ :refer [fn-or fn-and]] [quantum.core.vars :as var :refer [defalias]] - [quantum.core.type :as t]) + [quantum.core.type-old :as t]) #?(:clj (:import com.carrotsearch.sizeof.RamUsageEstimator - quanta.ClassIntrospector))) + quantum.misc.ClassIntrospector))) ; TO EXPLORE ; - Timbre profiling @@ -52,6 +52,7 @@ (defn deep-byte-size "Warning: doesn't handle ref-cycles." [obj] + ;; TODO port ClassIntrospector (-> (ClassIntrospector.) (.introspect obj) (.getDeepSize)))) diff --git a/src/quantum/core/nondeterministic.cljc b/src/quantum/core/nondeterministic.cljc index 247a90a0..590b4b10 100644 --- a/src/quantum/core/nondeterministic.cljc +++ b/src/quantum/core/nondeterministic.cljc @@ -27,17 +27,18 @@ :refer [>ex-info TODO throw-unless]] [quantum.core.macros :as macros :refer [defnt]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [regex?]] [quantum.core.logic :as logic :refer [splice-or condf1 whenc default]] [quantum.core.log :as log] [quantum.core.numeric :as num] [quantum.core.fn :as fn - :refer [<- rfn fn1]] + :refer [rfn fn1]] [quantum.core.data.array :as arr ] [quantum.core.vars - :refer [defalias]]) + :refer [defalias defaliases]] + [quantum.untyped.core.nondeterministic :as u]) (:import #?@(:clj [[java.util Random Collections Collection ArrayList] java.security.SecureRandom @@ -59,14 +60,7 @@ ; From Java 7 prefer java.util.concurrent.ThreadLocalRandom to java.util.Random in all ; circumstances - it is backwards compatible with existing code, but uses cheaper ; operations internally. -#?(:clj (defonce ^SecureRandom secure-random-generator - (SecureRandom/getInstance "SHA1PRNG"))) - -(defn #?(:clj ^Random get-generator :cljs get-generator) [secure?] - #?(:clj (if secure? - secure-random-generator - (java.util.concurrent.ThreadLocalRandom/current)) - :cljs (TODO))) +(defaliases u secure-random-generator get-generator) #?(:cljs (defn prime diff --git a/src/quantum/core/ns.cljc b/src/quantum/core/ns.cljc deleted file mode 100644 index a398a131..00000000 --- a/src/quantum/core/ns.cljc +++ /dev/null @@ -1,39 +0,0 @@ -(ns - ^{:doc "Useful namespace and var-related functions." - :attribution "alexandergunnarson"} - quantum.core.ns - (:refer-clojure :exclude - [ns in-ns all-ns create-ns the-ns find-ns ns-name ns-map - alias ns-aliases require import ns-imports use - ns-interns ns-publics refer ns-refers refer-clojure ns-unalias ns-unmap loaded-libs - remove-ns]) - (:require - [quantum.untyped.core.ns :as uns] - [quantum.untyped.core.vars :as uvar - :refer [defaliases]])) - -(defaliases uns - ns the-ns find-ns ns-name ns-map - ns-map ns-unmap ns-unmap! - in-ns all-ns - create-ns create-ns! - alias alias! - ns-unalias ns-unalias! - ns-aliases - require require! - import import! - ns-imports - use use! - ns-interns - ns-publics - refer refer! - refer-clojure refer-clojure! - ns-refers - remove-ns remove-ns! - ;; - the-alias ns>alias ns-name>alias - clear-ns-interns! search-var ns-exclude - with-ns with-temp-ns - import-static load-ns load-nss - loaded-libs load-lib! load-package! load-dep! - assert-ns-aliased) diff --git a/src/quantum/core/numeric.cljc b/src/quantum/core/numeric.cljc index 8fcd652d..26e8d426 100644 --- a/src/quantum/core/numeric.cljc +++ b/src/quantum/core/numeric.cljc @@ -1,7 +1,9 @@ -(ns - ^{:doc "Useful numeric functions. Floor, ceil, round, sin, abs, neg, etc." - :attribution "alexandergunnarson"} - quantum.core.numeric +(ns quantum.core.numeric + "Numeric functions. + Aliases all subnamespaces." + {:todo #{"Incorporate https://github.com/thi-ng/math/blob/master/src/bits.org" + "Incorporate https://github.com/thi-ng/math/blob/master/src/core.org" + "Add mutable numeric operations like `+!` or `-!` etc."}} (:refer-clojure :exclude [* *' + +' - -' / < > <= >= == rem inc dec zero? neg? pos? pos-int? min max quot mod format @@ -10,28 +12,26 @@ [clojure.core :as c] #?@(:cljs [[com.gfredericks.goog.math.Integer :as int]]) - [quantum.core.convert.primitive :as pconvert - :refer [#?(:clj ->long)]] - [quantum.core.error :as err - :refer [>err err! TODO]] - [quantum.core.fn - :refer [aritoid fn1 fn-> fn']] + [quantum.core.data.numeric :as dn] + [quantum.core.data.primitive + :refer [#?(:clj >long)]] [quantum.core.log :as log] - [quantum.core.logic :as logic + [quantum.untyped.core.logic :refer [fn-and whenf1]] - [quantum.core.macros :as macros - :refer [defnt #?@(:clj [defnt'])]] - [quantum.core.vars :as var - :refer [defalias defaliases]] - [quantum.core.numeric.convert ] - [quantum.core.numeric.misc ] - [quantum.core.numeric.operators :as op - :include-macros true] + [quantum.core.numeric.convert] + [quantum.core.numeric.misc] + [quantum.core.numeric.operators :as op] [quantum.core.numeric.predicates] - [quantum.core.numeric.trig ] - [quantum.core.numeric.truncate :as trunc - :include-macros true] - [quantum.core.numeric.types :as ntypes]) + [quantum.core.numeric.trig] + [quantum.core.numeric.truncate :as trunc] + [quantum.core.type :as t] + [quantum.core.vars + :refer [defalias defaliases]] + ;; TODO TYPED excise + [quantum.untyped.core.error + :refer [TODO]] + [quantum.untyped.core.fn + :refer [aritoid fn1 fn-> fn']]) #?(:cljs (:require-macros [quantum.core.numeric :as self])) @@ -181,12 +181,10 @@ ([form1 form2 & more] (cons 'do (map type-convert-form (list* form1 form2 more)))))) -(def num-ex (>err :overflow "Numeric overflow")) - ; ===== NON-TRANSFORMATIVE OPERATIONS ===== ; -(defalias numerator ntypes/numerator) -(defalias denominator ntypes/denominator) +(defalias numerator dn/numerator) +(defalias denominator dn/denominator) ;_____________________________________________________________________ ;==================={ CONVERT }====================== ;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° @@ -234,16 +232,16 @@ :cljs (defonce ONE int/ONE )) ; For units -(defonce ^:const ten (#?(:clj ->long :cljs int) 10 )) -(defonce ^:const hundred (#?(:clj ->long :cljs int) 100 )) -(defonce ^:const thousand (#?(:clj ->long :cljs int) 1000 )) -(defonce ^:const ten-thousand (#?(:clj ->long :cljs int) 10000 )) -(defonce ^:const hundred-thousand (#?(:clj ->long :cljs int) 100000)) -(defonce ^:const million (#?(:clj ->long :cljs int) 1E6 )) -(defonce ^:const billion (#?(:clj ->long :cljs int) 1E9 )) -(defonce ^:const trillion (#?(:clj ->long :cljs int) 1E12 )) -(defonce ^:const quadrillion (#?(:clj ->long :cljs int) 1E15 )) -(defonce ^:const quintillion (#?(:clj ->long :cljs int) 1E18 )) ; + exa | - atto +(defonce ^:const ten (#?(:clj >long :cljs int) 10 )) +(defonce ^:const hundred (#?(:clj >long :cljs int) 100 )) +(defonce ^:const thousand (#?(:clj >long :cljs int) 1000 )) +(defonce ^:const ten-thousand (#?(:clj >long :cljs int) 10000 )) +(defonce ^:const hundred-thousand (#?(:clj >long :cljs int) 100000)) +(defonce ^:const million (#?(:clj >long :cljs int) 1E6 )) +(defonce ^:const billion (#?(:clj >long :cljs int) 1E9 )) +(defonce ^:const trillion (#?(:clj >long :cljs int) 1E12 )) +(defonce ^:const quadrillion (#?(:clj >long :cljs int) 1E15 )) +(defonce ^:const quintillion (#?(:clj >long :cljs int) 1E18 )) ; + exa | - atto (defonce ^:const sextillion #?(:clj (c/bigint 1E21 ) :cljs 0)) (defonce ^:const septillion #?(:clj (c/bigint 1E24 ) :cljs 0)) (defonce ^:const octillion #?(:clj (c/bigint 1E27 ) :cljs 0)) @@ -312,7 +310,7 @@ ~@body) :nils (binding [*+* nils+ *-* nils- *** nils* *div* nils-div ] ~@body) - (err! "Numeric operation not recognized" {:op k#}))))) + (throw (ex-info "Numeric operation not recognized" {:op k#})))))) (defn whole-number? [n] (= n (trunc/floor n))) ; TODO use == @@ -347,7 +345,7 @@ complex functions"} [f] (or (get inverse-map f) - (err! :undefined "|inverse| not defined for function" f))) + (throw (ex-info "|inverse| not defined for function" {:f f})))) (def ^{:doc "Base values for operators." :const true} base-map @@ -366,7 +364,7 @@ (base *) 1}} [f] (or (get base-map f) - (err! :undefined "|base| not defined for function" f))) + (throw (ex-info "|base| not defined for function" {:f f})))) (defn range? {:tests `{((range? 1 4) 3) @@ -391,7 +389,7 @@ :dollar (->> n display-num (str "$")) ;:accounting - (err! "Unrecognized format" type))) + (throw (ex-info "Unrecognized format" {:type type})))) (defn percentage-of [of total-n] (-> of (op// total-n) double (c/* 100) display-num (str "%"))) ; TODO use *-2 diff --git a/src/quantum/core/numeric/convert.cljc b/src/quantum/core/numeric/convert.cljc deleted file mode 100644 index 3d943287..00000000 --- a/src/quantum/core/numeric/convert.cljc +++ /dev/null @@ -1,69 +0,0 @@ -(ns quantum.core.numeric.convert - (:refer-clojure :exclude [bigdec]) - (:require - [clojure.core :as core] - [quantum.core.error :as err - :refer [TODO]] - [quantum.core.macros - :refer [defnt #?@(:clj [defnt'])]] - [quantum.core.vars - :refer [defalias]] - [quantum.core.numeric.types :as ntypes]) -#?(:cljs - (:require-macros - [quantum.core.numeric.convert :as self])) -#?(:clj - (:import - java.math.BigInteger - clojure.lang.BigInt))) - -(defnt ->num - (^long [^boolean x] (if x 1 0)) - ([#{number? byte char} x] x)) - -(defn ->boolean-num [x] (if x 1 0)) - -#?(:clj (defalias ->big-integer ntypes/->big-integer)) - -#?(:clj (defnt' ^BigInt ->bigint - ([^BigInt x] x) - ([^BigInteger x] (BigInt/fromBigInteger x)) - ([^long x] (-> x BigInt/fromLong)) - ([^string? x radix] (->bigint (BigInteger. x (int radix)))) - ([#{double? Number} x] (-> x BigInteger/valueOf ->bigint))) - :cljs (defalias ->bigint ntypes/->bigint)) - -#?(:clj (doto (defalias ->bigdec core/bigdec) (alter-meta! assoc :tag BigDecimal)) - #_(defnt' ^BigDecimal ->bigdec - ([^java.math.BigDecimal x] x) - ([^BigInt x] - (if (-> x (.bipart) nil? ) - (-> x (.lpart ) BigDecimal/valueOf) - (-> x (.bipart) (BigDecimal.) ))) - ([^BigInteger x] (BigDecimal. x)) - ([#{(- decimal? :curr)} x] (BigDecimal. x)) - ([^Ratio x] (/ (BigDecimal. (.numerator x)) (.denominator x))) - ([#{(- number? :curr)} x] (BigDecimal/valueOf x))) - :cljs (defn ->bigdec [x] (TODO))) - -#?(:clj (defalias ->ratio ntypes/->ratio) - #_(defnt ^clojure.lang.Ratio ->ratio - ([^clojure.lang.Ratio x] x) - ([^java.math.BigDecimal x] - (let [^BigInteger bv (.unscaledValue x) - ^int scale (.scale x)] ; technically int - (if (neg? scale) - (Ratio. (->> (neg scale) - (.pow BigInteger/TEN) - (.multiply bv)) - BigInteger/ONE) - (Ratio. bv (-> BigInteger/TEN (.pow scale)))))) - ([^Object x] (-> x ->big-integer (Ratio. BigInteger/ONE)))) - :cljs (defalias ->ratio ntypes/->ratio)) - -#?(:clj -(defnt exactly - ([#{decimal?} x] - (-> x rationalize exactly)) - ([#{int? long?} x] (->bigint x)) - ([#{bigint? ratio?} x] x))) diff --git a/src/quantum/core/numeric/exponents.cljc b/src/quantum/core/numeric/exponents.cljc index ec70c56a..895425cc 100644 --- a/src/quantum/core/numeric/exponents.cljc +++ b/src/quantum/core/numeric/exponents.cljc @@ -1,15 +1,14 @@ (ns quantum.core.numeric.exponents - (:refer-clojure :exclude [+ *]) (:require - [clojure.core :as core] - [quantum.core.error :as err - :refer [TODO]] - [quantum.core.macros - :refer [defnt #?@(:clj [defnt'])]] + [clojure.core :as core] + [quantum.core.data.bits :as bit] + [quantum.core.numeric.operators :as no] + [quantum.core.type :as t] [quantum.core.vars - :refer [defalias #?@(:clj [defmalias])]] - [quantum.core.numeric.operators - :refer [+ * dec* div*]]) + :refer [defalias]] + ;; TODO TYPED excise this reference + [quantum.untyped.core.error + :refer [TODO]]) #?(:clj (:import [quantum.core Numeric] @@ -22,7 +21,7 @@ [#{byte #_char short int float double} x #{long? double?} n] (loop [acc (Long. 1) nn n] (if (<= (double nn) 0) acc - (recur (* x acc) (dec* nn))))) + (recur (no/* x acc) (no/dec* nn))))) :cljs (defn pow- [x n] (TODO))) (defn pow' @@ -108,6 +107,11 @@ #?(:clj (def ^:const ^double ln-2 (ln 2))) +(t/defn log-2? + {:adapted-from 'thi.ng.math.bits/log2?} + ( [x dn/integer?] (and (no/zero? (bit/and x (no/dec x))) (??/not (no/zero? x)))) + (^:intrinsic [x dn/number?] false)) + #?(:clj (defnt log-2 [^double x] (/ (ln x) ln-2)) :cljs (defnt log-2 [^number? x] (js/Math.log2 x))) @@ -141,7 +145,7 @@ {:todo ["Need to intelligently determine, at compile time if possible, whether @x is e, 2, or 10 and choose the appropriate fn."]} ([#?(:clj #{double}) x #?(:clj #{double}) base] ; arbitrary to choose ln vs. log-10 - (div* (ln x) (ln base)))) + (no/div* (ln x) (ln base)))) #?(:clj (defmacro log [base x] ; TODO do ln' diff --git a/src/quantum/core/numeric/misc.cljc b/src/quantum/core/numeric/misc.cljc index 5617a80b..2a40b710 100644 --- a/src/quantum/core/numeric/misc.cljc +++ b/src/quantum/core/numeric/misc.cljc @@ -16,8 +16,7 @@ #?(:clj (defmacro rem [n div] `(Numeric/rem ~n ~div)) ; TODO `defnt` :cljs (defnt rem - ([^double? x n] (core/rem x n)) - ([^bigint? x n] (.modulo x n)))) + ([^double? x n] (core/rem x n)))) #?(:clj (defalias mod core/mod) ; TODO fix :cljs (defnt mod diff --git a/src/quantum/core/numeric/operators.cljc b/src/quantum/core/numeric/operators.cljc index 378808c9..35fa28f9 100644 --- a/src/quantum/core/numeric/operators.cljc +++ b/src/quantum/core/numeric/operators.cljc @@ -1,104 +1,106 @@ (ns quantum.core.numeric.operators - (:refer-clojure :exclude - [+ +' - -' * *' / - inc inc' dec dec' - numerator denominator]) - (:require - [clojure.core :as core] - #?(:cljs - [com.gfredericks.goog.math.Integer :as int]) - [quantum.core.error :as err - :refer [TODO]] - [quantum.core.log :as log] - [quantum.core.macros - :refer [defnt defntp #?@(:clj [defnt' variadic-proxy])]] - [quantum.core.numeric.types :as ntypes - :refer [numerator denominator]] - [quantum.core.numeric.convert :as conv - :refer [->bigint #?@(:clj [->big-integer])]] - [quantum.core.type :as t - :refer [val?]] - [quantum.core.vars - :refer [defalias #?@(:clj [defmalias])]] - [quantum.untyped.core.form - :refer [#?(:clj core-symbol)]]) -#?(:cljs - (:require-macros - [quantum.core.numeric.operators :as self - :refer [+ - *]])) + (:refer-clojure :exclude + [+ +' - -' * *' / + inc inc' dec dec' + numerator denominator]) + (:require + [clojure.core :as core] + ;; TODO TYPED remove + #?(:cljs [com.gfredericks.goog.math.Integer :as int]) + [quantum.core.data.bits :as bit + :refer [<< >> >>>]] + [quantum.core.data.numeric :as dn + :refer [bigdec? clj-bigint? denominator numerator numeric? numerically-int?]] + [quantum.core.data.primitive :as p] + [quantum.core.data.refs :as ref] + ;; TODO TYPED re-enable + #_[quantum.core.numeric.convert :as conv + :refer [>bigint #?@(:clj [>big-integer])]] + [quantum.core.type :as t] + [quantum.core.vars + :refer [defalias]] + ;; TODO TYPED excise reference + [quantum.untyped.core.error + :refer [TODO]] + ;; TODO TYPED excise reference + [quantum.untyped.core.form + :refer [#?(:clj core-symbol)]] + [quantum.untyped.core.log :as ulog]) +#?(:cljs (:require-macros + [quantum.core.numeric.operators :as self + :refer [+ - *]])) +#?(:clj (:import + [clojure.lang BigInt Ratio] + [quantum.core Numeric] + [java.math BigInteger BigDecimal]))) + +(ulog/this-ns) + +;; ===== (Up-to-)binary operators ===== ;; + +;; ----- Addition ----- ;; + + ;; TODO we're missing CLJS bigdec/bigint (`dn/-add`) as well as other type combos + (t/defn ^:inline +* + "Lax `+`. Continues on overflow/underflow." + > numeric? + ([] 0) + ([x numeric?] x) + ([x numeric-primitive?, y numeric-primitive? > ?] + (#?(:clj Numeric/add :cljs cljs.core/+) x y)) +#?(:clj ([x clj-bigint?, y clj-bigint? > clj-bigint?] (.add x y))) +#?(:clj ([x bigdec? , y bigdec? > bigdec?] + (if (p/nil? *math-context*) + (.add x y) + (.add x y *math-context*))))) + + ;; TODO we're missing CLJS bigdec/bigint (`dn/-add`) as well as other type combos + (t/defn ^:inline +' + "Strict `+`. Throws exception on overflow/underflow." + > numeric? + ([] (+*)) + ([x numeric?] (+* x)) + ;; A Java intrinsic, so we keep this arity + ([x p/int? , y p/int? > p/int?] (Math/addExact x y)) + ;; A Java intrinsic, so we keep this arity +#?(:clj ([x p/long?, y p/long? > p/long?] (Math/addExact x y)))) + + ;; TODO we're missing CLJS bigdec/bigint (`dn/-add`) as well as other type combos + (t/defn ^:inline + + "Natural `+`. Promotes on overflow/underflow." + > numeric? + ;; TODO TYPED port from CLJ and CLJS core nss/classes + ) + +;; ----- Subtraction ----- ;; + + ;; TODO we're missing CLJS bigdec/bigint (`dn/-subtract`, `dn/-negate`) as well as other + ;; type combos + (t/defn ^:inline -* + "Lax `-`. Continues on overflow/underflow." + > numeric? + ([] 0) + ([x numeric-primitive? > (t/type x)] (#?(:clj Numeric/negate :cljs cljs.core/-) x)) +#?(:clj ([x clj-bigint? > (t/type x)] ...)) +#?(:clj ([x java-bigint? > (t/type x)] (.negate x))) + ([x numeric-primitive?, y numeric-primitive? > ?] + (#?(:clj Numeric/subtract :cljs cljs.core/-) x y)))) + + ;; TODO we're missing CLJS bigdec/bigint (`dn/-subtract`, `dn/-negate`) as well as other + ;; type combos + (t/defn ^:inline -' + "Strict `-`. Throws exception on overflow/underflow." + > numeric? + ([] (-*)) + ;; A Java intrinsic, so we keep this arity +#?(:clj ([x p/int? > p/int?] (Math/negateExact x))) +#?(:clj ([x p/long? > p/long?] (Math/negateExact x))) +#?(:clj ([x p/int? , y p/int? > p/int?] (Math/subtractExact x y))) +#?(:clj ([x p/long?, y p/long? > p/long?] (Math/subtractExact x y)))) + +;; TODO TYPED continue to port #?(:clj - (:import - (quantum.core Numeric) - (java.math BigInteger BigDecimal) - (clojure.lang BigInt Ratio)))) - -(log/this-ns) - -; Auto-unboxes; no boxed combinations necessary -; TODO right now: multiple typed arguments in |defnt|, even in protocols -; TODO `==` from Numeric/equals - -; ===== ADD ===== ; - -(defn num-ex [] (throw (#?(:clj ArithmeticException. :cljs js/Error.) "Out of range"))) - -#?(:clj #_(defalias +*-bin unchecked-add) - (defnt' +*-bin "Lax `+`. Continues on overflow/underflow." - ([] 0) - ([#{byte char short int long float double Number} x] x) - ([#{byte char short int long float double} #_(- prim? boolean) x - #{byte char short int long float double} #_(- prim? boolean) y] - (Numeric/add x y)) - (^BigInt [^BigInt x ^BigInt y] (.add x y)) - (^BigDecimal [^BigDecimal x ^BigDecimal y] - (if (nil? *math-context*) - (.add x y) - (.add x y *math-context*))) - #?(:cljs ([x y] (TODO) (ntypes/-add x y)))) - :cljs (defalias +*-bin unchecked-add)) - -#?(:clj (variadic-proxy +* quantum.core.numeric.operators/+*-bin )) -#?(:clj (variadic-proxy +*& quantum.core.numeric.operators/+*-bin&)) - -#?(:clj (defnt' +'-bin "Strict `+`. Throws exception on overflow/underflow." - (^int ^:intrinsic [^int x ^int y] (Math/addExact x y)) - (^long ^:intrinsic [^long x ^long y] (Math/addExact x y)) - ( [#{byte char short int long float double Number} x] x)) ; TODO do the rest - :cljs (defalias +'-bin core/+)) - -#?(:clj (variadic-proxy +' quantum.core.numeric.operators/+'-bin )) -#?(:clj (variadic-proxy +'& quantum.core.numeric.operators/+'-bin&)) - -; "Natural |+|; promotes on overflow/underflow" -#?(:clj (defalias +-bin core/+) ; TODO port - :cljs (defalias +-bin core/+)) - -#?(:clj (variadic-proxy + quantum.core.numeric.operators/+-bin)) -#?(:clj (variadic-proxy +& quantum.core.numeric.operators/+-bin&)) - -; ===== SUBTRACT ===== ; - -#?(:clj (defnt' -*-bin "Lax `-`. Continues on overflow/underflow." - #?(:clj ([#{byte char short int long float double} x] - (Numeric/negate x)) - :cljs (^first [^double? x] (TODO "fix") (ntypes/-negate x))) - ([#{byte char short int long float double} #_(- prim? boolean) x - #{byte char short int long float double} #_(- prim? boolean) y] - (Numeric/subtract x y)) - (^BigInteger [^BigInteger x] (-> x .negate)) - (^BigInt [^BigInt x] - (-> x ->big-integer -*-bin ->bigint))) ; TODO reflection - :cljs (defalias -*-bin unchecked-subtract)) - -#?(:clj (variadic-proxy -* quantum.core.numeric.operators/-*-bin )) -#?(:clj (variadic-proxy -*& quantum.core.numeric.operators/-*-bin&)) - -#?(:clj #_(defalias -'-bin core/-) - (defnt' -'-bin "Strict `-`. Throws exception on overflow/underflow." - (^int ^:intrinsic [^int x ^int y] (Math/subtractExact x y)) - (^long ^:intrinsic [^long x ^long y] (Math/subtractExact x y)) - (^int ^:intrinsic [^int x] (Math/negateExact x)) - (^long ^:intrinsic [^long x] (Math/negateExact x)) + (defnt' -'-bin (^byte [^byte x] (if (Numeric/eq x Byte/MIN_VALUE ) (num-ex) (-* x))) (^char [^char x] (if (Numeric/eq x 0 ) 0 (num-ex))) (^short [^short x] (if (Numeric/eq x Short/MIN_VALUE ) (num-ex) (-* x))) @@ -106,18 +108,15 @@ (^long [^long x] (if (Numeric/eq x Long/MIN_VALUE ) (num-ex) (-* x)))) :cljs (defalias -'-bin core/-)) -#?(:clj (variadic-proxy -' quantum.core.numeric.operators/-'-bin )) -#?(:clj (variadic-proxy -'& quantum.core.numeric.operators/-'-bin&)) - -#?(:cljs (defn --bin- [x y] (core/- x y))) ; TODO only to fix CLJS arithmetic warning here - -(defnt --bin "Natural `-`. Promotes on overflow/underflow." - ([#?(:clj x :cljs ^double? x) y] (#?(:clj core/- :cljs --bin-) x y))) - -#?(:clj (variadic-proxy - quantum.core.numeric.operators/--bin )) -#?(:clj (variadic-proxy -& quantum.core.numeric.operators/--bin&)) + ;; TODO we're missing CLJS bigdec/bigint (`dn/-subtract`, `dn/-negate`) as well as other + ;; type combos + (t/defn ^:inline - + "Natural `-`. Promotes on overflow/underflow." + > numeric? + ;; TODO TYPED port from CLJ and CLJS core nss/classes + ) -; ===== MULTIPLY ===== ; +;; ----- Multiplication ----- ;; ; (js/Math.imul x y) ; 32-bit int multiplication @@ -133,10 +132,7 @@ :cljs (defn **-bin "Lax `*`. Continues on overflow/underflow." ([] 0) ([x] x) - ([x y] (TODO "fix") (ntypes/-multiply x y)))) - -#?(:clj (variadic-proxy ** quantum.core.numeric.operators/**-bin )) -#?(:clj (variadic-proxy **& quantum.core.numeric.operators/**-bin&)) + ([x y] (TODO "fix") (dn/-multiply x y)))) #?(:cljs (defn *'-bin- [x y] (TODO))) ; TODO only to fix CLJS arithmetic warning here @@ -146,17 +142,11 @@ :cljs (defnt *'-bin ([x y] (*'-bin- x y)))) -#?(:clj (variadic-proxy *' quantum.core.numeric.operators/*'-bin )) -#?(:clj (variadic-proxy *'& quantum.core.numeric.operators/*'-bin&)) - ; "Natural |*|; promotes on overflow/underflow" #?(:clj (defalias *-bin core/*) :cljs (defalias *-bin core/*)) -#?(:clj (variadic-proxy * quantum.core.numeric.operators/*-bin )) -#?(:clj (variadic-proxy *& quantum.core.numeric.operators/*-bin&)) - -; ===== DIVIDE ===== ; +;; ----- Division ----- ;; #?(:cljs (defn div*-bin- [x y] (core// x y))) ; TODO only to fix CLJS arithmetic warning here @@ -189,17 +179,14 @@ (.divide n d) (.divide n d *math-context*)))) :cljs (defnt div*-bin "Lax `/`. Continues on overflow/underflow." - ([^ratio? x ] (TODO "fix") (ntypes/-invert x)) + ([^ratio? x ] (TODO "fix") (dn/-invert x)) ([^ratio? x y] (TODO "fix") ;(* x (-invert (apply * y more))) - (* x (ntypes/-invert y))) + (* x (dn/-invert y))) ([^double? x ] (core// x)) ([^double? x y] (div*-bin- x y)))) -#?(:clj (variadic-proxy div* div*-bin )) -#?(:clj (variadic-proxy div*& div*-bin&)) - ; "Strict |/|. Throws exception on overflow/underflow." #?(:clj (defalias div'-bin core//) ; TODO port :cljs (defalias div'-bin core//)) @@ -224,9 +211,7 @@ ; TODO integer division via div:int ; TODO div:nil which returns nil if dividing by 0 -;_____________________________________________________________________ -;==================={ UNARY MATH OPERATORS }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° +;; ===== (Up-to-)unary operators ===== ;; #?(:clj (defnt' dec* "Lax `dec`. Continues on overflow/underflow." ([#{byte char short long float double} x] (Numeric/dec x)) @@ -288,12 +273,22 @@ (+* x 1)))) :cljs (defalias inc' inc )) +(t/defn abs > nneg? +#?(:clj (^:inline [x char?] x)) + (^{:adapted-from 'thi.ng.math.bits/abs + :doc "Faster than using conditionals to determine the absolute value"} + [x #?(:clj (t/or p/byte? p/short? p/int? p/long?) :cljs ni-double?) + > (t/and (t/type x) (t/assume nneg?))] + (let [mask (>> x (bit/dec-bits-of x))] + (- (bit/xor x mask) mask))) +#?(:clj (^:intrinsic ^:inline [x p/float? > (t/and p/float? (t/assume nneg?))] (Math/abs x))) +#?(:clj (^:inline [x p/double? ...]) + :cljs (^:inline [x p/double? > (t/assume (t/and p/double? nneg?))] (js/Math.abs x))) +#?(:clj (^:inline [x bigdec? > (t/and bigdec? (t/assume nneg?))] (.abs x))) +) + +;; TODO TYPED incorporate #?(:clj (defnt abs' - ([#{int long double} x] (Math/abs x)) - (^float ^:intrinsic [^float x] (Math/abs x)) - ([#{byte char short} x] (if (Numeric/isNeg x) (-' x) x)) ; TODO abstract this - (^BigDecimal [^BigDecimal x] - (.abs x)) (^BigDecimal [^BigDecimal x math-context] (.abs x math-context)) (^BigInteger [^BigInteger x] @@ -307,8 +302,6 @@ (abs' (denominator x))))) :cljs (defnt abs' ([x] (TODO "incomplete") (js/Math.abs x)))) -#?(:clj (defalias abs abs')) - #?(:clj (defmacro int-nil [x] `(let [x# ~x] (if (nil? x#) 0 x#)))) #?(:clj @@ -339,4 +332,4 @@ ([a# b# c#] (when (and a# b# c#) (~core-op a# b# c#))) ([a# b# c# & args#] (let [argsf# (conj args# c# b# a#)] - (when (every? val? argsf#) (reduce ~core-op argsf#)))))))) + (when (every? p/val? argsf#) (reduce ~core-op argsf#)))))))) diff --git a/src/quantum/core/numeric/predicates.cljc b/src/quantum/core/numeric/predicates.cljc deleted file mode 100644 index 3bef215f..00000000 --- a/src/quantum/core/numeric/predicates.cljc +++ /dev/null @@ -1,64 +0,0 @@ -(ns quantum.core.numeric.predicates - (:refer-clojure :exclude - [neg? pos? zero? pos-int?]) - (:require [#?(:clj clojure.core - :cljs cljs.core ) :as core ] - #?(:cljs [com.gfredericks.goog.math.Integer :as int ]) - [quantum.core.error :as err - :refer [TODO]] - [quantum.core.logic - :refer [#?@(:clj [fn-and fn-not])] - :refer-macros [fn-and fn-not]] - [quantum.core.macros - :refer [#?@(:clj [defnt defnt'])] - :refer-macros [defnt defntp]]) - #?(:clj (:import - [java.math BigInteger BigDecimal] - [clojure.lang Ratio BigInt] - [quantum.core Numeric]))) - -#?(:clj (defnt ^boolean neg? - ([#{byte char short int long float double} x] (Numeric/isNeg x)) - ([#{BigInteger - BigDecimal} x] (-> x .signum neg?)) - ([^Ratio x] (-> x .numerator .signum neg?)) - ([^BigInt x] (if (-> x .bipart nil?) - (-> x .lpart neg?) - (-> x .bipart .signum neg?)))) - :cljs (defnt neg? - ([^double? x] (core/neg? x)) - ([^bigint? x] (.isNegative x)))) - -#?(:clj (defnt ^boolean pos? - ([#{byte char short int long float double} x] (Numeric/isPos x)) - ([#{BigInteger - BigDecimal} x] (-> x .signum pos?)) - ([^Ratio x] (-> x .numerator .signum pos?)) - ([^BigInt x] (if (-> x .bipart nil?) - (-> x .lpart pos?) - (-> x .bipart .signum pos?)))) - :cljs (defnt pos? - ([^double? x] (core/pos? x)) - ([^com.gfredericks.goog.math.Integer x] (not (.isNegative x))))) - -#?(:clj (defnt ^boolean zero? - ([#{byte char short int long float double} x] (Numeric/isZero x)) - ([^Ratio x] (-> x .numerator .signum zero?)) - ([^BigInt x] (if (nil? (.bipart x)) - (zero? (.lpart x)) - (-> x .bipart .signum zero?))) - ([#{BigInteger - BigDecimal} x] (-> x .signum zero?))) - :cljs (defnt zero? - ([^double? x] (core/zero? x)) - ([^bigint? x] (.isZero x)))) - -#?(:clj (defnt nan? - ([^double? x] (Double/isNaN x)) - ([^float? x] (Float/isNaN x))) - :cljs (defn nan? [x] (TODO "fix") (identical? x js/NaN))) - -(def nneg? (fn-not neg?)) -(def pos-int? (fn-and integer? pos?)) -(def nneg-int? (fn-and integer? nneg?)) -(defn exact? [x] (TODO)) diff --git a/src/quantum/core/numeric/strict_args.cljc b/src/quantum/core/numeric/strict_args.cljc deleted file mode 100644 index f4c1a539..00000000 --- a/src/quantum/core/numeric/strict_args.cljc +++ /dev/null @@ -1,57 +0,0 @@ -(ns - quantum.core.numeric.strict-args - "Useful numeric functions. Floor, ceil, round, sin, abs, neg, etc. - All vars in this namespace are strict-arg vars (i.e., are guaranteed - not to rely on protocol dispatch.)" - {:attribution "alexandergunnarson"} - (:refer-clojure :exclude - [* *' + +' - -' / < > <= >= == rem inc dec zero? neg? pos? pos-int? - min max quot mod format - #?@(:clj [bigint biginteger bigdec numerator denominator inc' dec'])]) - (:require - [clojure.core :as c] - [quantum.core.vars :as var - :refer [defalias defaliases]] - [quantum.core.numeric.convert ] - [quantum.core.numeric.misc ] - [quantum.core.numeric.operators :as op] - [quantum.core.numeric.predicates] - [quantum.core.numeric.trig ] - [quantum.core.numeric.truncate :as trunc] - [quantum.core.numeric.types :as ntypes]) -#?(:cljs - (:require-macros - [quantum.core.numeric.strict-args :as self])) -#?(:clj - (:import - [java.nio ByteBuffer] - [quantum.core Numeric] ; loops? - [net.jafama FastMath] - clojure.lang.BigInt - java.math.BigDecimal))) -;_____________________________________________________________________ -;==================={ OPERATORS }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -#?(:clj (defalias +* op/+*&)) -#?(:clj (defalias +' op/+'&)) -#?(:clj (defalias + op/+& )) - -#?(:clj (defalias -* op/-*&)) -#?(:clj (defalias -' op/-'&)) -#?(:clj (defalias - op/-& )) - -#?(:clj (defalias ** op/**&)) -#?(:clj (defalias *' op/*'&)) -#?(:clj (defalias * op/*& )) - -#?(:clj (defalias div* op/div*&)) -#?(:clj (defalias div' op/div'&)) -#?(:clj (defalias / op/div& )) - -#_(defaliases quantum.core.numeric.operators - #?@(:clj [;inc*$ #_inc' inc$ - ;dec*$ #_dec' dec$ - ; abs'$ abs$ - ]) - ;inc'$ dec'$ - ) diff --git a/src/quantum/core/numeric/trig.cljc b/src/quantum/core/numeric/trig.cljc index 31e6937c..57542b3d 100644 --- a/src/quantum/core/numeric/trig.cljc +++ b/src/quantum/core/numeric/trig.cljc @@ -3,16 +3,12 @@ [+ * /]) (:require [quantum.core.error :as err - :refer [TODO] ] - [quantum.core.macros - :refer [#?@(:clj [defnt defnt'])] - :refer-macros [defnt]] + :refer [TODO]] + [quantum.core.type :as t] [quantum.core.numeric.exponents :as exp - :refer [#?@(:clj [log-e sqrt pow])] - :refer-macros [log-e sqrt pow]] + :refer [log-e sqrt pow]] [quantum.core.numeric.operators - :refer [#?@(:clj [+ * / inc* dec*])] - :refer-macros [+ * / inc* dec*]]) + :refer [+ * / inc* dec*]]) #?(:clj (:import [net.jafama FastMath]))) ; ===== SINE ===== ; diff --git a/src/quantum/core/numeric/truncate.cljc b/src/quantum/core/numeric/truncate.cljc index 239b6ef9..f4d943f2 100644 --- a/src/quantum/core/numeric/truncate.cljc +++ b/src/quantum/core/numeric/truncate.cljc @@ -8,8 +8,7 @@ :refer [defnt #?@(:clj [defnt'])]] [quantum.core.vars :as var :refer [defalias defaliases]] - [quantum.core.convert.primitive - :refer [#?@(:clj [->int ->double])]] + [quantum.core.data.primitive :as p] [quantum.core.numeric.convert :refer [->bigdec]] [quantum.core.compare.core :as ccomp @@ -18,8 +17,14 @@ :refer [pos?]]) #?(:clj (:import java.math.BigDecimal clojure.lang.Ratio))) +;; TODO js/Math.trunc for CLJS +;; TODO js/Math.round for CLJS +;; TODO js/Math.fround for CLJS +;; TODO js/Math.rint for CLJS + #?(:clj -(defnt' rint "The double value that is closest in value to @x and is equal to a mathematical integer." +(defnt' rint + "The double value that is closest in value to ->`x` and is equal to a mathematical integer." (^double [^double x] (Math/rint x)))) #?(:clj (defalias round-double rint)) @@ -31,7 +36,7 @@ (^BigDecimal [^BigDecimal x math-context] (.round x math-context)) (^long [#{long ratio?} x] - (round-int (->double x))) ; TODO 0 + (round-int (p/>double x))) ; TODO 0 (^BigDecimal [#{long ratio?} x math-context] (round-int (->bigdec x) math-context))) :cljs (defn round-int [x] (js/Math.round x))) diff --git a/src/quantum/core/numeric/types.cljc b/src/quantum/core/numeric/types.cljc deleted file mode 100644 index 462accce..00000000 --- a/src/quantum/core/numeric/types.cljc +++ /dev/null @@ -1,205 +0,0 @@ -(ns quantum.core.numeric.types - (:refer-clojure :exclude - [denominator numerator ratio? #?@(:cljs [-compare]) read-string]) - (:require - [clojure.core :as core] - [clojure.string :as str] - [clojure.tools.reader - :refer [read-string]] - #?(:cljs - [com.gfredericks.goog.math.Integer :as int]) - [quantum.core.macros - :refer [defnt]] - [quantum.core.logic - :refer [whenf fn-not fn=]] - [quantum.core.vars - :refer [defalias]] - [quantum.core.error - :refer [>ex-info]]) -#?(:cljs - (:require-macros - [quantum.core.numeric.types :as self]))) - -#?(:clj -(defnt ^java.math.BigInteger ->big-integer - ([^java.math.BigInteger x] x) - ([^clojure.lang.BigInt x] (.toBigInteger x)) - ([;#{(- number? BigInteger BigInt)} x - #{short int long} x] ; TODO BigDecimal - (-> x core/long (BigInteger/valueOf))))) - -(declare gcd) -(declare normalize) -#?(:cljs (declare ->bigint)) -#?(:cljs (declare ->ratio)) - -#?(:cljs (defprotocol Add (-add [x y]))) -#?(:cljs (defprotocol AddWithInteger (-add-with-integer [x y]))) -#?(:cljs (defprotocol AddWithRatio (-add-with-ratio [x y]))) -#?(:cljs (defprotocol Multiply (-multiply [x y]))) -#?(:cljs (defprotocol MultiplyWithInteger (-multiply-with-integer [x y]))) -#?(:cljs (defprotocol MultiplyWithRatio (-multiply-with-ratio [x y]))) -#?(:cljs (defprotocol Invert (-invert [x] ))) -#?(:cljs (defprotocol Negate (-negate [x] ))) -#?(:cljs (defprotocol Ordered (-compare [x y]))) -#?(:cljs (defprotocol CompareToInteger (-compare-to-integer [x y]))) -#?(:cljs (defprotocol CompareToRatio (-compare-to-ratio [x y]))) - -#?(:cljs -(extend-type number - Add (-add [x y] (-add (->bigint x) y)) - ;; I have a hard time reasoning about whether or not this is necessary - AddWithInteger (-add-with-integer [x y] (-add-with-integer (->bigint x) y)) - AddWithRatio (-add-with-ratio [x y] (-add-with-ratio (->bigint x) y)) - Multiply (-multiply [x y] (-multiply (->bigint x) y)) - MultiplyWithInteger (-multiply-with-integer [x y] (-multiply-with-integer (->bigint x) y)) - MultiplyWithRatio (-multiply-with-ratio [x y] (-multiply-with-ratio (->bigint x) y)) - Negate (-negate [x] (-negate (->bigint x) )) - Ordered (-compare [x y] (-compare (->bigint x) y)) - CompareToInteger (-compare-to-integer [x y] (-compare-to-integer (->bigint x) y)) - CompareToRatio (-compare-to-ratio [x y] (-compare-to-ratio (->bigint x) y)))) - -#?(:cljs -(extend-type com.gfredericks.goog.math.Integer - Add (-add [x y] (-add-with-integer y x)) - AddWithInteger (-add-with-integer [x y] (.add x y)) - AddWithRatio (-add-with-ratio [x y] (-add-with-ratio (->ratio x) y)) - Multiply (-multiply [x y] (-multiply-with-integer y x)) - MultiplyWithInteger (-multiply-with-integer [x y] (.multiply x y)) - MultiplyWithRatio (-multiply-with-ratio [x y] (-multiply-with-ratio (->ratio x) y)) - Negate (-negate [x] (.negate x)) - Invert (-invert [x] (->ratio int/ONE x)) - Ordered (-compare [x y] (core/- (-compare-to-integer y x))) - CompareToInteger (-compare-to-integer [x y] (.compare x y)) - CompareToRatio (-compare-to-ratio [x y] (-compare-to-ratio (->ratio x) y)) - IEquiv (-equiv [x y] (and (instance? com.gfredericks.goog.math.Integer y) (.equals x y))) - ;; dunno? - IHash (-hash [this] (reduce bit-xor 899242490 (.-bits_ this))) - IComparable (-compare [x y] (-compare x y)))) - -#?(:cljs -(defnt ^com.gfredericks.goog.math.Integer ->bigint - ([^bigint? x] x) - ([^string? x] (int/fromString x)) - ([^double? x] (-> x str ->bigint)))) - -#?(:cljs -(deftype Ratio [n d] - ;; "Ratios should not be constructed directly by user code; we assume n and d are - ;; canonical; i.e., they are coprime and at most n is negative." - Object - (toString [_] - (str "#ratio [" n " " d "]")) - Add (-add [x y] (-add-with-ratio y x)) - AddWithInteger (-add-with-integer [x y] (-add-with-ratio x (->ratio y))) - AddWithRatio - (-add-with-ratio [x y] - (let [+ -add-with-integer - * -multiply-with-integer - n' (+ (* (.-n x) (.-d y)) - (* (.-d x) (.-n y))) - d' (* (.-d x) (.-d y)) - the-gcd (gcd n' d')] - (normalize (.divide n' the-gcd) (.divide d' the-gcd)))) - Multiply (-multiply [x y] (-multiply-with-ratio y x )) - MultiplyWithInteger (-multiply-with-integer [x y] (-multiply x (->ratio y))) - MultiplyWithRatio - (-multiply-with-ratio [x y] - (let [* -multiply-with-integer - n' (* (.-n x) (.-n y)) - d' (* (.-d x) (.-d y)) - the-gcd (gcd n' d')] - (normalize (.divide n' the-gcd) (.divide d' the-gcd)))) - Negate (-negate [x] (->ratio (-negate n) d)) - Invert (-invert [x] (normalize d n)) - Ordered (-compare [x y] (core/- (-compare-to-ratio y x))) - CompareToInteger (-compare-to-integer [x y] (-compare-to-ratio x (->ratio y))) - CompareToRatio - (-compare-to-ratio [x y] - (let [* -multiply-with-integer] - (-compare-to-integer (* (.-n x) (.-d y)) - (* (.-n y) (.-d x))))) - IEquiv - (-equiv [_ other] - (and (instance? Ratio other) - (core/= n (.-n other)) - (core/= d (.-d other)))) - IHash - (-hash [_] - (bit-xor 124790411 (-hash n) (-hash d))) - IComparable - (-compare [x y] - (-compare x y)))) - -#?(:cljs -(defn- normalize - [n d] - (if (.isNegative d) - (let [n' (.negate n) - d' (.negate d)] - (if (.equals d' int/ONE) - n' - (->ratio n' d'))) - (if (.equals d int/ONE) - n - (->ratio n d))))) - -(defn ->ratio - ([x] (->ratio x #?(:clj 1 :cljs int/ONE))) - ([x y] - #?(:clj (whenf (rationalize (/ x y)) - (fn-not core/ratio?) - #(clojure.lang.Ratio. (->big-integer %) java.math.BigInteger/ONE)) - :cljs (let [x (->bigint x) - y (->bigint y) - d (gcd x y) - x' (.divide x d) - y' (.divide y d)] - (if (.isNegative y') - (Ratio. (.negate x') (.negate y')) - (Ratio. x' y')))))) - -#?(:clj (defalias numerator core/numerator) - :cljs (defnt numerator - ([^ratio? x] (.-n x)))) - -#?(:clj (defalias denominator core/denominator) - :cljs (defnt denominator - ([^ratio? x] (.-d x)))) - -#?(:clj (defalias ratio? core/ratio?) - :cljs (defn ratio? [x] (instance? Ratio x))) - -(defn read-rational - "Create cross-platform literal rational numbers from decimal, without intermediate inexact - (e.g. float/double) representation. - #r 2.712 -> (rationalize 2.712M)" - {:todo #{"Support exponent notation e.g. 2.313E7 | 2.313e7"}} - [^String r] - (let [r-str (cond (string? r) - r - (symbol? r) - (do (assert (-> r namespace nil?)) - (assert (-> r name first (= \r))) - (->> r name rest (apply str)))) - minus-ct (->> r-str (filter #(= % \-)) count) - _ (assert (#{0 1} minus-ct)) - r-str (case minus-ct - 0 r-str - 1 (do (assert (-> r-str first (= \-))) - (->> r-str rest (apply str)))) - [integral-str decimal-str :as split] (str/split r-str #"\.") - _ (when (-> split count (> 2)) - (throw (>ex-info "Number cannot have more than one decimal point" {:num r-str}))) - _ (doseq [s split] - (when-not (every? #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9} s) - (throw (>ex-info "Number must have only numeric characters" {:num s})))) - integral (read-string integral-str) - decimal (read-string decimal-str) - scale (if decimal - (#?(:clj Math/pow :cljs js/Math.pow) 10 (count decimal-str)) - 1)] - (* (if (= minus-ct 1) -1 1) - (->ratio (+ (* scale integral) (or decimal 0)) - scale)))) - diff --git a/src/quantum/core/paths.cljc b/src/quantum/core/paths.cljc index 786cdfcc..2f3892d1 100644 --- a/src/quantum/core/paths.cljc +++ b/src/quantum/core/paths.cljc @@ -161,10 +161,10 @@ (defn up-dir-str [dir] (->> dir - (<- whenf (fn1 str/ends-with? sys/separator) popr) + (<- (whenf (fn1 str/ends-with? sys/separator) popr)) (dropr-until sys/separator) - (<- whenc empty? - (throw (>ex-info :err/io "Directory does not have a parent directory:" dir))))) + (<- (whenc empty? + (throw (>ex-info :err/io "Directory does not have a parent directory:" dir)))))) (def dirs #?(:clj diff --git a/src/quantum/core/print/prettier.cljc b/src/quantum/core/print/prettier.cljc index a27a893c..21fdeb18 100644 --- a/src/quantum/core/print/prettier.cljc +++ b/src/quantum/core/print/prettier.cljc @@ -1,174 +1,7 @@ (ns quantum.core.print.prettier (:require - [fipp.edn] - [fipp.visit] - [fipp.ednize] - [quantum.core.fn :as fn - :refer [rcomp]] - [quantum.core.print :as pr] - [quantum.core.ns :as ns] - [quantum.untyped.core.convert :as uconv] - [quantum.untyped.core.qualify :as qual] - [quantum.core.vars :as var])) + [quantum.core.vars + :refer [defalias]] + [quantum.untyped.core.print.prettier :as u])) -#?(:clj -(defmethod print-method fipp.ednize.IEdn [^fipp.ednize.IEdn v ^java.io.Writer w] - (print-method (._edn v) w))) - -#?(:clj (prefer-method print-method fipp.ednize.IEdn clojure.lang.IRecord)) -#?(:clj (prefer-method print-method fipp.ednize.IEdn clojure.lang.IPersistentMap)) -#?(:clj (prefer-method print-method fipp.ednize.IEdn java.util.Map)) -#?(:clj (prefer-method print-method fipp.ednize.IEdn clojure.lang.ISeq)) -#?(:clj (prefer-method print-method clojure.lang.IRecord Throwable)) - -(in-ns 'fipp.visit) - -(defn transient-vector? [x] - (instance? #?(:clj clojure.lang.ITransientVector - :cljs cljs.core/TransientVector) x)) - -;; TODO more efficient -;; TODO move? -#?(:clj -(deftype IntIndexedIterator - [^long ^:unsynchronized-mutable i ^long ct ^clojure.lang.Indexed xs] - java.util.Iterator - (hasNext [this] (< i ct)) - (next [this] - (if (< i ct) - (let [i-prev i] - (set! i (unchecked-inc i)) - (.nth xs i-prev)) - (throw (java.util.NoSuchElementException.)))) - (remove [this] (throw (UnsupportedOperationException.))))) - -#?(:clj -(deftype IntIndexedIterable [^clojure.lang.Indexed xs] - Iterable - (iterator [this] (IntIndexedIterator. 0 (count xs) xs)))) - -(defn visit-symbol* [x] - [:text (cond-> x - quantum.core.print/*collapse-symbols?* - (quantum.untyped.core.qualify/collapse-symbol (not quantum.core.print/*print-as-code?*)))]) - -(defn visit-fn [visitor x] - [:group "#" "fn" " " (-> x quantum.untyped.core.convert/>symbol visit-symbol*)]) - -(defn visit* - "Visits objects, ignoring metadata." - [visitor x] - (cond - (nil? x) (visit-nil visitor) - (quantum.core.print/group? x) - (fipp.edn/pretty-coll visitor "" (.-xs ^quantum.untyped.core.print.Group x) :line "" visit) - (fipp.ednize/override? x) (visit-unknown visitor x) - (boolean? x) (visit-boolean visitor x) - (string? x) (visit-string visitor x) - (char? x) (visit-character visitor x) - (symbol? x) (visit-symbol* x) - (keyword? x) (visit-keyword visitor x) - (number? x) (visit-number visitor x) - (seq? x) (visit-seq visitor x) - (vector? x) (visit-vector visitor x) - (record? x) (visit-record visitor x) - (map? x) (visit-map visitor x) - (set? x) (visit-set visitor x) - (tagged-literal? x) (visit-tagged visitor x) - (var? x) (visit-var visitor x) - (regexp? x) (visit-pattern visitor x) - (fn? x) (visit-fn visitor x) - (transient-vector? x) - [:group "#" (pr-str '!+) - (when (and (:print-meta visitor) (meta (:form visitor))) " ") - (visit-vector visitor (IntIndexedIterable. x))] - :else (visit-unknown visitor x))) - -(defn visit [visitor x] - (let [m (meta x)] - (if (and m (not (var? x))) - (visit-meta visitor m x) - (visit* visitor x)))) - -(in-ns 'quantum.core.print.prettier) - -(defn extend-pretty-printing! [] - (extend-type java.util.ArrayList - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal '! (vec this)))) ; TODO faster - (extend-type it.unimi.dsi.fastutil.longs.LongArrayList - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal '!l (vec this)))) ; TODO faster - - (extend-type (Class/forName "[Z") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal '?<> (vec this)))) ; TODO faster - (extend-type (Class/forName "[B") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 'b<> (vec this)))) ; TODO faster - (extend-type (Class/forName "[C") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 'c<> (vec this)))) ; TODO faster - (extend-type (Class/forName "[[C") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 'c<><> (into [] this)))) ; TODO faster - (extend-type (Class/forName "[S") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 's<> (vec this)))) ; TODO faster - (extend-type (Class/forName "[I") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 'i<> (vec this)))) ; TODO faster - (extend-type (Class/forName "[J") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 'l<> (vec this)))) ; TODO ->vec for this - (extend-type (Class/forName "[F") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 'f<> (vec this)))) ; TODO faster - (extend-type (Class/forName "[D") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 'd<> (vec this)))) ; TODO ->vec for this - (extend-type (Class/forName "[[D") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 'd<><> (into [] this)))) ; TODO faster - (extend-type (Class/forName "[Ljava.lang.Object;") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal '*<> (vec this)))) ; TODO faster - (extend-type (Class/forName "[[Ljava.lang.Object;") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal '*<><> (into [] this)))) ; TODO faster - (extend-type (Class/forName "[Ljava.lang.Class;") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 'class<> (vec this)))) ; TODO faster - - (extend-type java.util.HashMap - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal '! (into {} this)))) - (extend-type java.util.concurrent.ConcurrentHashMap - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal '!! (into {} this)))) ; TODO ->map - (extend-type quantum.core.error.Error - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (tagged-literal 'err (into {} this)))) - (extend-type (Class/forName "[Ljava.lang.StackTraceElement;") - fipp.ednize/IOverride - fipp.ednize/IEdn - (-edn [this] (mapv (rcomp StackTraceElement->vec str symbol) this))) - ) +(defalias u/extend-pretty-printing!) diff --git a/src/quantum/core/process.cljc b/src/quantum/core/process.cljc index 27e7408d..a55e5a69 100644 --- a/src/quantum/core/process.cljc +++ b/src/quantum/core/process.cljc @@ -174,7 +174,7 @@ ; entire-process ; (fn [] ; (let [pb (->> args -; (<- conjl command) +; (<- (conjl command)) ; (map str) ; into-array ; (ProcessBuilder.)) diff --git a/src/quantum/core/reducers.cljc b/src/quantum/core/reducers.cljc index e85a93a3..7fdb9468 100644 --- a/src/quantum/core/reducers.cljc +++ b/src/quantum/core/reducers.cljc @@ -39,18 +39,17 @@ [quantum.core.numeric :as num] [quantum.core.refs :as refs :refer [! deref reset! volatile atom*]] - [quantum.core.type :as type + [quantum.core.type-old :as type :refer [instance+? lseq?]] [quantum.core.reducers.reduce :as red :refer [transformer]] [quantum.core.reducers.fold :as fold] [quantum.core.vars :as var :refer [defalias def-]] - [quantum.untyped.core.qualify :as qual] + [quantum.untyped.core.collections.logic :as ucoll&] [quantum.untyped.core.reducers :as ur] [quantum.untyped.core.form.generate - :refer [gen-args arity-builder max-positional-arity - unify-gensyms]]) + :refer [arity-builder max-positional-arity unify-gensyms]]) #?(:cljs (:require-macros [quantum.core.reducers @@ -71,11 +70,7 @@ (defalias transducer->transformer red/transducer->transformer) -(defn preserving-reduced [rf] - #(let [ret (rf %1 %2)] - (if (reduced? ret) - (reduced ret) - ret))) +(defalias ur/preserving-reduced) (defn gen-multiplex* [lang] `(~'defn ~'multiplex @@ -90,8 +85,8 @@ This function is not thread-safe." {:attribution "alexandergunnarson" :equivalent '~'{(!multiplex / - (aritoid + identity + ) ; sum:rf - (aritoid + identity (rcomp firsta inc))) ; count:rf + (aritoid + identity + ) ; sum|rf + (aritoid + identity (rcomp firsta inc))) ; count|rf (fn ([] [(f0) (f1)]) ([[x0 x1]] (/ (f0 x0) (f1 x1))) ; to get the mean at the end ([[x0 x1] x'] [(f0 x0 x') (f1 x1 x')]))}} @@ -143,8 +138,7 @@ (let [ret (reduce (fn ([ret] ret) - ([ret x] - (if (identical? ret sentinel) (f x) (f ret x)))) + ([ret x] (if (identical? ret sentinel) (f x) (f ret x)))) sentinel xs)] (if (identical? ret sentinel) (f) ret))) @@ -155,12 +149,20 @@ (let [ret (red/reducei (fn ([ret] ret) - ([ret x i] - (if (identical? ret sentinel) (f x) (f ret x i)))) + ([ret x i] (if (identical? ret sentinel) (f x) (f ret x i)))) sentinel xs)] (if (identical? ret sentinel) (f) ret))) +(defn pairwise-seq-or + ([pred] (fn [xs] (pairwise-seq-or pred xs))) + ([pred xs] (red-apply (ucoll&/seq-or|rf pred)))) + +;; Useful for e.g. comparison operators like `<=` +(defn pairwise-seq-and + ([pred] (fn [xs] (pairwise-seq-and pred xs))) + ([pred xs] (red-apply (ucoll&/seq-and|rf pred)))) + (defn reduce-sentinel "Calls `reduce` with a sentinel. Useful for e.g. `max` and `min`." @@ -206,7 +208,7 @@ ;___________________________________________________________________________________________________________________________________ ;=================================================={ CAT }===================================================== ;=================================================={ }===================================================== -(defn cat:transducer [rf] +(defn cat|transducer [rf] (let [rrf (preserving-reduced rf)] (fn ([] (rf)) @@ -214,7 +216,7 @@ ([ret x] (reduce rrf ret x)) ([ret k v] (reduce rrf ret [k v]))))) ; TODO is this arity right? -(defn cat+ [xs] (transformer xs cat:transducer)) +(defn cat+ [xs] (transformer xs cat|transducer)) (defn foldcat+ "Equivalent to `(fold cat+ conj! xs)`" @@ -223,7 +225,7 @@ ;___________________________________________________________________________________________________________________________________ ;=================================================={ MAP }===================================================== ;=================================================={ }===================================================== -(defn map:transducer [f] +(defn map|transducer [f] (fn [rf] (fn ; TODO auto-generate? ([] (rf)) @@ -233,36 +235,36 @@ ([ret x0 x1 x2] (rf ret (f x0 x1 x2))) ([ret x0 x1 x2 & xs] (rf ret (apply f x0 x1 x2 xs)))))) -(def map+ (transducer->transformer 1 map:transducer)) +(def map+ (transducer->transformer 1 map|transducer)) ; ----- MAP-INDEXED ----- ; -(defn map-indexed:transducer-base +(defn map-indexed|transducer-base [f !box inc!f] (fn [rf] (let [*i (!box -1)] (aritoid rf rf (fn [ret x] (rf ret (f (inc!f *i) x))))))) -(defn !map-indexed:transducer +(defn !map-indexed|transducer "Like the transducer of `core/map-indexed`, but uses a mutable variable internally instead of a `volatile`. As the name suggests, this transducer is not thread-safe." - [f] (map-indexed:transducer-base f (fn [^long i] (! i)) inc!)) + [f] (map-indexed|transducer-base f (fn [^long i] (! i)) inc!)) -(def !map-indexed+ (transducer->transformer 1 !map-indexed:transducer)) +(def !map-indexed+ (transducer->transformer 1 !map-indexed|transducer)) -(defn v!map-indexed:transducer +(defn v!map-indexed|transducer "Same as the transducer of `core/map-indexed`, but uses a typed volatile to avoid autoboxing." - [f] (map-indexed:transducer-base f (fn [^long i] (volatile i)) inc!:volatile)) ; TODO use typed volatile + [f] (map-indexed|transducer-base f (fn [^long i] (volatile i)) inc!:volatile)) ; TODO use typed volatile -(def v!map-indexed+ (transducer->transformer 1 v!map-indexed:transducer)) +(def v!map-indexed+ (transducer->transformer 1 v!map-indexed|transducer)) -(defn map-indexed:transducer +(defn map-indexed|transducer "Like the transducer of `core/map-indexed`, but uses an `AtomicLong` internally instead of a `volatile`." - [f] (map-indexed:transducer-base f (fn [^long i] (atom* i)) inc!:atom*)) + [f] (map-indexed|transducer-base f (fn [^long i] (atom* i)) inc!:atom*)) -(def map-indexed+ (transducer->transformer 1 map-indexed:transducer)) +(def map-indexed+ (transducer->transformer 1 map-indexed|transducer)) ; TODO pmap-indexed+ @@ -283,13 +285,13 @@ ;___________________________________________________________________________________________________________________________________ ;=================================================={ REDUCTIONS }===================================================== ;=================================================={ }===================================================== -(defn map-accum:transducer +(defn map-accum|transducer {:attribution "alexandergunnarson"} [f] (fn [rf] (aritoid rf rf (fn [ret x] (rf ret (f ret x)))))) (def ^{:doc "Like `map+`, but the accumulated reduction gets passed through as the first argument to `f`, and the current element as the second argument."} - map-accum+ (transducer->transformer 1 map-accum:transducer)) + map-accum+ (transducer->transformer 1 map-accum|transducer)) #_(defn reductions-transducer ; TODO finish {:attribution "alexandergunnarson"} @@ -306,7 +308,7 @@ ;___________________________________________________________________________________________________________________________________ ;=================================================={ FILTER, REMOVE }===================================================== ;=================================================={ }===================================================== -(defn filter:transducer [pred] +(defn filter|transducer [pred] (fn [rf] (aritoid rf rf (fn [ret x] (if (pred x) (rf ret x) ret)) @@ -314,32 +316,32 @@ (def ^{:doc "Returns a version of the folder which only passes on inputs to subsequent transforms when `(pred )` is truthy."} - filter+ (transducer->transformer 1 filter:transducer)) + filter+ (transducer->transformer 1 filter|transducer)) ; ----- FILTER-INDEXED ----- ; -(defn filter-indexed:transducer-base +(defn filter-indexed|transducer-base [pred !box inc!f] (fn [rf] (let [*i (!box -1)] (aritoid rf rf (fn [ret x] (if (pred (inc!f *i) x) (rf ret x) ret)))))) -(defn !filter-indexed:transducer - [f] (filter-indexed:transducer-base f (fn [^long i] (! i)) inc!)) +(defn !filter-indexed|transducer + [f] (filter-indexed|transducer-base f (fn [^long i] (! i)) inc!)) (def ^{:doc "map+ : filter+ :: !map-indexed+ : !filter-indexed+"} - !filter-indexed+ (transducer->transformer 1 !filter-indexed:transducer)) + !filter-indexed+ (transducer->transformer 1 !filter-indexed|transducer)) -(defn v!filter-indexed:transducer - [f] (filter-indexed:transducer-base f (fn [^long i] (volatile i)) inc!:volatile)) ; TODO use typed volatile +(defn v!filter-indexed|transducer + [f] (filter-indexed|transducer-base f (fn [^long i] (volatile i)) inc!:volatile)) ; TODO use typed volatile (def ^{:doc "map+ : filter+ :: v!map-indexed+ : v!filter-indexed+"} - v!filter-indexed+ (transducer->transformer 1 v!filter-indexed:transducer)) + v!filter-indexed+ (transducer->transformer 1 v!filter-indexed|transducer)) -(defn filter-indexed:transducer - [f] (filter-indexed:transducer-base f (fn [^long i] (atom* i)) inc!:atom*)) +(defn filter-indexed|transducer + [f] (filter-indexed|transducer-base f (fn [^long i] (atom* i)) inc!:atom*)) -(def filter-indexed+ (transducer->transformer 1 filter-indexed:transducer)) +(def filter-indexed+ (transducer->transformer 1 filter-indexed|transducer)) ; TODO pfilter-indexed+ @@ -377,7 +379,7 @@ ;=================================================={ }===================================================== (declare flatten+) -(defn flatten:transducer [] +(defn flatten|transducer [] (fn [rf] (fn ([] (rf)) ([ret] ret) @@ -386,7 +388,7 @@ (reduce rf ret (flatten+ v)) (rf ret v)))))) -(def flatten+ (transducer->transformer 0 flatten:transducer)) +(def flatten+ (transducer->transformer 0 flatten|transducer)) ;___________________________________________________________________________________________________________________________________ ;=================================================={ SOURCES }===================================================== ;=================================================={ }===================================================== @@ -604,7 +606,7 @@ ; TODO conform to `group-by-into` ; (group-by-into init kf (aritoid vector nil conj) xs) -(defn !partition-into:transducer-base [all? ^long n combinef] +(defn !partition-into|transducer-base [all? ^long n combinef] (fn [rf] (let [!chunk-temp (combinef)] ; this could in theory be an atomic, in which case `empty?` and `count` would need to be adjusted (fn @@ -621,43 +623,43 @@ (rf ret chunk)) ret)))))) -(defn !partition-?all:transducer [all? ^long n] - (!partition-into:transducer-base all? n +(defn !partition-?all|transducer [all? ^long n] + (!partition-into|transducer-base all? n (fn ([] (java.util.ArrayList. n)) ([^java.util.ArrayList xs] (with-do (vec (.toArray xs)) (.clear xs))) ([^java.util.ArrayList xs x] (conj! xs x))))) ; ----- PARTITION(-INTO)? ----- ; -(defn !partition-into:transducer [n genf combinef] - (!partition-into:transducer-base false n +(defn !partition-into|transducer [n genf combinef] + (!partition-into|transducer-base false n (aritoid (fn [] (genf n)) combinef combinef))) -(defn !partition:transducer [n] (!partition-?all:transducer false n)) +(defn !partition|transducer [n] (!partition-?all|transducer false n)) -(def !partition+ (transducer->transformer 1 !partition:transducer)) +(def !partition+ (transducer->transformer 1 !partition|transducer)) (defn partition+ [& args] (TODO)) ; ----- PARTITION-ALL(-INTO)? ----- ; -(defn !partition-all-into:transducer [n genf combinef] - (!partition-into:transducer-base true n +(defn !partition-all-into|transducer [n genf combinef] + (!partition-into|transducer-base true n (aritoid (fn [] (genf n)) combinef combinef))) -(defn !partition-all:transducer [n] (!partition-?all:transducer true n)) +(defn !partition-all|transducer [n] (!partition-?all|transducer true n)) -(def !partition-all-into+ (transducer->transformer 3 !partition-all-into:transducer)) +(def !partition-all-into+ (transducer->transformer 3 !partition-all-into|transducer)) (defn partition-all-into+ [& args] (TODO)) -(def !partition-all+ (transducer->transformer 1 !partition-all:transducer)) +(def !partition-all+ (transducer->transformer 1 !partition-all|transducer)) (defn partition-all+ [& args] (TODO)) ; TODO partition-all-into-timeout #?(:clj -(defn !partition-all-timeout:transducer [^long n ^long timeout-ms] +(defn !partition-all-timeout|transducer [^long n ^long timeout-ms] (fn [rf] (let [a (java.util.ArrayList. n) *last-aggregated (! Long/MAX_VALUE)] ; to ensure that aggregation doesn't happen immediately @@ -694,7 +696,7 @@ This transformer is not thread-safe."} !partition-all-timeout+ - (transducer->transformer 2 !partition-all-timeout:transducer))) + (transducer->transformer 2 !partition-all-timeout|transducer))) (defn partition-all-timeout+ [& args] (TODO)) @@ -716,7 +718,7 @@ ;___________________________________________________________________________________________________________________________________ ;=================================================={ DISTINCT, INTERLEAVE }===================================================== ;=================================================={ interpose, frequencies }===================================================== -(defn v!dedupe-by:transducer [kf] +(defn v!dedupe-by|transducer [kf] (fn abcde [rf] (let [*prior (volatile! ::none)] (aritoid rf rf @@ -728,12 +730,12 @@ result (rf result input)))))))) -(def v!dedupe-by+ (transducer->transformer 1 v!dedupe-by:transducer)) +(def v!dedupe-by+ (transducer->transformer 1 v!dedupe-by|transducer)) -(defn v!dedupe:transducer - [] (v!dedupe-by:transducer identity)) +(defn v!dedupe|transducer + [] (v!dedupe-by|transducer identity)) -(def v!dedupe+ (transducer->transformer 0 v!dedupe:transducer)) +(def v!dedupe+ (transducer->transformer 0 v!dedupe|transducer)) ; TODO compare this to clojure/core `dedupe`, and an impl of it using atoms (defn dedupe+ @@ -752,15 +754,15 @@ ; TODO default to using a `HashSet` internally ? Other options? ; TODO do volatile and unsync-mutable versions -(defn distinct-by-storing:transducer +(defn distinct-by-storing|transducer "Like `core/distinct`, but you can choose what collection to store the distinct items in." - ([kf] (distinct-by-storing:transducer kf + ([kf] (distinct-by-storing|transducer kf (fn [] (atom #{})))) ([kf genf] - (distinct-by-storing:transducer kf genf + (distinct-by-storing|transducer kf genf (fn [seen x] (contains? @seen x)))) ([kf genf contains?f] - (distinct-by-storing:transducer kf genf contains?f + (distinct-by-storing|transducer kf genf contains?f (fn [seen x] (swap! seen conj x)))) ([kf genf contains?f conj!f] (fn [rf] @@ -775,14 +777,14 @@ (rf ret x)))))))))) (defn distinct-by-storing+ - ([kf genf ] (distinct-by-storing:transducer kf genf)) - ([kf genf contains?f ] (distinct-by-storing:transducer kf genf contains?f)) - ([kf genf contains?f conj!f] (distinct-by-storing:transducer kf genf contains?f conj!f)) + ([kf genf ] (distinct-by-storing|transducer kf genf)) + ([kf genf contains?f ] (distinct-by-storing|transducer kf genf contains?f)) + ([kf genf contains?f conj!f] (distinct-by-storing|transducer kf genf contains?f conj!f)) ([kf genf contains?f conj!f xs] (transformer xs (distinct-by-storing+ kf genf contains?f conj!f)))) -(defn distinct-by:transducer [kf] (distinct-by-storing:transducer kf)) +(defn distinct-by|transducer [kf] (distinct-by-storing|transducer kf)) -(def distinct-by+ (transducer->transformer 1 distinct-by:transducer)) +(def distinct-by+ (transducer->transformer 1 distinct-by|transducer)) (defn distinct-storing+ ([genf ] (distinct-by-storing+ identity genf)) @@ -790,9 +792,9 @@ ([genf contains?f conj!f] (distinct-by-storing+ identity genf contains?f conj!f)) ([genf contains?f conj!f xs] (transformer xs (distinct-storing+ genf contains?f conj!f)))) -(defn distinct:transducer [] (distinct-by-storing:transducer identity)) +(defn distinct|transducer [] (distinct-by-storing|transducer identity)) -(def distinct+ (transducer->transformer 0 distinct:transducer)) +(def distinct+ (transducer->transformer 0 distinct|transducer)) (def replace+ (transducer->transformer 1 core/replace)) diff --git a/src/quantum/core/reducers/fold.cljc b/src/quantum/core/reducers/fold.cljc index 91eb6309..e5241301 100644 --- a/src/quantum/core/reducers/fold.cljc +++ b/src/quantum/core/reducers/fold.cljc @@ -32,7 +32,7 @@ :refer [defnt]] [quantum.core.reducers.reduce :as red :refer [reduce]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [lseq? editable? ->joinable]] [quantum.untyped.core.reducers #?@(:cljs [:refer [Transformer]])]) diff --git a/src/quantum/core/reducers/reduce.cljc b/src/quantum/core/reducers/reduce.cljc index 16ab063d..13fe0fec 100644 --- a/src/quantum/core/reducers/reduce.cljc +++ b/src/quantum/core/reducers/reduce.cljc @@ -30,7 +30,7 @@ :refer [defnt]] [quantum.core.refs :as refs :refer [deref !boolean !long ! reset!]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [editable? val?]] [quantum.core.type.defs #?@(:cljs [:refer [Transformer]])] @@ -55,185 +55,7 @@ ; Fixing it so the seqs are headless. ; Christophe Grand - https://groups.google.com/forum/#!searchin/clojure-dev/reducer/clojure-dev/t6NhGnYNH1A/2lXghJS5HywJ -;___________________________________________________________________________________________________________________________________ -;=================================================={ REDUCE }===================================================== -;=================================================={ }===================================================== -; TODO rreduce [f init o] - like reduce but in reverse order = Equivalent to Scheme's `foldr` -#?(:cljs - (defn- -reduce-seq - "For some reason |reduce| is not implemented in ClojureScript for certain types. - This is a |loop|-|recur| replacement for it." - {:attribution "alexandergunnarson" - :todo ["Check if this is really the case..." - "Improve performance with chunking, etc."]} - [xs f init] - (loop [xs (seq xs) v init] - (if xs - (let [ret (f v (first xs))] - (if (reduced? ret) - @ret - (recur (next xs) ret))) - v)))) - -(defnt reduce* - "Much of this content taken from clojure.core.protocols for inlining and - type-checking purposes." - {:attribution "alexandergunnarson"} - ([^fast_zip.core.ZipperLocation z f init] - (loop [xs (zip/down z) v init] - (if (val? z) - (let [ret (f v z)] - (if (reduced? ret) - @ret - (recur (zip/right xs) ret))) - v))) - ([^array? arr f init] ; Adapted from `areduce` - #?(:clj (let [ct (Array/count arr)] - (loop [i 0 v init] - (if (< i ct) - (let [ret (f v (Array/get arr i))] - (if (reduced? ret) - @ret - (recur (unchecked-inc i) ret))) - v))) - :cljs (array-reduce arr f init))) - ([^!+vector? xs f init] ; because transient vectors aren't reducible - (let [ct (#?(:clj .count :cljs count) xs)] ; TODO fix for CLJS - (loop [i 0 v init] - (if (< i ct) - (let [ret (f v (#?(:clj .valAt :cljs get) xs i))] ; TODO fix for CLJS - (if (reduced? ret) - @ret - (recur (unchecked-inc i) ret))) - v)))) - ([^string? s f init] - (let [ct (#?(:clj .length :cljs .-length) s)] - (loop [i 0 v init] - (if (< i ct) - (let [ret (f v (.charAt s i))] - (if (reduced? ret) - @ret - (recur (unchecked-inc i) ret))) - v)))) -#?(:clj ([^clojure.lang.StringSeq xs f init] - (let [s (.s xs)] - (loop [i (.i xs) v init] - (if (< i (.length s)) - (let [ret (f v (.charAt s i))] - (if (reduced? ret) - @ret - (recur (unchecked-inc i) ret))) - v))))) -#?(:clj ([#{clojure.lang.PersistentVector ; vector's chunked seq is faster than its iter - clojure.lang.LazySeq ; for range - clojure.lang.ASeq} xs f] ; aseqs are iterable, masking internal-reducers - (if-let [s (seq xs)] - (clojure.core.protocols/internal-reduce (next s) f (first s)) - (f)))) -#?(:clj ([#{clojure.lang.PersistentVector ; vector's chunked seq is faster than its iter - clojure.lang.LazySeq ; for range - clojure.lang.ASeq} xs f init] ; aseqs are iterable, masking internal-reducers - (let [s (seq xs)] - (clojure.core.protocols/internal-reduce s f init)))) - ([^transformer? x f] - (let [rf ((.-xf x) f)] - (rf (reduce* (.-prev x) rf (rf))))) - ([^transformer? x f init] - (let [rf ((.-xf x) f)] - (rf (reduce* (.-prev x) rf init)))) - ([^chan? x f init] (async/reduce f init x)) -#?(:cljs ([^+map? xs f init] (#_(:clj clojure.core.protocols/kv-reduce - :cljs -kv-reduce) ; in order to use transducers... - -reduce-seq xs f init))) -#?(:cljs ([^+set? xs f init] (-reduce-seq xs f init))) - ([#{#?(:clj integer? :cljs double?)} n f init] - (loop [i 0 v init] - (if (< i n) - (let [ret (f v i)] - (if (reduced? ret) - @ret - (recur (unchecked-inc i) ret))) - v))) - ;; `iter-reduce` -#?(:clj ([#{clojure.lang.APersistentMap$KeySeq - clojure.lang.APersistentMap$ValSeq - Iterable} xs f] - (let [iter (.iterator xs)] - (if (.hasNext iter) - (loop [ret (.next iter)] - (if (.hasNext iter) - (let [ret (f ret (.next iter))] - (if (reduced? ret) - @ret - (recur ret))) - ret)) - (f))))) - ;; `iter-reduce` -#?(:clj ([#{clojure.lang.APersistentMap$KeySeq - clojure.lang.APersistentMap$ValSeq - Iterable} xs f init] - (let [iter (.iterator xs)] - (loop [ret init] - (if (.hasNext iter) - (let [ret (f ret (.next iter))] - (if (reduced? ret) - @ret - (recur ret))) - ret))))) -#?(:clj ([^clojure.lang.IReduce xs f ] (.reduce xs f))) -#?(:clj ([^clojure.lang.IKVReduce xs f init] (.kvreduce xs f init))) -#?(:clj ([^clojure.lang.IReduceInit xs f init] (.reduce xs f init))) - ([^default xs f] (if (val? xs) - (#?(:clj clojure.core.protocols/coll-reduce - :cljs -reduce) xs f) - (f))) - ([^default xs f init] - (if (val? xs) - (#?(:clj clojure.core.protocols/coll-reduce - :cljs -reduce) xs f init) - init))) - -#?(:clj -(defmacro reduce - "Like `core/reduce` except: - When init is not provided, (f) is used. - Maps are reduced with reduce-kv. - - Entry point for internal reduce (in order to switch the args - around to dispatch on type). - - Equivalent to Scheme's `foldl`." - {:attribution "alexandergunnarson" - :todo ["definline"]} - ([f xs] `(reduce* ~xs ~f)) - ([f init xs] `(reduce* ~xs ~f ~init)))) - -#?(:clj -(defmacro reducei ; TODO unmacro when type inference is available - "`reduce`, indexed. - Uses an unsynchronized mutable counter internally, but this cannot cause race conditions." - {:attribution "alexandergunnarson"} - [f init xs] - `(let [f# ~f - f'# (let [*i# (! -1)] - (fn ([ret# x#] - (f# ret# x# (reset! *i# (unchecked-inc (deref *i#))))) ; TODO use `inc*!` - ([ret# k# v#] - (f# ret# k# v# (reset! *i# (unchecked-inc (deref *i#)))))))] - (reduce f'# ~init ~xs)))) - -#?(:clj -; TODO unmacro when type inference is available -(defmacro transduce - ([ f xs] `(transduce identity ~f ~xs)) - ([xf f xs] `(transduce ~xf ~f (~f) ~xs)) - ([xf f init xs] - `(let [f'# (~xf ~f)] - (f'# (reduce f'# ~init ~xs)))))) -; TODO `transducei` ? -;___________________________________________________________________________________________________________________________________ -;=================================================={ REDUCING FUNCTIONS }===================================================== -;=================================================={ (Generalized) }===================================================== +;; TODO TYPED (defaliases ur transformer transformer? transducer->transformer) (defn conj-red diff --git a/src/quantum/core/reflect.cljc b/src/quantum/core/reflect.cljc index 2dc02155..86228a0f 100644 --- a/src/quantum/core/reflect.cljc +++ b/src/quantum/core/reflect.cljc @@ -79,7 +79,7 @@ ([^Class c ^String name- args] (let [m (->> (.getDeclaredMethods c) ^java.lang.reflect.Method (coll/ffilter (fn [^java.lang.reflect.Method x] (= (.getName x) name-))) - (<- doto (.setAccessible true)))] + (<- (doto (.setAccessible true))))] (.invoke m nil (into-array Object args)))) ([^Class c ^String name- params args] (invoke c name- params nil args)) diff --git a/src/quantum/core/refs.cljc b/src/quantum/core/refs.cljc index 77732a47..18090e8d 100644 --- a/src/quantum/core/refs.cljc +++ b/src/quantum/core/refs.cljc @@ -1,4 +1,4 @@ -(ns quantum.core.refs +(ns quantum.core.refs ; TODO TYPED move to `quantum.core.data.refs`? (:refer-clojure :exclude [deref volatile! @@ -9,19 +9,17 @@ set-error-mode! var-set]) (:require - [clojure.core :as core] - [clojure.string :as str] - [quantum.core.error :as err + [clojure.core :as core] + [clojure.string :as str] + [quantum.core.error :as err :refer [TODO]] + [quantum.core.identifiers :as id] [quantum.core.macros :refer [case-env defnt #?(:clj defnt') env-lang]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]] - [quantum.core.type.defs :as tdefs] - [quantum.untyped.core.qualify :as qual] - [quantum.untyped.core.refs - :refer [atom?]] - [quantum.core.vars :as var + [quantum.core.type.defs :as tdefs] + [quantum.core.vars :as var :refer [defalias]]) #?(:clj (:import @@ -29,25 +27,101 @@ [java.util.concurrent.atomic AtomicReference AtomicBoolean AtomicInteger AtomicLong] [com.google.common.util.concurrent AtomicDouble]))) -; ===== UNSYNCHRONIZED MUTABILITY ===== ; +(defalias uref/>!thread-local) + +;; TODO technically this belongs in like `quantum.core.data.effects` or something +(defprotocol Transactional + (transact [target f] [target f opts] + "Transactionally applies `f` to `target`, outputting whatever `f` does. Subject to the + following caveats: + - Transactionality here means at least atomicity — i.e. that any effects of `f` on `target` are + guaranteed to be rolled back or undone in the case of a failed application of `f` (e.g. in + the case of an exception). + - Here transactionality says nothing whatsoever about referential integrity or durability; and + whether the operation is `Serializable`, `Linearizable`, or both is up to the implementation + and is marked as such. For example, targets intended only for single-threaded use do not + satisfy linearizability ('thread-safety') by definition in multi-threaded contexts, but may + yet be atomic and thus satisfy this narrow definition of transactionality. + - Some implementations may run `f` multiple times in an effort to transactionally apply it, so + in those cases `f` must be free of side-effects not applied to the `target`. + - Some implementations may run `f` in another thread or even on another machine. + + It is the burden of the implementation to call the 1-arity function `f` in one of the following + ways: + + A) Given an immutable `target`, the `target` is supplied to `f`, and `f` outputs an updated + immutable version of it. The original `target` is by definition unaffected. + - Example: Any built-in Clojure immutable data structure like a map, vector, set, etc. + B) Given a `target` consisting of a container for an immutable value, the immutable value in + question is supplied to `f`, and `f` outputs an updated immutable value which is + transactionally applied to the container. + - Example: A Clojure atom wrapping e.g. an immutable Clojure map + - Example: A 'box' type having a mutable, non-linearizable / thread-unsafe field which may + be set any number of times to refer only to immutable values. + C) Given a `target` consisting of an 'opaque' structure that supports transactional + modification, the `target` is supplied to `f`, and `f` outputs the modified/updated + `target`. + - Example: A JDBC connection, in which the connection *itself* might not be modified but a + caller may request modifications to be transactionally applied to the underlying + DB. + - Example: A Redis cache to which atomic updates may be applied. + - Example: A version of (the mutable, non-linearizable / thread-unsafe) `java.util.HashMap` + which keeps track of modifications made to it within an atomic function + application and rolls them back in the case of a failed application (e.g. in the + case of an exception). + + It is also the burden of the implementation to handle nested transactions on at least a per- + thread basis. That is, if `transact` is called inside of another `transact` on the same thread, + the implementation must ensure that both calls are transactional, usually by making the inner + one a no-op. + + This differs from `core/swap!` in that `swap!`, by convention, only supports case B), and that + only for linearizable `target`s (if in a concurrent environment).")) + +(defprotocol + ^{:doc "A marker protocol — 'serializable' in the sense that its `transact` implementation + satisfies serializability, i.e. Isolation (the 'I' in ACID)."} + Serializable) + +(defprotocol + ^{:doc "A marker protocol — 'linearizable' i.e. 'strongly consistent' in the sense that reads + within its `transact` implementation are guaranteed to yield the most recently written + value. If combined with the `Serializable` marker protocol, this means that the 'most + recently written value' means the value of the `target` at the moment of the beginning of + the transaction, and thereafter the value of the `target` only as modified within the + transaction."} + Linearizable) + +(def atom? (t/isa?|direct #?(:clj clojure.lang.IAtom :cljs cljs.core/IAtom))) + +(def volatile? (t/isa? #?(:clj clojure.lang.Volatile :cljs cljs.core/Volatile))) -(#?(:clj definterface :cljs defprotocol) IMutableReference - (get [#?(:cljs this)]) - (set [#?(:cljs this) v]) - (getAndSet [#?(:cljs this) v])) - -; TODO create for every primitive datatype as well -(deftype MutableReference [#?(:clj ^:unsynchronized-mutable val :cljs ^:mutable val)] - IMutableReference - (get [this] val) - (set [this v] (set! val v) val) - (getAndSet [this v] (let [v-prev val] (set! val v) v-prev)) - #?(:clj clojure.lang.IDeref - :cljs cljs.core/IDeref) - (#?(:clj deref :cljs -deref) [this] val)) - - (defnt !ref* "Creates a mutable reference to an Object." [x] (MutableReference. x)) -#?(:clj (defmacro !ref ([] `(MutableReference. nil)) ([x] `(!ref* ~x)))) +#?(:clj +(var/def atomic? + "From the `java.util.concurrent` package: + 'Additionally, classes are provided only for those types that are commonly useful in intended + applications. For example, there is no atomic class for representing byte. In those infrequent + cases where you would like to do so, you can use an `AtomicInteger` to hold byte values, and + cast appropriately. You can also hold floats using `Float.floatToIntBits` and + `Float.intBitstoFloat` conversions, and doubles using `Double.doubleToLongBits` and + `Double.longBitsToDouble` conversions.'" + (t/or atom? + java.util.concurrent.atomic.AtomicReference + java.util.concurrent.atomic.AtomicBoolean + #_java.util.concurrent.atomic.AtomicByte + #_java.util.concurrent.atomic.AtomicShort + java.util.concurrent.atomic.AtomicInteger + java.util.concurrent.atomic.AtomicLong + #_java.util.concurrent.atomic.AtomicFloat + #_java.util.concurrent.atomic.AtomicDouble + com.google.common.util.concurrent.AtomicDouble))) + +;; ===== Unsynchronized mutability ===== ;; + +(defnt !ref + "Creates an unsynchronized mutable reference to an Object." + ([] (!ref nil)) + ([x (t/ref t/any?)] (MutableReference. x))) (defn gen-primitive-mutable-interface-and-deftype [kind] (let [interface-sym (symbol (str "IMutable" (str/capitalize (name kind)))) @@ -77,7 +151,7 @@ [~(with-meta 'x {:tag kind})] (new ~deftype-sym ~'x)) (defmacro ~(symbol (str "!" kind)) ([ ] `(new ~'~deftype-sym (~'~kind 0))) - ([~macro-param] `(~'~(qual/qualify *ns* defnt-sym) ~~macro-param)))))) + ([~macro-param] `(~'~(id/qualify *ns* defnt-sym) ~~macro-param)))))) #?(:clj (defmacro gen-primitive-mutables [] @@ -117,19 +191,24 @@ #?(:clj (defmacro setm! "Set mutable" [x v] (case-env :cljs `(set! (.-val ~x) ~v) `(setm!* ~x ~v)))) #?(:clj (defmacro setm!& "Set mutable" [x v] (case-env :cljs `(set! (.-val ~x) ~v) `(setm!*& ~x ~v)))) +;; ===== Dereferencing ===== ;; + +(def derefable? (t/isa?|direct #?(:clj clojure.lang.IDeref :cljs cljs.core/IDeref))) + +;; TODO TYPED #?(:clj (defnt deref ([#{clojure.lang.IDeref} x] (.deref x)) ([#{AtomicBoolean - #_AtomicByte - #_AtomicChar - #_AtomicShort + #_AtomicByte + #_AtomicChar + #_AtomicShort AtomicInteger AtomicLong - #_AtomicFloat + #_AtomicFloat AtomicDouble AtomicReference java.util.concurrent.Future - #_IMutableReference + #_IMutableReference IMutableBoolean IMutableByte IMutableChar @@ -149,11 +228,13 @@ (defn ?deref [a] (when (val? a) (deref a))) ; TODO type this (defn ->derefable [x] - (if (t/derefable? x) + (if (derefable? x) x (reify #?(:clj clojure.lang.IDeref :cljs cljs.core/IDeref) ; TODO `reify-compatible` (#?(:clj deref :cljs -deref) [_] x)))) +;; ===== End dereferencing ===== ;; + #?(:clj (defmacro swapm! [*x0 *x1] `(let [*x0# ~*x0 *x1# ~*x1 @@ -237,12 +318,12 @@ ; ===== AGENTS ===== ; -#?(:clj (defalias agent core/agent)) -#?(:Clj (defalias restart-agent core/restart-agent)) -#?(:clj (defalias agent-error core/agent-error)) -#?(:clj (defalias await core/await)) -#?(:clj (defalias await-for core/await-for)) -#?(:clj (defalias commute core/commute)) +#?(:clj (defalias agent core/agent)) +#?(:Clj (defalias restart-agent core/restart-agent)) +#?(:clj (defalias agent-error core/agent-error)) +#?(:clj (defalias await core/await)) +#?(:clj (defalias await-for core/await-for)) +#?(:clj (defalias commute core/commute)) #?(:clj (defalias send core/send)) #?(:clj (defalias set-agent-send-executor! core/set-agent-send-executor!)) #?(:clj (defalias send-off core/send-off)) @@ -251,12 +332,12 @@ ; ===== REFS ===== ; -#?(:clj (defalias ref core/ref )) -#?(:clj (defalias alter core/alter )) -#?(:clj (defalias io! core/io! )) -#?(:clj (defalias sync core/sync )) -#?(:clj (defalias dosync core/dosync )) -#?(:clj (defalias ensure core/ensure )) +#?(:clj (defalias ref core/ref)) +#?(:clj (defalias alter core/alter)) +#?(:clj (defalias io! core/io!)) +#?(:clj (defalias sync core/sync)) +#?(:clj (defalias dosync core/dosync)) +#?(:clj (defalias ensure core/ensure)) #?(:clj (defalias ref-set core/ref-set)) #?(:clj (defalias error-handler core/error-handler)) #?(:clj (defalias set-error-handler! core/set-error-handler!)) diff --git a/src/quantum/core/resources.cljc b/src/quantum/core/resources.cljc index 733d26f5..771cde0d 100644 --- a/src/quantum/core/resources.cljc +++ b/src/quantum/core/resources.cljc @@ -6,24 +6,24 @@ #?(:clj [clojure.tools.namespace.repl :as repl :refer [refresh refresh-all - set-refresh-dirs] ]) + set-refresh-dirs]]) [clojure.core.async :as casync] [quantum.core.cache :as cache :refer [callable-times]] [quantum.core.core :as qcore] + [quantum.core.data.primitive :as p] [quantum.core.data.set :as set] [quantum.core.error :as err :refer [>ex-info catch-all]] - [quantum.core.log :as log ] + [quantum.core.log :as log] [quantum.core.fn - :refer [fn1 fnl with-do fn-> <-]] + :refer [fn1 fnl with-do fn->]] [quantum.core.logic :as logic :refer [whenf whenf1 fn-not fn-or whenp->]] [quantum.core.macros :as macros :refer [defnt]] [quantum.core.async :as async] - [quantum.core.type :as type - :refer [atom? val?]] + [quantum.core.refs :as ref] [quantum.core.spec :as s :refer [validate]]) #?(:cljs @@ -60,7 +60,7 @@ ([^quantum.core.data.queue.LinkedBlockingQueue obj] (async/close! obj))]) ([^clojure.core.async.impl.channels.ManyToManyChannel obj] (casync/close! obj)) ([ obj] - (when (val? obj) (throw (>ex-info :not-implemented)))))) + (when (p/val? obj) (throw (>ex-info :not-implemented)))))) #?(:cljs (declare close!)) @@ -467,15 +467,15 @@ (with-do (swap! systems assoc k (->system k config make-system)) (log/pr ::debug "Registered system.")))) -(defn stop-registered-system! [system-kw] (swap! systems update system-kw (whenf1 val? stop!))) +(defn stop-registered-system! [system-kw] (swap! systems update system-kw (whenf1 p/val? stop!))) -(defn deregister-system! [system-kw] (swap! systems (fn-> (update system-kw (whenf1 val? stop!)) (dissoc system-kw)))) +(defn deregister-system! [system-kw] (swap! systems (fn-> (update system-kw (whenf1 p/val? stop!)) (dissoc system-kw)))) (defn default-main [system-kw re-register? config] (when-not (async/web-worker?) (let [system (get @systems system-kw) - system (whenf system val? stop!) + system (whenf system p/val? stop!) system (if (or re-register? (nil? system)) (get (register-system! system-kw config) system-kw) system) diff --git a/src/quantum/core/spec.cljc b/src/quantum/core/spec.cljc index 9ec3a6c4..89308e4d 100644 --- a/src/quantum/core/spec.cljc +++ b/src/quantum/core/spec.cljc @@ -23,4 +23,4 @@ valid? invalid? #?@(:clj [or* or*-forms constantly-or set-of]) - validate:val? any?) + validate|val?) diff --git a/src/quantum/core/specs.cljc b/src/quantum/core/specs.cljc index a8ca1689..5e6d3a24 100644 --- a/src/quantum/core/specs.cljc +++ b/src/quantum/core/specs.cljc @@ -1,327 +1,3 @@ (ns quantum.core.specs - "Adapted from clojure.core.specs version 1.9.0-alpha19 - and enabled in CLJS. Other specs added too. - See https://github.com/clojure/core.specs.alpha/blob/5d85f93ab78386855374256934475af0afe7f380/src/main/clojure/clojure/core/specs/alpha.clj" (:require - [clojure.core :as core] - [clojure.set :as set] - [quantum.core.core - :refer [val?]] - [quantum.core.fn :as fn - :refer [fn1 fnl]] - [quantum.core.spec :as s])) - -;;;; GENERAL - -(s/def ::meta map?) - -;;;; destructure - -(s/def ::local-name (s/and simple-symbol? #(not= '& %))) - -(s/def ::binding-form - (s/or :sym ::local-name - :seq ::seq-binding-form - :map ::map-binding-form)) - -;; sequential destructuring - -(s/def ::seq-binding-form - (s/and vector? - (s/cat :elems (s/* ::binding-form) - :rest (s/? (s/cat :amp #{'&} :form ::binding-form)) - :as (s/? (s/cat :as #{:as} :sym ::local-name))))) - -;; map destructuring - -(s/def ::keys (s/coll-of ident? :kind vector?)) -(s/def ::syms (s/coll-of symbol? :kind vector?)) -(s/def ::strs (s/coll-of simple-symbol? :kind vector?)) -(s/def ::or (s/map-of simple-symbol? any?)) -(s/def ::as ::local-name) - -(s/def ::map-special-binding - (s/keys :opt-un [::as ::or ::keys ::syms ::strs])) - -(s/def ::map-binding (s/tuple ::binding-form any?)) - -(s/def ::ns-keys - (s/tuple - (s/and qualified-keyword? #(-> % name #{"keys" "syms"})) - (s/coll-of simple-symbol? :kind vector?))) - -(s/def ::map-bindings - (s/every (s/or :mb ::map-binding - :nsk ::ns-keys - :msb (s/tuple #{:as :or :keys :syms :strs} any?)) :into {})) - -(s/def ::map-binding-form (s/merge ::map-bindings ::map-special-binding)) - -;; bindings - -(s/def ::binding (s/cat :binding ::binding-form :init-expr any?)) -(s/def ::bindings (s/and vector? (s/* ::binding))) - -;; let, if-let, when-let - -(s/fdef core/let - :args (s/cat :bindings ::bindings - :body (s/* any?))) - -(s/fdef core/if-let - :args (s/cat :bindings (s/and vector? ::binding) - :then any? - :else (s/? any?))) - -(s/fdef core/when-let - :args (s/cat :bindings (s/and vector? ::binding) - :body (s/* any?))) - -;; defn, defn-, fn - -(s/def ::fn|arglist - (s/and - vector? - (s/cat :args (s/* ::binding-form) - :varargs (s/? (s/cat :amp #{'&} :form ::binding-form))))) - -(s/def ::fn|prepost - (s/and (s/keys :req-un [(or ::core/pre ::core/post)]) ; TODO we actually really only want to accept un-namespaced keys... - (s/conformer #(set/rename-keys % {::core/pre :pre ::core/post :post})))) - -(s/def ::fn|body - (s/alt :prepost+body (s/cat :prepost ::fn|prepost - :body (s/+ any?)) - :body (s/* any?))) - -(s/def ::fn|arglist+body - (s/cat ::fn|arglist ::fn|arglist :body ::fn|body)) - -(s/def ::fn|name simple-symbol?) - -(s/def ::docstring string?) - -(s/def ::fn|unique-doc - #(->> [(::docstring %) - (-> % ::fn|name meta :doc) - (-> % :pre-meta :doc) - (-> % :post-meta :doc)] - (filter val?) - count - ((fn [x] (<= x 1))))) - -(s/def ::fn|unique-meta - #(empty? (set/intersection - (-> % ::fn|name meta keys set) - (-> % :pre-meta keys set) - (-> % :post-meta keys set)))) - -(s/def ::fn|aggregate-meta - (s/conformer - (fn [{:keys [::fn|name ::docstring pre-meta post-meta] :as m}] - (-> m - (dissoc ::docstring :pre-meta :post-meta) - (cond-> fn|name - (update ::fn|name with-meta - (-> (merge (meta fn|name) pre-meta post-meta) ; TODO use `merge-unique` instead of `::defn|unique-meta` - (cond-> docstring (assoc :doc docstring))))))))) - -(s/def ::fn|postchecks - (s/and (s/conformer - (fn [v] - (let [[overloads-k overloads-v] (get v :overloads) - overloads - (-> (case overloads-k - :overload-1 {:overloads [overloads-v]} - :overload-n overloads-v) - (update :overloads - (fnl mapv - (fn1 update :body - (fn [[k v]] - (case k - :body {:body v} - :prepost+body v))))))] - (assoc v :post-meta (:post-meta overloads) - :overloads (:overloads overloads))))) - ::fn|unique-doc - ::fn|unique-meta - ;; TODO validate metadata like return value etc. - ::fn|aggregate-meta)) - -(s/def ::fn - (s/and (s/spec - (s/cat ::fn|name (s/? ::fn|name) - :overloads (s/alt :overload-1 ::fn|arglist+body - :overload-n (s/cat :overloads (s/+ (s/spec ::fn|arglist+body)))))) - ::fn|postchecks)) - -(s/def ::defn - (s/and - (s/spec - (s/cat ::fn|name ::fn|name - ::docstring (s/? ::docstring) - :pre-meta (s/? ::meta) - :overloads (s/alt :overload-1 ::fn|arglist+body - :overload-n (s/cat :overloads (s/+ (s/spec ::fn|arglist+body)) - :post-meta (s/? ::meta))))) - ::fn|postchecks)) - -(s/fdef core/defn :args ::defn :ret any?) -(s/fdef core/defn- :args ::defn :ret any?) -(s/fdef core/fn :args ::fn :ret any?) - -;;;; ns - -(s/def ::exclude (s/coll-of simple-symbol?)) -(s/def ::only (s/coll-of simple-symbol?)) -(s/def ::rename (s/map-of simple-symbol? simple-symbol?)) -(s/def ::filters (s/keys* :opt-un [::exclude ::only ::rename])) - -(s/def ::ns-refer-clojure - (s/spec (s/cat :clause #{:refer-clojure} - :filters ::filters))) - -(s/def ::refer (s/or :all #{:all} - :syms (s/coll-of simple-symbol?))) - -(s/def ::prefix-list - (s/spec - (s/cat :prefix simple-symbol? - :libspecs (s/+ ::libspec)))) - -(s/def ::libspec - (s/alt :lib simple-symbol? - :lib+opts (s/spec (s/cat :lib simple-symbol? - :options (s/keys* :opt-un [::as ::refer]))))) - -(s/def ::ns-require - (s/spec (s/cat :clause #{:require} - :body (s/+ (s/alt :libspec ::libspec - :prefix-list ::prefix-list - :flag #{:reload :reload-all :verbose}))))) - -(s/def ::package-list - (s/spec - (s/cat :package simple-symbol? - :classes (s/* simple-symbol?)))) - -(s/def ::import-list - (s/* (s/alt :class simple-symbol? - :package-list ::package-list))) - -(s/def ::ns-import - (s/spec - (s/cat :clause #{:import} - :classes ::import-list))) - -(s/def ::ns-refer - (s/spec (s/cat :clause #{:refer} - :lib simple-symbol? - :filters ::filters))) - -;; same as ::prefix-list, but with ::use-libspec instead -(s/def ::use-prefix-list - (s/spec - (s/cat :prefix simple-symbol? - :libspecs (s/+ ::use-libspec)))) - -;; same as ::libspec, but also supports the ::filters options in the libspec -(s/def ::use-libspec - (s/alt :lib simple-symbol? - :lib+opts (s/spec (s/cat :lib simple-symbol? - :options (s/keys* :opt-un [::as ::refer ::exclude ::only ::rename]))))) - -(s/def ::ns-use - (s/spec (s/cat :clause #{:use} - :libs (s/+ (s/alt :libspec ::use-libspec - :prefix-list ::use-prefix-list - :flag #{:reload :reload-all :verbose}))))) - -(s/def ::ns-load - (s/spec (s/cat :clause #{:load} - :libs (s/* string?)))) - -(s/def ::name simple-symbol?) -(s/def ::extends simple-symbol?) -(s/def ::implements (s/coll-of simple-symbol? :kind vector?)) -(s/def ::init symbol?) -(s/def ::class-ident (s/or :class simple-symbol? :class-name string?)) -(s/def ::signature (s/coll-of ::class-ident :kind vector?)) -(s/def ::constructors (s/map-of ::signature ::signature)) -(s/def ::post-init symbol?) -(s/def ::method (s/and vector? - (s/cat :name simple-symbol? - :param-types ::signature - :return-type simple-symbol?))) -(s/def ::methods (s/coll-of ::method :kind vector?)) -(s/def ::main boolean?) -(s/def ::factory simple-symbol?) -(s/def ::state simple-symbol?) -(s/def ::get simple-symbol?) -(s/def ::set simple-symbol?) -(s/def ::expose (s/keys :opt-un [::get ::set])) -(s/def ::exposes (s/map-of simple-symbol? ::expose)) -(s/def ::prefix string?) -(s/def ::impl-ns simple-symbol?) -(s/def ::load-impl-ns boolean?) - -(s/def ::ns-gen-class - (s/spec (s/cat :clause #{:gen-class} - :options (s/keys* :opt-un [::name ::extends ::implements - ::init ::constructors ::post-init - ::methods ::main ::factory ::state - ::exposes ::prefix ::impl-ns ::load-impl-ns])))) - -(s/def ::ns-clauses - (s/* (s/alt :refer-clojure ::ns-refer-clojure - :require ::ns-require - :import ::ns-import - :use ::ns-use - :refer ::ns-refer - :load ::ns-load - :gen-class ::ns-gen-class))) - -(s/def ::ns-form - (s/cat :name simple-symbol? - :docstring (s/? ::docstring) - :attr-map (s/? ::meta) - :clauses ::ns-clauses)) - -(s/fdef core/ns - :args ::ns-form) - -#?(:clj -(defmacro ^:private quotable - "Returns a spec that accepts both the spec and a (quote ...) form of the spec" - [spec] - `(s/or :spec ~spec :quoted-spec (s/cat :quote #{'quote} :spec ~spec)))) - -(s/def ::quotable-import-list - (s/* (s/alt :class (quotable simple-symbol?) - :package-list (quotable ::package-list)))) - -(s/fdef core/import - :args ::quotable-import-list) - -(s/fdef core/refer-clojure - :args (s/* (s/alt - :exclude (s/cat :op (quotable #{:exclude}) :arg (quotable ::exclude)) - :only (s/cat :op (quotable #{:only}) :arg (quotable ::only)) - :rename (s/cat :op (quotable #{:rename}) :arg (quotable ::rename))))) - -;; ----- INTERFACE ----- ;; - -(s/def ::code any?) ; TODO must be embeddable - -(s/def :interface/name simple-symbol?) - -;; ----- REIFY ----- ;; - -(s/def :reify/method-name simple-symbol?) - -(s/def :reify|arglist/arg-sym simple-symbol?) ; technically, can be tagged with only particular tags -(s/def :reify/arglist (s/and vector? (s/+ :reify|arglist/arg-sym))) - -(s/def :reify|overload/ret-class-sym simple-symbol?) ; technically, one resolvable to a class - -(s/def :reify|overload/body (s/* ::code)) + [quantum.untyped.core.specs])) diff --git a/src/quantum/core/streams.cljc b/src/quantum/core/streams.cljc index d88433cc..bb1af71d 100644 --- a/src/quantum/core/streams.cljc +++ b/src/quantum/core/streams.cljc @@ -1,10 +1,11 @@ -(ns quantum.core.streams) - -; pingles/zilch — ZeroMQ Clojure Library -#_"mpenet/grease — Provides faster non thread-safe alternatives to common Classes: - ByteArrayInputStream ByteArrayOuputStream - BufferedInputStream BufferedOutputStream - CharArrayReader CharArrayWriter - StringReader - Code taken from various repositories such as Apache Cassandra and ElasticSearch. - TODO provide bindings for e.g. Cassandra and ElasticSearch to update with bugfixes" +(ns quantum.core.streams + {:todo #{"Maybe move to `quantum.core.data.streams`?" + "Incorporate https://github.com/thi-ng/dstruct/blob/master/src/streams.org" + "pingles/zilch — ZeroMQ Clojure Library" + "mpenet/grease — Provides faster non thread-safe alternatives to common Classes: + ByteArrayInputStream ByteArrayOuputStream + BufferedInputStream BufferedOutputStream + CharArrayReader CharArrayWriter + StringReader + Code taken from various repositories such as Apache Cassandra and ElasticSearch. + TODO provide bindings for e.g. Cassandra and ElasticSearch to update with bugfixes"}}) diff --git a/src/quantum/core/string.cljc b/src/quantum/core/string.cljc index cdee7f8a..d0dae7c4 100644 --- a/src/quantum/core/string.cljc +++ b/src/quantum/core/string.cljc @@ -10,31 +10,32 @@ (:refer-clojure :exclude [reverse replace remove val re-find reduce]) (:require - [clojure.core :as core] - [clojure.string :as str] + [clojure.core :as core] + [clojure.string :as str] [frak] - [cuerdas.core :as str+] - [quantum.core.data.map :as map] - [quantum.core.data.set :as set] + [cuerdas.core :as str+] + [quantum.core.data.primitive :as p] + [quantum.core.data.map :as map] + [quantum.core.data.set :as set] [quantum.core.error :refer [>ex-info]] - [quantum.core.fn :as fn + [quantum.core.fn :as fn :refer [fn-> fn1 rfn fnl]] - [quantum.core.logic :as logic + [quantum.core.logic :as logic :refer [fn-and whenc whenc1 ifn condf]] - [quantum.core.loops :as loops + [quantum.core.loops :as loops :refer [reduce reducei]] - [quantum.core.macros :as macros + [quantum.core.macros :as macros :refer [defnt defnt']] [quantum.core.collections.core :refer [contains? containsv?]] [quantum.core.collections.logic :refer [seq-and]] - [quantum.core.string.format :as form] - [quantum.core.string.regex :as regex] - [quantum.core.vars :as var + [quantum.core.string.format :as form] + [quantum.core.string.regex :as regex] + [quantum.core.vars :as var :refer [defalias]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]]) #?(:cljs (:require-macros @@ -402,7 +403,7 @@ (defn properize-key [k v] (let [k-0 (keywordize k) - k-f (if (t/boolean? v) + k-f (if (p/boolean? v) (keyword+ k-0 "?") k-0)] k-f)) diff --git a/src/quantum/core/string/regex.cljc b/src/quantum/core/string/regex.cljc index c45e86ae..b277e9eb 100644 --- a/src/quantum/core/string/regex.cljc +++ b/src/quantum/core/string/regex.cljc @@ -29,8 +29,8 @@ #"\b") ; TODO: not using ccoll because this namespace is required for `defnt` -(defn conjr!* [#?(:clj ^StringBuilder !s :cljs StringBuffer !s) x] (.append !s x)) -(defn conjl!* [#?(:clj ^StringBuilder !s :cljs StringBuffer !s) x] +(defn conjr!* [#?(:clj ^StringBuilder !s :cljs ^StringBuffer !s) x] (.append !s x)) +(defn conjl!* [#?(:clj ^StringBuilder !s :cljs ^StringBuffer !s) x] #?(:clj (.insert !s 0 x) :cljs (-> (!str) (.append x) (.append !s)))) diff --git a/src/quantum/core/system.cljc b/src/quantum/core/system.cljc index de2f5184..25307808 100644 --- a/src/quantum/core/system.cljc +++ b/src/quantum/core/system.cljc @@ -30,7 +30,7 @@ ;; TODO possibly move JS feature detection here? ;; ================================ -#?(:cljs (defalias u/ReactNative)) +#?(:cljs (defalias u/react-native)) (defaliases u info os separator) diff --git a/src/quantum/core/telemetry.cljc b/src/quantum/core/telemetry.cljc index a5a6394e..74632aae 100644 --- a/src/quantum/core/telemetry.cljc +++ b/src/quantum/core/telemetry.cljc @@ -11,7 +11,7 @@ :refer [whenf]] [quantum.core.resources :as res] [quantum.core.system :as sys] - [quantum.core.type :as t])) + [quantum.core.type-old :as t])) #_(t/def ::offloader keyword? "The offloader implementation to use") diff --git a/src/quantum/core/test.cljc b/src/quantum/core/test.cljc index a0a71332..e1cff915 100644 --- a/src/quantum/core/test.cljc +++ b/src/quantum/core/test.cljc @@ -1,23 +1,11 @@ (ns quantum.core.test (:require [clojure.test :as test] - [quantum.core.error :as err] - [quantum.core.fn :as fn - :refer [fn->]] - [quantum.core.print :as pr - :refer [ppr-meta]] - [quantum.core.type - :refer [val?]] [quantum.core.vars - :refer [#?(:clj defmalias) defalias]]) -#?(:cljs - (:require-macros - [quantum.core.test :as self]))) + :refer [defaliases]] + [quantum.untyped.core.test :as u])) ; TO EXPLORE -; - Generative testing -; - https://github.com/clojure/test.check -; - clojure/test.generative ; - A/B testing ; - https://github.com/ptaoussanis/touchstone ; - https://github.com/facebook/planout @@ -28,58 +16,4 @@ ; - myfreeweb/clj-http-fake ; =========================== -#?(:clj (defmalias is clojure.test/is cljs.test/is )) -#?(:clj (defmalias deftest clojure.test/deftest cljs.test/deftest)) -#?(:clj (defmalias testing clojure.test/testing cljs.test/testing)) -#?(:clj (defalias test-ns test/test-ns)) - -#?(:clj -(defn test-nss-where [pred] - (->> (all-ns) (filter (fn/fn-> ns-name name pred)) (map test-ns) doall))) - -#?(:clj (defmacro is= [& args] `(is (= ~@args)))) -#?(:clj (defmacro throws - ([x] `(do (is (~'thrown? ~(err/env>generic-error &env) ~x)) true)) - ([expr err-pred] - `(try ~expr - (is (throws '~err-pred)) - (catch ~(err/env>generic-error &env) e# (is (~err-pred e#))))))) - -; Makes test failures and errors print prettily -; TODO CLJS -#?(:clj -(defmethod test/report :fail [m] - (test/with-test-out - (test/inc-report-counter :fail) - (println "\nFAIL in" (test/testing-vars-str m)) - (when (seq test/*testing-contexts*) (println (test/testing-contexts-str))) - (when-let [message (:message m)] (println message)) - (println "expected:" (with-out-str (ppr-meta (:expected m)))) - (println " actual:" (with-out-str (ppr-meta (:actual m))))))) - -#?(:clj -(defmethod test/report :error [m] - (test/with-test-out - (test/inc-report-counter :error) - (println "\nERROR in" (test/testing-vars-str m)) - (when (seq test/*testing-contexts*) (println (test/testing-contexts-str))) - (when-let [message (:message m)] (println message)) - (println "expected:" (with-out-str (ppr-meta (:expected m)))) - (print " actual: ") - (println (with-out-str (ppr-meta (:actual m))))))) - -#?(:clj -(defn test-syms! - "Tests the provided syms, in order, deduplicating them." - [& syms] - (try - (let [test-syms (distinct syms)] - (doseq [test-sym test-syms] - (try - (println "=====" "Testing" test-sym "..." "=====" ) - (let [v (find-var test-sym)] - (assert (val? v) (str "Test sym not found: " test-sym)) - (clojure.test/test-var v)) - (println "=====" "Done with" test-sym "=====" ) - (catch Throwable t - (println "ERROR in test" test-sym t)))))))) +#?(:clj (defaliases u is is= deftest defspec-test testing test-syms! test-ns test-nss-where throws)) diff --git a/src/quantum/core/thread.cljc b/src/quantum/core/thread.cljc index 71253555..de20a5ef 100644 --- a/src/quantum/core/thread.cljc +++ b/src/quantum/core/thread.cljc @@ -28,7 +28,7 @@ :refer [defnt]] [quantum.core.spec :as s :refer [validate]] - [quantum.core.type :as type + [quantum.core.type-old :as type :refer [boolean? val?]] [quantum.core.time.core :as time] [quantum.core.cache @@ -193,7 +193,7 @@ "A working version of |close-all|." [] (->> @reg - (<- dissoc :thread-reaper) + (<- (dissoc :thread-reaper)) (map (fn-> val :thread async/close!)) dorun))) @@ -685,5 +685,3 @@ ; (whenf ~millis nil? (fn' 500)) ; (whenf ~n-times nil? (fn' 6)) ; #(update-out-str-with! ~out-str baos#))))) - - diff --git a/src/quantum/core/time/core.cljc b/src/quantum/core/time/core.cljc index ebe77dab..682e8436 100644 --- a/src/quantum/core/time/core.cljc +++ b/src/quantum/core/time/core.cljc @@ -14,12 +14,12 @@ [cljsjs.js-joda-timezone]]) ; For IANA timezone support [quantum.core.collections :as coll :refer [ifor]] - [quantum.core.convert.primitive :as pconv - :refer [->int ->long]] + [quantum.core.data.primitive + :refer [>int >long]] [quantum.core.error :as err :refer [>ex-info TODO throw-unless err!]] [quantum.core.fn :as fn - :refer [fn1 <-]] + :refer [fn1]] [quantum.core.logic :as logic :refer [fn-or whenc]] [quantum.core.macros :as macros @@ -27,7 +27,7 @@ [quantum.core.numeric :as num] [quantum.core.spec :as s] [quantum.core.vars :as var - :refer [defalias]] + :refer [def- defalias]] [quantum.measure.convert :as uconv :refer [convert]]) #?(:cljs @@ -43,6 +43,17 @@ [java.time.format DateTimeFormatter] [java.time.temporal Temporal TemporalAccessor ChronoField]))) +#?(:cljs +(def- now-nanos* + (or (.-now js/performance) + (.-webkitNow js/performance) + (.-mozNow js/performance) + (.-msNow js/performance) + (.-oNow js/performance)))) + +(t/defn ^:inline now-nanos > #?(:clj long? :cljs (t/assume std-fixint?)) [] + #?(:clj (System/nanoTime) :cljs (now-nanos*))) + ; ===== ABOUT ===== ; https://www.npmjs.com/package/js-joda ; js-joda is fast. It is about 2 to 10 times faster than other javascript date libraries. @@ -92,7 +103,8 @@ #?(:clj (def formats ; TODO map->record? - {:rfc DateTimeFormatter/RFC_1123_DATE_TIME ; "EEE, dd MMM yyyy HH:mm:ss zzz" + {:rfc DateTimeFormatter/RFC_1123_DATE_TIME ; e.g. 'Tue, 3 Jun 2008 11:05:30 GMT' + ; e.g. '2011-12-03T10:15:30+01:00' or '2018-07-23T16:58:17.000Z' :iso-offset-date-time DateTimeFormatter/ISO_OFFSET_DATE_TIME :windows "E, dd MMM yyyy HH:mm:ss O" :calendar "EEE MMM dd HH:mm:ss.SSS z yyyy" @@ -125,12 +137,12 @@ #?@(:clj [([^long x] x) ([^java.time.Instant x] (-> x (.toEpochMilli))) ([^java.util.Date x] (-> x (.getTime) )) - ([^java.time.LocalDate x] (-> x (.toEpochDay ) (convert :days :millis) ->long)) + ([^java.time.LocalDate x] (-> x (.toEpochDay ) (convert :days :millis) >long)) ([^java.time.LocalDateTime x] (-> x (.toInstant ZoneOffset/UTC) ->epoch-millis)) ([^java.time.ZonedDateTime x] (-> x .toInstant ->epoch-millis)) ([^org.joda.time.DateTime x] (-> x (.getMillis) )) ([^java.util.Calendar x] (-> x (.getTimeInMillis)))] - :cljs [([^number? x] (->long x)) + :cljs [([^number? x] (>long x)) ([^js/Date x] (.getTime x))])) (declare ->local-date-time-protocol) @@ -138,7 +150,7 @@ #?(:clj (defnt ^java.time.Instant ->instant "Coerces to an instantaneous point on an imaginary timeline." - ([#{long? bigint?} x] (-> x ->long (java.time.Instant/ofEpochMilli))) + ([#{long? bigint?} x] (-> x >long (java.time.Instant/ofEpochMilli))) ([x] (-> x ->epoch-millis-protocol ->instant)))) ; ===== DATE ===== ; @@ -153,7 +165,7 @@ (^{:doc "Obtain an instance of LocalDate from a year, month, and dayOfMonth value"} [#?(:cljs ^number? y :clj y) m d] - (#?(:clj LocalDate/of :cljs js/JSJoda.LocalDate.of) (->long y) (->long m) (->long d)))) + (#?(:clj LocalDate/of :cljs js/JSJoda.LocalDate.of) (>long y) (>long m) (>long d)))) #?(:clj (defmacro ->local-date @@ -174,15 +186,15 @@ (^{:doc "Obtain an instance of LocalTime from an hour and minute value"} [#?(:cljs ^number? h :clj h) m] - (#?(:clj LocalTime/of :cljs js/JSJoda.LocalTime.of) (->long h) (->long m))) + (#?(:clj LocalTime/of :cljs js/JSJoda.LocalTime.of) (>long h) (>long m))) (^{:doc "Obtain an instance of LocalTime from an hour, minute, and second value"} [#?(:cljs ^number? h :clj h) m s] - (#?(:clj LocalTime/of :cljs js/JSJoda.LocalTime.of) (->long h) (->long m) (->long s))) + (#?(:clj LocalTime/of :cljs js/JSJoda.LocalTime.of) (>long h) (>long m) (>long s))) (^{:doc "Obtain an instance of LocalTime from an hour, minute, second, and nano value"} [#?(:cljs ^number? h :clj h) m s n] - (#?(:clj LocalTime/of :cljs js/JSJoda.LocalTime.of) (->long h) (->long m) (->long s) (->long n)))) + (#?(:clj LocalTime/of :cljs js/JSJoda.LocalTime.of) (>long h) (>long m) (>long s) (>long n)))) #?(:clj (defmacro ->local-time @@ -204,17 +216,17 @@ [#?(:cljs ^number? y :clj y) mo d h m] (#?(:clj LocalDateTime/of :cljs js/JSJoda.LocalDateTime.of) - (->long y) (->long mo) (->long d) (->long h) (->long m))) + (>long y) (>long mo) (>long d) (>long h) (>long m))) (^{:doc "Obtain an instance of LocalDateTime from a year, month, day, hour, minute, and second value"} [#?(:cljs ^number? y :clj y) mo d h m s] (#?(:clj LocalDateTime/of :cljs js/JSJoda.LocalDateTime.of) - (->long y) (->long mo) (->long d) (->long h) (->long m) (->long s))) + (>long y) (>long mo) (>long d) (>long h) (>long m) (>long s))) (^{:doc "Obtain an instance of LocalDateTime from a year, month, day, hour, minute, second, and nano value"} [#?(:cljs ^number? y :clj y) mo d h m s n] (#?(:clj LocalDateTime/of :cljs js/JSJoda.LocalDateTime.of) - (->long y) (->long mo) (->long d) (->long h) (->long m) (->long s) (->long n) ))) + (>long y) (>long mo) (>long d) (>long h) (>long m) (>long s) (>long n) ))) #?(:clj (defmacro ->local-date-time @@ -245,7 +257,7 @@ [#?(:cljs ^number? y :clj y) mo d h m s n zone] (#?(:clj ZonedDateTime/of :cljs js/JSJoda.ZonedDateTime.of) - (->long y) (->long mo) (->long d) (->long h) (->long m) (->long s) (->long n) (->zone-id zone)))) + (>long y) (>long mo) (>long d) (>long h) (>long m) (>long s) (>long n) (->zone-id zone)))) #?(:clj (defmacro ->zoned-date-time @@ -269,7 +281,7 @@ ([y ] (->period* y 0 0)) ([y mo ] (->period* y mo 0)) ([y mo d] - (#?(:clj Period/of :cljs (TODO)) (->int y) (->int mo) (->int d))))) + (#?(:clj Period/of :cljs (TODO)) (>int y) (>int mo) (>int d))))) ; TODO CLJS #?(:clj (defmacro ->period ([] (case-env :clj `Period/ZERO :cljs (TODO))) @@ -283,13 +295,13 @@ (defnt ^{:tag #?(:clj Duration)} ->duration* ([d ] (#?(:clj Duration/ofDays :cljs (TODO)) d)) ([d h ] (.plus (->duration* d) - (#?(:clj Duration/ofHours :cljs (TODO)) (->long h)))) + (#?(:clj Duration/ofHours :cljs (TODO)) (>long h)))) ([d h m ] (.plus (->duration* d h) - (#?(:clj Duration/ofMinutes :cljs (TODO)) (->long m)))) + (#?(:clj Duration/ofMinutes :cljs (TODO)) (>long m)))) ([d h m s ] (.plus (->duration* d h m) - (#?(:clj Duration/ofSeconds :cljs (TODO)) (->long s)))) + (#?(:clj Duration/ofSeconds :cljs (TODO)) (>long s)))) ([d h m s n] (.plus (->duration* d h m s) - (#?(:clj Duration/ofNanos :cljs (TODO)) (->long n)))))) + (#?(:clj Duration/ofNanos :cljs (TODO)) (>long n)))))) ; TODO CLJS #?(:clj (defmacro ->duration ([] (case-env :clj `Duration/ZERO :cljs (TODO))) @@ -415,14 +427,11 @@ ; (between date (now)))) #?(:clj -(defn parse [text formatter] - (LocalDate/parse text (DateTimeFormatter/ofPattern formatter)))) +(defn parse [text formatter] (LocalDate/parse text (DateTimeFormatter/ofPattern formatter)))) -#?(:clj (defn system-timezone [] - (.getID (java.util.TimeZone/getDefault)))) +#?(:clj (defn system-timezone [] (.getID (java.util.TimeZone/getDefault)))) -#?(:clj (def date-format-json - (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss'Z'"))) +#?(:clj (def date-format-json (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss'Z'"))) #?(:clj (defnt ^java.util.Calendar ->calendar @@ -709,4 +718,3 @@ ; ===== DAYS OF WEEK ===== ; - diff --git a/src/quantum/core/type.cljc b/src/quantum/core/type.cljc index 84c9434b..f71154a5 100644 --- a/src/quantum/core/type.cljc +++ b/src/quantum/core/type.cljc @@ -1,265 +1,69 @@ -(ns - ^{:doc "Type-checking predicates, 'transientization' checks, class aliases, etc." - :attribution "alexandergunnarson"} - quantum.core.type +(ns quantum.core.type + "This is this the namespace upon which all other fully-typed namespaces rest." (:refer-clojure :exclude - [vector? map? set? associative? seq? seqable? string? fn? map-entry? boolean? - double? decimal? - nil? char? number? integer? float? - sequential? indexed? list? coll? - symbol? keyword?, array?, record?, var?, counted?, bytes? - identity - class type - ancestors descendants, supers bases, isa? instance?, derive underive]) + [- < <= = >= > and any? compare defn fn fn? isa? not or ref seq? symbol? type var?]) (:require - [clojure.core :as core] - [quantum.core.analyze.clojure.core :as ana] - [quantum.core.classes :as classes] - [quantum.core.data.vector :as vec] - [quantum.core.fn :as fn - :refer [fn1 fnl mfn fn->]] - [quantum.core.logic :as logic - :refer [fn-and whenf1]] - [quantum.core.macros :as macros - :refer [defnt #?(:clj defnt')]] - [quantum.core.type.core :as tcore] - [quantum.core.vars :as var - :refer [defalias]] - [quantum.untyped.core.refs :as uref] - [quantum.untyped.core.type.predicates :as utpred]) -#?(:cljs - (:require-macros - [quantum.core.type :as self - :refer [should-transientize? boolean?]]))) - -; TODO: Should include typecasting? (/cast/) - -; ===== HIERARCHY ===== ; - -#?(:clj (defalias ancestors core/ancestors)) -#?(:clj (defalias descendants core/descendants)) - -#?(:clj (defalias supers core/supers )) -#?(:clj (defalias bases core/bases )) - - (defalias isa? core/isa? ) - (defalias instance? core/instance?) - -#?(:clj (defalias derive core/derive )) -#?(:clj (defalias underive core/underive )) - -(def class #?(:clj core/class :cljs core/type)) -(defalias type core/type) - -#?(:clj (def instance+? instance?) - :cljs - (defn instance+? - {:todo #{"try-catch in something this basic is a performance issue"}} - [c x] ; inline this? - (try - (instance? c x) - (catch js/TypeError _ - (try (satisfies? c x)))))) - -#?(:clj (defalias static-cast tcore/static-cast)) -#?(:clj (defalias static-cast-depth ana/static-cast-depth)) - - (def val? some?) - - ; TODO for JS, primitives (function, array, number, string) aren't covered by these - -#?(:clj (defnt' prim-long? ([^long x] true) - ([#{boolean byte char int float double Object} x] false))) ; TODO #{(- prim? long) Object} - - (defnt integer? - "Whether x is integer-like (primitive/boxed integer, BigInteger, etc.)." - ([^integer? obj] true) ([^default obj] false)) -#?(:clj (defnt double? ([^double x] true) ([^default x] false)) - :cljs (do (defalias double? core/number?) ; TODO fix - (defalias double?-protocol double?))) -#?(:clj (defnt float? ([^float x] true) ([^default x] false)) - :cljs (do (defalias float? core/number?) ; TODO fix - (defalias float?-protocol float?))) - (defnt number? ([^number? x] true) ([^default x] false)) - - (defnt boolean? ([^boolean x] true) ([^default x] false)) - - (defnt bigint? ([^bigint? x] true) ([^default x] false)) - - (defnt byte-array? ([^byte-array? x] true) ([^default x] false)) - (defnt bytes? ([^bytes? x] true) ([^default x] false)) - (defnt double-array? ([^double-array? x] true) ([^default x] false)) - (defnt doubles? ([^doubles? x] true) ([^default x] false)) -#?(:clj (defnt array-2d? ([^array-2d? x] true) ([^default x] false))) - (defnt array? - ([^array? x] true) - ([x] #?(:clj (-> x class .isArray) ; Have to use reflection here because we can't check *ALL* possible array types in a `defnt` - :cljs (-> x core/array?)))) - - (defnt svector? ([^svector? x] true) ([^default x] false)) - (defnt +vector? ([^+vector? x] true) ([^default x] false)) - (defnt !+vector? ([^!+vector? x] true) ([^default x] false)) - (defnt ?!+vector? ([^?!+vector? x] true) ([^default x] false)) - (defnt !vector? ([^!vector? x] true) ([^default x] false)) - (defnt vector? ([^vector? x] true) ([^default x] false)) - - (defnt +array-map? ([^+array-map? x] true) ([^default x] false)) - (defnt !+array-map? ([^!+array-map? x] true) ([^default x] false)) - (defnt ?!+array-map? ([^?!+array-map? x] true) ([^default x] false)) - - (defnt +hash-map? ([^+hash-map? x] true) ([^default x] false)) - (defnt !+hash-map? ([^!+hash-map? x] true) ([^default x] false)) - (defnt ?!+hash-map? ([^?!+hash-map? x] true) ([^default x] false)) - (defnt !hash-map? ([^!hash-map? x] true) ([^default x] false)) -#?(:clj (defnt !!hash-map? ([^!!hash-map? x] true) ([^default x] false))) - - (defnt +unsorted-map? ([^+unsorted-map? x] true) ([^default x] false)) - (defnt unsorted-map? ([^unsorted-map? x] true) ([^default x] false)) - (defnt +sorted-map? ([^+sorted-map? x] true) ([^default x] false)) - (defnt sorted-map? ([^sorted-map? x] true) ([^default x] false)) - (defnt +insertion-ordered-map? ([^+insertion-ordered-map? x] true) ([^default x] false)) - (defnt !insertion-ordered-map? ([^!insertion-ordered-map? x] true) ([^default x] false)) - (defnt insertion-ordered-map? ([^insertion-ordered-map? x] true) ([^default x] false)) - (defnt +map? ([^+map? x] true) ([^default x] false)) - (defnt !map? ([^!map? x] true) ([^default x] false)) - (defnt map? ([^map? x] true) ([^default x] false)) - - (defnt +unsorted-set? ([^+unsorted-set? x] true) ([^default x] false)) - (defnt unsorted-set? ([^unsorted-set? x] true) ([^default x] false)) - (defnt +sorted-set? ([^+sorted-set? x] true) ([^default x] false)) - (defnt sorted-set? ([^sorted-set? x] true) ([^default x] false)) - (defnt +set? ([^+set? x] true) ([^default x] false)) - (defnt !set? ([^!set? x] true) ([^default x] false)) - (defnt set? ([^set? x] true) ([^default x] false)) - - (defnt !array-list? ([^!array-list? x] true) ([^default x] false)) - (defnt list? ([^list? x] true) ([^default x] false)) - (defnt +list? ([^+list? x] true) ([^default x] false)) - (defnt +queue? ([^+queue? x] true) ([^default x] false)) - (defnt queue? ([^queue? x] true) ([^default x] false)) - (defnt lseq? ([^lseq? x] true) ([^default x] false)) - (defnt sequential? ([^sequential? x] true) ([^default x] false)) - (defnt counted? ([^counted? x] true) ([^default x] false)) - (defnt transformer? ([^transformer? x] true) ([^default x] false)) - (defalias seqable? utpred/seqable?) - -#?(:clj (defnt file? ([^file? x] true) ([^default x] false))) - (defnt regex? ([^regex? x] true) ([^default x] false)) - (defnt editable? ([^editable? x] true) ([^default x] false)) - (defnt transient? ([^transient? x] true) ([^default x] false)) - (defnt indexed? ([^indexed? x] true) ([^default x] false)) - (defnt m2m-chan? ([^m2m-chan? x] true) ([^default x] false)) - -; #?(:cljs (defnt typed-array? ...)) - - (def map-entry? #?(:clj core/map-entry? - :cljs (fn-and vector? (fn-> count (= 2))))) - (defalias atom? uref/atom?) -#?(:clj (defalias var? core/var?)) - ; TODO `ref?`, `future?` - - (defn derefable? [obj] - #?(:clj (instance? clojure.lang.IDeref obj) - :cljs (satisfies? cljs.core/IDeref obj))) - -#?(:clj (def throwable? (partial instance+? java.lang.Throwable ))) - (defnt error? ([#{#?(:clj Throwable - :cljs js/Error)} obj] true) ([obj] false)) -#?(:clj -(defnt interface? - [^java.lang.Class class-] - (.isInterface class-))) - -#?(:clj -(defnt abstract? - [^java.lang.Class class-] - (java.lang.reflect.Modifier/isAbstract (.getModifiers class-)))) - - -#?(:clj (def multimethod? (fnl instance? clojure.lang.MultiFn))) -#?(:clj (def unbound? (fnl instance? clojure.lang.Var$Unbound))) -#?(:clj (def thread? (fnl instance? Thread))) - -#?(:clj -(defn protocol? - "Returns true if an argument is a protocol" - [x] (and (map? x) (-> x :on-interface class?)))) - -#?(:clj (defn namespace? [x] (instance? clojure.lang.Namespace x))) - -#?(:clj -(defn promise? - {:source 'zcaudate/hara.class.checks} - [^Object obj] - (let [^String s (.getName ^Class (type obj))] - (.startsWith s "clojure.core$promise$")))) - -; ===== JAVA ===== - -#?(:clj -(defn enum? - {:source "zcaudate/hara.object.enum"} - [type] - (-> (classes/class->ancestors type) - (get java.lang.Enum)))) - -; ; ======= TRANSIENTS ======= - -; ; TODO this is just intuition. Better to |bench| it -; ; TODO move these vars -(def transient-threshold 3) - -; macro because it will probably be heavily used -#?(:clj -(defmacro should-transientize? [coll] - `(and (editable? ~coll) - (counted? ~coll) - (-> ~coll count (> transient-threshold))))) - -; (def primitive-records -; [{:raw "Z" :symbol 'boolean :string "boolean" :class Boolean/TYPE :container Boolean} -; {:raw "B" :symbol 'byte :string "byte" :class Byte/TYPE :container Byte} -; {:raw "C" :symbol 'char :string "char" :class Character/TYPE :container Character} -; {:raw "I" :symbol 'int :string "int" :class Integer/TYPE :container Integer} -; {:raw "J" :symbol 'long :string "long" :class Long/TYPE :container Long} -; {:raw "F" :symbol 'float :string "float" :class Float/TYPE :container Float} -; {:raw "D" :symbol 'double :string "double" :class Double/TYPE :container Double} -; {:raw "V" :symbol 'void :string "void" :class Void/TYPE :container Void}]) - -#?(:clj (def ^:runtime-eval construct (mfn new))) - -(defnt identity - "Type identity function." - {:todo ["Fix so only immmutable data stuctures have immutable identity fns."]} - ([^+vector? x] vector) - ([^+map? x] hash-map) - ([^+set? x] hash-set)) - -(def +vector?-fn (fn1 +vector?)) -(def +set?-fn (fn1 +set?)) -(def +map?-fn (fn1 +map?)) - -(defnt ->pred - "Gets the type predicate associated with the value passed." - ([^+vector? x] +vector?-fn) - ([^+set? x] +set?-fn) - ([^+map? x] +map?-fn)) - -(defnt ->literal - "Gets the literal value associated with the value passed." - ([^+vector? x] []) - ([^+set? x] #{}) - ([^+map? x] {})) - -(defnt ->base - "Gets the base value associated with the value passed." - ([^+vector? x] (vector)) - ([^+unsorted-set? x] (hash-set)) - ([^+hash-map? x] #?(:clj clojure.lang.PersistentHashMap/EMPTY - :cljs cljs.core.PersistentHashMap.EMPTY)) - ([^default x] (empty x))) - -(defnt ->joinable - ([#{+vector? +hash-map? +unsorted-set?} x] x) - ([#{+array-map?} x] (into (->base x) x)) - ([^default x] x)) + [quantum.untyped.core.type.defnt :as udefnt] + [quantum.untyped.core.type :as ut] + ;; TODO TYPED prefer e.g. `deft-alias` + [quantum.untyped.core.vars + :refer [defalias defaliases]])) + +;; TODO if we ever spec-instrument we need to be careful of these aliases as they'll no longer be +;; valid + +(defalias def udefnt/def) + +(defaliases udefnt def- dotyped fn defn extend-defn!) + +(defaliases ut + type type? + ;; Generators + ? run, isa? isa?|direct + ; fn ; TODO TYPED rename + ftype + input input|meta-or input|or + output output|meta-or output|or + unordered ordered + value unvalue + ;; Combinators + and or - if not + ;; Metadata suppliers + ref unref, assume unassume + ;; Predicates + any? + nil? + none? + ref? + fn? + compare compare|in compare|out < <= = >= > <> ><) + + +;; TODO TYPED move +#_(defnt ^boolean nil? + ([^Object x] (quantum.core.Numeric/isNil x)) + ([:else x] false)) + +;; TODO TYPED move +#_(:clj (defalias nil? core/nil?)) + +;; TODO TYPED move +#_(defnt ^boolean not' + ([^boolean? x] (Numeric/not x)) + ([x] (if (nil? x) true))) ; Lisp nil punning + +;; TODO TYPED move +#_(defnt ^boolean true? + ([^boolean? x] x) + ([:else x] false)) + +;; TODO TYPED move +#_(:clj (defalias true? core/true?)) + +;; TODO TYPED move +#_(defnt ^boolean false? + ([^boolean? x] (not' x)) + ([:else x] false)) + +;; TODO TYPED move +#_(:clj (defalias false? core/false?)) diff --git a/src/quantum/core/type/core.cljc b/src/quantum/core/type/core.cljc index 007eab61..967753ae 100644 --- a/src/quantum/core/type/core.cljc +++ b/src/quantum/core/type/core.cljc @@ -26,4 +26,4 @@ #?@(:clj [nth-elem-type|clj primitive-array-type?]) default-types type-casts-map return-types-map ->boxed|sym ->unboxed|sym boxed?|sym - static-cast-code #?@(:clj [static-cast class>prim-subclasses])) + #?@(:clj [class>prim-subclasses])) diff --git a/src/quantum/core/type/defs.cljc b/src/quantum/core/type/defs.cljc index 63f87c92..d5f919a8 100644 --- a/src/quantum/core/type/defs.cljc +++ b/src/quantum/core/type/defs.cljc @@ -16,5 +16,5 @@ array-ident->primitive-sym elem-types-clj max-values max-type - #?@(:clj [boxed-types* unboxed-types* boxed->unboxed-types-evaled promoted-types* array-1d-types* class->str]) - types|unevaled types) + #?@(:clj [boxed-types unboxed-types boxed->unboxed-types-evaled promoted-types class->str]) + #_types|unevaled #_types) diff --git a/src/quantum/core/type_old.cljc b/src/quantum/core/type_old.cljc new file mode 100644 index 00000000..6cd7658c --- /dev/null +++ b/src/quantum/core/type_old.cljc @@ -0,0 +1,260 @@ +(ns + ^{:doc "Type-checking predicates, 'transientization' checks, class aliases, etc." + :attribution "alexandergunnarson"} + quantum.core.type-old + (:refer-clojure :exclude + [vector? map? set? associative? seq? seqable? string? fn? map-entry? boolean? + double? decimal? + nil? char? number? integer? float? + sequential? indexed? list? coll? + symbol? keyword?, array?, record?, var?, counted?, bytes? + identity + class type + ancestors descendants, supers bases, isa? instance?, derive underive]) + (:require + [clojure.core :as core] + [quantum.core.analyze.clojure.core :as ana] + [quantum.core.classes :as classes] + [quantum.core.data.vector :as vec] + [quantum.core.fn :as fn + :refer [fn1 fnl mfn fn->]] + [quantum.core.logic :as logic + :refer [fn-and whenf1]] + [quantum.core.macros :as macros + :refer [defnt #?(:clj defnt')]] + [quantum.core.type.core :as tcore] + [quantum.core.vars :as var + :refer [defalias]] + [quantum.untyped.core.data :as udata] + [quantum.untyped.core.refs :as uref]) +#?(:cljs + (:require-macros + [quantum.core.type-old :as self + :refer [should-transientize? boolean?]]))) + +; TODO: Should include typecasting? (/cast/) + +; ===== HIERARCHY ===== ; + +#?(:clj (defalias ancestors core/ancestors)) +#?(:clj (defalias descendants core/descendants)) + +#?(:clj (defalias supers core/supers )) +#?(:clj (defalias bases core/bases )) + + (defalias isa? core/isa? ) + (defalias instance? core/instance?) + +#?(:clj (defalias derive core/derive )) +#?(:clj (defalias underive core/underive )) + +(def class #?(:clj core/class :cljs core/type)) +(defalias type core/type) + +#?(:clj (def instance+? instance?) + :cljs + (defn instance+? + {:todo #{"try-catch in something this basic is a performance issue"}} + [c x] ; inline this? + (try + (instance? c x) + (catch js/TypeError _ + (try (satisfies? c x)))))) + +#?(:clj (defalias static-cast-depth ana/static-cast-depth)) + + (def val? some?) + + ; TODO for JS, primitives (function, array, number, string) aren't covered by these + +#?(:clj (defnt' prim-long? ([^long x] true) + ([#{boolean byte char int float double Object} x] false))) ; TODO #{(- prim? long) Object} + + (defnt integer? + "Whether x is integer-like (primitive/boxed integer, BigInteger, etc.)." + ([^integer? obj] true) ([^default obj] false)) +#?(:clj (defnt double? ([^double x] true) ([^default x] false)) + :cljs (do (defalias double? core/number?) ; TODO fix + (defalias double?-protocol double?))) +#?(:clj (defnt float? ([^float x] true) ([^default x] false)) + :cljs (do (defalias float? core/number?) ; TODO fix + (defalias float?-protocol float?))) + (defnt number? ([^number? x] true) ([^default x] false)) + + (defnt boolean? ([^boolean x] true) ([^default x] false)) + + (defnt bigint? ([^bigint? x] true) ([^default x] false)) + + (defnt byte-array? ([^byte-array? x] true) ([^default x] false)) + (defnt bytes? ([^bytes? x] true) ([^default x] false)) + (defnt double-array? ([^double-array? x] true) ([^default x] false)) + (defnt doubles? ([^doubles? x] true) ([^default x] false)) +#?(:clj (defnt array-2d? ([^array-2d? x] true) ([^default x] false))) + (defnt array? + ([^array? x] true) + ([x] #?(:clj (-> x class .isArray) ; Have to use reflection here because we can't check *ALL* possible array types in a `defnt` + :cljs (-> x core/array?)))) + + (defnt svector? ([^svector? x] true) ([^default x] false)) + (defnt +vector? ([^+vector? x] true) ([^default x] false)) + (defnt !+vector? ([^!+vector? x] true) ([^default x] false)) + (defnt ?!+vector? ([^?!+vector? x] true) ([^default x] false)) + (defnt !vector? ([^!vector? x] true) ([^default x] false)) + (defnt vector? ([^vector? x] true) ([^default x] false)) + + (defnt +array-map? ([^+array-map? x] true) ([^default x] false)) + (defnt !+array-map? ([^!+array-map? x] true) ([^default x] false)) + (defnt ?!+array-map? ([^?!+array-map? x] true) ([^default x] false)) + + (defnt +hash-map? ([^+hash-map? x] true) ([^default x] false)) + (defnt !+hash-map? ([^!+hash-map? x] true) ([^default x] false)) + (defnt ?!+hash-map? ([^?!+hash-map? x] true) ([^default x] false)) + (defnt !hash-map? ([^!hash-map? x] true) ([^default x] false)) +#?(:clj (defnt !!hash-map? ([^!!hash-map? x] true) ([^default x] false))) + + (defnt +unsorted-map? ([^+unsorted-map? x] true) ([^default x] false)) + (defnt unsorted-map? ([^unsorted-map? x] true) ([^default x] false)) + (defnt +sorted-map? ([^+sorted-map? x] true) ([^default x] false)) + (defnt sorted-map? ([^sorted-map? x] true) ([^default x] false)) + (defnt +insertion-ordered-map? ([^+insertion-ordered-map? x] true) ([^default x] false)) + (defnt !insertion-ordered-map? ([^!insertion-ordered-map? x] true) ([^default x] false)) + (defnt insertion-ordered-map? ([^insertion-ordered-map? x] true) ([^default x] false)) + (defnt +map? ([^+map? x] true) ([^default x] false)) + (defnt !map? ([^!map? x] true) ([^default x] false)) + (defnt map? ([^map? x] true) ([^default x] false)) + + (defnt +unsorted-set? ([^+unsorted-set? x] true) ([^default x] false)) + (defnt unsorted-set? ([^unsorted-set? x] true) ([^default x] false)) + (defnt +sorted-set? ([^+sorted-set? x] true) ([^default x] false)) + (defnt sorted-set? ([^sorted-set? x] true) ([^default x] false)) + (defnt +set? ([^+set? x] true) ([^default x] false)) + (defnt !set? ([^!set? x] true) ([^default x] false)) + (defnt set? ([^set? x] true) ([^default x] false)) + + (defnt !array-list? ([^!array-list? x] true) ([^default x] false)) + (defnt list? ([^list? x] true) ([^default x] false)) + (defnt +list? ([^+list? x] true) ([^default x] false)) + (defnt +queue? ([^+queue? x] true) ([^default x] false)) + (defnt queue? ([^queue? x] true) ([^default x] false)) + (defnt lseq? ([^lseq? x] true) ([^default x] false)) + (defnt sequential? ([^sequential? x] true) ([^default x] false)) + (defnt counted? ([^counted? x] true) ([^default x] false)) + (defnt transformer? ([^transformer? x] true) ([^default x] false)) + (defalias seqable? udata/seqable?) + +#?(:clj (defnt file? ([^file? x] true) ([^default x] false))) + (defnt regex? ([^regex? x] true) ([^default x] false)) + (defnt editable? ([^editable? x] true) ([^default x] false)) + (defnt transient? ([^transient? x] true) ([^default x] false)) + (defnt indexed? ([^indexed? x] true) ([^default x] false)) + (defnt m2m-chan? ([^m2m-chan? x] true) ([^default x] false)) + +; #?(:cljs (defnt typed-array? ...)) + + (def map-entry? #?(:clj core/map-entry? + :cljs (fn-and vector? (fn-> count (= 2))))) + +#?(:clj (defalias var? core/var?)) + ; TODO `ref?`, `future?` + +#?(:clj (def throwable? (partial instance+? java.lang.Throwable ))) + (defnt error? ([#{#?(:clj Throwable + :cljs js/Error)} obj] true) ([obj] false)) +#?(:clj +(defnt interface? + [^java.lang.Class class-] + (.isInterface class-))) + +#?(:clj +(defnt abstract? + [^java.lang.Class class-] + (java.lang.reflect.Modifier/isAbstract (.getModifiers class-)))) + + +#?(:clj (def multimethod? (fnl instance? clojure.lang.MultiFn))) +#?(:clj (def unbound? (fnl instance? clojure.lang.Var$Unbound))) +#?(:clj (def thread? (fnl instance? Thread))) + +#?(:clj +(defn protocol? + "Returns true if an argument is a protocol" + [x] (and (map? x) (-> x :on-interface class?)))) + +#?(:clj (defn namespace? [x] (instance? clojure.lang.Namespace x))) + +#?(:clj +(defn promise? + {:source 'zcaudate/hara.class.checks} + [^Object obj] + (let [^String s (.getName ^Class (type obj))] + (.startsWith s "clojure.core$promise$")))) + +; ===== JAVA ===== + +#?(:clj +(defn enum? + {:source "zcaudate/hara.object.enum"} + [type] + (-> (classes/class->ancestors type) + (get java.lang.Enum)))) + +; ; ======= TRANSIENTS ======= + +; ; TODO this is just intuition. Better to |bench| it +; ; TODO move these vars +(def transient-threshold 3) + +; macro because it will probably be heavily used +#?(:clj +(defmacro should-transientize? [coll] + `(and (editable? ~coll) + (counted? ~coll) + (-> ~coll count (> transient-threshold))))) + +; (def primitive-records +; [{:raw "Z" :symbol 'boolean :string "boolean" :class Boolean/TYPE :container Boolean} +; {:raw "B" :symbol 'byte :string "byte" :class Byte/TYPE :container Byte} +; {:raw "C" :symbol 'char :string "char" :class Character/TYPE :container Character} +; {:raw "I" :symbol 'int :string "int" :class Integer/TYPE :container Integer} +; {:raw "J" :symbol 'long :string "long" :class Long/TYPE :container Long} +; {:raw "F" :symbol 'float :string "float" :class Float/TYPE :container Float} +; {:raw "D" :symbol 'double :string "double" :class Double/TYPE :container Double} +; {:raw "V" :symbol 'void :string "void" :class Void/TYPE :container Void}]) + +#?(:clj (def ^:runtime-eval construct (mfn new))) + +(defnt identity + "Type identity function." + {:todo ["Fix so only immmutable data stuctures have immutable identity fns."]} + ([^+vector? x] vector) + ([^+map? x] hash-map) + ([^+set? x] hash-set)) + +(def +vector?-fn (fn1 +vector?)) +(def +set?-fn (fn1 +set?)) +(def +map?-fn (fn1 +map?)) + +(defnt ->pred + "Gets the type predicate associated with the value passed." + ([^+vector? x] +vector?-fn) + ([^+set? x] +set?-fn) + ([^+map? x] +map?-fn)) + +(defnt ->literal + "Gets the literal value associated with the value passed." + ([^+vector? x] []) + ([^+set? x] #{}) + ([^+map? x] {})) + +(defnt ->base + "Gets the base value associated with the value passed." + ([^+vector? x] (vector)) + ([^+unsorted-set? x] (hash-set)) + ([^+hash-map? x] #?(:clj clojure.lang.PersistentHashMap/EMPTY + :cljs cljs.core.PersistentHashMap.EMPTY)) + ([^default x] (empty x))) + +(defnt ->joinable + ([#{+vector? +hash-map? +unsorted-set?} x] x) + ([#{+array-map?} x] (into (->base x) x)) + ([^default x] x)) diff --git a/src/quantum/core/vars.cljc b/src/quantum/core/vars.cljc index fe64d755..f18076b9 100644 --- a/src/quantum/core/vars.cljc +++ b/src/quantum/core/vars.cljc @@ -1,100 +1,273 @@ (ns quantum.core.vars - "Var- and namespace-related functions." + "Functions related to vars and their enclosing namespaces. + + We colocate namespace and var functions because namespaces cannot exist separately from vars: + for instance, namespace-mapping values are either vars or classes, and vars exist only in the + context of an enclosing namespace." (:refer-clojure :exclude - [defonce, intern, binding with-local-vars, meta, reset-meta!]) - (:require [clojure.core :as c] - #?(:clj [quantum.core.ns :as ns]) - [quantum.untyped.core.form.evaluate - :refer [case-env]] - [quantum.untyped.core.qualify :as qual] - [quantum.untyped.core.vars :as uvar]) -#?(:cljs - (:require-macros - [quantum.core.vars :as this]))) + [binding defonce intern loaded-libs ns var? with-local-vars]) + (:require + ;; TODO TYPED remove reference to `clojure.core` + [clojure.core :as core] + [quantum.core.data.identifiers :as id] + [quantum.core.data.meta :as dm + :refer [>meta]] + [quantum.core.type :as t] + ;; TODO TYPED remove reference to `quantum.untyped.core.ns` + [quantum.untyped.core.ns :as uns] + ;; TODO TYPED remove reference to `quantum.untyped.core.vars` + [quantum.untyped.core.vars :as uvar])) + +;; ===== Namespaces ===== ;; + +#?(:clj (def namespace? (t/isa? clojure.lang.Namespace))) + +;; TODO TYPED +#?(:clj (defalias core/ns)) -; ===== META ===== ; +#?(:clj +(t/defn >?ns + "Supersedes `clojure.core/find-ns`." + [x id/symbol? > (t/? namespace?)] (clojure.lang.Namespace/find x))) -(def reset-meta! c/reset-meta!) -(def meta c/meta) +#?(:clj +(t/defn >ns + "Supersedes `clojure.core/the-ns`." + ([x namespace? > namespace?] x) + ([x id/symbol? > (t/run namespace?)] (>?ns x)))) -(def update-meta vary-meta) +#?(:clj (t/extend-defn! id/>name (^:inline [x namespace?] (-> x .getName id/>name)))) -(defn merge-meta - "See also `cljs.tools.reader/merge-meta`." - [x m] (update-meta x merge m)) +;; TODO TYPED finish `id/unqualified-symbol?` +#_(:clj +(t/defn unmap! + "Removes the mapping for the symbol from the namespace and outputs the namespace. -(def merge-meta-from uvar/merge-meta-from) -(def replace-meta-from uvar/replace-meta-from) + Supersedes `clojure.core/ns-unmap`." + [ns-val namespace?, sym id/unqualified-symbol? > namespace?] + (.unmap ns-val sym) + ns-val)) -; ===== DECLARATION/INTERNING ===== ; +;; `in-ns` cannot be shadowed +#?(:clj (def in-ns in-ns)) -#?(:clj (uvar/defalias defalias uvar/defalias)) +;; TODO TYPED finish `t/of` +#_(:clj +(t/defn all-ns + "Returns a `traversable?` of all namespaces." + [> (t/assume (t/of namespace?))] (clojure.lang.Namespace/all))) -#?(:clj (defalias intern c/intern)) -#?(:clj (uvar/defaliases uvar defaliases defaliases')) +;; ===== Creation/Destruction ===== ;; #?(:clj -(defn alias-var - "Create a var with the supplied name in the current namespace, having the same - metadata and root-binding as the supplied var." - {:attribution "flatland.useful.ns"} - [sym var-0] +(t/defn create-ns! + "Creates a new namespace named by the symbol if one doesn't already exist. Returns it or the + already-existing namespace of the same name. + + Supersedes `clojure.core/create-ns`." + [x id/symbol? > (t/run namespace?)] (clojure.lang.Namespace/findOrCreate x))) + +#?(:clj +(t/defn remove-ns! + "Removes the namespace named by the symbol. Use with caution. Cannot be used to remove the + `clojure.core` namespace." + [x id/symbol? > (t/run namespace?)] (clojure.lang.Namespace/remove x))) + +;; ===== Modification ===== ;; + +#?(:clj +(t/defn alias! + "Add an alias to another namespace in the destination namespace. Returns the destination + namespace. This corresponds roughly to the `:as` directive in the ns macro. + + Supersedes `clojure.core/alias`." + [dest-ns namespace?, alias-sym id/symbol?, ns-to-alias namespace?] + (.addAlias dest-ns alias-sym ns-to-alias) + dest-ns)) + +#?(:clj +(t/defn unalias! + "Removes the alias as designated by `alias-sym` from the namespace." + [ns-val namespace?, alias-sym id/symbol?] + (.removeAlias ns-val alias-sym) + ns-val)) + +;; TODO TYPED +#?(:clj (defalias require! core/require)) + +;; TODO TYPED +#?(:clj (defalias import! core/import)) + +;; TODO TYPED +#?(:clj (defalias refer! core/refer)) + +;; TODO TYPED +#?(:clj (defalias refer-clojure! core/refer-clojure)) + +;; ===== Vars ===== ;; + +(def var? (t/isa? #?(:clj clojure.lang.Var :cljs cljs.core/Var))) + +;; TODO maybe extend to CLJS? +#?(:clj (t/defn var-defined? [x var?] (.hasRoot x))) + +;; TODO maybe extend to CLJS? +#?(:clj (t/defn dynamic? [x var?] (.isDynamic x))) + +#?(:clj (t/extend-defn! id/>name (^:inline [x var?] (-> x >meta :name id/>name)))) +#?(:clj (t/extend-defn! id/>namespace (^:inline [x var?] (-> x >meta :ns id/>name)))) +#?(:clj (t/extend-defn! id/>symbol (^:inline [x var?] + (id/>symbol (id/>namespace x) (id/>name x))))) + +;; ---- Var declaration/interning ----- ;; + +#?(:clj +(t/defn intern + "Finds or creates a var named by the symbol name in ->`ns-val`, setting its root binding to ->`v` + if supplied. The namespace must exist. The var will adopt any metadata from ->`name-val`. + Returns the var." + > var? + ([ns-val (t/or id/symbol? namespace?), var-name id/symbol? > (t/run var?)] + (let [var-ref (clojure.lang.Var/intern (>ns ns-val) var-name)] + (when (>meta var-name) (.setMeta var-ref (>meta var-name))) + var-ref)) + ([ns-val (t/or id/symbol? namespace?), var-name id/symbol?, var-val t/ref? > (t/run var?)] + (let [var-ref (clojure.lang.Var/intern (>ns ns-val) var-name var-val)] + (when (>meta var-name) (.setMeta var-ref (>meta var-name))) + var-ref)))) + +;; TODO TYPED +;; Note that `def` can never be shadowed +#?(:clj (uvar/defalias uvar/def)) + +;; TODO TYPED +#?(:clj (uvar/defaliases uvar defalias defaliases defaliases')) + +;; TODO TYPED — need to do `apply`, and `apply` with t/defn; also `merge`, `str`, `deref` +#_(:clj +(t/defn alias-var + "Create a var with the supplied name in the current namespace, having the same metadata and + root-binding as the supplied var." + {:attribution "flatland.useful.ns" + :contributors ["Alex Gunnarson"]} + [sym id/symbol?, var-val var?] (apply intern *ns* - (with-meta sym + (dm/with-meta sym (merge {:dont-test - (str "Alias of " (-> var-0 meta :name))} - (meta var-0) - (meta sym))) - (when (.hasRoot ^clojure.lang.Var var-0) [@var-0])))) - -(comment - "What to do when aliasing a macro:" - ;(def cljs-doseqi (var loops/doseqi)) ; doesn't work because not a var in CLJS - ;(def cljs-doseqi (mfn loops/doseqi)) ; doesn't work because no |eval| in CLJS - ;(defalias doseqi #?(:clj loops/doseqi :cljs cljs-doseqi)) - ; #?(:clj (alter-meta! (var doseqi) assoc :macro true)) ; Sometimes this works - - #_(:clj (defmacro doseqi [& args] `(loops/doseqi ~@args)))) + (str "Alias of " (-> var-val >meta :name))} + (>meta var-0) + (>meta sym))) + (when (defined? var-) [(deref var-val)])))) +;; TODO TYPED #?(:clj (quantum.untyped.core.vars/defmalias defmalias quantum.untyped.core.vars/defmalias)) +;; TODO TYPED #?(:clj (defaliases uvar defonce def- defmacro-)) -; ============ MANIPULATION + OTHER ============ -; CLJS compatible only if you port |alter-var-root| as in-ns, def, in-ns -#?(:clj -(defn reset-var! - "Like |reset!| but for vars." +;; ----- Var modification ----- ;; + +;; TODO TYPED — need to do `fnt` +#_(:clj +(t/defn reset-var! + "Like `reset!` but for vars. Atomically sets the root binding of ->`var-` to ->`v`." {:attribution "alexandergunnarson"} - [var-0 val-f] - ;(.bindRoot #'clojure.core/ns ns+) - ;(alter-meta! #'clojure.core/ns merge (meta #'ns+)) - (alter-var-root var-0 (fn [_] val-f)))) + [var-val var?, v t/ref? > var?] + (.alterRoot var-val (t/fn [_] v)))) -; CLJS compatible -#?(:clj -(defn swap-var! - "Like |swap!| but for vars." +;; TODO TYPED — need to do `fnt`, `apply` +#_(:clj +(t/defn update-var! {:attribution "alexandergunnarson"} - ([var-0 f] - (do (alter-var-root var-0 f) - var-0)) - ([var-0 f & args] - (do (alter-var-root var-0 - (fn [var-n] - (apply f var-n args))) - var-0)))) + ([var- var?, f (t/fn [_]) > var?] + (do (.alterRoot var- f) + var-)) + ;; TODO we need to be able to conditionalize `f`'s arity based on the count of `args` + ([var- f t/fn? & args (? t/seq?) > var?] + (do (.alterRoot var- (t/fn [v' _] (apply f v' args))) + var-)))) -#?(:clj -(defn clear-vars! - "Sets each var in ~@vars to nil." +;; TODO TYPED — `doseq` +#_(:clj +(t/defn clear-vars! + "Sets each var in ->`vars` to nil." {:attribution "alexandergunnarson"} - [& vars] - (doseq [v vars] - (reset-var! v nil)))) + [& vars (? (t/seq-of var?))] + (doseq [v vars] (reset-var! v nil)))) + +;; ----- Thread-local ----- ;; + +;; TODO TYPED +#?(:clj (defalias binding core/binding)) +;; TODO TYPED +#?(:clj (defalias with-local-vars core/with-local-vars)) + +;; ----- Mappings ----- ;; + +;; TODO TYPED finish `t/of`, `id/unqualified-symbol?` +#_(:clj +(t/defn ns>mappings + "Supersedes `clojure.core/ns-map`." + [x namespace? > (t/assume (t/of ut/+map? id/unqualified-symbol? (t/or var? t/class?)))] + (.getMappings x))) + +;; TODO TYPED finish `t/of`, `id/unqualified-symbol?` +#_(:clj +(t/defn ns>alias-map + "Outputs the alias->namespace mappings for the namespace. + + Supersedes `clojure.core/ns-aliases`." + [x namespace? > (t/assume (t/of ut/+map? id/unqualified-symbol? namespace?))] + (.getAliases x))) + +;; TODO TYPED finish `t/of`, `id/unqualified-symbol?`, decide on `filter-vals'`? +#_(:clj +(t/defn ns>imports + "Outputs the import-mappings for the namespace. + + Supersedes `clojure.core/ns-imports`." + [x namespace? > (t/assume (t/of ut/+map? id/unqualified-symbol? t/class?))] + (->> x (filter-vals' t/class?)))) + +;; TODO TYPED finish `t/of`, `id/unqualified-symbol?`, decide on `filter-vals'`? +#_(:clj +(t/defn ns>interns + "Outputs the intern-mappings for the namespace. + + Supersedes `clojure.core/ns-interns`." + [ns-val namespace? > (t/assume (t/of ut/+map? id/unqualified-symbol? var?))] + (->> ns-val + ns>mappings + (filter-vals' (fn [^clojure.lang.Var v] (and (var? v) (= ns-val (.ns v)))))))) + +;; TODO TYPED finish `t/of`, `id/unqualified-symbol?`, decide on `filter-vals'`? +#_(:clj +(t/defn ns>publics + "Outputs the public intern-mappings for the namespace. + + Supersedes `clojure.core/ns-publics`." + [ns-val namespace? > (t/assume (t/of ut/+map? id/unqualified-symbol? var?))] + (->> ns-val + ns>interns + (filter-vals' (fn [^clojure.lang.Var v] (.isPublic v)))))) + +;; TODO TYPED finish `t/of`, `id/unqualified-symbol?`, decide on `remove-vals'`? +#_(:clj +(t/defn ns>refers + "Outputs the refer-mappings for the namespace. + + Supersedes `clojure.core/ns-refers`." + [ns-val namespace? > (t/assume (t/of ut/+map? id/unqualified-symbol? var?))] + (->> ns-val + ns>mappings + (remove-vals' (fn [^clojure.lang.Var v] (and (var? v) (= ns-val (.ns v)))))))) #?(:clj +(t/defn alias>?ns [src-ns namespace?, sym id/symbol? > (t/? namespace?)] (.lookupAlias src-ns sym))) + +;; TODO TYPED — enable +#_(:clj (defn alias-ns "Create vars in the current namespace to alias each of the public vars in the supplied namespace. @@ -102,39 +275,11 @@ {:attribution "flatland.useful.ns"} [ns-name-] (require ns-name-) - (doseq [[name var] (ns-publics (the-ns ns-name-))] - (alias-var name var)))) - -#?(:clj -(defn defs - "Defines a provided list of symbol-value pairs as vars in the - current namespace." - {:attribution "alexandergunnarson" - :usage '(defs 'a 1 'b 2 'c 3)} - [& {:as vars}] - (doseq [[sym v] vars] - (intern *ns* sym v)))) - -#?(:clj -(defn defs- - "Like |defs|, but each var defined is private." - {:attribution "alexandergunnarson" - :usage '(defs- 'a 1 'b 2 'c 3)} - [& {:as vars}] - (doseq [[sym v] vars] - (intern *ns* (-> sym (with-meta {:private true})) v)))) - -; ===== THREAD-LOCAL ===== ; - -#?(:clj (defalias binding c/binding)) -#?(:clj (defalias with-local-vars c/with-local-vars)) + (doseq [[name var] (ns>publics (the-ns ns-name-))] + (uvar/alias-var name var)))) +;; TODO TYPED #?(:clj -(defmacro def - ([sym] `(~'def ~sym)) - ([sym v] `(~'def ~sym ~v)) - ([sym doc-or-meta v] - (if (string? doc-or-meta) - `(~'def ~(with-meta sym {:doc doc-or-meta}) ~v) - `(~'def ~(with-meta sym doc-or-meta) ~v))) - ([sym -doc -meta v] `(~'def ~(with-meta sym (merge -meta {:doc -doc})) ~v)))) +(defaliases uns + ns>alias ns-name>alias clear-ns-interns! search-var ns-exclude with-ns with-temp-ns import-static + load-ns load-nss loaded-libs load-lib! load-package! load-dep! assert-ns-aliased ?resolve intern! intern-once!)) diff --git a/src/quantum/db/datomic.cljc b/src/quantum/db/datomic.cljc index 5dc150d6..43bba7ac 100644 --- a/src/quantum/db/datomic.cljc +++ b/src/quantum/db/datomic.cljc @@ -28,10 +28,11 @@ :refer [fn-and fn-or whenf condf default]] [quantum.core.process :as proc] [quantum.core.resources :as res] + [quantum.core.refs :as ref] [quantum.core.string :as str] [quantum.core.async :as async :refer [go]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]] [quantum.core.vars :as var :refer [defalias defaliases]] @@ -120,9 +121,9 @@ (let [history-limit (validate (or history-limit #?(:clj Integer/MAX_VALUE :cljs js/Number.MAX_SAFE_INTEGER)) integer?) - reactive? (validate (default reactive? true ) (fn1 t/boolean?)) - set-main-conn? (validate (default set-main-conn? false) (fn1 t/boolean?)) - set-main-part? (validate (default set-main-part? false) (fn1 t/boolean?)) + reactive? (validate (default reactive? true ) (fn1 p/boolean?)) + set-main-conn? (validate (default set-main-conn? false) (fn1 p/boolean?)) + set-main-part? (validate (default set-main-part? false) (fn1 p/boolean?)) _ (validate conn nil?)] (try (log/pr ::debug "EPHEMERAL:" (kw-map post schemas set-main-conn? reactive?)) @@ -164,7 +165,7 @@ {:this this :err {:e e :stack #?(:clj (.getStackTrace e) :cljs (.-stack e))}}) this)))) (stop [this] - (when (t/atom? conn) + (when (ref/atom? conn) (reset! conn nil)) ; TODO is this wise? ; TODO unregister all listeners? this)) @@ -275,12 +276,12 @@ name (validate (or name "test") (s/and string? (fn1 contains?))) host (validate (or host "localhost") (s/and string? (fn1 contains?))) port (validate (or port 4334) integer?) ; TODO `net/valid-port?` - create? (validate (default create? false) (fn1 t/boolean?)) - create-if-not-present? (validate (default create-if-not-present? true ) (fn1 t/boolean?)) - set-main-conn? (validate (default set-main-conn? false) (fn1 t/boolean?)) - set-main-part? (validate (default set-main-part? false) (fn1 t/boolean?)) + create? (validate (default create? false) (fn1 p/boolean?)) + create-if-not-present? (validate (default create-if-not-present? true ) (fn1 p/boolean?)) + set-main-conn? (validate (default set-main-conn? false) (fn1 p/boolean?)) + set-main-part? (validate (default set-main-part? false) (fn1 p/boolean?)) default-partition (validate (or default-partition :db.part/test) (s/and keyword? (fn-> namespace (= "db.part")))) - conn (validate (or conn (atom nil)) t/atom?) + conn (validate (or conn (atom nil)) ref/atom?) connection-retries (validate (or (if (= type :dynamo) 1 5)) integer?) ; DynamoDB auto-retries uri (case type :free @@ -344,7 +345,7 @@ (c/assoc this :txr-process txr-process-f) (kw-map type uri name host port create-if-not-present? default-partition conn))))) (stop [this] - (when (and (t/atom? conn) (val? @conn)) + (when (and (ref/atom? conn) (val? @conn)) #?(:clj (bdb/release @conn)) (swap! conn* #(if (identical? % @conn) nil %)) (reset! conn nil)) diff --git a/src/quantum/db/datomic/core.cljc b/src/quantum/db/datomic/core.cljc index ab4637fb..fe1d3ace 100644 --- a/src/quantum/db/datomic/core.cljc +++ b/src/quantum/db/datomic/core.cljc @@ -5,38 +5,38 @@ update merge if-let for doseq nth filter contains?]) (:require - [clojure.core :as c] + [clojure.core :as c] #?@(:clj - [[datomic.api :as db]]) - [datascript.core :as mdb] - [com.stuartsierra.component :as comp] - [quantum.core.collections :as coll + [[datomic.api :as db]]) + [datascript.core :as mdb] + [com.stuartsierra.component :as comp] + [quantum.core.collections :as coll :refer [join for kw-map val? contains? filter+ filter-vals+ filter-vals', remove-vals+, map+, remove+ remove', nth group-by+ prewalk postwalk merge-deep dissoc-in doseq]] - [quantum.core.core :as qcore] - [quantum.core.async :as async + [quantum.core.core :as qcore] + [quantum.core.async :as async :refer [! >!!]] - [quantum.core.data.set :as set] - [quantum.core.error :as err + [quantum.core.data.primitive :as p + :refer [>long]] + [quantum.core.data.set :as set] + [quantum.core.error :as err :refer [>ex-info >err TODO catch-all]] - [quantum.core.fn :as fn + [quantum.core.fn :as fn :refer [<- fn-> fn->> fn1 fnl fn' rfn with-do]] - [quantum.core.log :as log] - [quantum.core.logic :as logic + [quantum.core.log :as log] + [quantum.core.logic :as logic :refer [fn-not fn-and fn-or whenf whenf1 ifn ifn1 if-let condf1]] - [quantum.core.print :as pr] - [quantum.core.resources :as res] - [quantum.core.process :as proc] - [quantum.core.convert.primitive :as pconv - :refer [->long]] - [quantum.core.vars :as var + [quantum.core.print :as pr] + [quantum.core.resources :as res] + [quantum.core.process :as proc] + [quantum.core.vars :as var :refer [defalias]] - [quantum.core.data.validated :as dv] - [quantum.core.spec :as s + [quantum.core.data.validated :as dv] + [quantum.core.spec :as s :refer [validate]] - [quantum.core.type :as t] - [quantum.untyped.core.convert + [quantum.core.type-old :as t] + [quantum.untyped.core.identifiers :refer [>?name]]) #?(:clj (:import @@ -77,7 +77,7 @@ mdb? (partial instance? datascript.db.DB)) #?(:clj (def conn? (partial instance? datomic.Connection))) -(defn mconn? [x] (and (t/atom? x) (mdb? @x))) +(defn mconn? [x] (and (ref/atom? x) (mdb? @x))) (defn ->uri-string [{:keys [type host port db-name] @@ -322,18 +322,18 @@ (dv/def -ref (s/or* :db/id :db/ident dbfn-call?)) ; TODO look over this more (dv/def -keyword (s/or* keyword? dbfn-call?)) (dv/def -string (s/or* string? dbfn-call?)) -(dv/def -boolean (s/or* (fn1 t/boolean?) dbfn-call?)) +(dv/def -boolean (s/or* (fn1 p/boolean?) dbfn-call?)) (dv/def -long (s/or* #?(:clj (fn-or (fnl instance? Long ) - (fnl instance? Integer) - (fnl instance? Short )) #_long? + (fnl instance? Integer) + (fnl instance? Short )) #_long? :cljs c/integer?) ; TODO CLJS |long?| ; TODO autocast from e.g. bigint if safe to do so dbfn-call?)) (dv/def -bigint (s/or* (fn1 t/bigint?) dbfn-call?)) -(dv/def -float (s/or* #?(:clj (fn1 t/float?) +(dv/def -float (s/or* #?(:clj (fn1 p/float?) :cljs number?) dbfn-call?)) ; TODO CLJS |float?| -(dv/def -double (s/or* #?(:clj (fn1 t/double?) +(dv/def -double (s/or* #?(:clj (fn1 p/double?) :cljs number?) dbfn-call?)) (dv/def -bigdec (s/or* #?(:clj (fnl instance? BigDecimal) #_bigdec? @@ -341,7 +341,7 @@ dbfn-call?)) ; TODO CLJS |bigdec?| (dv/def -instant (s/or* (fnl instance? #?(:clj java.util.Date :cljs js/Date )) ; TODO time/->instant #?(:clj (s/and string? (s/conformer clojure.instant/read-instant-date))) - (s/and (fn1 t/integer?) (s/conformer #(#?(:clj java.util.Date. :cljs js/Date.) (->long %)))) + (s/and (fn1 t/integer?) (s/conformer #(#?(:clj java.util.Date. :cljs js/Date.) (>long %)))) dbfn-call?)) (dv/def -uri (s/or* (fnl instance? #?(:clj java.net.URI :cljs (TODO) #_paths/URI)) dbfn-call?)) @@ -361,7 +361,7 @@ ([conn] (->> conn db/log - (<- db/tx-range nil nil) + (<- (db/tx-range nil nil)) seq)))) ; TODO deprecate this in favor of `attributes` @@ -419,10 +419,10 @@ (def :datomic:schema/type allowed-types) (def :datomic:schema/cardinality #{:one :many})] :opt-un [(def :datomic:schema/doc string?) - (def :datomic:schema/component? (fn1 t/boolean?)) - (def :datomic:schema/index? (fn1 t/boolean?)) - (def :datomic:schema/full-text? (fn1 t/boolean?)) - (def :datomic:schema/no-history? (fn1 t/boolean?)) + (def :datomic:schema/component? (fn1 p/boolean?)) + (def :datomic:schema/index? (fn1 p/boolean?)) + (def :datomic:schema/full-text? (fn1 p/boolean?)) + (def :datomic:schema/no-history? (fn1 p/boolean?)) (def :datomic:schema/unique #{:identity :value})]) ; TODO for datascript: @@ -534,8 +534,8 @@ (->> m (remove-vals+ nil?) (join {}) - (<- c/assoc :db/id id) - (<- c/conj! txn-components)) + (<- (c/assoc :db/id id)) + (<- (c/conj! txn-components))) id))))) :db/id (tempid part)))) @@ -774,7 +774,7 @@ ([^Database db] (let [history (-> db :ephemeral :history) conn (-> db :ephemeral :conn )] - (validate history t/atom?) + (validate history ref/atom?) (when (contains? @history) (let [prev (peek @history) before (:db-before prev) @@ -794,7 +794,7 @@ ; "Returns all Datomic database transactions in the log." ; [^Database db] ; (->> (:conn db) db/log -; (<- db/tx-range nil nil) +; (<- (db/tx-range nil nil)) ; seq)) ; (defn dissoc+ @@ -1176,14 +1176,14 @@ ; (fn [tx] ; {:before (->> tx :db/id datomic.api/tx->t dec ; (datomic.api/as-of (db*)) -; (<- datomic.api/entity eid)) +; (<- (datomic.api/entity eid))) ; :after (->> tx :db/id ; (datomic.api/as-of (db*)) -; (<- datomic.api/entity eid))})) +; (<- (datomic.api/entity eid)))})) ; (join []) -; (<- whenp show-entity-maps? -; (fn->> (postwalk (whenf1 (partial instance? datomic.query.EntityMap) -; (fn->> (join {})))))))) +; (<- (whenp show-entity-maps? +; (fn->> (postwalk (whenf1 (partial instance? datomic.query.EntityMap) +; (fn->> (join {}))))))))) #?(:clj diff --git a/src/quantum/db/subs.cljc b/src/quantum/db/subs.cljc index a307a766..d4bcb7f3 100644 --- a/src/quantum/db/subs.cljc +++ b/src/quantum/db/subs.cljc @@ -32,7 +32,7 @@ (->> dom-id db/entity (into {}) - (<- get k))))})) + (<- (get k)))))})) #?(:cljs (def handlers diff --git a/src/quantum/db/voltdb.cljc b/src/quantum/db/voltdb.cljc new file mode 100644 index 00000000..72eb6dfb --- /dev/null +++ b/src/quantum/db/voltdb.cljc @@ -0,0 +1,57 @@ +(ns quantum.db.voltdb + (:require + [com.stuartsierra.component :as comp]) + #?(:clj (:import + [org.voltdb SQLStmt] + [org.voltdb.client Client ClientConfig ClientFactory]))) + +(do + +(defrecord VoltDB [^Client client host username password] + comp/Lifecycle + (start [this] + (let [^String username (or username "") + ^String password (or password "") + config (ClientConfig. username password) + _ (.setTopologyChangeAware config true) + client (ClientFactory/createClient config)] + (.createConnection client (or host "localhost")) + (assoc this :client client))) + (stop [this] + (.drain client) + (.close client) + (assoc this :client nil))) + +(let [{:as db :keys [^Client client]} (comp/start (map->VoltDB {}))] + (try + ( client) + (finally (comp/stop db))))) + + +public final SQLStmt GetSeats = new SQLStmt( + "SELECT numberofseats FROM Flight WHERE flightid=?;"); + +voltQueueSQL(GetSeats, EXPECT_ONE_ROW, flightid); +VoltTable[] recordset = voltExecuteSQL(); + + +VoltTable[] results; + +try { results = client.callProcedure("LookupFlight", 1 + origin, + dest, + departtime).getResults(); 2 +} catch (Exception e) { 3 + e.printStackTrace(); + System.exit(-1); +} + + +Asynchronous Invocation +To invoke stored procedures asynchronously, use the callProcedure() method with an additional first argument, a callback that will be notified when the procedure completes (or an error occurs). For example, to invoke a NewCustomer() stored procedure asynchronously, the call to callProcedure() might look like the following: + +client.callProcedure(new MyCallback(), + "NewCustomer", + firstname, + lastname, + custID}; diff --git a/src/quantum/format/clojure/core.cljc b/src/quantum/format/clojure/core.cljc index 7241a84c..67be632f 100644 --- a/src/quantum/format/clojure/core.cljc +++ b/src/quantum/format/clojure/core.cljc @@ -1,17 +1,18 @@ (ns ^{:doc "Code formatting. Taken shamelessly from cljfmt.core."} quantum.format.clojure.core - (:require [clojure.zip :as zip] - [rewrite-clj.parser :as p] - [rewrite-clj.node :as n] - [rewrite-clj.zip :as z] - [quantum.core.core - :refer [regex?]] - [quantum.core.fn :as fn - :refer [rcomp fn-> fn->> fn1]] - [quantum.core.logic - :refer [fn-and fn-not fn-or whenf1]] - [quantum.core.vars :as var - :refer [def-]])) + (:require + [clojure.zip :as zip] + [rewrite-clj.parser :as p] + [rewrite-clj.node :as n] + [rewrite-clj.zip :as z] + [quantum.core.fn :as fn + :refer [rcomp fn-> fn->> fn1]] + [quantum.core.logic + :refer [fn-and fn-not fn-or whenf1]] + [quantum.core.vars :as var + :refer [def-]] + [quantum.untyped.core.string + :refer [regex?]])) ;(java/load-deps '[rewrite-clj "0.4.12"]) @@ -320,4 +321,3 @@ (-> (p/parse-string-all form-string) (reformat-form options) (n/string))) - diff --git a/src/quantum/generate/identifiers.cljc b/src/quantum/generate/identifiers.cljc index bdbedc8d..1a0998db 100644 --- a/src/quantum/generate/identifiers.cljc +++ b/src/quantum/generate/identifiers.cljc @@ -10,7 +10,7 @@ :refer [>ex-info]] [quantum.core.numeric :as num] [quantum.core.fn - :refer [<- fn->>]] + :refer [fn->>]] [quantum.core.collections :as coll :refer [lfor for slice lasti join #?(:clj array)]] [quantum.core.nondeterministic :as rand])) diff --git a/src/quantum/media/imaging/convert.cljc b/src/quantum/graphics/convert.cljc similarity index 72% rename from src/quantum/media/imaging/convert.cljc rename to src/quantum/graphics/convert.cljc index 8b651597..9ee72f22 100644 --- a/src/quantum/media/imaging/convert.cljc +++ b/src/quantum/graphics/convert.cljc @@ -1,16 +1,12 @@ -(ns - ^{:doc "Image library. Conversion." - :attribution "alexandergunnarson"} - quantum.media.imaging.convert +(ns quantum.graphics.convert (:refer-clojure :exclude [contains?]) (:require [quantum.core.process :as proc - :refer [proc!] ] - [quantum.core.io :as io ] - [quantum.core.paths :as path - :include-macros true ] + :refer [proc!]] + [quantum.core.io :as io] + [quantum.core.paths :as path] [quantum.core.collections - :refer [contains? in?] ])) + :refer [contains? in?]])) (def supported-types #{:jpg :png :tiff :jpeg :gif :pdf}) @@ -22,6 +18,7 @@ (str #_[to-type ":"] (-> to path/file-str))] {:dir (path/file-str [:resources "Images"])})) +;; TODO extend `quantum.core.convert/convert" instead of doing this (defn convert! "DOC http://libjpeg-turbo.virtualgl.org" {:usage @@ -41,3 +38,13 @@ (assert (in? from-type supported-types)) (assert (in? to-type supported-types)) (convert!* from-type from to-type to))))) + + +(defn ocr + "Uses the open-source tool `tesseract` to perform OCR on a document. + Refer to the Tesseract GitHub for help and setup. + + To OCR a PDF: + `gs -o -sDEVICE=tiffg4 && tesseract stdout pdf > `" + [in out opts] + (TODO)) diff --git a/src/quantum/media/imaging/core.cljc b/src/quantum/graphics/core.cljc similarity index 86% rename from src/quantum/media/imaging/core.cljc rename to src/quantum/graphics/core.cljc index e608d935..cc64807e 100644 --- a/src/quantum/media/imaging/core.cljc +++ b/src/quantum/graphics/core.cljc @@ -1,7 +1,4 @@ -(ns - ^{:doc "Image library. Conversion, compression, etc." - :attribution "alexandergunnarson"} - quantum.media.imaging.core +(ns quantum.graphics.core #?(:clj (:import javax.imageio.ImageIO java.awt.image.BufferedImage))) diff --git a/src/quantum/graphics/gl.cljc b/src/quantum/graphics/gl.cljc new file mode 100644 index 00000000..05e26b31 --- /dev/null +++ b/src/quantum/graphics/gl.cljc @@ -0,0 +1,6 @@ +(ns quantum.graphics.gl + "Functionality relating to WebGL/GLSL shaders." + {:todo #{"Incorporate https://github.com/thi-ng/shadergraph" + "Incorporate https://github.com/thi-ng/geom/blob/master/geom-webgl/src/shaders.org" + "Incorporate https://github.com/thi-ng/geom/blob/master/geom-webgl/src/core.org" + "Incorporate https://github.com/thi-ng/geom/blob/master/geom-webgl/src/buffers.org"}}) diff --git a/src/quantum/graphics/physics.cljc b/src/quantum/graphics/physics.cljc new file mode 100644 index 00000000..7edc04ec --- /dev/null +++ b/src/quantum/graphics/physics.cljc @@ -0,0 +1,2 @@ +(ns quantum.graphics.physics + {:todo #{"Incorporate https://github.com/thi-ng/geom/blob/master/geom-physics/src/core.org"}}) diff --git a/src/quantum/graphics/svg.cljc b/src/quantum/graphics/svg.cljc new file mode 100644 index 00000000..4ac8f8cf --- /dev/null +++ b/src/quantum/graphics/svg.cljc @@ -0,0 +1,4 @@ +(ns quantum.graphics.svg + {:todo #{"Incorporate https://github.com/thi-ng/geom/blob/master/geom-svg/src/renderer.org" + "Incorporate https://github.com/thi-ng/geom/blob/master/geom-svg/src/shaders.org" + "Incorporate https://github.com/thi-ng/geom/blob/master/geom-svg/src/core.org"}}) diff --git a/src/quantum/graphics/voxel.cljc b/src/quantum/graphics/voxel.cljc new file mode 100644 index 00000000..bc8a9074 --- /dev/null +++ b/src/quantum/graphics/voxel.cljc @@ -0,0 +1,3 @@ +(ns quantum.graphics.voxel + "A voxel is the smallest unit in a 3-dimensional graphics space." + {:todo #{"Incorporate https://github.com/thi-ng/geom/blob/master/geom-voxel/src/index.org"}}) diff --git a/src/quantum/location/climate.cljc b/src/quantum/location/climate.cljc index 0e6c9861..3d985726 100644 --- a/src/quantum/location/climate.cljc +++ b/src/quantum/location/climate.cljc @@ -21,7 +21,7 @@ [quantum.core.convert :as conv] [quantum.core.data.primitive :as prim] [quantum.core.data.set - :refer [!hash-set:double]] + :refer [!hash-set|double]] [quantum.core.data.vector :refer [!vector]] [quantum.core.fn :as fn @@ -33,7 +33,7 @@ [quantum.core.numeric :as num] [quantum.core.reducers :as r] [quantum.core.reflect :as refl] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]] [quantum.measure.convert :as unit]) (:import @@ -77,12 +77,12 @@ (.evaluate grid (org.geotools.geometry.DirectPosition2D. longitude latitude))) (deftype/deftype ClimateDataPoint ; 8 (ref) + 8 (header) + 6*4 (fields) -> 40 bytes - [^:get ^:set ^:unsynchronized-mutable ^float precipitation - ^:get ^:set ^:unsynchronized-mutable ^float solar-radiation - ^:get ^:set ^:unsynchronized-mutable ^float wind - ^:get ^:set ^:unsynchronized-mutable ^float min-temperature - ^:get ^:set ^:unsynchronized-mutable ^float avg-temperature - ^:get ^:set ^:unsynchronized-mutable ^float max-temperature]) + [^:get ^:set ^:! ^float precipitation + ^:get ^:set ^:! ^float solar-radiation + ^:get ^:set ^:! ^float wind + ^:get ^:set ^:! ^float min-temperature + ^:get ^:set ^:! ^float avg-temperature + ^:get ^:set ^:! ^float max-temperature]) (def ^GeoTiffReader reader ; If you load this first (after importing the class), it's fine, but if you load it after the namespaces, certain classes aren't found... strange! (GeoTiffReader. @@ -177,7 +177,7 @@ (filter+ val?) #_(distinct-by-storing+ ; TODO really, we may want to exclude extremely similar points (fn [^objects xs] (second xs)) - (fn [] (!hash-set:double)) + (fn [] (!hash-set|double)) (fn [^DoubleOpenHashSet seen ^double x] (contains? seen x)) (fn [^DoubleOpenHashSet seen ^double x] (conj! seen x))) ))) diff --git a/src/quantum/location/core.clj b/src/quantum/location/core.clj index f5a3e85d..36514296 100644 --- a/src/quantum/location/core.clj +++ b/src/quantum/location/core.clj @@ -13,6 +13,7 @@ ; TO EXPLORE ; - http://developer.factual.com for Factual (Geo, etc.) API +; - https://www.mapbox.com/ — The premiere solution for map/geographical related things. Used by pretty much everybody important ; - Factual/geo ; - Countries of the world ; - (http/request! {:url http://restcountries.eu/rest/v1/all :parse? true}) diff --git a/src/quantum/media/imaging/ocr.cljc b/src/quantum/media/imaging/ocr.cljc deleted file mode 100644 index 109570f1..00000000 --- a/src/quantum/media/imaging/ocr.cljc +++ /dev/null @@ -1,26 +0,0 @@ -(ns quantum.media.imaging.ocr - (:require - [quantum.core.error :as err - :refer [TODO]] - [quantum.core.paths :as path] - [quantum.core.system :as sys ] - [quantum.core.io :as io ] - [quantum.core.process - :refer [proc!]] - [quantum.core.fn - :refer [fn-> fn']] - [quantum.core.logic - :refer [ifn1]] - [quantum.core.collections :as coll - :refer [join map+ filter+ flatten+]])) - -(defn ocr - "Uses the open-source tool `tesseract` to perform OCR on a document. - Refer to the Tesseract GitHub for help and setup. - - To OCR a PDF: - `gs -o -sDEVICE=tiffg4 && tesseract stdout pdf > `" - [in out opts] - (TODO)) - - diff --git a/src/quantum/net/http.cljc b/src/quantum/net/http.cljc index 46befa40..76be5338 100644 --- a/src/quantum/net/http.cljc +++ b/src/quantum/net/http.cljc @@ -31,7 +31,7 @@ "Creates a socket on the first available port, starting at port 49152 (the minimum recommended available port, according to https://en.wikipedia.org/wiki/Ephemeral_port)." [] - (let [; According to https://en.wikipedia.org/wiki/Ephemeral_port + (let [;; According to https://en.wikipedia.org/wiki/Ephemeral_port min-recommended-available-port 49152 max-recommended-available-port 65535] (red-for [port min-recommended-available-port diff --git a/src/quantum/net/server/router.clj b/src/quantum/net/server/router.clj index 66e00477..b462920c 100644 --- a/src/quantum/net/server/router.clj +++ b/src/quantum/net/server/router.clj @@ -52,7 +52,7 @@ (defn resource [root path] (prl! root path) (->> path - (<- str/remove "..") ; to prevent insecure access + (<- (str/remove "..")) ; to prevent insecure access ^String (paths/url-path root) (java.io.FileInputStream.))) diff --git a/src/quantum/net/url.cljc b/src/quantum/net/url.cljc index 025de8e9..3f6e14cd 100644 --- a/src/quantum/net/url.cljc +++ b/src/quantum/net/url.cljc @@ -102,7 +102,7 @@ params))] (->> str-params (#(if decode? (decode :xml %) %)) - (<- str/split #"&") + (<- (str/split #"&")) decode-if-necessary (map+ (fn [param] @@ -114,7 +114,7 @@ [^String embedded-url] (->> embedded-url (decode :xml) - (<- url-params->map true))) + (<- (url-params->map true)))) (defn url->map [url] (let [[url str-params] diff --git a/src/quantum/net/websocket.cljc b/src/quantum/net/websocket.cljc index 011febf1..7981b7cb 100644 --- a/src/quantum/net/websocket.cljc +++ b/src/quantum/net/websocket.cljc @@ -17,7 +17,7 @@ :refer [promise offer! go]] [quantum.core.spec :as s :refer [validate]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]] [quantum.core.resources :as res] #?(:clj [quantum.net.server.router :as router]))) diff --git a/src/quantum/nlp/core.cljc b/src/quantum/nlp/core.cljc index 2d86eff7..19644d74 100644 --- a/src/quantum/nlp/core.cljc +++ b/src/quantum/nlp/core.cljc @@ -57,7 +57,7 @@ :else (.append s c))) #?(:clj (StringBuilder.) :cljs (StringBuffer.))) - (<- coll/padr 3 \0) + (<- (coll/padr 3 \0)) str keyword)) diff --git a/src/quantum/nlp/document.cljc b/src/quantum/nlp/document.cljc index a34353cb..d05b849d 100644 --- a/src/quantum/nlp/document.cljc +++ b/src/quantum/nlp/document.cljc @@ -475,7 +475,7 @@ (delay (->> (http/request! {:url "https://raw.githubusercontent.com/dwyl/english-words/master/words3.txt"}) :body - (<- str/split #"\s") + (<- (str/split #"\s")) (map+ (fn-> str/->lower keyword)) (join #{})))) @@ -490,8 +490,8 @@ post (s/or* nil? fn?)) (->> doc-str ; Normalize - (<- str/replace undesirables-regex " ") ; How to do this distributively? - (<- str/split #" ") ; How to do this distributively? + (<- (str/replace undesirables-regex " ")) ; How to do this distributively? + (<- (str/split #" ")) ; How to do this distributively? (r/remove+ empty?) ((or post identity)) (r/map+ (fn1 str/->lower)) @@ -505,13 +505,13 @@ (fn->> (r/map+ (ifn1 (fn1 containsv? "-") (fn->> (coll/remove-surrounding "-") str - (<- str/split #"\-") - (<- whenf (partial every? (fn1 in? @dictionary)) - (fn [words] - (let [concatted (apply str words)] - (if (in? concatted @dictionary) - concatted - words))))) + (<- (str/split #"\-")) + (<- (whenf (partial every? (fn1 in? @dictionary)) + (fn [words] + (let [concatted (apply str words)] + (if (in? concatted @dictionary) + concatted + words)))))) vector)) r/cat+ (r/remove+ empty?))) diff --git a/src/quantum/numeric/core.cljc b/src/quantum/numeric/core.cljc index 294c2419..a425c2bf 100644 --- a/src/quantum/numeric/core.cljc +++ b/src/quantum/numeric/core.cljc @@ -14,14 +14,14 @@ [quantum.core.error :as err :refer [>ex-info TODO]] [quantum.core.fn - :refer [fn-> <- fn1 fnl fn& fn&2 fn']] + :refer [fn-> fn1 fnl fn& fn&2 fn']] [quantum.core.log :as log] [quantum.core.numeric :as num :refer [abs mod sqrt pow #?(:clj *') +' exactly] #?@(:cljs [:refer-macros [*']])] [quantum.core.reducers :refer [multiplex]] - [quantum.core.type :as t] + [quantum.core.type-old :as t] [quantum.core.vars :refer [defalias]] [quantum.core.macros diff --git a/src/quantum/numeric/functions.cljc b/src/quantum/numeric/functions.cljc index cf22864c..c89fe29a 100644 --- a/src/quantum/numeric/functions.cljc +++ b/src/quantum/numeric/functions.cljc @@ -11,6 +11,7 @@ ; ===== GAMMA ===== ; +;; TODO incorporate https://github.com/thi-ng/math/blob/master/src/gamma.org (defn ^double gamma "Gamma function. The extension of the factorial function to the reals. Breeze: exp(lgamma(a)) diff --git a/src/quantum/numeric/geometry.cljc b/src/quantum/numeric/geometry.cljc index d868e8ff..901b8a43 100644 --- a/src/quantum/numeric/geometry.cljc +++ b/src/quantum/numeric/geometry.cljc @@ -1,11 +1,16 @@ (ns quantum.numeric.geometry + {:todo #{"Incorporate https://github.com/thi-ng/geom/blob/master/geom-core/src/intersect.org" + "Incorporate https://github.com/thi-ng/geom/blob/master/geom-core/src/utils.org" + "Incorporate https://github.com/thi-ng/geom/blob/master/geom-core/src/core.org" + "Incorporate https://github.com/thi-ng/ndarray/blob/master/src/contours.org" + "Incorporate https://github.com/thi-ng/geom/tree/master/geom-types/src" + "Incorporate https://github.com/thi-ng/geom/tree/master/geom-meshops/src"}} (:require [quantum.core.error :as err :refer [TODO]])) (defn smallest-enclosing-ball - "Uses the Emo Welzl algorithm to find the smallest - enclosing ball in linear time." + "Uses the Emo Welzl algorithm to find the smallest enclosing ball in linear time." {:implemented-by '#{org.apache.commons.math3.geometry.enclosing.*}} [pts] (TODO)) diff --git a/src/quantum/numeric/noise.cljc b/src/quantum/numeric/noise.cljc new file mode 100644 index 00000000..83f41cf0 --- /dev/null +++ b/src/quantum/numeric/noise.cljc @@ -0,0 +1,2 @@ +(ns quantum.numeric.noise + {:todo #{"Import https://github.com/thi-ng/math/blob/master/src/noise.org"}}) diff --git a/src/quantum/numeric/statistics/core.cljc b/src/quantum/numeric/statistics/core.cljc index a8640849..8c54c45b 100644 --- a/src/quantum/numeric/statistics/core.cljc +++ b/src/quantum/numeric/statistics/core.cljc @@ -9,11 +9,11 @@ reduce reduce-multi, transduce]] [quantum.core.compare :as comp] [quantum.core.data.map - :refer [!hash-map]] + :refer [!>hash-map]] [quantum.core.data.set - :refer [!hash-set]] + :refer [!>hash-set]] [quantum.core.data.vector - :refer [!vector]] + :refer [!>vector]] [quantum.core.fn :refer [fn1 fn&2 fnl fn-> <-]] [quantum.core.log :as log] @@ -104,7 +104,7 @@ {:attribution "alexandergunnarson"} [xs] ; TODO xs is `reducible?` (->> xs - (frequencies (!hash-map)) + (frequencies (!>hash-map)) (comp/reduce-max-keys-into !vector val) ; TODO this is possible to do this without allocating the intermediate collection (map+ key))) @@ -117,7 +117,7 @@ {:attribution "alexandergunnarson"} [xs] ; TODO xs is `reducible?` (->> xs - (frequencies (!hash-map)) + (frequencies (!>hash-map)) (comp/reduce-max-key val) key)) @@ -143,7 +143,7 @@ (->> xs (map+ (fn-> (- mean') sq)) sum - (<- / (- ct diff)))))) + (<- (/ (- ct diff))))))) (#?(:clj defnt' :cljs defnt) mse:predictor "The mean squared error between a vector of predictions `p•` and observed values `o•`." @@ -177,7 +177,7 @@ #_(map+ = predictions actuals) ; TODO assert same count (filter+ true?) count - (<- / ct))))) + (<- (/ ct)))))) (defn semivariance "Computes the semivariance of a set of values with respect to a given cutoff value." diff --git a/src/quantum/numeric/statistics/distribution.cljc b/src/quantum/numeric/statistics/distribution.cljc index be146224..77bd607f 100644 --- a/src/quantum/numeric/statistics/distribution.cljc +++ b/src/quantum/numeric/statistics/distribution.cljc @@ -1,19 +1,15 @@ (ns quantum.numeric.statistics.distribution (:require - [quantum.core.log :as log - :include-macros true] + [quantum.core.log :as log] [quantum.core.numeric :as cnum - :refer [*+* *-* *** *div* mod - #?@(:clj [abs sqrt pow e-exp floor log-e])] - :refer-macros [ abs sqrt pow e-exp floor log-e]] + :refer [*+* *-* *** *div* mod + abs sqrt pow e-exp floor log-e]] [quantum.core.collections :as coll - :refer [map+]] + :refer [map+]] [quantum.core.fn - :refer [#?@(:clj [<- fn1 fn->])] - :refer-macros [ <- fn1 fn->]] + :refer [fn1 fn->]] [quantum.core.vars - :refer [#?@(:clj [defalias])] - :refer-macros [ defalias]] + :refer [defalias]] [quantum.core.error :refer [>ex-info TODO]])) diff --git a/src/quantum/numeric/subdivision.cljc b/src/quantum/numeric/subdivision.cljc new file mode 100644 index 00000000..8434d1bd --- /dev/null +++ b/src/quantum/numeric/subdivision.cljc @@ -0,0 +1,3 @@ +(ns quantum.numeric.subdivision + "Functionality relating to the subdivision of geometric spaces — lines, planes, and volumes." + {:todo #{"Incorporate https://github.com/thi-ng/geom/blob/master/geom-core/src/subdiv.org"}}) diff --git a/src/quantum/numeric/tensors.cljc b/src/quantum/numeric/tensors.cljc index 04ff3d4d..4b6d310c 100644 --- a/src/quantum/numeric/tensors.cljc +++ b/src/quantum/numeric/tensors.cljc @@ -1,8 +1,24 @@ (ns quantum.numeric.tensors "1D array: vector 2D array: matrix - 3D array: (no special name) - ND array: tensor" + ND array: tensor + + Note: (Java-only) Colt performs atrociously." + {:todo #{"Incorporate https://github.com/thi-ng/geom/blob/master/geom-core/src/vector.org" + "Incorporate https://github.com/thi-ng/geom/blob/master/geom-core/src/matrix.org" + "Incorporate https://github.com/thi-ng/geom/blob/master/geom-core/src/quaternion.org" + "Probably use core.matrix API" + "Incorporate core.matrix" + "EJML if performance on small matrices is more important than features" + "Neanderthal if performance on large (n >= 50) matrices is needed. + Even for very small matrices (except for matrices smaller than 5x5), Neanderthal is + faster than the pure Java library Vectorz. + - http://blog.mikiobraun.de/2009/04/some-benchmark-numbers-for-jblas.html" + "MTJ=" + "spark.mllib -> breeze -> netlib-java -> BLAS/LAPACK + matrix-toolkits-java (MTJ) -> netlib-java -> BLAS/LAPACK" + "Mathematica + - Matrix and data manipulation tools including support for sparse arrays"}} (:refer-clojure :exclude [max count get subvec swap! first last empty contains? for dotimes, reduce]) @@ -23,12 +39,12 @@ ->objects]] [quantum.core.compare :refer [max]] - [quantum.core.convert.primitive - :refer [->int ->long ->double* ->double]] + [quantum.core.data.primitive + :refer [>int >long >double]] [quantum.core.error :as err :refer [>ex-info TODO]] [quantum.core.fn :as fn - :refer [fn1 fn&2 <- fn-> fn->>]] + :refer [fn1 fn&2 fn-> fn->>]] [quantum.core.numeric :as cnum :refer [sqrt]] [quantum.numeric.core :as num @@ -39,28 +55,12 @@ :refer [defalias]] [quantum.core.spec :as s :refer [validate]] - [quantum.core.type :as t]) + [quantum.core.type-old :as t]) #?(:clj (:import [org.apache.spark.mllib.linalg BLAS DenseVector] [uncomplicate.neanderthal.protocols Vector RealVector RealMatrix RealChangeable]))) -; TODO probably use core.matrix API - -; TO EXPLORE -; - core.matrix — incorporate! -; - EJML if performance on small matrices is more important than features -; - Neanderthal if performance on large (n >= 50) matrices is needed -; http://blog.mikiobraun.de/2009/04/some-benchmark-numbers-for-jblas.html -; - (Java-only) Colt performs atrociously -; Even for very small matrices (except for matrices smaller than 5x5), -; Neanderthal is faster than pure Java library Vectorz. -; MTJ=matrix-toolkits-java -; spark.mllib -> breeze -> netlib-java -> BLAS/LAPACK -; MTJ -> netlib-java -> BLAS/LAPACK -; - Mathematica -; - Matrix and data manipulation tools including support for sparse arrays - ; ================================= ; ================= @@ -131,9 +131,9 @@ numpy: a[0,1] R: a[1,2]" {:implemented-by '#{smile.math.matrix.Matrix}} - #?(:clj (^double [^RealVector X ^long a ] (->double (real/entry X a )))) + #?(:clj (^double [^RealVector X ^long a ] (>double (real/entry X a )))) ( [ X a ] (TODO)) - #?(:clj (^double [^RealMatrix X ^long a ^long b] (->double (real/entry X a b)))) + #?(:clj (^double [^RealMatrix X ^long a ^long b] (>double (real/entry X a b)))) ( [ X a b] (TODO))) (defnt set-in!* @@ -167,17 +167,17 @@ ([^long m ^long n ] (nat/dge m n)) ([ x ] (nat/dge x)) ([^array-2d? x] - (let [width (-> x c/first ccoll/count& ->long) ; TODO fix where type hints aren't showing up + (let [width (-> x c/first ccoll/count& >long) ; TODO fix where type hints aren't showing up height (c/count x) ret (->dmatrix width height)] (dotimes [i height j width] - (set-in!* ret (-> x (c/get-in* (int i) (int j)) ->double) i j)) ; TODO figure out why `->int` instead of `int` creates verifyerror + (set-in!* ret (-> x (c/get-in* (int i) (int j)) >double) i j)) ; TODO figure out why `>int` instead of `int` creates verifyerror ret)) ([^vector? x] ; TODO lists/seqs are okay too (if (c/empty? x) (->dmatrix 0 0) (let [_ (validate x (fn-> c/first t/sequential?)) - width (-> x c/first c/count ->long) + width (-> x c/first c/count >long) height (c/count x) ret (->dmatrix width height)] (red-fori [row x @@ -185,7 +185,7 @@ ; All rows must be same width (assert (-> row c/count (= width)) (kw-map row width i)) ; TODO cheap `validate` (red-fori [elem row _ nil j] - (set-in!* ret' (->double elem) i j))) + (set-in!* ret' (>double elem) i j))) ret))))) #_"May take either a boxed or unboxed fn: diff --git a/src/quantum/security/cryptography.cljc b/src/quantum/security/cryptography.cljc index f41595f1..fe99bb4c 100644 --- a/src/quantum/security/cryptography.cljc +++ b/src/quantum/security/cryptography.cljc @@ -33,7 +33,7 @@ [quantum.core.string :as str] [quantum.core.spec :as s :refer [validate]] - [quantum.core.type :as t + [quantum.core.type-old :as t :refer [val?]] [quantum.core.vars :as var :refer [defalias]]) @@ -321,7 +321,7 @@ (or key-length 192)) hashed (->> (SecretKeyFactory/getInstance "PBKDF2WithHmacSHA1") - (<- .generateSecret k) + (<- (.generateSecret k)) (.getEncoded)) salt (conv/->text salt) ;(->> iterations (encode :base64) ->str) @@ -637,4 +637,3 @@ :aes (aes obj :decrypt password opts) :threefish #?(:clj (threefish obj :decrypt opts) :cljs (throw (>ex-info :unsupported "Threefish unsupported as of yet in CLJS."))))) - diff --git a/src/quantum/ui/components.cljc b/src/quantum/ui/components.cljc index d02b81bb..3a62f74c 100644 --- a/src/quantum/ui/components.cljc +++ b/src/quantum/ui/components.cljc @@ -6,25 +6,25 @@ (:refer-clojure :exclude [for reduce]) (:require #?@(:cljs - [[reagent.core :as rx] + [[reagent.core :as rx] [re-frame.core :refer [subscribe dispatch dispatch-sync reg-event reg-sub]]]) - [quantum.ui.revision :as rev] - [quantum.core.fn :as fn - :refer [fn-> fn->> <- fn']] + [quantum.ui.revision :as rev] + [quantum.core.data.primitive :as p] + [quantum.core.fn :as fn + :refer [fn-> fn->> fn']] [quantum.core.logic :refer [whenf]] - [quantum.db.datomic :as db] - [quantum.core.collections :as coll + [quantum.core.refs :as ref] + [quantum.db.datomic :as db] + [quantum.core.collections :as coll :refer [for fori join kw-map reduce map-vals+ ensurec merge-deep]] - [quantum.core.error :as err] - [quantum.core.log :as log] - [quantum.core.system :as sys - :refer [#?@(:cljs [ReactNative])]] - [quantum.core.type :as t - :refer [val?]] - [quantum.core.async :as async + [quantum.core.error :as err] + [quantum.core.log :as log] + [quantum.core.system :as sys + :refer [#?@(:cljs [react-native])]] + [quantum.core.async :as async :refer [go]] [quantum.ui.style.core :refer [layout-x layout-y layout layout-perp @@ -69,27 +69,27 @@ (defn alert [title] (if (= sys/os "web") (go (js/alert title)) ; even this totally stops everything - (.alert (.-Alert ReactNative) title)))) + (.alert (.-Alert react-native) title)))) #?(:cljs (defn rx-adapt [super sub] (when super - (whenf (aget super sub) val? rx/adapt-react-class)))) + (whenf (aget super sub) p/val? rx/adapt-react-class)))) -#?(:cljs (def text (rx-adapt ReactNative "Text" ))) -#?(:cljs (def view (rx-adapt ReactNative "View" ))) -#?(:cljs (def image (rx-adapt ReactNative "Image"))) +#?(:cljs (def text (rx-adapt react-native "Text" ))) +#?(:cljs (def view (rx-adapt react-native "View" ))) +#?(:cljs (def image (rx-adapt react-native "Image"))) ; var CacheImage = require('@remobile/react-native-cache-image'); doesn't work on web ; better to have something else -#?(:cljs (def touchable-highlight (rx-adapt ReactNative "TouchableHighlight"))) +#?(:cljs (def touchable-highlight (rx-adapt react-native "TouchableHighlight"))) #?(:cljs (def accordion (when-not (= sys/os "web") (err/ignore (rx/adapt-react-class (js/require "react-native-accordion")))))) -#?(:cljs (def text-input (rx-adapt ReactNative "TextInput"))) +#?(:cljs (def text-input (rx-adapt react-native "TextInput"))) #?(:cljs (def modal (when-not (= sys/os "web") - (rx-adapt ReactNative "Modal")))) -#?(:cljs (def scroll-view (rx-adapt ReactNative "ScrollView"))) -#?(:cljs (def list-view (rx-adapt ReactNative "ListView" ))) + (rx-adapt react-native "Modal")))) +#?(:cljs (def scroll-view (rx-adapt react-native "ScrollView"))) +#?(:cljs (def list-view (rx-adapt react-native "ListView" ))) #?(:cljs (def video (if (= sys/os "web") :video ; https://github.com/react-native-community/react-native-video @@ -113,7 +113,7 @@ #?(:cljs (def audio (when (= sys/os "web") :audio))) -#?(:cljs (def list-view-data-source (err/ignore (-> ReactNative .-ListView .-DataSource)))) +#?(:cljs (def list-view-data-source (err/ignore (-> react-native .-ListView .-DataSource)))) ; https://github.com/react-native-community/react-native-blur #?(:cljs (def Blur (when-not (= sys/os "web") @@ -524,21 +524,21 @@ handle-touch-start (fn [e] (println "TOUCH START") - (when (and (atom? scroller) (:touchable? props)) + (when (and (ref/atom? scroller) (:touchable? props)) (println "SCROLLING IN TOUCH START") (-> scroller deref (.doTouchStart (.-touches e) (.-timeStamp e))) (.preventDefault e))) handle-touch-move (fn [e] (println "TOUCH MOVE") - (when (and (atom? scroller) (:touchable? props)) + (when (and (ref/atom? scroller) (:touchable? props)) (println "SCROLLING IN TOUCH MOVE") (-> scroller deref (.doTouchMove (.-touches e) (.-timeStamp e) (.-scale e))) (.preventDefault e))) handle-touch-end (fn [e] (println "TOUCH END") - (when (and (atom? scroller) (:touchable? props)) + (when (and (ref/atom? scroller) (:touchable? props)) (println "SCROLLING IN TOUCH END") #_(-> scroller deref (.doTouchEnd (.-timeStamp e))) ; Without this the scroller was reset to top:0 left: 0 on touchEnd. @@ -561,8 +561,8 @@ (defn touch-wrapper [[child-tag {:keys [table-width table-height] :as child-props} & child-elems] ] - (assert (atom? table-width )) - (assert (atom? table-height)) + (assert (ref/atom? table-width )) + (assert (ref/atom? table-height)) (let [scroller (rx/atom nil) left (rx/atom 0) top (rx/atom 0) @@ -622,8 +622,8 @@ (defn fb-table-example [{:keys [data headers headers-widths style width height cell-props-fn fixed-header-key]}] - (assert (val? width )) - (assert (val? height)) + (assert (p/val? width )) + (assert (p/val? height)) (let [std-col-width (/ @width (count @headers)) col-indices (reaction (->> @headers ; TODO code pattern (map-indexed (fn [i x] [x i])) @@ -707,9 +707,9 @@ :or {row-height-getter (fn [] row-height) scrolling-deceleration 0.97 scrolling-acceleration 0.13}}] - (assert (atom? data )) - (assert (val? width )) - (assert (val? height)) + (assert (ref/atom? data )) + (assert (p/val? width )) + (assert (p/val? height)) (assert (fn? row-render-fn)) (let [] (fn [] @@ -771,9 +771,9 @@ (defn ellipsis [{:keys [clamp-lines font-size line-height width] :as style} content] - (assert (val? clamp-lines)) - (assert (val? font-size )) - (assert (val? width )) + (assert (p/val? clamp-lines)) + (assert (p/val? font-size )) + (assert (p/val? width )) (fn [] [:div.ellipsis {:style (merge (style/ellipsis clamp-lines font-size line-height) (dissoc style diff --git a/src/quantum/ui/features.cljc b/src/quantum/ui/features.cljc index 4a2f2435..9dbde635 100644 --- a/src/quantum/ui/features.cljc +++ b/src/quantum/ui/features.cljc @@ -2,12 +2,20 @@ :todo ["Possibly rename 'quantum.ui.platform'?"]} quantum.ui.features (:require - [quantum.core.vars + [quantum.core.vars :as var :refer [defaliases]] [quantum.untyped.ui.features :as u])) #?(:cljs (defaliases u flex-test feature-test)) +#?(:cljs +(var/def mobile-user-agent? + "From https://github.com/thi-ng/domus/blob/master/src/detect.org" + (and (re-find #"(?i)mobile|tablet|ip(ad|hone|od)|android|silk" (.-userAgent js/navigator)) + (not (re-find #"(?i)crios" (.-userAgent js/navigator)))))) + +#?(:cljs (def websocket-enabled? (some? (aget js/window "WebSocket")))) + #?(:cljs (def touch-events (delay (let [events (cond diff --git a/src/quantum/ui/navigation.cljc b/src/quantum/ui/navigation.cljc new file mode 100644 index 00000000..6db7d3e9 --- /dev/null +++ b/src/quantum/ui/navigation.cljc @@ -0,0 +1,5 @@ +(ns quantum.ui.navigation + "Implements, for instance, HTML5 history / navigation / page routing. + + TODO incorporate: + - https://github.com/thi-ng/domus/blob/master/src/router.org") diff --git a/src/quantum/ui/style/color.cljc b/src/quantum/ui/style/color.cljc index f214ebcc..69f4c3ae 100644 --- a/src/quantum/ui/style/color.cljc +++ b/src/quantum/ui/style/color.cljc @@ -1,13 +1,10 @@ (ns quantum.ui.style.color - (:require [clojure.string :as str] - [garden.color :as color - :refer [color? #?(:cljs CSSColor)]] - [quantum.core.vars :as var - :refer [#?(:clj defalias)] ]) - #?(:cljs (:require-macros - [quantum.core.vars :as var - :refer [defalias] ])) - #?(:clj (:import garden.color.CSSColor))) + "TODO import: + - https://github.com/thi-ng/color" + (:require + [quantum.core.vars :as var + :refer [defaliases]] + [quantum.ui.untyped.style.color :as u])) ;(defnt ->color* ; ([^garden.color.CSSColor c] @@ -164,24 +161,7 @@ :yellow-green "#9acd32"} (map (fn [[k v]] [k (color/as-rgb v)])) (into {})))) - -(defn color [k] (get @colors k)) - -(defn css-color? [obj] (instance? CSSColor obj)) - -(defn ->rgba [c] - (-> c color/as-rgb (assoc :alpha (:alpha c)))) -(defn ->hsla [c] - (-> c color/as-hsl (assoc :alpha (:alpha c)))) - -(defn render-color [c] ; ->str - (if (:alpha c) - (let [{:keys [red green blue alpha]} (->rgba c)] - (str "rgba(" (str/join "," [red green blue (or alpha 1)]) ")")) - (color/as-hex c))) - -(defalias darken color/darken) -(defalias lighten color/lighten) +(defn color [k] (get @colors k)) -(defn ->hex [c] (-> c ->hsla color/as-hex)) \ No newline at end of file +(defaliases u css-color? >rgba >hsla >hex render-color darken lighten ) diff --git a/src/quantum/ui/style/css/core.cljc b/src/quantum/ui/style/css/core.cljc index 07334b2c..e07c557e 100644 --- a/src/quantum/ui/style/css/core.cljc +++ b/src/quantum/ui/style/css/core.cljc @@ -104,7 +104,7 @@ {:in "{:width 2 :font-size [[\"16px\" \"1px\"] [\"17px\"]]}" :out "width:2;font-size:16px 1px,17px" } [css-block] - (if (or (derefable? css-block) + (if (or (ref/derefable? css-block) (and (string? css-block) (str/starts-with? css-block "calc"))) css-block @@ -263,7 +263,7 @@ (normalize-prop-v sub-prop-k-f) css-prop-str))))) redm) - (fn->> (<- normalize-prop-v prop-k) + (fn->> (<- (normalize-prop-v prop-k)) css-prop-str (map-entry prop-k)))] (merge ret normalized-props))) @@ -330,7 +330,7 @@ {:attribution "alexandergunnarson"} [] (->> @styles-template - (<- get :+media) + (<- (get :+media)) (apply css-style/at-media) css-block-str gstyle/installStyles)) diff --git a/src/quantum/ui/style/css/untitled b/src/quantum/ui/style/css/untitled deleted file mode 100644 index 85fafe9a..00000000 --- a/src/quantum/ui/style/css/untitled +++ /dev/null @@ -1,123 +0,0 @@ -https://github.com/clojure/clojure/blob/f572a60262852af68cdb561784a517143a5847cf/src/clj/clojure/core/specs.clj - - - - -(let [ignore? (fn-or fn? t/protocol? t/multimethod? t/unbound? t/namespace? t/thread?)] - (->> (all-ns) - (map+ ns-interns) - (join {}) - (map+ val) - (remove+ #{#'clojure.core/*1 - #'clojure.core/*2 - #'clojure.core/*3 - #'clojure.core/*data-readers* - #'clojure.core/default-data-readers - #'clojure.tools.reader/default-data-readers - #'clojure.core.async.impl.timers/timeouts-queue - #'clojure.tools.analyzer.jvm/default-passes - #'aleph.http/default-connection-pool - #'aleph.http/default-response-executor - #'clojure.core.async.impl.ioc-macros/passes - #'byte-streams/inverse-conversions - #'byte-streams/conversions}) - (remove+ (rcomp deref (fn-or ignore? (fn-and var? (fn-> deref ignore?))))) - (map+ (juxt identity (fn-> deref quantum.core.meta.bench/shallow-byte-size))) - (join {}) - (map+ val) - (reduce +) - (#(quantum.measure.convert/convert % :bytes :MB)) - double)) - -(def-map 1) - -; -> 18.21 MB... there must be lots of data not referenced by vars - -; TODO log these stats when every namespace is compiled -(->> (java.lang.management.ManagementFactory/getMemoryPoolMXBeans) - (mapv (juxt #(.getName %) #(.getType %) #(.getUsage %)))) - - {:code-cache 25.52099609375, - :metaspace 203.1375122070312, (some of this is definitely garbage collected) - :compressed-class-space 69.5936279296875} - - -TODO make sure to set a global onerror handler for PhantomJS (via a flag of course) - -TODO decrease memory footprint? (it's huge!) -TODO allow return types for `defnt` like `sequential?` -TODO also allow return types like :whatever/validator - -TODO longs vs. long-array - -; TODO fn (params-match? ->double 1) -> true; (params-match? ->double "asd") -> false -; TODO do fast-as-possible ops given math expr -; (* a (- b c) v) -> (scale (* a (- b c)) v) - -; TODO: - -(fnt [^indexed? x a] - (conj' x a)) ; and have it know what function needs to be looked up - -(:abcde my-validated-map) ; and know what its type will be - - - - -(defn dropr-digit - ([n] (quot n 10)) - ([digits n] - (if (<= digits 0) - n - (recur (dec digits) (dropr-digit n))))) - -(defn count-digits-integral - "Counts the digits of a number `n` not having a decimal portion." - ([n] (count-digits-integral (dropr-digit n) 1)) - ([n d] (if (zero? n) - d - (recur (dropr-digit n) (inc d))))) - -(defn ->integral [n] (- n (->decimal n))) - -(defn ->decimal [n] (rem n 1)) - -(defn pow-10 [n] (long (Math/pow 10 (int n)))) - -(defn decimal->integer-like-decimal - "E.g. 0.003812317M -> 1003812317N - `n` must be 0 ≤ n < 1 - Returns a `bigint`." - [n] - (if (zero? n) - 0 - (bigint (str "1" (subs (str (.stripTrailingZeros (bigdec n))) 2))))) - -(defn integer-like-decimal->decimal - "E.g. 1003812317N -> 0.003812317M - `n` must be an integer. - Returns a `bigdec`." - [n] - (bigdec (str "0." (subs (str n) 1)))) - -(->decimal 1/4) - - -(defn num-decimal-places [n] - (-> n ->decimal bigdec (.stripTrailingZeros) (.scale) (max 0))) - -(defn truncate-digits - "Truncates an integer `n` the specified number of `digits`, replacing - the truncated portion with 0s." - [digits n] - (if (<= digits 0) - n - (* (dropr-digit digits n) - (pow-10 digits)))) - -(defn exact [n] - (if (or (double? n) - (float? n) - (decimal? n)) - (rationalize n) - n)) diff --git a/src/quantum/ui/view.cljc b/src/quantum/ui/view.cljc index 283ef5b5..9afd33d9 100644 --- a/src/quantum/ui/view.cljc +++ b/src/quantum/ui/view.cljc @@ -1,35 +1,41 @@ -(ns quantum.ui.view) +(ns quantum.ui.view + (:require + [quantum.core.vars + :refer [def-]])) + +#?(:cljs +(defn full-screen? [] + (or (.-fullscreenElement js/document) + (.-mozFullScreenElement js/document) + (.-webkitFullscreenElement js/document) + (.-msFullscreenElement js/document)))) + +#?(:cljs +(def- *enable-full-screen! + (delay + (let [de (.-documentElement js/document)] + (or (.-requestFullscreen de) + (.-msRequestFullscreen de) + (.-mozRequestFullscreen de) + (.-webkitRequestFullscreen de)))))) + +#?(:cljs +(defn enable-full-screen! [] (@*enable-full-screen!))) + +#?(:cljs +(def- *disable-full-screen! + (delay + (or (.-exitFullscreen js/document) + (.-msExitFullscreen js/document) + (.-mozCancelFullScreen js/document) + (.-webkitExitFullscreen js/document))))) + +#?(:cljs (defn disable-full-screen! [] (@*disable-full-screen!))) #?(:cljs (defn toggle-full-screen! - {:from "https://developer.mozilla.org/en-US/docs/Web/API/Fullscreen_API" - :todo ["More elegant way to do this"]} + {:adapted-from "https://developer.mozilla.org/en-US/docs/Web/API/Fullscreen_API"} [] - (if (and (not (.-fullscreenElement js/document)) - (not (.-mozFullScreenElement js/document)) - (not (.-webkitFullscreenElement js/document)) - (not (.-msFullscreenElement js/document))) - (cond - (-> js/document .-documentElement .-requestFullscreen) - (-> js/document .-documentElement .requestFullscreen ) - - (-> js/document .-documentElement .-msRequestFullscreen) - (-> js/document .-documentElement .msRequestFullscreen ) - - (-> js/document .-documentElement .-mozRequestFullscreen) - (-> js/document .-documentElement .mozRequestFullscreen ) - - (-> js/document .-documentElement .-webkitRequestFullscreen) - (-> js/document .-documentElement (.webkitRequestFullscreen js/Element.ALLOW_KEYBOARD_INPUT))) - (cond - (-> js/document (.-exitFullscreen)) - (-> js/document (.-exitFullscreen)) - - (-> js/document (.-msExitFullscreen)) - (-> js/document (.-msExitFullscreen)) - - (-> js/document (.-mozCancelFullScreen)) - (-> js/document (.-mozCancelFullScreen)) - - (-> js/document (.-webkitExitFullscreen)) - (-> js/document (.-webkitExitFullscreen)))))) \ No newline at end of file + (if (full-screen?) + (disable-full-screen!) + (enable-full-screen!)))) diff --git a/src/quantum/ui/plots.cljc b/src/quantum/ui/visualization.cljc similarity index 93% rename from src/quantum/ui/plots.cljc rename to src/quantum/ui/visualization.cljc index c1627125..dd427211 100644 --- a/src/quantum/ui/plots.cljc +++ b/src/quantum/ui/visualization.cljc @@ -1,7 +1,9 @@ -(ns quantum.ui.plots) +(ns quantum.ui.visualization) ; TO EXPLORE +; https://github.com/thi-ng/geom/blob/master/geom-viz/src/core.org + ; Mathematica ; - 2D and 3D data, function and geo visualization and animation tools diff --git a/src/quantum/validate/specs.cljc b/src/quantum/validate/specs.cljc index be8f856d..6ecb36de 100644 --- a/src/quantum/validate/specs.cljc +++ b/src/quantum/validate/specs.cljc @@ -15,7 +15,6 @@ :refer [declare-spec]] [quantum.core.spec :as s] [quantum.db.datomic :as db] - [quantum.core.convert.primitive :as pconv] [quantum.core.numeric :as num :refer [percent?]])) diff --git a/subprojects/quantum-java/pom.xml.asc b/subprojects/quantum-java/pom.xml.asc deleted file mode 100644 index a1058823..00000000 --- a/subprojects/quantum-java/pom.xml.asc +++ /dev/null @@ -1,16 +0,0 @@ ------BEGIN PGP SIGNATURE----- - -iQIcBAABCAAGBQJXV4koAAoJEGXow+9wO0KxKH0P/38T/iMpVkKqtL9CSH887Kv+ -D1cVRix67EzAvVlPB0dMhoawcnKPz5LdubMBxmRzjpSXI4wGRs8J4gSJgNPvvMJy -yjb/GZ3QbEd9rEU15z0jK/zORiujunnA6CtFIuxyAXr1eOTOwFrYILWsWXM7DjS8 -caTAa9jroLMUWjjLO7wbi+BNATsVziyYmMupODRnrMxIwkWrtBgfZpGrPRPwkgrc -ZsmkJfkFMjq1wX58vR3w2ejDHjyz6Uy3UzFXG/upUwadaEvpomZ8IVqUtJCb+JnQ -bKQjepxMMW2fw3+ugppCq+RQ6mQrCvck2K3JkK29bBLMtKAetFoa3x89cZzQBC6R -0cWF8ep4DjOS25fsnt8oPSIcoK9/v2kWBVk054VHTxhMm06yTBT0Y7EAcQRFM/Yz -2YZMkSA7JiWp2YqPyP3xN/VATwlO1olcbTP+nXUnxdgkVHwUTWvOR77bvohFGDF0 -3Ldns3jD4tZgoKNO0+goIECpOPBWhP8lVOjnVLyxudhttP0L4o4Ixr/6/0TY6OL7 -JacLAV6+G8aXkKmp1Y8MFGGCGVIOzIEhXa2vCsjVrUjg/oD/UEnHIAA91/Nb77aD -TstpuieCVWR+KpZy7yC0NJV6LfNUY0a8aplmhzO5y0+i8db7BTOSvwr5+JQ2rnqL -n/REWoCASvxL4BpuiYIv -=UZWJ ------END PGP SIGNATURE----- diff --git a/subprojects/quantum-java/project.clj b/subprojects/quantum-java/project.clj deleted file mode 100644 index 43702ca4..00000000 --- a/subprojects/quantum-java/project.clj +++ /dev/null @@ -1,17 +0,0 @@ -(defproject quantum/java "1.8.2" - :description "Some quanta of computational abstraction, assembled." - :jvm-opts [] - ;:uberjar {:aot :all} - :jar-name "quantum-java-dep.jar" - :uberjar-name "quantum-java.jar" - :url "https://www.github.com/alexandergunnarson/quantum-java" - :license {:name "Creative Commons Attribution-ShareAlike 3.0 US (CC-SA) license" - :url "https://creativecommons.org/licenses/by-sa/3.0/us/"} - ; :signing {:gpg-key "72F3C25A"} - ;:deploy-repositories [["releases" :clojars] - ; ["clojars" {:creds :gpg}]] - :dependencies [[org.clojure/clojure "1.8.0"]] - :aliases {"deploy-dev" ["do" "clean," "install"] - "deploy-prod" ["do" "clean," "install," "deploy" "clojars"]} - :source-paths ["src/cljc"] - :java-source-paths ["src/java"]) diff --git a/test-dev/cljc/quantum/test/ir/classify.cljc b/test-dev/cljc/quantum/test/ir/classify.cljc index fb7bc0f1..27f9ab73 100644 --- a/test-dev/cljc/quantum/test/ir/classify.cljc +++ b/test-dev/cljc/quantum/test/ir/classify.cljc @@ -10,7 +10,7 @@ [quantum.core.numeric :as num] [quantum.numeric.vectors :as v] [quantum.core.fn :as fn - :refer [<- fn-> fn->>]] + :refer [fn-> fn->>]] [quantum.core.cache :refer [#?(:clj defmemoized)] #?@(:cljs [:refer-macros [defmemoized]])] @@ -21,10 +21,10 @@ #?@(:clj [:refer-macros [condpc]])] [quantum.numeric.core :refer [∏ ∑ sum]] - [quantum.ir.classify :as this] - [quantum.core.log :as log]) + [quantum.ir.classify :as self] + [quantum.core.log :as log]) #?(:cljs (:require-macros - [quantum.core.log :as log]))) + [quantum.core.log :as log]))) (log/enable! :test) (log/pr :test "===== TESTING ======") @@ -42,12 +42,12 @@ test-doc ["Taiwan" "Taiwan" "Sapporo"] d' test-doc] (log/ppr :test "MULTINOMIAL IS" - [(->> (this/classifier-score+ D :multinomial d') + [(->> (self/classifier-score+ D :multinomial d') (join []) (sort-by second)) - (this/multinomial-naive-bayes-classifier D d')]) + (self/multinomial-naive-bayes-classifier D d')]) (log/ppr :test "MULTIPLE BERNOULLI IS" - [(->> (this/classifier-score+ D :bernoulli d') + [(->> (self/classifier-score+ D :bernoulli d') (join []) (sort-by second)) - (this/multiple-bernoulli-naive-bayes-classifier D d')])) + (self/multiple-bernoulli-naive-bayes-classifier D d')])) (log/pr :test "===== END TESTING ======") diff --git a/test-dev/incremental.clj b/test-dev/incremental.clj index e3135879..ce0e1d08 100644 --- a/test-dev/incremental.clj +++ b/test-dev/incremental.clj @@ -8,7 +8,7 @@ ; (require '[quantum.core.error]) ; (require '[quantum.core.function]) ; (require '[quantum.core.logic]) -; (require '[quantum.core.type]) +; (require '[quantum.core.type-old]) ; (require '[quantum.core.numeric]) ; (require '[quantum.core.data.vector]) ; (require '[quantum.core.macros]) @@ -51,4 +51,4 @@ ; (require '[quantum.google.core]) ; (require '[quantum.google.drive.auth]) ; ; 3RD TIER -; (require '[quantum.google.drive.core]) \ No newline at end of file +; (require '[quantum.google.drive.core]) diff --git a/test-dev/resources/quantum/compile/in-js.clj b/test-dev/resources/quantum/compile/in-js.clj index f99d3a78..d1027a98 100644 --- a/test-dev/resources/quantum/compile/in-js.clj +++ b/test-dev/resources/quantum/compile/in-js.clj @@ -42,12 +42,12 @@ (->> @arities-for-type# (filter (fn-> val (= :variadic))) first - (<- whenf nnil? key)) + (<- (whenf nnil? key))) curr-variadic-arity# (->> @genned-arities# (filter (fn-> val keys first (= :variadic))) first - (<- whenf nnil? key))] + (<- (whenf nnil? key)))] (when (contains? @arities-for-type# arity-n#) (throw+ {:msg (str "Cannot define more than one version of the same arity " "(" arity-n# ")" @@ -175,7 +175,7 @@ (apply merge {}) register-ns oeval - ;(<- str "\n") + ;(<- (str "\n")) ))) (defn array? [obj] (= obj/constructor Array)) diff --git a/test-dev/resources/quantum/compile/in.cljs b/test-dev/resources/quantum/compile/in.cljs index 821fb766..64c6eafe 100644 --- a/test-dev/resources/quantum/compile/in.cljs +++ b/test-dev/resources/quantum/compile/in.cljs @@ -42,12 +42,12 @@ (->> @arities-for-type# (filter (fn-> val (= :variadic))) first - (<- whenf nnil? key)) + (<- (whenf nnil? key))) curr-variadic-arity# (->> @genned-arities# (filter (fn-> val keys first (= :variadic))) first - (<- whenf nnil? key))] + (<- (whenf nnil? key)))] (when (contains? @arities-for-type# arity-n#) (throw+ {:msg (str "Cannot define more than one version of the same arity " "(" arity-n# ")" @@ -175,7 +175,7 @@ (apply merge {}) register-ns oeval - ;(<- str "\n") + ;(<- (str "\n")) ))) (defn array? [obj] (= obj/constructor Array)) diff --git a/test/quantum/test.cljc b/test/quantum/test.cljc index 77c68961..9556db96 100644 --- a/test/quantum/test.cljc +++ b/test/quantum/test.cljc @@ -91,7 +91,6 @@ [quantum.test.core.numeric.predicates] [quantum.test.core.numeric.trig] [quantum.test.core.numeric.truncate] - [quantum.test.core.numeric.types] [quantum.test.core.paths] [quantum.test.core.print] [quantum.test.core.process] diff --git a/test/quantum/test/core/collections.cljc b/test/quantum/test/core/collections.cljc index 49b2b5ef..5a219695 100644 --- a/test/quantum/test/core/collections.cljc +++ b/test/quantum/test/core/collections.cljc @@ -12,7 +12,7 @@ :refer [fn-or fn-and whenf1]] [quantum.core.refs :refer [!ref]] - [quantum.core.type :as t] + [quantum.core.type-old :as t] [quantum.core.meta.profile :refer [p profile]])) @@ -185,10 +185,6 @@ :p 8}}} :q 9}}})))))) -; _______________________________________________________________ -; ======================== COMBINATIVE ========================== -; ••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• -(defn test:sorted-map-by-val [m-0]) ; _______________________________________________________________ ; ========================== SOCIATIVE ========================== ; ••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• diff --git a/test/quantum/test/core/compare.cljc b/test/quantum/test/core/compare.cljc index cc6e70d0..76a5b42f 100644 --- a/test/quantum/test/core/compare.cljc +++ b/test/quantum/test/core/compare.cljc @@ -4,74 +4,6 @@ [quantum.core.test :refer [deftest is testing]])) -(defn test:= - ([x]) - ([x y]) - ([x y & more])) - -(defn test:not= - ([x]) - ([x y]) - ([x y & more])) - -(defn test:< - ([x]) - ([x y]) - ([x y & more])) - -(defn test:<= - ([x] ) - ([x y]) - ([x y & more])) - -(defn test:> - ([x]) - ([x y]) - ([x y & more])) - -(defn test:>= - ([x]) - ([x y]) - ([x y & more])) - -(defn test:max - ([x]) - ([x y]) - ([x y & more])) - -(defn test:min - ([x]) - ([x y]) - ([x y & more])) - -(defn test:min-key - ([k x]) - ([k x y]) - ([k x y & more])) - -(defn test:max-key - ([k x]) - ([k x y]) - ([k x y & more])) - -(defn test:rcompare [x y]) -(defn test:least [coll & [?comparator]]) -(defn test:greatest [coll & [?comparator]]) -(defn test:least-or [a b else]) -(defn test:greatest-or [a b else]) - -(defn test:compare-bytes-lexicographically - [a b]) - -(defn test:extreme-comparator [comparator-n]) - -; ===== APPROXIMATION ===== ; - -(defn test:approx= - [x y eps]) - -(defn test:within-tolerance? [n total tolerance]) - (deftest test:comp-keys-into (is (= [0] (apply ns/comp-keys-into vector #(ns/< %1 %2) identity [0 2 3 4 4 3]))) (is (= [4 4] (apply ns/comp-keys-into vector #(ns/> %1 %2) identity [0 2 3 4 4 3]))) diff --git a/test/quantum/test/core/convert/primitive.cljc b/test/quantum/test/core/convert/primitive.cljc deleted file mode 100644 index 87d18c40..00000000 --- a/test/quantum/test/core/convert/primitive.cljc +++ /dev/null @@ -1,54 +0,0 @@ -(ns quantum.test.core.convert.primitive - (:require [quantum.core.convert.primitive :as ns])) - -;_____________________________________________________________________ -;==================={ LONG }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -(defn test:->long* [x]) -;_____________________________________________________________________ -;==================={ BOOLEAN }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -(defn test:->boolean [x]) -;_____________________________________________________________________ -;==================={ BYTE }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -(defn test:->byte [x]) -(defn test:->byte* [x]) -;_____________________________________________________________________ -;==================={ CHAR }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -(defn test:->char [x]) -(defn test:->char* [x]) -;_____________________________________________________________________ -;==================={ SHORT }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -(defn test:->short [x]) -(defn test:->short* [x]) -;_____________________________________________________________________ -;==================={ INT }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -(defn test:->int [x]) -(defn test:->int* [x]) -;_____________________________________________________________________ -;==================={ FLOAT }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -(defn test:->float [x]) -(defn test:->float* [x]) -;_____________________________________________________________________ -;==================={ DOUBLE }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -(defn test:->double [x]) -(defn test:->double* [x]) - -(defn test:->boxed [x]) - -(defn test:->unboxed [x]) -;_____________________________________________________________________ -;==================={ UNSIGNED }====================== -;°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° -(defn test:->unsigned [x]) - -(defn test:ubyte->byte [x]) -(defn test:ushort->short [x]) -(defn test:uint->int [x]) -(defn test:ulong->long [x]) \ No newline at end of file diff --git a/test/quantum/test/core/core.cljc b/test/quantum/test/core/core.cljc deleted file mode 100644 index 1b9a7893..00000000 --- a/test/quantum/test/core/core.cljc +++ /dev/null @@ -1,36 +0,0 @@ -(ns quantum.test.core.core - (:require [quantum.core.core :as ns])) - -; ===== TYPE PREDICATES ===== - -(defn test:atom? [x]) - -(defn test:boolean? [x]) - -(defn test:seqable? [x]) - -(defn test:editable? [coll]) - -; ===== REFS AND ATOMS ===== - -(defn test:?deref [a]) - -(defn test:lens [x getter]) - -(defn test:cursor - [x getter & [setter]]) - -(defn test:seq= [a b]) - -; ===== TYPE ===== - -(defn test:unchecked-inc-long [x]) - -(defn test:with - [expr & body]) - -(defn test:name+ [x]) - -(defn test:ensure-println [& args]) - -(defn test:js-println [& args]) diff --git a/test/quantum/test/core/defnt.cljc b/test/quantum/test/core/defnt.cljc index 04ffe390..8cf85ba3 100644 --- a/test/quantum/test/core/defnt.cljc +++ b/test/quantum/test/core/defnt.cljc @@ -1,721 +1,76 @@ (ns quantum.test.core.defnt (:require - [clojure.core :as core] - [quantum.core.core - :refer [istr]] + [clojure.core :as core] + [criterium.core :as bench] [quantum.core.fn :as fn :refer [fn->]] [quantum.core.logic :refer [fn-and]] - [quantum.core.defnt :as this + [quantum.core.defnt :as self :refer [!ref analyze defnt]] - [quantum.core.macros.core - :refer [$]] - [quantum.core.macros.type-hint :as th - :refer [tag]] - [quantum.core.spec :as s] - [quantum.core.test :as test - :refer [deftest testing is is= throws]] - [quantum.core.type.defs :as tdef] + [quantum.core.macros.type-hint :as th] + [quantum.core.type.defs :as tdef] [quantum.untyped.core.analyze.ast :as ast] [quantum.untyped.core.analyze.expr :as xp] - [quantum.untyped.core.core - :refer [code=]] - [quantum.untyped.core.type :as t]) + [quantum.untyped.core.form + :refer [$ code=]] + [quantum.untyped.core.form.type-hint + :refer [tag]] + [quantum.untyped.core.spec :as s] + [quantum.untyped.core.string + :refer [istr]] + [quantum.untyped.core.test :as test + :refer [deftest testing is is= throws]] + [quantum.untyped.core.type :as t]) #?(:clj (:import [clojure.lang Keyword Symbol] [quantum.core Numeric]))) -;; # args | ret | ? arg specs (delimited by `,`) -;; abstract > concrete > concrete -#?(:clj (def t0> java.io.OutputStream)) -#?(:clj (def t0 java.io.FilterOutputStream)) -#?(:clj (def t0< java.io.PrintStream)) -;; Object > interface > concrete final -#?(:clj (def t1> java.lang.Object)) -#?(:clj (def t1 java.lang.CharSequence)) -#?(:clj (def t1< java.lang.String)) -;; Object > abstract > concrete final dual as primitive -#?(:clj (def t2> java.lang.Object)) -#?(:clj (def t2 java.lang.Number)) -#?(:clj (def t2< java.lang.Long)) -#?(:clj (def t2

tag th/class->str) - -;; arity 0 -(def defnt|code|0 - `(defnt ~'abc [])) - -;; arity 1: empty input, nil return -(def defnt|code|1|empty - `(defnt ~'abc [~'a ~'_])) - -;; arity 1: nil return -(def defnt|code|1|nil - `(defnt ~'abc [~'a t0])) - -;; arity 1 -(def defnt|code|1 - `(defnt ~'abc [~'a t0] ~'a)) - -;; arity 2 -(def defnt|code|2 - `(defnt ~'abc [~'a t0 ~'b t0] ~'a)) - -;; dispatch classes =; arity 1; arg 0 -> error: ambiguous dispatch -(def defnt|code|class|=|1|0 - `(defnt ~'abc - ([~'a t0] ~'a) - ([~'b t0] ~'b))) - -;; dispatch classes !=; arity 1; arg 0 -(def defnt|code|class|!=|1|0 - `(defnt ~'abc - ([~'a t0 ] ~'a) - ([~'b t2; arity 2; arg 0 -(def defnt|code|class|>|2|0 - `(defnt ~'abc - ([~'a t0 ~'b t0] ~'a) - ([~'c t0> ~'d t0] ~'c))) - -;; next dispatch class <; arity 2; arg 0 -;; -> error: specs in the same arity and position must be ordered in monotonically -;; increasing order in terms of `t/compare` -(def defnt|code|class|<|2|0 - `(defnt ~'abc - ([~'a t0 ~'b t0] ~'a) - ([~'c t0< ~'d t0] ~'c))) - -;; dispatch differs by spec <, not class; arity 1; arg 0 -(def defnt|code|spec|<|1|0 - `(defnt ~'abc - ([~'a t0] ~'a) - ([~'b (t/and t0 (fn-> count (= 1)))] ~'b))) - -;; dispatch differs by spec <, not class; arity 2; arg 0 -(def defnt|code|spec|<|2|0 - `(defnt ~'abc - ([~'a t0 - ~'b t0] ~'a) - ([~'c (t/and t0 (fn-> count (= 1))) - ~'d t0] ~'c))) - -;; arity 2; -> error: ambiguous dispatch -(def defnt|code|... - `(defnt ~'abc - ([~'a t0 ~'b t0] ~'a) - ([~'c t0 ~'d t0] ~'c))) - -;; concrete and primitive mix -(def defnt|code|concrete+primitive - `(defnt ~'abc - ([~'a t0 ~'b t0 ] ~'a) - ([~'c t2

overloads [code lang] - (->> (s/validate (rest code) ::this/defnt) - :overloads - (mapv #(this/fnt|overload-data>overload % {:lang lang})))) - -(def defnt|code>overloads|ret|1 - [{:arg-classes [t0] - :arg-specs [(t/isa? t0)] - :arglist-code|fn|hinted [(tag (>tag t0) 'a)] - :arglist-code|reify|unhinted ['a] - :body-codelist ['a] - :positional-args-ct 1 - :spec (t/isa? t0) - :variadic? false}]) - -(def defnt|code>overloads|ret|2 - [{:arg-classes [t0 t0] - :arg-specs [(t/isa? t0) (t/isa? t0)] - :arglist-code|fn|hinted [(tag (>tag t0) 'a) (tag (>tag t0) 'b)] - :arglist-code|reify|unhinted ['a 'b] - :body-codelist ['a] - :positional-args-ct 2 - :spec (t/isa? t0) - :variadic? false}]) - -(deftest fnt|overload-data>overload - (is (code= (defnt|code>overloads defnt|code|0 :clj) - [{:arg-classes [] - :arg-specs [] - :arglist-code|fn|hinted [] - :arglist-code|reify|unhinted [] - :body-codelist [] - :positional-args-ct 0 - :spec (t/value nil) - :variadic? false}])) - (is (code= (defnt|code>overloads defnt|code|1|empty :clj) - [{:arg-classes [java.lang.Object] - :arg-specs [(t/? t/object?)] - :arglist-code|fn|hinted [(tag "java.lang.Object" 'a)] - :arglist-code|reify|unhinted ['a] - :body-codelist [] - :positional-args-ct 1 - :spec (t/value nil) - :variadic? false}])) - (is (code= (defnt|code>overloads defnt|code|1|nil :clj) - [{:arg-classes [t0] - :arg-specs [(t/isa? t0)] - :arglist-code|fn|hinted [(tag (>tag t0) 'a)] - :arglist-code|reify|unhinted ['a] - :body-codelist [] - :positional-args-ct 1 - :spec (t/value nil) - :variadic? false}])) - (is (code= (defnt|code>overloads defnt|code|1 :clj) - defnt|code>overloads|ret|1)) - (is (code= (defnt|code>overloads defnt|code|class|!=|1|0 :clj) - [(first defnt|code>overloads|ret|1) - {:arg-classes [t2tag t2overloads defnt|code|2 :clj) - defnt|code>overloads|ret|2)) - (is (code= (defnt|code>overloads defnt|code|concrete+primitive :clj) - [(first defnt|code>overloads|ret|2) - {:arg-classes [t2

tag t2tag t2overloads defnt|code|class|=|2|0 :clj) - [(first defnt|code>overloads|ret|2) - {:arg-classes [t0 t2tag t0) 'c) (tag (>tag t2protocols [fn|name code lang] - (this/fnt|overloads>protocols - {:fn|name fn|name :overloads (defnt|code>overloads code lang)})) - -(deftest fnt|overloads>protocol - (is (code= (defnt|code>protocols 'abc defnt|code|0 :clj) - [{:defprotocol nil - :extend-protocols nil - :defn ($ (defn ~'abc [] (.invoke ~'abc|__0)))}])) - (is (code= (defnt|code>protocols 'abc defnt|code|1|empty :clj) - [{:defprotocol nil - :extend-protocols nil - :defn ($ (defn ~'abc [~(tag "java.lang.Object" 'x0)] (.invoke ~'abc|__0 ~'x0)))}])) - (is (code= (defnt|code>protocols 'abc defnt|code|1|nil :clj) - [{:defprotocol nil - :extend-protocols nil - :defn ($ (defn ~'abc [~(tag (>tag t0) 'x0)] (.invoke ~'abc|__0 ~'x0)))}])) - (is (code= (defnt|code>protocols 'abc defnt|code|1 :clj) - [{:defprotocol nil - :extend-protocols nil - :defn ($ (defn ~'abc [~(tag (>tag t0) 'x0)] (.invoke ~'abc|__0 ~'x0)))}])) - (is (code= (defnt|code>protocols 'abc defnt|code|class|!=|1|0 :clj) - [{:defprotocol - ($ (defprotocol ~'abc__Protocol__0 - (~'abc [~'x0]))) - :extend-protocols - [($ (extend-protocol ~'abc - java.io.FilterOutputStream (~'abc [~(tag "java.io.FilterOutputStream" 'x0)] (.invoke ~'abc|__0 ~'x0)) - java.lang.Long (~'abc [~(tag "long" 'x0)] (.invoke ~'abc|__1 ~'x0))))] - :defn nil}])) - (is (code= (defnt|code>protocols 'abc defnt|code|2 :clj) - [{:defprotocol nil - :extend-protocols nil - :defn ($ (defn ~'abc [~(tag (>tag t0) 'x0) - ~(tag (>tag t0) 'x1)] - (.invoke ~'abc|__0 ~'x0 ~'x1)))}])) - (is (code= (defnt|code>protocols 'abc (do defnt|code|concrete+primitive) :clj) - [{:defprotocol - ($ (defprotocol ~'abc|__Protocol - (~'abc [~'x0 ~'x1]))) - :extend-protocols - [($ (extend-protocol ~'abc - java.io.FilterOutputStream - (~'abc [~(tag "java.io.FilterOutputStream" 'x0) ~(tag "java.io.FilterOutputStream" 'x1)] - (.invoke ~'abc|__0 ~'x0 ~'x1)) - java.lang.Long - (~'abc [~(tag "long" 'x0) ~(tag "long" 'x1)] - (.invoke ~'abc|__1 ~'x0 ~'x1))))] - :defn nil}])) - (is (code= (defnt|code>protocols 'abc (do defnt|code|class|=|2|0) :clj) - [{:defprotocol - ($ (defprotocol ~'abc|__Protocol__java|io|FilterOutputStream - (~'abc|__protofn__java|io|FilterOutputStream [~'x0 ~'x1]))) - :extend-protocols - [($ (extend-protocol ~'abc|__Protocol__java|io|FilterOutputStream - java.io.FilterOutputStream - (~'abc|__protofn__java|io|FilterOutputStream - [~(tag "java.io.FilterOutputStream" 'x1) ~(tag "java.io.FilterOutputStream" 'x0)] - (.invoke ~'abc|__0 ~'x0 ~'x1)) - java.lang.Long - (~'abc|__protofn__java|io|FilterOutputStream - [~(tag "long" 'x1) ~(tag "java.io.FilterOutputStream" 'x0)] - (.invoke ~'abc|__1 ~'x0 ~'x1))))] - :defn nil} - {:defprotocol - ($ (defprotocol ~'abc|__Protocol - (~'abc [~'x0 ~'x1]))) - :extend-protocols - [($ (extend-protocol ~'abc - java.io.FilterOutputStream - (~'abc [~(tag "java.io.FilterOutputStream" 'x0) ~'x1] - (~'abc|__protofn__java|io|FilterOutputStream ~'x1 ~'x0))))] - :defn nil}])) - (is (code= (defnt|code>protocols 'abc (do defnt|code|class|=|2|1) :clj) - [{:defprotocol - ($ (defprotocol ~'abc|__Protocol__java|io|FilterOutputStream - (~'abc|__protofn__java|io|FilterOutputStream [~'x0 ~'x1]))) - :extend-protocols - [($ (extend-protocol ~'abc|__Protocol__java|io|FilterOutputStream - java.io.FilterOutputStream - (~'abc|__protofn__java|io|FilterOutputStream - [~(tag "java.io.FilterOutputStream" 'x1) ~(tag "java.io.FilterOutputStream" 'x0)] - (.invoke ~'abc|__0 ~'x0 ~'x1))))] - :defn nil} - {:defprotocol - ($ (defprotocol ~'abc|__Protocol__long - (~'abc|__protofn__long [~'x0 ~'x1]))) - :extend-protocols - [($ (extend-protocol ~'abc|__Protocol__long - java.io.FilterOutputStream - (~'abc|__protofn__long - [~(tag "java.io.FilterOutputStream" 'x1) ~(tag "long" 'x0)] - (.invoke ~'abc|__0 ~'x0 ~'x1))))] - :defn nil} - {:defprotocol - ($ (defprotocol ~'abc|__Protocol - (~'abc [~'x0 ~'x1]))) - :extend-protocols - [($ (extend-protocol ~'abc|__Protocol - java.io.FilterOutputStream - (~'abc - [~(tag "java.io.FilterOutputStream" 'x0) ~'x1] - (~'abc|__protofn__java|io|FilterOutputStream ~'x1 ~'x0)) - java.lang.Long - (~'abc - [~(tag "long" 'x0) ~'x1] - (~'abc|__protofn__long ~'x1 ~'x0))))] - :defn nil}]))) - -(deftest test|methods->spec - (testing "Class hierarchy" - (is= - (this/methods->spec - [{:rtype Object :argtypes [t/int? t/char?]} - {:rtype Object :argtypes [String]} - {:rtype Object :argtypes [CharSequence]} - {:rtype Object :argtypes [Object]} - {:rtype Object :argtypes [Comparable]}]) - (xp/casef count - 1 (xp/condpf-> t/<= (xp/get 0) - (t/? t/string?) (t/? t/object?) - (t/? t/char-seq?) (t/? t/object?) - (t/? t/comparable?) (t/? t/object?) - (t/? t/object?) (t/? t/object?)) - 2 (xp/condpf-> t/<= (xp/get 0) - t/int? (xp/condpf-> t/<= (xp/get 1) - t/char? (t/? t/object?)))))) - (testing "Complex dispatch based off of `Numeric/bitAnd`" - (is= - (this/methods->spec - [{:rtype t/int? :argtypes [t/int? t/char?]} - {:rtype t/int? :argtypes [t/int? t/byte?]} - {:rtype t/int? :argtypes [t/int? t/short?]} - {:rtype t/int? :argtypes [t/int? t/int?]} - {:rtype t/long? :argtypes [t/short? t/long?]} - {:rtype t/int? :argtypes [t/short? t/int?]} - {:rtype t/short? :argtypes [t/short? t/short?]} - {:rtype t/long? :argtypes [t/long? t/long?]} - {:rtype t/long? :argtypes [t/long? t/int?]} - {:rtype t/long? :argtypes [t/long? t/short?]} - {:rtype t/long? :argtypes [t/long? t/char?]} - {:rtype t/long? :argtypes [t/long? t/byte?]} - {:rtype t/long? :argtypes [t/int? t/long?]} - {:rtype t/char? :argtypes [t/char? t/byte?]} - {:rtype t/long? :argtypes [t/byte? t/long?]} - {:rtype t/int? :argtypes [t/byte? t/int?]} - {:rtype t/short? :argtypes [t/byte? t/short?]} - {:rtype t/char? :argtypes [t/byte? t/char?]} - {:rtype t/byte? :argtypes [t/byte? t/byte?]} - {:rtype t/short? :argtypes [t/short? t/char?]} - {:rtype t/short? :argtypes [t/short? t/byte?]} - {:rtype t/long? :argtypes [t/char? t/long?]} - {:rtype t/long? :argtypes [t/char? t/long? t/long?]} - {:rtype t/char? :argtypes [t/char? t/char?]} - {:rtype t/short? :argtypes [t/char? t/short?]} - {:rtype t/int? :argtypes [t/char? t/int?]}]) - (xp/casef count - 2 (xp/condpf-> t/<= (xp/get 0) - t/int? - (xp/condpf-> t/<= (xp/get 1) - t/char? t/int? - t/byte? t/int? - t/short? t/int? - t/int? t/int? - t/long? t/long?) - t/short? - (xp/condpf-> t/<= (xp/get 1) - t/long? t/long? - t/int? t/int? - t/short? t/short? - t/char? t/short? - t/byte? t/short?) - t/long? - (xp/condpf-> t/<= (xp/get 1) - t/long? t/long? - t/int? t/long? - t/short? t/long? - t/char? t/long? - t/byte? t/long?) - t/char? - (xp/condpf-> t/<= (xp/get 1) - t/byte? t/char? - t/long? t/long? - t/char? t/char? - t/short? t/short? - t/int? t/int?) - t/byte? - (xp/condpf-> t/<= (xp/get 1) - t/long? t/long? - t/int? t/int? - t/short? t/short? - t/char? t/char? - t/byte? t/byte?)) - 3 (xp/condpf-> t/<= (xp/get 0) - t/char? - (xp/condpf-> t/<= (xp/get 1) - t/long? - (xp/condpf-> t/<= (xp/get 2) - t/long? t/long?))))))) - -(deftest test|analyze-seq|do - (is= (analyze '(do)) - (ast/do {:env {} - :form '(do) - :body [] - :spec t/nil?})) - (is= (analyze '(do 1)) - (ast/do {:env {} - :form '(do 1) - :body [1] - :spec (t/value 1)})) - (is= (analyze '(do 1 "a")) - (ast/do {:env {} - :form '(do 1 "a") - :body [1 "a"] - :spec (t/value "a")}))) - -(deftest test|analyze - (testing "symbol" - (testing "unbound" - (is= (analyze {'c (ast/unbound 'c)} 'c) - (ast/unbound 'c)))) - (testing "static call" - (testing "literal arguments" - (is= (analyze '(Numeric/bitAnd 1 2)) - (ast/macro-call - {:form '(Numeric/bitAnd 1 2), - :expanded (ast/method-call - {:env {} - :form '(. Numeric bitAnd 1 2) - :target (ast/symbol 'Numeric t/class?) - :method 'bitAnd - :args [(ast/literal 1 (t/value 1)) - (ast/literal 2 (t/value 2))] - :spec t/long?}) ;; TODO more specific than this? - :spec t/long?})) ;; TODO more specific than this? - (throws (analyze '(Numeric/bitAnd 1.0 2.0)) - (fn-and (fn-> :message (= "No matching clause found")) - (fn-> :data (= {:v (t/value 1.0)})))) - (throws (analyze '(Numeric/bitAnd 1.0 2)) - (fn-and (fn-> :message (= "No matching clause found")) - (fn-> :data (= {:v (t/value 1.0)})))) - (throws (analyze '(Numeric/bitAnd 1 2.0)) - (fn-and (fn-> :message (= "No matching clause found")) - (fn-> :data (= {:v (t/value 2.0)})))) - (throws (analyze '(Numeric/bitAnd "" 2.0)) - (fn-and (fn-> :message (= "No matching clause found")) - (fn-> :data (= {:v (t/value "")})))) - (throws (analyze '(Numeric/bitAnd nil 2.0)) - (fn-and (fn-> :message (= "No matching clause found")) - (fn-> :data (= {:v t/nil?})))) - - (is= (analyze '(byte 1)) - (ast/macro-call - {:form '(byte 1) - :expanded (ast/method-call - {:env {} - :form '(. clojure.lang.RT (uncheckedByteCast 1)) - :target (ast/symbol 'clojure.lang.RT t/class?) - :method 'uncheckedByteCast - :args [(ast/literal 1 t/long?)] - :spec t/byte?}) - :spec t/byte?})) - (throws (analyze '(byte "")) ; TODO fix - (fn-> :message (= "Spec assertion failed")))) - (testing "unbound arguments" - (analyze {'a (ast/unbound 'a)} - '(Numeric/isZero a))))) - -(let* [a 1 b (byte 2)] - a - (Numeric/add c (Numeric/bitAnd a b))) - -;; For any unquoted seq-expression E that has at least one leaf: -;; if E is an expression whose type must be inferred: -;; if E has not reached stability (stability = only one reified, TODO what about abstracts?) -;; E's type must itself be inferred - -#_(let [gen-unbound - #(!ref (->type-info - {:reifieds #{} - :infer? true})) - gen-expected - (fn [env ast] - [env ast] - #_(->expr-info - {:env env - :form form - :type-info - (->type-info type-info)}))] - #_(let [env {'a (gen-unbound) - 'b (gen-unbound)} - form '(and:boolean a b)] - (is= (->typed env form) - (gen-expected form env - {:reifieds #{boolean} - :abstracts #{#_...} - #_:conditionals - #_{boolean {boolean #{boolean}}}}))) - #_(let [env {'a (gen-unbound)} - form '(Numeric/isZero a)] - (is= (-> (->typed env form) - (assoc-in [:type-info :fn-types] nil)) - (gen-expected - {'a (!ref (t/ast 'a ? (t/or t/byte t/char t/short t/int t/long t/float t/double)))} - (t/ast '(. Numeric isZero a) (t/fn' t/boolean))))) - #_(let [env {'a (gen-unbound) - 'b (gen-unbound)} - form '(Numeric/bitAnd a b)] - (is= nil #_(->typed env form) - (gen-expected - {'a (!ref (t/ast 'a ? (t/or t/byte t/char t/short t/int t/long))) - 'b (!ref (t/ast 'b ? (t/or t/byte t/char t/short t/int t/long)))} - (t/ast '(. Numeric bitAnd a b) - ;; TODO make spec fns easily editable - (t/spec [[a0 a1]] ; input is sequence of arg-specs; return value is spec - (condp = a0 - ;; TODO use map lookup? - t/byte (condp = a1 - t/byte t/byte - t/char t/char - t/short t/short - t/int t/int - t/long t/long) - t/char (condp = a1 - t/byte t/char - t/char t/char - t/short t/short - t/int t/int - t/long t/long) - t/short (condp = a1 - t/byte t/short - t/char t/short - t/short t/short - t/int t/int - t/long t/long) - t/int (condp = a1 - t/byte t/int - t/char t/int - t/short t/int - t/int t/int - t/long t/long) - t/long (condp = a1 - t/byte t/long - t/char t/long - t/short t/long - t/int t/long - t/long t/long))))))) - - (let [env {'a (gen-unbound) - 'b (gen-unbound)} - form '(Numeric/negate (Numeric/bitAnd a b))] - (is= #_(->typed env form) - (gen-expected form - {'a (!ref (t/ast 'a ? ...)) - 'b (!ref (t/ast 'b ? ...))} - (t/ast '(. Numeric bitAnd a b)) - {:reifieds #{byte char short int long} - :abstracts #{...}}))) - #_(let [env {'a (gen-unbound) - 'b (gen-unbound)} - form '(negate:int|long (Numeric/bitAnd a b))] - ;; Because the only valid argtypes to `negate:int|long` are S = #{[int] [long]}, - ;; `Numeric/bitAnd` must only accept argtypes that produce a subset of S - ;; The argtypes to `Numeric/bitAnd` that produce a subset of S are: - #_#{[byte int] - [byte long] - [char int] - [char long] - [short int] - [short long] - [int byte] - [int char] - [int short] - [int int] - [int long] - [long byte] - [long char] - [long short] - [long int] - [long long]} - ;; So `a`, then, can be: - #_#{byte char short int long} - ;; and likewise `b` can be: - #_#{byte char short int long} - (is= (->typed env form) - (gen-expected form - {'a (!ref (->type-info - {:reifieds #{byte char short int long} - :fn-types {} - :infer? true})) - 'b (!ref (->type-info - {:reifieds #{byte char short int long} - :fn-types {} - :infer? true}))} - {:reifieds #{int long} - :abstracts #{...}})))) - -(def ff this/fn-type-satisfies-expr?) - -(deftest test|fn-type-satisfies-expr? - (is= (ff ))) - -(defn test|->typed|literal-equivalence [f formf] - (testing "nil" - (is= (f nil) - (->expr-info {:env {} :form (formf nil) - :type-info (->type-info {:reifieds #{:nil}})}))) - (testing "numbers" - (is= (f 1) - (->expr-info {:env {} :form (formf 1) - :type-info (->type-info {:reifieds #{Long/TYPE}})})) - (is= (f 1.0) - (->expr-info {:env {} :form (formf 1.0) - :type-info (->type-info {:reifieds #{Double/TYPE}})})) - (is= (f 1N) - (->expr-info {:env {} :form (formf 1N) - :type-info (->type-info {:reifieds #{clojure.lang.BigInt}})})) - (is= (f 1M) - (->expr-info {:env {} :form (formf 1M) - :type-info (->type-info {:reifieds #{java.math.BigDecimal}})}))) - (testing "string" - (is= (f "abc") - (->expr-info {:env {} :form (formf "abc") - :type-info (->type-info {:reifieds #{String}})}))) - (testing "keyword" - (is= (f :abc) - (->expr-info {:env {} :form (formf :abc) - :type-info (->type-info {:reifieds #{Keyword}})})))) - -(deftest test|->typed|literals - (test|->typed|literal-equivalence ->typed identity)) - -(deftest test|->typed|do - (testing "Base case" - (is= (->typed '(do)) - (->expr-info {:env {} :form nil - :type-info (->type-info {:reifieds #{:nil}})}))) - (testing "Literals" - (test|->typed|literal-equivalence #(->typed (list 'do %)) #(list 'do %)))) - -(deftest test|->typed|let - (testing "Base case" - (is= (->typed '(let [])) - (->expr-info {:env {} :form '(let* [] (do))}))) - (testing "Literals" - (test|->typed|literal-equivalence - #(->typed (list 'let* '[a nil] %)) - #(list 'let* '[a nil] (list 'do %)))) - ) - -(def ->typed:if:test-cases -; pruning?, true-form, false-form, branch - {false {2 {3 {true (fn [pred true-form false-form] - (->expr-info {:env {} - :form (list 'if pred true-form false-form) - :type-info (->type-info {:reifieds #{Long/TYPE}})})) - false (fn [pred true-form false-form] - (->expr-info {:env {} - :form (list 'if pred true-form false-form) - :type-info (->type-info {:reifieds #{Long/TYPE}})}))}}} - true {2 {3 {true (fn [pred true-form false-form] - (->expr-info {:env {} - :form true-form - :type-info (->type-info {:reifieds #{Long/TYPE}})})) - false (fn [pred true-form false-form] - (->expr-info {:env {} - :form false-form - :type-info (->type-info {:reifieds #{Long/TYPE}})}))}}}}) +;; ===== Type predicates ===== ;; +;; Declared here instead of in `quantum.untyped.core.type` to avoid dependency + +#?(:clj (def boolean? (t/isa? #?(:clj Boolean :cljs js/Boolean)))) +#?(:clj (def byte? (t/isa? Byte))) +#?(:clj (def short? (t/isa? Short))) +#?(:clj (def char? (t/isa? Character))) +#?(:clj (def int? (t/isa? Integer))) +#?(:clj (def long? (t/isa? Long))) +#?(:clj (def float? (t/isa? Float))) + (def double? (t/isa? #?(:clj Double :cljs js/Number))) + +(def string? (t/isa? #?(:clj java.lang.String :cljs js/String))) + +;; ===== End type predicates ===== ;; + +(deftest test|arg-types>split + (is= (self/arg-types>split + [(t/or byte? double? string?) + (t/or t/map? byte?)]) + [[(t/isa? Byte) (t/isa? clojure.lang.ITransientMap)] + [(t/isa? Byte) (t/isa? clojure.lang.IPersistentMap)] + [(t/isa? Byte) (t/isa? java.util.Map)] + [(t/isa? Byte) (t/isa? Byte)] + [(t/isa? Double) (t/isa? clojure.lang.ITransientMap)] + [(t/isa? Double) (t/isa? clojure.lang.IPersistentMap)] + [(t/isa? Double) (t/isa? java.util.Map)] + [(t/isa? Double) (t/isa? Byte)] + [(t/isa? String) (t/isa? clojure.lang.ITransientMap)] + [(t/isa? String) (t/isa? clojure.lang.IPersistentMap)] + [(t/isa? String) (t/isa? java.util.Map)] + [(t/isa? String) (t/isa? Byte)]])) + +;; ============== OLD TESTS ============== ;; (def truthy-objects [1 1.0 1N 1M "abc" :abc]) (def falsey-objects [nil]) (def objects {true truthy-objects false falsey-objects}) -(deftest test|->typed|if - (testing "Syntax" - (throws (->typed '(if))) - (throws (->typed '(if 1))) - (throws (->typed '(if 1 2)))) - (testing "Literals" - (doseq [pruning? [true false] - true-form [2] - false-form [3] - branch [true false]] - (testing (istr "conditional branch pruning = ~{pruning?}; form = ~{(list 'if true-form false-form)}; branch = ~{branch}") - (binding [this/*conditional-branch-pruning?* pruning?] - (doseq [pred (get objects branch)] - (is= (->typed (list 'if pred true-form false-form)) - ((get-in ->typed|if|test-cases [pruning? true-form false-form branch]) - pred true-form false-form)))))))) - - - ;; ----- Overload resolution ----- -; TODO use logic programming and variable unification e.g. `?1` `?2` ? - (defnt +* "Lax `+`. Continues on overflow/underflow." - {:variadic-proxy true} + {:variadic-proxy? true} ([] 0) ;; Here `Number`, determined to be a class, is treated like an `instance?` predicate ([a (t/or numeric-primitive? Number)] a) @@ -733,7 +88,7 @@ (defnt +' "Strict `+`. Throws exception on overflow/underflow." - {:variadic-proxy true} + {:variadic-proxy? true} ([a int? , b int? ] (Math/addExact a b)) ([a long?, b long?] (Math/addExact x y)) ; TODO do the rest @@ -762,11 +117,6 @@ `reduce-count` is 36.824665 ms - twice as fast"} [xs] (reduce count|rf xs)) -(defnt ^:inline name - ([x string?] x) - #?(:clj ([x Named ] (.getName x)) - :cljs ([x INamed ] (-name x)))) - ; the order encountered is the preferred order in case of ambiguity ; Some things tracked include arity of function, arguments to function, etc. ; Lazily compiled; will cause a chain reaction of compilations @@ -823,44 +173,6 @@ #?(:cljs ([x array-1d? , k js-integer? ] (core/aget x k))) #?(:clj ([x ? , k ? ] (Array/get x k)))) -(defnt transformer - "Given a reducible collection, and a transformation function transform, - returns a reducible collection, where any supplied reducing - fn will be transformed by transform. transform is a function of reducing fn to - reducing fn." - ([xs reducible?, xf xfn?] - (if (instance? Transformer xs) - (Transformer. (.-xs ^Transformer xs) xs xf) - (Transformer. xs xs xf)))) - -(defnt transducer->transformer - "Converts a transducer into a transformer." - {:todo #{"More arity"}} - ([n ?, xf xfn?] - (case n - 0 (fn ([] (xf)) - ([xs] (transformer xs (xf)))) - 1 (fn ([a0] (xf a0)) - ([a0 xs] (transformer xs (xf a0)))) - 2 (fn ([a0 a1] (xf a0 a1)) - ([a0 a1 xs] (transformer xs (xf a0 a1)))) - 3 (fn ([a0 a1 a2] (xf a0 a1 a2)) - ([a0 a1 a2 xs] (transformer xs (xf a0 a1 a2)))) - (throw (ex-info "Unhandled arity for transducer" nil))))) - -(defnt map:transducer [f ?] - ; TODO what does this actually entail? should it be that it errors on `f`s that don't implement *all* possible arities? - (fnt [rf ?] - (fn ; TODO auto-generate? ; TODO `fnt` ? - ([] (rf)) - ([ret] (rf ret)) - ([ret x0] (rf ret (f x0))) - ([ret x0 x1] (rf ret (f x0 x1))) - ([ret x0 x1 x2] (rf ret (f x0 x1 x2))) - ([ret x0 x1 x2 & xs] (rf ret (apply f x0 x1 x2 xs)))))) - -(def map+ (transducer->transformer 1 map:transducer)) - (defnt get-in* ([x ? k0 ?] (get x k0)) ([x ? k0 ? k1 ?] (Array/get x k0 k1)) @@ -883,160 +195,119 @@ ... [IPersistentVector long long]] -(defonce *interfaces (atom {})) - -; IF AN EAGER RESULT: - -; +* 0 arity -(definterface long•I (^long invoke [])) - -; `+*` 1 arity -(definterface byte•I•byte (^byte invoke [^byte a0])) -(definterface char•I•char (^char invoke [^char a0])) -(definterface int•I•int (^int invoke [^int a0])) -(definterface long•I•long (^long invoke [^long a0])) -(definterface float•I•float (^float invoke [^float a0])) -(definterface double•I•double (^double invoke [^double a0])) - -; `+*` 2-arity -(definterface byte•I•byte (^byte invoke [^byte a0 ...])) -(definterface char•I•char (^char invoke [^char a0 ...])) -(definterface int•I•int (^int invoke [^int a0 ...])) -(definterface long•I•long (^long invoke [^long a0 ...])) -(definterface float•I•float (^float invoke [^float a0 ...])) -(definterface double•I•double (^double invoke [^double a0 ...])) -(definterface double•I•double (^double invoke [^double a0 ...])) -... - -; `+*` 2-arity variadic -? - -(definterface boolean•I•byte (^boolean invoke [^byte a0])) -(or (get @*interfaces 'boolean•I•byte) (swap! *interfaces assoc 'boolean•I•byte boolean•I•byte)) -(definterface boolean•I•char (^boolean invoke [^char a0])) -(or (get @*interfaces 'boolean•I•char) (swap! *interfaces assoc 'boolean•I•char boolean•I•char)) -(definterface boolean•I•int (^boolean invoke [^int a0])) -(swap! *interfaces assoc 'boolean•I•byte boolean•I•byte) -(definterface boolean•I•long (^boolean invoke [^long a0])) -(swap! *interfaces assoc 'boolean•I•byte boolean•I•byte) -(definterface boolean•I•float (^boolean invoke [^float a0])) -(swap! *interfaces assoc 'boolean•I•byte boolean•I•byte) -(definterface boolean•I•double (^boolean invoke [^double a0])) -(swap! *interfaces assoc 'boolean•I•byte boolean•I•byte) - -(def zero? (reify boolean•I•byte (^boolean invoke [this ^byte n] (Numeric/isZero n)) - boolean•I•char (^boolean invoke [this ^char n] (Numeric/isZero n)) - boolean•I•int (^boolean invoke [this ^int n] (Numeric/isZero n)) - boolean•I•long (^boolean invoke [this ^long n] (Numeric/isZero n)) - boolean•I•float (^boolean invoke [this ^float n] (Numeric/isZero n)) - boolean•I•double (^boolean invoke [this ^double n] (Numeric/isZero n)))) - -(defnt zero? [n ?] (Numeric/isZero n)) - - - - - - - -(defnt zero? ([n long] (Numeric/isZero n))) - -(defn zero?) - -(defnt zero? ([n ?] (Numeric/isZero n))) -(zero? 1) - -(let [^boolean•I•double z zero?] (.invoke z 3.0)) ; it's just a simple reify - -#_(defnt even? - [n ?] (zero? (bit-and n 1))) -#_=> -(def even? (reify )) - -; Normally `zero?` when passed e.g. as a higher-order function might be like - -;; ----- Spec'ed `defnt+`s ----- - -;; One thing that would be nice is to marry `defnt` with `clojure.spec`. -;; We want the specs to be reflected in the parameter declaration, type hints, and so on. -;; -;; We also want it to know about e.g., since a function returns `(< 5 x 100)`, then x must -;; be not just a number, but *specifically* a number between 5 and 100, exclusive. -;; Non-`Collection` datatypes are opaque and do not participate in this benefit (?). -;; -;; core.spec functions like `s/or`, `s/and`, `s/coll-of`, and certain type predicates are -;; able to be leveraged in computing the best overload with the least dynamic dispatch -;; possible. - -(defnt example - ([a (s/and even? #(< 5 % 100)) - b t/any? - c ::number-between-6-and-20 - d {:req-un [e (default t/boolean? true) - :f t/number? - g (default (s/or t/number? t/sequential?) 0)]} - | (< a @c) ; pre - > (s/and (s/coll odd? :kind t/array?) ; post - #(= (first %) c))] - ...) - ([a string? - b (s/coll bigdec? :kind vector?) - c t/any? - d t/any? - ...)) - -;; expands to: - -(dv/def ::example:a (s/and even? #(< 5 % 100))) -(dv/def ::example:b t/any) -(dv/def ::example:c ::number-between-6-and-20) -(dv/def-map ::example:d - :conformer (fn [m#] (assoc-when-not-contains m# :e true :g 0)) - :req-un [[:e t/boolean?] - [:f t/number?] - [:g (s/or* t/number? t/sequential?)]]) -(dv/def ::example|__ret - (s/and (s/coll-of odd? :kind t/array?) - #(= (first %) (:c ...)))) ; TODO fix `...` - -;; -> TODO should it be: -(defnt example - [^example:a a ^:example|b b ^example|c c ^example|d d] - (let [ret (do ...)] - (validate ret ::example|__ret))) -;; -> OR -(defnt example - [^number? a b ^number? c ^map? d] - (let [ret (do ...)] - (validate ret ::example|__ret))) -;; ? The issue is one of performance. Maybe we don't want boxed values all over the place. - -(s/fdef example - :args (s/cat :a ::example|a - :b ::example|b - :c ::example|c - :d ::example|d) - :fn ::example|__ret) - - -;; ----- TYPE INFERENCE ----- ;; - -(expr-info '(let [a (Integer. 2) b (Double. 3)] a)) -; => {:class java.lang.Integer, :prim? false} -(expr-info '(let [a (Integer. 2) b (Double. 3)] (if false a b))) -; => nil -; But I'd like to have it infer the "LCD", namely, `(v/and number? (v/or* (fn= 2) (fn= 3)))`. - -;; I realize that this also is probably prohibitively expensive. - -(expr-info '(let [a (Integer. 2) b (Double. 3)] (if false a (int b)))) -; => nil (inferred `Integer` or `int`) - -(expr-info '(let [a (Integer. 2) b (Double. 3)] (if false a (Integer. b)))) -; => {:class java.lang.Integer, :prim? false} - -;; At very least it would be nice to have "spec inference". I.e. know, via `fdef`, that a -;; function meets a particular set of specs/characteristics and so any call to that function -;; will necessarily comply with the type. - - +;; ===== Dynamicity ===== ;; + +(definterface Abcde (^long abcdemethod [^int a ^byte b])) +(def ^Abcde abcde (reify Abcde (abcdemethod [this a b] (inc a)))) +(defn fghij [] (.abcdemethod abcde 1 5)) +(is= (fghij) 2) +(def ^Abcde abcde (reify Abcde (abcdemethod [this a b] (+ a 2)))) +(is= (fghij) 3) +(def abcde nil) ; To simulate clearing of unnecessary/invalid code +(throws NullPointerException (fghij)) + +;; This approach then benefits from the optional staticizing of vars in 1.8 + +;; ===== Performance ===== ;; + +;; As we can see, there is definitely benefit (50% performance increase in this case) to be gained +;; from primitive overloads, but there is no apparent benefit to pre-casting in the reify for +;; reference types. +;; This is actually nice because we don't have to generate as much interface code. + +(definterface PrimitiveIntTest (^long invoke [^int a])) +(def ^PrimitiveIntTest primitive-int-test|reify + (reify PrimitiveIntTest (invoke [this a] (Numeric/add a 1)))) +(defn primitive-int-test|primitive-fn [^long a] (Numeric/add a 1)) +(defn primitive-int-test|fn [a] (Numeric/add (long a) 1)) + +(let [a (int 1) + ^PrimitiveIntTest primitive-int-test|reify|direct @#'primitive-int-test|reify + primitive-int-test|primitive-fn|direct @#'primitive-int-test|primitive-fn + primitive-int-test|fn|direct @#'primitive-int-test|fn] + ;; ~3.33 ns + (bench/quick-bench (.invoke primitive-int-test|reify|direct a)) + ;; ~7.24 ns + (bench/quick-bench (.invoke ^PrimitiveIntTest @#'primitive-int-test|reify a)) + ;; ~5.00 ns + (bench/quick-bench (primitive-int-test|primitive-fn|direct a)) + ;; ~7.93 ns + (bench/quick-bench (@#'primitive-int-test|primitive-fn a)) + ;; ~4.99 ns + (bench/quick-bench (primitive-int-test|fn|direct a)) + ;; ~7.98 ns + (bench/quick-bench (@#'primitive-int-test|fn a))) + +(definterface String>Object|Test (^Object invoke [^String a])) +(def ^String>Object|Test string-test|reify + (reify String>Object|Test (invoke [this a] (.length a)))) +(definterface Object>Object|Test (^Object invoke [^Object a])) +(def ^Object>Object|Test string-test|generic-reify + (reify Object>Object|Test (invoke [this a] (let [^String a a] (.length a))))) +(defn string-test|fn [^String a] (.length a)) + +(let [a "" + ^String>Object|Test string-test|reify|direct @#'string-test|reify + ^Object>Object|Test string-test|generic-reify|direct @#'string-test|generic-reify + string-test|fn|direct @#'string-test|fn] + ;; ~4.09 ns + (bench/quick-bench (.invoke string-test|reify|direct a)) + ;; ~7.60 ns + (bench/quick-bench (.invoke ^String>Object|Test @#'string-test|reify a)) + ;; ~3.94 ns + (bench/quick-bench (.invoke string-test|generic-reify|direct a)) + ;; ~7.61 ns + (bench/quick-bench (.invoke ^Object>Object|Test @#'string-test|generic-reify a)) + ;; ~3.94 ns + (bench/quick-bench (string-test|fn|direct a)) + ;; ~7.55 ns + (bench/quick-bench (@#'string-test|fn a))) + +;; ============== Taken from untyped tests; should be modified in lock step =============== ;; + +;; ----- Implicit compilation tests ----- ;; + +(self/defnt abcde "Documentation" {:metadata "fhgjik"} + ([a number? > number?] (inc a)) + ([a pos-int?, b pos-int? + | (> a b) + > (s/and number? #(> % a) #(> % b))] (+ a b)) + ([a #{"a" "b" "c"} + b boolean? + {:as c + :keys [ca keyword? cb string?] + {:as cc + {:as cca + :keys [ccaa keyword?] + [[ccabaa some? {:as ccabab :keys [ccababa some?]} some?] some? ccabb some? & ccabc some? :as ccab] + [:ccab seq?]} + [:cca map?]} + [:cc map?]} + #(-> % count (= 3)) + [da double? & db seq? :as d] sequential? + [ea symbol?] ^:gen? (s/coll-of symbol? :kind vector?) + & [fa #{"a" "b" "c"} :as f] seq? + | (and (> da 50) (contains? c a) + a b c ca cb cc cca ccaa ccab ccabaa ccabab ccababa ccabb ccabc d da db ea f fa) + > number?] 0)) + +(self/defns basic [a number? > number?] (rand)) + +(defspec-test test|basic `basic) + +(self/defns equality [a number? > #(= % a)] a) + +(defspec-test test|equality `equality) + +(self/defns pre-post [a number? | (> a 3) > #(> % 4)] (inc a)) + +(defspec-test test|pre-post `pre-post) + +(self/defns gen|seq|0 [[a number? b number? :as b] ^:gen? (s/tuple double? double?)]) + +(defspec-test test|gen|seq|0 `gen|seq|0) + +(self/defns gen|seq|1 + [[a number? b number? :as b] ^:gen? (s/nonconforming (s/cat :a double? :b double?))]) + +(defspec-test test|gen|seq|1 `gen|seq|1) diff --git a/test/quantum/test/core/logic.cljc b/test/quantum/test/core/logic.cljc index 8d7479b5..9517fe2a 100644 --- a/test/quantum/test/core/logic.cljc +++ b/test/quantum/test/core/logic.cljc @@ -6,14 +6,14 @@ :refer [deftest is]])) #?(:clj -(deftest test:some-but-not-more-than-n +(deftest test|some-but-not-more-than-n (doseq [n [1]] ; TODO test more (doseq [args-n (range 5)] (doseq [args (combo/selections #{true false} args-n)] (is (= (boolean (eval `(ns/some-but-not-more-than-n ~n ~@args))) (boolean (eval `(and (or ~@args) (not (and ~@args)))))))))))) -(deftest test:default +(deftest test|default (let [a (atom 0)] (ns/default nil (reset! a 1)) (is (= @a 1)) @@ -25,100 +25,3 @@ (is (= @a 1)) (ns/default nil (reset! a 5)) (is (= @a 5)))) - -;___________________________________________________________________________________________________________________________________ -;==================================================={ BOOLEANS + CONDITIONALS }===================================================== -;==================================================={ }===================================================== -(defn test:nnil? [x]) -(defn test:nempty? [x]) -(defn test:nseq? [x]) - -(defn test:iff [pred const else]) -(defn test:iffn [pred const else-fn]) - -(defn test:eq? [x]) - -(defn test:neq? [x]) - -(defn test:any? [pred args]) - -(defn test:every? [pred args]) - -(defn test:apply-and [arg-list]) - -(defn test:apply-or [arg-list]) - -(defn test:dor [& args]) - -(defn test:fn-logic-base - [oper & preds]) - -(defn test:fn-or [& preds]) -(defn test:fn-and [& preds]) -(defn test:fn-not [pred] ) - -(defn test:falsey? [x]) -(defn test:truthy? [x]) - -(defn test:splice-or [obj compare-fn & coll]) -(defn test:splice-and [obj compare-fn & coll]) - -(defn test:coll-base [logical-oper & elems]) - -(defn test:coll-or [& elems]) - -(defn test:coll-and [& elems]) - -(defn test:bool [v]) - -(defn test:rcompare [x y]) - -(defn test:condf - [obj & clauses]) - -(defn test:condf1 [& args]) - -(defn test:condf**n [& args]) - -(defn test:condfc - [obj & clauses]) - -(defn test:ifn [obj pred true-fn false-fn]) - -(defn test:ifc [obj pred true-expr false-expr]) - -(defn test:ifp [obj pred true-fn false-fn]) - -(defn test:ifcf$n [pred true-expr false-expr]) - -(defn test:ifn1 [pred true-fn false-fn]) - -(defn test:whenf - [obj pred true-fn]) - -(defn test:whenc - [obj pred true-expr]) - -(defn test:whenp - [obj pred true-fn]) - -(defn test:whenf1 - [pred true-fn]) - -(defn test:whenc1 - [pred true-obj]) - -(defn test:condpc - [pred expr & clauses]) - -; ======== CONDITIONAL LET BINDINGS ======== - -(defn test:if-let - ([bindings then]) - ([[bnd expr & more] then else])) - -(defn test:when-let - ([[var- expr & more] & body])) - -(defn test:cond-let - [bindings & clauses]) diff --git a/test/quantum/test/core/macros/defnt.cljc b/test/quantum/test/core/macros/defnt.cljc deleted file mode 100644 index 0c7a8747..00000000 --- a/test/quantum/test/core/macros/defnt.cljc +++ /dev/null @@ -1,620 +0,0 @@ -(ns quantum.test.core.macros.defnt - (:require - [quantum.core.macros.defnt :as ns] - [quantum.core.log :as log - :refer [prl]] - [quantum.core.error :as err] - [quantum.core.macros.protocol :as proto] - [quantum.core.macros.reify :as reify] - [quantum.core.macros.transform :as trans] - [quantum.core.analyze.clojure.core :as ana] - [quantum.core.macros - :refer [macroexpand-all]] - [quantum.core.test - :refer [deftest is testing]] - [quantum.untyped.core.form.evaluate :as ufeval - :refer [case-env]]) - #?(:cljs - (:require-macros - [quantum.test.core.macros.defnt - :refer [with-merge-test]])) - #?(:clj (:import java.util.concurrent.atomic.AtomicInteger))) - -; TODO look at this for type-checked Spec implementation: https://github.com/arohner/spectrum/blob/master/src/spectrum/conform.clj -; TODO look at this thread for useful discussion on potential type systems in Clojure: https://groups.google.com/forum/#!topic/clojure/Dxk-rCVL5Ss -; TODO look at HM impl : https://github.com/ericnormand/hindley-milner - -(defn quantum.test.core.macros.defnt/simple:a a0)))))))) - (testing "CLJS" - (is (meta= (expand-all-arities-for-defnt+ simple {:lang :cljs}) - '(do (def simple:__overloads (js-obj)) - (aset simple:__overloads "fn0" - (fn [a] (+ (.deref a) 5))) - (aset simple:__overloads "fn1" - (fn [a] (. simple:__overloads fn0 (->quantum.test.core.macros.defnt/simple:a a)))) - ))))) - (testing "Macro-expansion" - (testing "Definition" - (is (= expanded - '(do (defn simple - ([a] - (validate a even?) - (+ a 5))))))) - (testing "Valid types" - (testing "Type check (compile-time check)" - (is (= '(. ^Fn__number__even simple:__reify invoke 2) - (macroexpand-all '(typed (simple 2)))))) - (testing "No type check (runtime check)" - (is (= '(simple 2) - (macroexpand-all '(simple 2)))))) - (testing "Invalid types" - (testing "Type check (compile-time check)" - (is (error? (macroexpand-all '(typed (simple "asd"))))) - (is (error? (macroexpand-all '(typed (simple 3)))))) - (testing "No type check (runtime check)" - (is (= '(simple "asd") - (macroexpand-all '(simple "asd")))) - (is (= '(simple 3) - (macroexpand-all '(simple 3))))))) - (testing "Evaluation" - (testing "Valid types" - (testing "Type check (compile-time check)" - (is (= 6 (eval '(typed (simple 2)))))) - (testing "No type check (runtime check)" - (is (= 6 (eval '(simple 2)))))) - (testing "Invalid types" - (testing "Type check (compile-time check)" - (is (compile-error? (eval '(typed (simple "asd"))))) - (is (compile-error? (eval '(typed (simple 3)))))) - (testing "No type check (runtime check)" - (is (runtime-error? (eval '(simple "asd")))) - (is (runtime-error? (eval '(simple 3))))))) - - - - (un-defnt+ simple)) - (let [simple:opts '(defnt+ simple:opts - ([a {:spec even? :opts #{:compile-time?}}]))])) - -(def defnt+:example - '(defnt+ example - ([a (s/and even? #(< 5 % 100)) - b t/any - c ::number-between-6-and-20 - {:as d :keys [e g]} (s/keys* :req-un [[:e t/boolean? true] - [:f t/number?] - [:g (s/or* t/number? t/sequential?) - 0]])] - {:pre (< a @c) - :post (s/and (s/coll-of odd? :kind t/array?) - #(= (first %) c))} - ...) - ([a string? - b (s/coll-of bigdec? :kind vector?) - c t/any - d t/any] - ...))) - -(def data - {:ns- *ns* - :lang :clj - :class-sym 'AtomicInteger - :expanded 'java.util.concurrent.atomic.AtomicInteger}) - -#?(:clj -(deftest test:get-qualified-class-name ; TODO :clj only for now - (let [{:keys [ns- lang class-sym]} data] - (is (= (ns/get-qualified-class-name - lang ns- class-sym) - (:expanded data)))))) - -(defn test:classes-for-type-predicate - ([pred lang]) - ([pred lang type-arglist])) - -(deftest test:defnt-keyword->positional-profundal ; TODO derepeat - (is (thrown? Throwable (ns/defnt-keyword->positional-profundal :else))) - (is (thrown? Throwable (ns/defnt-keyword->positional-profundal :nope<>))) - (is (= nil (ns/defnt-keyword->positional-profundal "<0>"))) - (testing "Positional" - (is (= [0 nil] (ns/defnt-keyword->positional-profundal :<0>))) - (is (= [0 nil] (ns/defnt-keyword->positional-profundal '<0>))) - (is (thrown? Throwable (ns/defnt-keyword->positional-profundal :<01>))) - (is (= nil (ns/defnt-keyword->positional-profundal '<01>))) ; Assumes it's an actual type - (is (= [1 nil] (ns/defnt-keyword->positional-profundal '<1>))) - (is (= [89 nil] (ns/defnt-keyword->positional-profundal '<89>)))) - (testing "Elemental" - (is (= [0 1] (ns/defnt-keyword->positional-profundal :<0>:1))) - (is (= [0 0] (ns/defnt-keyword->positional-profundal :<0>:0))) - (is (= [93 27] (ns/defnt-keyword->positional-profundal :<93>:27))) - (is (thrown? Throwable (ns/defnt-keyword->positional-profundal :<93>:07))))) - -(deftest test:positional-profundal->hint - (is (= 'String (ns/positional-profundal->hint - :clj 0 nil '[a b c d] '[String :<0> "[D" :<2>:1]))) - (is (= 'double (ns/positional-profundal->hint - :clj 2 1 '[a b c d] '[String :<0> "[D" :<2>:1]))) - (is (= :<2>:1 (ns/positional-profundal->hint - :clj 3 nil '[a b c d] '[String :<0> "[D" :<2>:1])))) - -(deftest test:hints->with-replace-special-kws - (testing "Position+depth spec" - (is (= '[String String "[D" double] - (ns/hints->with-replace-special-kws - {:lang :clj - :arglist '[a b c d] - :hints '[String :<0> "[D" :<2>:1]})))) - (testing "CLJS throws on depth spec" - (is (thrown? Throwable - (ns/hints->with-replace-special-kws - {:lang :cljs - :arglist '[a b c d] - :hints '[String :<0> "[D" :<2>:1]})))) - (testing "Refs" - (testing "No cycles" - (is (= '["[D" "[D" "[D" double] - (ns/hints->with-replace-special-kws - {:lang :clj - :arglist '[a b c d] - :hints '["[D" :<0> :<1> :<2>:1]})))) - (testing "Self-reference" - (is (thrown? Throwable - (ns/hints->with-replace-special-kws - {:lang :clj - :arglist '[a b c d] - :hints '[:<0> :<0> "[D" :<2>:1]})))) - (testing "Currently doesn't handle forward references" - (is (thrown? Throwable - (ns/hints->with-replace-special-kws - {:lang :clj - :arglist '[a b c d] - :hints '[:<1> String "[D" :<2>:1]})))))) - -#?(:clj -(ns/defnt dummy-defnt - ([^objects? x ^int k v] 0) - ([^clojure.lang.PersistentVector x k v] 1) - ([^default x k v] 2) - ([ x k ] 3) - ([^clojure.lang.PersistentVector x k ] 4) - ([ x ] 5))) - -(defn interface-call? [code] (-> code first (= '.))) -(defn protocol-call? [code] (-> code first (= 'quantum.test.core.macros.defnt/dummy-defnt-protocol))) - -#?(:clj -(deftest test:defnt:0 - (testing "Specific match -> interface" - (let [code (macroexpand-all '(dummy-defnt (object-array 2) 4 (Object.)))] - (is (interface-call? code)) - (is (= 0 (eval code))))) - (testing "Matches only a default method (not in interface) -> protocol" - (let [code (macroexpand-all '(dummy-defnt (Object.) 4 (Object.)))] - (is (protocol-call? code)) - (is (= 2 (eval code))))) - (testing "Non-default `Object` method -> interface" - (let [code (macroexpand-all '(dummy-defnt (Object.)))] - (is (= '. (first code))) - (is (= nil #_"java.lang.Object" (-> code (nth 3) ana/type-hint))) - (is (= 5 (eval code))))) - (testing "Downcast on related" - (let [code (macroexpand-all '(dummy-defnt ^clojure.lang.IPersistentVector (vector) (long 4)))] - (is (= '. (first code))) - (is (= "clojure.lang.PersistentVector" (-> code (nth 3) ana/type-hint))) - (is (= 4 (eval code))))) - (testing "No downcast on Object" - (let [code (macroexpand-all '(dummy-defnt (vector) (long 4)))] - (is (= '. (first code))) - (is (= "java.lang.Object" (-> code (nth 3) ana/type-hint))) - (is (= 3 (eval code))))))) - -#?(:clj -(deftest test:expand-classes-for-type-hint ; TODO :clj only for now - (let [{:keys [ns- lang class-sym]} data] - (is (= (ns/expand-classes-for-type-hint - class-sym lang ns- [class-sym]) - #{(:expanded data)}))))) - -(deftest - ^{:todo ["Add failure tests"]} - test:protocol-verify-unique-first-hint - (is (= nil - (ns/protocol-verify-unique-first-hint - '([Test_COLON_defnt_COLON_nsEval - [#{java.util.concurrent.atomic.AtomicInteger}] - Object] - [Test_COLON_defnt_COLON_nsEval - [#{java.lang.Short java.lang.Integer java.math.BigInteger long short - int java.lang.Long clojure.lang.BigInt}] - Object]))))) - -; Non |deftest| tests - -#_(log/enable! :macro-expand) -#_(log/enable! :macro-expand-protocol) - -#?(:clj (def test-boxed-long (Long. 1))) -#?(:clj (def test-boxed-int (Integer. 1))) -(def test-string "abcde") - -#_(ns/defnt test:defnt-def** - ([^integer? a b] (+ a b))) - -#_(ns/defnt test:defnt-def - #?(:clj ([^AtomicInteger a] (.get a))) ; namespace-resolved class - ([^integer? a] (inc a)) ; predicate class - #_([^integer? a ^integer? b] [a b]) - ([#{String StringBuilder} a #{boolean char} b] [a b]) - ([#{byte short} a #{int long} b #{float double} c] [a b c])) - -#_(ns/defnt test:defnt-def-generic - ([^string? x] (first x)) ; predicate class - ([x] x)) ; Generic - -#?(:clj -(defmacro with-merge-test [env sym expected] - `(quantum.core.collections.base/merge-call ~env - (fn [env#] - (testing '~sym - (let [ret# (~sym env#)] - (log/ppr-hints :user ~(str "<< TESTING " (name sym) " >>") ret#) - (is (= ret# ~expected)) - ret#)))))) - -#_(deftest integration:defnt - (let [sym 'test-defnt - env {:sym sym ; TODO test the defnt before it gets to this point - :strict? false - :relaxed? false - :sym-with-meta sym - :lang :clj - :ns- *ns* - :body '(([a] (.get a)) - ([a] (inc a)) - ([#{String StringBuilder} a #{boolean char} b] [a b]) - ([#{short byte} a #{long int} b #{double float} c] [a b c])) - :externs (atom [])} - reify-body (fn [env] {:reify-body (reify/gen-reify-body env)}) - reify-def (fn [{:keys [lang] :as env}] - (when (= lang :clj) - (reify/gen-reify-def env))) - defprotocol-from-interface - (fn [{:keys [strict?] :as env}] - (when-not strict? - (proto/gen-defprotocol-from-interface env))) - reify-body-result - '(reify user.TestDefntInterface - (^Object TestDefnt [this ^java.lang.Object a ] (inc ^java.lang.Object a )) - (^Object TestDefnt [this ^java.lang.StringBuilder a ^boolean b ] [^java.lang.StringBuilder a b ]) - (^Object TestDefnt [this ^java.lang.StringBuilder a ^char b ] [^java.lang.StringBuilder a b ]) - (^Object TestDefnt [this ^java.lang.String a ^boolean b ] [^java.lang.String a b ]) - (^Object TestDefnt [this ^java.lang.String a ^char b ] [^java.lang.String a b ]) - (^Object TestDefnt [this ^short a ^long b ^double c] [ a b c]) - (^Object TestDefnt [this ^short a ^long b ^float c] [ a b c]) - (^Object TestDefnt [this ^short a ^int b ^double c] [ a b c]) - (^Object TestDefnt [this ^short a ^int b ^float c] [ a b c]) - (^Object TestDefnt [this ^byte a ^long b ^double c] [ a b c]) - (^Object TestDefnt [this ^byte a ^long b ^float c] [ a b c]) - (^Object TestDefnt [this ^byte a ^int b ^double c] [ a b c]) - (^Object TestDefnt [this ^byte a ^int b ^float c] [ a b c])) - env (-> env - (with-merge-test ns/defnt-arities - '{:arities - [[[a] (.get a)] - [[a] (inc a)] - [[a b] [a b]] - [[a b c] [a b c]]]}) - (with-merge-test ns/defnt-arglists - '{:arglists - [[a] - [a] - [#{StringBuilder String} a - #{boolean char} b] - [#{short byte} a - #{long int} b - #{double float} c]]}) - (with-merge-test ns/defnt-gen-protocol-names - '{:genned-protocol-name TestDefntProtocol, - :genned-protocol-method-name test-defnt-protocol, - :genned-protocol-method-name-qualified user/test-defnt-protocol}) - (with-merge-test ns/defnt-arglists-types - '{:arglists-types - ([[Object] Object] - [[Object] Object] - [[#{StringBuilder String} - #{boolean char}] - Object] - [[#{short byte} - #{long int} - #{double float}] - Object])}) - (with-merge-test ns/defnt-gen-interface-unexpanded - '{:genned-method-name TestDefnt, - :genned-interface-name TestDefntInterface, - :ns-qualified-interface-name user.TestDefntInterface, - :gen-interface-code-header - (gen-interface :name user.TestDefntInterface :methods), - :gen-interface-code-body-unexpanded - {[TestDefnt [#{java.lang.Object}] Object] [[a] (inc a)], - [TestDefnt - [#{java.lang.StringBuilder java.lang.String} #{boolean char}] - Object] - [[a b] [a b]], - [TestDefnt [#{short byte} #{long int} #{double float}] Object] - [[a b c] [a b c]]}}) - (with-merge-test ns/defnt-types-for-arg-positions - {:types-for-arg-positions - '{0 {java.lang.Object #{1}, - java.lang.String #{2}, - java.lang.StringBuilder #{2}, - short #{3}, - byte #{3}}, - 1 {boolean #{2}, char #{2}, long #{3}, int #{3}}, - 2 {double #{3}, float #{3}}}, - :first-types - '{java.lang.Object #{1}, - java.lang.String #{2}, - java.lang.StringBuilder #{2}, - short #{3}, - byte #{3}}}) - (with-merge-test ns/defnt-available-default-types - '{:available-default-types - {0 #{Object boolean char long double int float}, - 1 #{Object double short float byte}, - 2 #{Object boolean char long short int byte}}}) - (with-merge-test ns/defnt-gen-interface-expanded - '{:gen-interface-code-body-expanded - [[[TestDefnt [java.lang.Object ] Object] ([^java.lang.Object a ] (inc a))] - [[TestDefnt [java.lang.StringBuilder boolean ] Object] ([^java.lang.StringBuilder a ^boolean b ] [a b ])] - [[TestDefnt [java.lang.StringBuilder char ] Object] ([^java.lang.StringBuilder a ^char b ] [a b ])] - [[TestDefnt [java.lang.String boolean ] Object] ([^java.lang.String a ^boolean b ] [a b ])] - [[TestDefnt [java.lang.String char ] Object] ([^java.lang.String a ^char b ] [a b ])] - [[TestDefnt [short long double] Object] ([^short a ^long b ^double c] [a b c])] - [[TestDefnt [short long float ] Object] ([^short a ^long b ^float c] [a b c])] - [[TestDefnt [short int double] Object] ([^short a ^int b ^double c] [a b c])] - [[TestDefnt [short int float ] Object] ([^short a ^int b ^float c] [a b c])] - [[TestDefnt [byte long double] Object] ([^byte a ^long b ^double c] [a b c])] - [[TestDefnt [byte long float ] Object] ([^byte a ^long b ^float c] [a b c])] - [[TestDefnt [byte int double] Object] ([^byte a ^int b ^double c] [a b c])] - [[TestDefnt [byte int float ] Object] ([^byte a ^int b ^float c] [a b c])]]}) - (with-merge-test ns/defnt-gen-interface-def - '{:gen-interface-def - (gen-interface - :name user.TestDefntInterface - :methods - [[TestDefnt [java.lang.Object ] Object] - [TestDefnt [java.lang.StringBuilder boolean ] Object] - [TestDefnt [java.lang.StringBuilder char ] Object] - [TestDefnt [java.lang.String boolean ] Object] - [TestDefnt [java.lang.String char ] Object] - [TestDefnt [short long double] Object] - [TestDefnt [short long float ] Object] - [TestDefnt [short int double] Object] - [TestDefnt [short int float ] Object] - [TestDefnt [byte long double] Object] - [TestDefnt [byte long float ] Object] - [TestDefnt [byte int double] Object] - [TestDefnt [byte int float ] Object]])}) - (with-merge-test reify-body - {:reify-body reify-body-result}) - (with-merge-test reify-def - {:reified-sym - 'test-defnt-reified, - :reified-sym-qualified - ^user.TestDefntInterface 'user/test-defnt-reified, - :reify-def - (list 'def 'test-defnt-reified reify-body-result)}) - (with-merge-test defprotocol-from-interface - '{:protocol-def - (defprotocol TestDefntProtocol - (test-defnt-protocol__3 [a0 a1 a2]) - (test-defnt-protocol__2 [a0 a1] [a0 a1 a2]) - (test-defnt-protocol [a0] [a0 a1] [a0 a1 a2])), - :genned-protocol-method-names - (test-defnt-protocol__3 - test-defnt-protocol__2 - test-defnt-protocol)}) - (with-merge-test ns/defnt-extend-protocol-def - '{:extend-protocol-def - (extend-protocol - TestDefntProtocol - nil - (test-defnt-protocol - ([#_(tag nil) a] (let [] (inc ^java.lang.Object a)))) - java.lang.StringBuilder - (test-defnt-protocol - ([^java.lang.StringBuilder a b] (let [b (boolean b)] [^java.lang.StringBuilder a b])) - ([^java.lang.StringBuilder a b] (let [b (char b)] [^java.lang.StringBuilder a b]))) - java.lang.String - (test-defnt-protocol - ([^java.lang.String a b] (let [b (boolean b)] [^java.lang.String a b])) - ([^java.lang.String a b] (let [b (char b)] [^java.lang.String a b]))) - java.lang.Short - (test-defnt-protocol - ([a ^long b ^double c] (let [a (short a) b (long b) c (double c)] [a b c])) - ([a ^long b c] (let [a (short a) b (long b) c (float c)] [a b c])) - ([a b ^double c] (let [a (short a) b (int b) c (double c)] [a b c])) - ([a b c] (let [a (short a) b (int b) c (float c)] [a b c]))) - java.lang.Byte - (test-defnt-protocol - ([a ^long b ^double c] (let [a (byte a) b (long b) c (double c)] [a b c])) - ([a ^long b c] (let [a (byte a) b (long b) c (float c)] [a b c])) - ([a b ^double c] (let [a (byte a) b (int b) c (double c)] [a b c])) - ([a b c] (let [a (byte a) b (int b) c (float c)] [a b c]))))}) - #_(with-merge-test ns/defnt-gen-helper-macro - '{}))])) - -#_(deftest test:defnt - #?(:clj (is (= 300 (test:defnt-def (AtomicInteger. 300))))) ; reify - (is (= 2 (test:defnt-def test-boxed-long))) ; protocol - (is (= 2 (test:defnt-def test-boxed-int ))) - (is (= 2 (test:defnt-def 1))) ; reify - #?(:clj (is (instance? IllegalArgumentException - (err/suppress (test:defnt-def 1.0))))) ; reify, 'No matching method found' - (is (= \a (test:defnt-def-generic test-string))) - (is (= 1 (test:defnt-def-generic 1))) - (is (= [1 2] (test:defnt-def 1 2))) ; reify - (is (= [1 "abcde"] (test:defnt-def test-boxed-int test-string))) ; reify - ) - -(log/disable! :macro-expand) - - -#_(:clj - (defnt' div*-bin- - "Lax |/|; continues on overflow/underflow. - TODO Doesn't preserve ratios." - (^double ; is it actually always double? - [#{byte char short int long float double} n - #{byte char short int long float double} d] - (quantum.core.Numeric/divide n d)) - (^Number [^java.math.BigInteger n ^java.math.BigInteger d] - (when (.equals d BigInteger/ZERO) - (throw (ArithmeticException. "Divide by zero"))) - (let [^BigInteger gcd (.gcd n d)] - (if (.equals gcd BigInteger/ZERO) - BigInt/ZERO - (let [n-f (.divide n gcd) - d-f (.divide d gcd)] - (cond - (.equals d BigInteger/ONE) - (BigInt/fromBigInteger n-f) - (.equals d (.negate BigInteger/ONE)) - (BigInt/fromBigInteger (.negate n-f)) - :else (clojure.lang.Ratio. (if (neg? d-f) (.negate n-f) n-f) - (if (neg? d-f) (.negate d-f) d-f))))))) - ([^clojure.lang.BigInt n ^clojure.lang.BigInt d] - (div*-bin- (->big-integer n) (->big-integer d))) - ([^java.math.BigDecimal n ^java.math.BigDecimal d] - (if (nil? *math-context*) - (.divide n d) - (.divide n d *math-context*))))) - -; TODO you lose the |defnt'| power with this - -; (:clj (defnt div*-bin-denom-byte -; ([#{byte char short int long float double} d ^byte n] (div*-bin- n d)))) -; (:clj (defnt div*-bin-denom-char -; ([#{byte char short int long float double} d ^char n] (div*-bin- n d)))) -; (:clj (defnt div*-bin-denom-short -; ([#{byte char short int long float double} d ^short n] (div*-bin- n d)))) -; (:clj (defnt div*-bin-denom-int -; ([#{byte char short int long float double} d ^int n] (div*-bin- n d)))) -; (:clj (defnt div*-bin-denom-long -; ([#{byte char short int long float double} d ^long n] (div*-bin- n d)))) -; (:clj (defnt div*-bin-denom-float -; ([#{byte char short int long float double} d ^float n] (div*-bin- n d)))) -; (:clj (defnt div*-bin-denom-double -; ([#{byte char short int long float double} d ^double n] (div*-bin- n d)))) diff --git a/test/quantum/test/core/numeric/types.cljc b/test/quantum/test/core/numeric/types.cljc deleted file mode 100644 index f6d55e40..00000000 --- a/test/quantum/test/core/numeric/types.cljc +++ /dev/null @@ -1,21 +0,0 @@ -(ns quantum.test.core.numeric.types - (:require [quantum.core.numeric.types :as ns])) - -(defn test:number [x]) - -(defn test:Integer [x]) - -(defn test:->bigint - ([x])) - -(defn test:ratio [x]) - -(defn test:normalize - [n d]) - -(defn test:->ratio - ([x]) - ([x y])) - -(defn test:numerator [x]) -(defn test:denominator [x]) \ No newline at end of file diff --git a/test/quantum/test/core/type.cljc b/test/quantum/test/core/type.cljc index ce052e8f..a94994c0 100644 --- a/test/quantum/test/core/type.cljc +++ b/test/quantum/test/core/type.cljc @@ -1,72 +1,2 @@ (ns quantum.test.core.type (:require [quantum.core.type :as ns])) - -(defn test:instance+? [x]) - - (defn test:byte-array? [x]) -#?(:clj (defn test:bigint? [x])) -#?(:clj (defn test:file? [x])) - (defn test:hash-map? [x]) - (defn test:sorted-map? [x]) - (defn test:boolean? [x]) - (defn test:listy? [x]) - (defn test:vector? [x]) - (defn test:set? [x]) - (defn test:hash-set? [x]) - (defn test:map? [x]) - (defn test:array-list? [x]) - (defn test:queue? [x]) - (defn test:lseq? [x]) - (defn test:pattern? [x]) - (defn test:regex? [x]) - (defn test:editable? [x]) - (defn test:transient? [x]) - (defn test:array? [x]) -#?(:clj (defn test:prim-long? [x])) - (defn test:double? [x]) -#?(:clj (defn test:indexed? [x])) -#?(:clj (defn test:throwable? [x])) - (defn test:error? [x]) -#?(:clj -(defn test:interface? - [^java.lang.Class class-])) - -#?(:clj -(defn test:abstract? - [^java.lang.Class class-])) - -#?(:clj (defn test:multimethod? [x])) - -#?(:clj -(defn test:protocol? - [obj])) - -#?(:clj -(defn test:promise? - [^Object obj])) -; ===== JAVA ===== - -#?(:clj -(defn test:enum? - [type])) - -; ; ======= TRANSIENTS ======= - -(defn test:should-transientize? [coll]) - -(defn test:identity [x]) - -(defn test:->pred [x]) - -(defn test:->literal [x]) - -(defn test:->base [x]) - -(defn test:transient!* [x]) -(defn test:persistent!* [x]) - -(defn test:transient-fns [coll]) - -(defn test:recommended-transient-fns [coll]) - -(defn test:->joinable [x]) \ No newline at end of file diff --git a/test/quantum/test/core/type/core.cljc b/test/quantum/test/core/type/core.cljc index 553d72d4..ace63072 100644 --- a/test/quantum/test/core/type/core.cljc +++ b/test/quantum/test/core/type/core.cljc @@ -1,19 +1,19 @@ (ns quantum.test.core.type.core (:require - [quantum.core.type.core :as this] + [quantum.core.type.core :as self] [quantum.core.test :refer [deftest is testing]])) #?(:clj (deftest test|nth-elem-type|clj - (is (= "[D" (this/nth-elem-type|clj "[D" 0))) - (is (= 'double (this/nth-elem-type|clj "[D" 1))) - (is (= 'long (this/nth-elem-type|clj "[J" 1))) - (is (= "[Z" (this/nth-elem-type|clj "[[Z" 1))) - (is (= 'boolean (this/nth-elem-type|clj "[[Z" 2))) - (is (= "[Ljava.lang.Object;" (this/nth-elem-type|clj "[[Ljava.lang.Object;" 1))) - (is (= 'java.lang.Object (this/nth-elem-type|clj "[Ljava.lang.Object;" 1))) - (is (thrown? Throwable (this/nth-elem-type|clj "[[Z" 3))) - (is (thrown? Throwable (this/nth-elem-type|clj 'boolean 0))) - (is (thrown? Throwable (this/nth-elem-type|clj Boolean 0))) - (is (thrown? Throwable (this/nth-elem-type|clj "Boolean" 0))))) + (is (= "[D" (self/nth-elem-type|clj "[D" 0))) + (is (= 'double (self/nth-elem-type|clj "[D" 1))) + (is (= 'long (self/nth-elem-type|clj "[J" 1))) + (is (= "[Z" (self/nth-elem-type|clj "[[Z" 1))) + (is (= 'boolean (self/nth-elem-type|clj "[[Z" 2))) + (is (= "[Ljava.lang.Object;" (self/nth-elem-type|clj "[[Ljava.lang.Object;" 1))) + (is (= 'java.lang.Object (self/nth-elem-type|clj "[Ljava.lang.Object;" 1))) + (is (thrown? Throwable (self/nth-elem-type|clj "[[Z" 3))) + (is (thrown? Throwable (self/nth-elem-type|clj 'boolean 0))) + (is (thrown? Throwable (self/nth-elem-type|clj Boolean 0))) + (is (thrown? Throwable (self/nth-elem-type|clj "Boolean" 0))))) diff --git a/test/quantum/test/core/untyped/analyze/expr.cljc b/test/quantum/test/core/untyped/analyze/expr.cljc deleted file mode 100644 index 9391792b..00000000 --- a/test/quantum/test/core/untyped/analyze/expr.cljc +++ /dev/null @@ -1,77 +0,0 @@ -(ns quantum.test.core.untyped.analyze.expr - (:require - [quantum.core.test :as test - :refer [deftest testing is is= throws]] - [quantum.core.untyped.analyze.ast :as ast] - [quantum.core.untyped.analyze.expr :as this] - [quantum.core.untyped.type :as t])) - -(deftest test|casef - (testing "equality" - (testing "self-equality" - (is= (this/casef count 1 nil 2 nil) - (this/casef count 1 nil 2 nil))) - (testing "different case orders are equal" - (is= (this/casef count 1 nil 2 nil) - (this/casef count 2 nil 1 nil)) - (is= (this/casef count "1" nil "2" nil) - (this/casef count "2" nil "1" nil)))) - (testing "inequality" - (testing "inequality of different cases" - (is (not= (this/casef count 1 nil 2 nil) - (this/casef count "1" nil 2 nil))))) - (testing "function call" - (let [dispatch - (this/casef count - 2 (this/condpf-> t/>= (this/get 0) - t/int - (this/condpf-> t/>= (this/get 1) - t/char? t/int? - t/byte? t/int? - t/short? t/int? - t/int? t/int? - t/long? t/long?) - t/short - (this/condpf-> t/>= (this/get 1) - t/long? t/long? - t/int? t/int? - t/short? t/short? - t/char? t/short? - t/byte? t/short?) - t/long - (this/condpf-> t/>= (this/get 1) - t/long? t/long? - t/int? t/long? - t/short? t/long? - t/char? t/long? - t/byte? t/long?) - t/char - (this/condpf-> t/>= (this/get 1) - t/byte? t/char? - t/long? t/long? - t/char? t/char? - t/short? t/short? - t/int? t/int?) - t/byte - (this/condpf-> t/>= (this/get 1) - t/long? t/long? - t/int? t/int? - t/short? t/short? - t/char? t/char? - t/byte? t/byte?)) - 3 (this/condpf-> t/>= (this/get 0) - t/char? - (this/condpf-> t/>= (this/get 1) - t/long? - (this/condpf-> t/>= (this/get 2) - t/long? t/long?))))] - (testing "Success" - (is= (dispatch [t/long? t/long?]) - t/long?) - (is= (dispatch [t/char? t/long? t/long?]) - t/long?) - (is= (dispatch [t/char? t/char?]) - t/char?)) - #_(testing "Failure" - (throws ? (dispatch [t/char]))) - ))) diff --git a/test/quantum/test/core/untyped/collections.cljc b/test/quantum/test/core/untyped/collections.cljc deleted file mode 100644 index 7deaa95f..00000000 --- a/test/quantum/test/core/untyped/collections.cljc +++ /dev/null @@ -1,15 +0,0 @@ -(ns quantum.test.untyped.core.collections - (:require - [quantum.core.test - :refer [deftest is is= testing]] - [quantum.untyped.core.collections :as this])) - -(deftest test:flatten - (is= (this/flatten [[0 1] [2 3 4]] 0) - [[0 1] [2 3 4]]) - - (is= (this/flatten [[0 1] [2 3 4]] 1) - [0 1 2 3 4]) - - (is= (this/flatten [[[0 1]] [[2 3 4]]] 2) - [0 1 2 3 4])) diff --git a/test/quantum/test/core/untyped/convert.cljc b/test/quantum/test/core/untyped/convert.cljc deleted file mode 100644 index 9aa7f730..00000000 --- a/test/quantum/test/core/untyped/convert.cljc +++ /dev/null @@ -1,37 +0,0 @@ -(ns quantum.test.untyped.core.convert - (:require - [quantum.core.test :as test - :refer [deftest testing is is= throws]] - [quantum.untyped.core.convert :as this] - [quantum.untyped.core.qualify - #?@(:cljs [:refer [Ident]])]) - #?(:clj (:import quantum.untyped.core.qualify.Ident))) - -(deftest test|>ident - (is= (this/>ident "a|b|c|d") (Ident. ["a" "b" "c" "d"])) - - (is= (this/>ident String) (Ident. ["java" "lang" "String"])) - - (testing "Symbol" - (is= (this/>ident 'a) (Ident. ["a"])) - (is= (this/>ident 'a/b) (Ident. ["a" "b"])) - (is= (this/>ident 'a|b/c) (Ident. ["a" "b" "c"])) - (is= (this/>ident 'a|b|c) (Ident. ["a" "b" "c"])) - (is= (this/>ident 'a/b|c) (Ident. ["a" "b" "c"])) - (is= (this/>ident 'a|b/c|d) (Ident. ["a" "b" "c" "d"])) - (is= (this/>ident 'a.b/c.d) (Ident. ["a" "b" "c" "d"]))) - - (testing "Keyword" - (is= (this/>ident :a) (Ident. ["a"])) - (is= (this/>ident :a/b) (Ident. ["a" "b"])) - (is= (this/>ident :a|b/c) (Ident. ["a" "b" "c"])) - (is= (this/>ident :a|b|c) (Ident. ["a" "b" "c"])) - (is= (this/>ident :a/b|c) (Ident. ["a" "b" "c"])) - (is= (this/>ident :a|b/c|d) (Ident. ["a" "b" "c" "d"])) - (is= (this/>ident :a.b/c.d) (Ident. ["a" "b" "c" "d"]))) - - (is= (this/>ident (find-ns 'quantum.core.test)) (Ident. ["quantum" "core" "test"])) - - (is= (this/>ident #'count) (Ident. ["clojure" "core" "count"])) - - (is= (this/>ident count) (Ident. ["clojure" "core" "count"]))) diff --git a/test/quantum/test/core/untyped/type.cljc b/test/quantum/test/core/untyped/type.cljc deleted file mode 100644 index d924cefb..00000000 --- a/test/quantum/test/core/untyped/type.cljc +++ /dev/null @@ -1,522 +0,0 @@ -(ns quantum.test.core.untyped.type - (:require - [clojure.core :as core] - [quantum.core.error :as err - :refer [>err]] - [quantum.core.fn :as fn - :refer [fn-> fn1]] - [quantum.core.test :as test - :refer [deftest testing is is= throws]] - [quantum.untyped.core.analyze.ast :as ast] - [quantum.untyped.core.analyze.expr :as xp - :refer [>expr]] - [quantum.untyped.core.numeric :as unum] - [quantum.untyped.core.type :as t])) - -(is= -1 (t/compare (t/value 1) t/numerically-byte?)) - -(is= (t/and t/long? (>expr (fn1 = 1))) - (t/value 1)) - -(is= (t/and (t/value 1) (>expr unum/integer-value?)) - (t/value 1)) - -(t/compare (t/value 1) (>expr unum/integer-value?)) - -(is= 0 (t/compare (t/value 1) (>expr (fn1 =|long 1)))) -(is= 0 (t/compare (t/value 1) (>expr (fn [^long x] (= x 1))))) -(is= 0 (t/compare (t/value 1) (>expr (fn [^long x] (== x 1))))) -(is= 0 (t/compare (t/value 1) (>expr (fn [x] (core/== (long x) 1))))) -(is= 0 (t/compare (t/value 1) (>expr (fn [x] (= (long x) 1))))) - -;; EXAMPLE HIERARCHY ;; - -(gen-interface :name t.a+b⊂) -(gen-interface :name t.a⊂0) -(gen-interface :name t.a⊂1) -(gen-interface :name t.b⊂0) -(gen-interface :name t.b⊂1) - -(gen-interface :name t.a :extends [t.a⊂0 t.a⊂1 t.a+b⊂]) -(gen-interface :name t.b :extends [t.b⊂0 t.b⊂1 t.a+b⊂]) - -(gen-interface :name t.a+b⊃ :extends [t.a t.b]) -(gen-interface :name t.a⊃0 :extends [t.a]) -(gen-interface :name t.a⊃1 :extends [t.a]) -(gen-interface :name t.b⊃0 :extends [t.b]) -(gen-interface :name t.b⊃1 :extends [t.b]) - -(gen-interface :name t.∅0) -(gen-interface :name t.∅1) -(gen-interface :name t.∅2) - -(def a+b⊂ (t/isa? t.a+b⊂)) -(def a⊂0 (t/isa? t.a⊂0)) -(def a⊂1 (t/isa? t.a⊂1)) -(def b⊂0 (t/isa? t.b⊂0)) -(def b⊂1 (t/isa? t.b⊂1)) -(def a (t/isa? t.a)) -(def b (t/isa? t.b)) -(def a+b⊃ (t/isa? t.a+b⊃)) -(def a⊃0 (t/isa? t.a⊃0)) -(def a⊃1 (t/isa? t.a⊃1)) -(def b⊃0 (t/isa? t.b⊃0)) -(def b⊃1 (t/isa? t.b⊃1)) -; ∅ : a (possibly empty) intersect that is neither a subset nor superset -(def ∅0 (t/isa? t.∅0)) -(def ∅1 (t/isa? t.∅1)) -(def ∅2 (t/isa? t.∅2)) - -;; TESTS ;; - -(deftest test|in|compare - (testing "ValueSpec" - (testing "+ ValueSpec" - (testing "=" - (is= 0 (t/compare (t/value 1) (t/value 1))) - (is= 0 (t/compare (t/value "a") (t/value "a")))) - (testing "<" - (is= -1 (t/compare (t/value 1) (t/value 2))) - (is= -1 (t/compare (t/value "a") (t/value "b")))) - (testing ">" - (is= 1 (t/compare (t/value 2) (t/value 1))) - (is= 1 (t/compare (t/value "b") (t/value "a")))) - (testing "∅" - (is= nil (t/compare (t/value 1) (t/value "a"))))) - (testing "+ ClassSpec" - (testing "<" - (testing "Class equality" - (is= -1 (t/compare (t/value "a") t/string?))) - (testing "Class inheritance" - (is= -1 (t/compare (t/value "a") t/char-seq?)) - (is= -1 (t/compare (t/value "a") t/object?)))) - (testing "∅" - (is= nil (t/compare (t/value "a") t/byte?)))) - (testing "+ ProtocolSpec") - (testing "+ NilableSpec") - (testing "+ OrSpec" - (testing "<" - ;; #{"a"} ∅ t/byte? - ;; #{"a"} ⊂ t/string? - ;; -> #{"a"} ⊂ (t/byte? ∪ t/string?) - (is= -1 (t/compare (t/value "a") (t/or t/byte? t/string?)))) - (testing "∅" - ;; #{"a"} ∅ t/byte? - ;; #{"a"} ∅ t/long? - ;; -> #{"a"} ∅ (t/byte? ∪ t/long?) - (is= nil (t/compare (t/value "a") (t/or t/byte? t/long?))))) - (testing "+ UnorderedOrSpec") - (testing "+ AndSpec" - (testing "in>" - (is= nil (t/compare (t/value "a") (t/and t/string? ...)))) - (testing "in: disjoint" - ;; #{"a"} ∅ t/byte? - ;; #{"a"} ⊂ t/char-seq? - ;; -> #{"a"} ∅ (t/byte? ∩ t/char-seq?) - (is= nil (t/compare (t/value "a") (t/and t/byte? t/char-seq?))) - ;; #{"a"} ∅ t/byte? - ;; #{"a"} ∅ t/long? - ;; -> #{"a"} ∅ (t/byte? ∩ t/long?) - (is= nil (t/compare (t/value "a") (t/and t/byte? t/long?))))) - (testing "+ UnorderedAndSpec")) - (testing "ClassSpec" - (testing "+ ValueSpec" - (testing ">" - (testing "Class equality" - (is= 1 (t/compare t/string? (t/value "a")))) - (testing "Class inheritance" - (is= 1 (t/compare t/char-seq? (t/value "a"))) - (is= 1 (t/compare t/object? (t/value "a"))))) - (testing "∅" - (is= nil (t/compare t/byte? (t/value "a"))))) - (testing "+ ClassSpec" - (testing "=" - (is= 0 (t/compare t/long? t/long?)) - (is= 0 (t/compare t/object? t/object?))) - (testing ">" - (testing "Primitive" - (is= 1 (t/compare t/object? t/long?))) - (testing "Reference" - (is= 1 (t/compare t/object? t/string?))) - (testing "Interface" - (is= 1 (t/compare t/char-seq? t/string?)))) - (testing "<" - (testing "Primitive" - (is= -1 (t/compare t/long? t/object?))) - (testing "Reference" - (is= -1 (t/compare t/string? t/object?))) - (testing "Interface" - (is= -1 (t/compare t/string? t/char-seq?)))) - (testing "∅" - (testing "Primitive + Primitive" - (is= nil (t/compare t/long? t/int?)) - (is= nil (t/compare t/int? t/long?))) - (testing "Primitive + Reference" - (is= nil (t/compare t/long? t/string?)) - (is= nil (t/compare t/string? t/long?))) - (testing "Reference + Reference" - (is= nil (t/compare t/string? (t/isa? java.util.Collection))) - (is= nil (t/compare (t/isa? java.util.Collection) t/string?))) - (testing "Reference + Interface" - (is= nil (t/compare (t/isa? java.util.ArrayList) t/char-seq?)) - (is= nil (t/compare t/char-seq? (t/isa? java.util.ArrayList)))) - (testing "Interface + Interface" - (is= nil (t/compare t/char-seq? t/comparable?)) - (is= nil (t/compare t/comparable? t/char-seq?))))) - (testing "+ ProtocolSpec") - (testing "+ NilableSpec" - (testing "Nilabled is =" - (is= -1 (t/compare t/long? (t/? t/long?)))) - (testing "Nilabled is ⊃" - (is= -1 (t/compare t/long? (t/? t/object?)))) - (testing "Nilabled is ⊂" - (is= nil (t/compare t/object? (t/? t/long?)))) - (testing "Nilabled is ∅" - (is= nil (t/compare t/long? (t/? t/string?))))) - (testing "+ OrSpec" - ;; #{(⊂ | =) ∅} -> ⊂ - ;; #{(⊃ ?) ∅} -> ∅ - ;; Otherwise whatever it is - (testing "#{⊂+} -> ⊂" - (is= -1 (t/compare a (t/or a+b⊂ a⊂0 a⊂1)))) - (testing "#{∅+} -> ∅" - (is= nil (t/compare a (t/or ∅0 ∅1)))) - (testing "#{⊂+ ∅+} -> ⊂" - (is= -1 (t/compare a (t/or a+b⊂ a⊂0 ∅0 ∅1)))) - (testing "#{=+ ∅+} -> ⊂" - (is= -1 (t/compare a (t/or a ∅0 ∅1)))) - (testing "#{⊃+ ∅+} -> ∅" - (is= nil (t/compare a (t/or a+b⊃ a⊃0 ∅0 ∅1))))) - (testing "+ UnorderedOrSpec") - (testing "+ AndSpec" - ;; Any ∅ -> ∅ - ;; Otherwise whatever it is - (testing "#{⊂+} -> ⊂" - (is= -1 (t/compare a (t/and a+b⊂ a⊂0 a⊂1)))) - (testing "#{⊃+} -> ⊃" - (is= 1 (t/compare a (t/and a+b⊃ a⊃0 a⊃1)))) - (testing "#{∅+} -> ∅" - (is= nil (t/compare a (t/and ∅0 ∅1)))) - (testing "#{⊂+ ∅+} -> ∅" - (is= nil (t/compare a (t/and a+b⊂ a⊂0 a⊂1 ∅0 ∅1)))) - (testing "#{=+ ∅+} -> ∅" - (is= nil (t/compare a (t/and a ∅0 ∅1)))) - (testing "#{⊃+ ∅+} -> ∅" - (is= nil (t/compare a (t/and a+b⊃ a⊃0 ∅0 ∅1))))) - (testing "+ UnorderedAndSpec")) - (testing "ProtocolSpec" - (testing "+ ValueSpec") - (testing "+ ClassSpec") - (testing "+ ProtocolSpec") - (testing "+ NilableSpec") - (testing "+ OrSpec") - (testing "+ UnorderedOrSpec") - (testing "+ AndSpec") - (testing "+ UnorderedAndSpec")) - (testing "NilableSpec" - (testing "+ ValueSpec") - (testing "+ ClassSpec") - (testing "+ ProtocolSpec") - (testing "+ NilableSpec") - (testing "+ OrSpec") - (testing "+ UnorderedOrSpec") - (testing "+ AndSpec") - (testing "+ UnorderedAndSpec")) - (testing "OrSpec" - (testing "+ ValueSpec") - (testing "+ ClassSpec") - (testing "+ ProtocolSpec") - (testing "+ NilableSpec") - (testing "+ OrSpec" - ;; (let [l - ;; r ] - ;; (if l - ;; (if r 0 -1) - ;; (if r 1 nil))) - ;; - ;; Comparison annotations achieved by first comparing each element of the first/left - ;; to the entire second/right, then comparing each element of the second/right to the - ;; entire first/left - (testing "#{= ⊂+} -> #{⊂+}" - (testing "+ #{⊂+}" - ;; comparisons: [-1, -1], [-1, -1] - (is= 0 (t/compare (t/or a a+b⊂ a⊂0) (t/or a+b⊂ a⊂0))) - ;; comparisons: [-1, -1, nil], [-1, -1] - (is= 1 (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/or a+b⊂ a⊂0))) - ;; comparisons: [-1, -1], [-1, -1, nil] - (is= -1 (t/compare (t/or a a+b⊂ a⊂0) (t/or a+b⊂ a⊂0 a⊂1))) - ;; comparisons: [-1, -1, -1], [-1, -1, -1] - (is= 0 (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/or a+b⊂ a⊂0 a⊂1)))) - (testing "+ #{∅+}" - ;; comparisons: [nil, nil, nil], [nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/or ∅0 ∅1)))) - (testing "+ #{⊂+ ∅+}" - ;; comparisons: [-1, nil], [-1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/or a+b⊂ ∅0 ∅1))) - ;; comparisons: [-1, nil, nil], [-1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/or a+b⊂ ∅0 ∅1))) - ;; comparisons: [-1, -1], [-1, -1, nil, nil] - (is= -1 (t/compare (t/or a a+b⊂ a⊂0) (t/or a+b⊂ a⊂0 ∅0 ∅1))) - ;; comparisons: [-1, -1, nil], [-1, -1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/or a+b⊂ a⊂0 ∅0 ∅1))) - ;; comparisons: [-1, -1], [-1, -1, nil, nil, nil] - (is= -1 (t/compare (t/or a a+b⊂ a⊂0) (t/or a+b⊂ a⊂0 a⊂1 ∅0 ∅1))) - ;; comparisons: [-1, -1, 1], [-1, -1, -1, nil, nil] - (is= -1 (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/or a+b⊂ a⊂0 a⊂1 ∅0 ∅1)))) - (testing "+ #{= ∅+}" - ;; comparisons: [nil, nil], [-1, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/or a ∅0))) - ;; comparisons: [nil, nil], [-1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/or a ∅0 ∅1)))) - (testing "+ #{⊃+ ∅+}" - ;; comparisons: [nil, nil], [-1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/or a+b⊃ ∅0 ∅1))) - ;; comparisons: [nil, nil, nil], [-1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/or a+b⊃ ∅0 ∅1))) - ;; comparisons: [nil, nil], [-1, -1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/or a+b⊃ a⊃0 ∅0 ∅1))) - ;; comparisons: [nil, nil, nil], [-1, -1, nil nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/or a+b⊃ a⊃0 ∅0 ∅1))) - ;; comparisons: [nil, nil], [-1, -1, nil, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/or a+b⊃ a⊃0 a⊃1 ∅0 ∅1))) - ;; comparisons: [nil, nil, nil], [-1, -1, -1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/or a+b⊃ a⊃0 a⊃1 ∅0 ∅1))))) - (testing "#{= ∅+}" - (testing "+ #{⊂+}" - ;; comparisons: [-1, nil], [nil, nil] - (is= nil (t/compare (t/or a ∅0) (t/or a+b⊂ a⊂0))) - ;; comparisons: [-1, nil, nil], [nil, nil] - (is= nil (t/compare (t/or a ∅0 ∅1) (t/or a+b⊂ a⊂0))) - ;; comparisons: [-1, nil], [nil, nil, nil] - (is= nil (t/compare (t/or a ∅0) (t/or a+b⊂ a⊂0 a⊂1))) - ;; comparisons: [-1, nil, nil], [nil, nil, nil] - (is= nil (t/compare (t/or a ∅0 ∅1) (t/or a+b⊂ a⊂0 a⊂1)))) - (testing "+ #{∅+}" - ;; comparisons: [nil, -1], [-1, nil] - (is= nil (t/compare (t/or a ∅0) (t/or ∅0 ∅1))) - ;; comparisons: [nil, -1, -1], [-1, -1] - (is= 1 (t/compare (t/or a ∅0 ∅1) (t/or ∅0 ∅1))) - ;; comparisons: [nil, nil], [nil, nil] - (is= nil (t/compare (t/or a ∅2) (t/or ∅0 ∅1))) - ;; comparisons: [nil, nil, -1], [nil, -1] - (is= nil (t/compare (t/or a ∅2 ∅1) (t/or ∅0 ∅1))) - ;; comparisons: [nil, nil], [nil, nil] - (is= nil (t/compare (t/or a ∅0) (t/or ∅1 ∅2))) - ;; comparisons: [nil, nil, -1], [-1, nil] - (is= nil (t/compare (t/or a ∅0 ∅1) (t/or ∅1 ∅2)))) - (testing "+ #{⊂+ ∅+}") ;; TODO flesh out (?) - (testing "+ #{= ∅+}") ;; TODO flesh out (?) - (testing "+ #{⊃+ ∅+}")) ;; TODO flesh out (?) - - (testing "#{⊂+ ∅+} -> ⊂") - (testing "#{= ∅+} -> ⊂") - (testing "#{⊃+ ∅+} -> ∅")) - (testing "+ UnorderedOrSpec") - (testing "+ AndSpec" - ;; (if 1 nil) - ;; - ;; Comparison annotations achieved by first comparing each element of the first/left - ;; to the entire second/right, then comparing each element of the second/right to the - ;; entire first/left - (testing "#{= ⊂+} -> #{⊂+}" - (testing "+ #{⊂+}" - ;; comparisons: [-1, -1], [-1, -1] - (is= 1 (t/compare (t/or a a+b⊂ a⊂0) (t/and a+b⊂ a⊂0))) - ;; comparisons: [-1, -1, nil], [-1, -1] - (is= 1 (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/and a+b⊂ a⊂0))) - ;; comparisons: [-1, -1], [-1, -1, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/and a+b⊂ a⊂0 a⊂1))) - ;; comparisons: [-1, -1, -1], [-1, -1, -1] - (is= 1 (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/and a+b⊂ a⊂0 a⊂1)))) - (testing "+ #{∅+}" - ;; comparisons: [nil, nil, nil], [nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/and ∅0 ∅1)))) - (testing "+ #{⊂+ ∅+}" - ;; comparisons: [-1, nil], [-1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/and a+b⊂ ∅0 ∅1))) - ;; comparisons: [-1, nil, nil], [-1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/and a+b⊂ ∅0 ∅1))) - ;; comparisons: [-1, -1], [-1, -1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/and a+b⊂ a⊂0 ∅0 ∅1))) - ;; comparisons: [-1, -1, nil], [-1, -1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/and a+b⊂ a⊂0 ∅0 ∅1))) - ;; comparisons: [-1, -1], [-1, -1, nil, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/and a+b⊂ a⊂0 a⊂1 ∅0 ∅1))) - ;; comparisons: [-1, -1, -], [-1, -1, -1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/and a+b⊂ a⊂0 a⊂1 ∅0 ∅1)))) - (testing "+ #{= ∅+}" - ;; comparisons: [nil, nil], [-1, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/and a ∅0))) - ;; comparisons: [nil, nil], [-1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/and a ∅0 ∅1)))) - (testing "+ #{⊃+ ∅+}" - ;; comparisons: [nil, nil], [-1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/and a+b⊃ ∅0 ∅1))) - ;; comparisons: [nil, nil, nil], [-1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/and a+b⊃ ∅0 ∅1))) - ;; comparisons: [nil, nil], [-1, -1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/and a+b⊃ a⊃0 ∅0 ∅1))) - ;; comparisons: [nil, nil, nil], [-1, -1, nil nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/and a+b⊃ a⊃0 ∅0 ∅1))) - ;; comparisons: [nil, nil], [-1, -1, nil, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0) (t/and a+b⊃ a⊃0 a⊃1 ∅0 ∅1))) - ;; comparisons: [nil, nil, nil], [-1, -1, -1, nil, nil] - (is= nil (t/compare (t/or a a+b⊂ a⊂0 a⊂1) (t/and a+b⊃ a⊃0 a⊃1 ∅0 ∅1)))))) - (testing "+ UnorderedAndSpec")) - (testing "UnorderedOrSpec" - (testing "+ ValueSpec") - (testing "+ ClassSpec") - (testing "+ ProtocolSpec") - (testing "+ NilableSpec") - (testing "+ OrSpec") - (testing "+ UnorderedOrSpec") - (testing "+ AndSpec") - (testing "+ UnorderedAndSpec")) - (testing "AndSpec" - (testing "+ ValueSpec") - (testing "+ ClassSpec") - (testing "+ ProtocolSpec") - (testing "+ NilableSpec") - (testing "+ OrSpec") - (testing "+ UnorderedOrSpec") - (testing "+ AndSpec") - (testing "+ UnorderedAndSpec")) - (testing "UnorderedAndSpec" - (testing "+ ValueSpec") - (testing "+ ClassSpec") - (testing "+ ProtocolSpec") - (testing "+ NilableSpec") - (testing "+ OrSpec") - (testing "+ UnorderedOrSpec") - (testing "+ AndSpec") - (testing "+ UnorderedAndSpec"))) - -(deftest test|intersection|spec - (testing "equality" - (is= (t/intersection|spec t/long? t/long?) - t/long?)) - (testing "specificity" - (testing "Primitive + Reference" - (is= (t/intersection|spec t/object? t/int?) - t/int?) - (is= (t/intersection|spec t/int? t/object?) - t/int?)) - (testing "Reference + Reference" - (is= (t/intersection|spec t/object? t/string?) - t/string?) - (is= (t/intersection|spec t/string? t/object?) - t/string?)) - (testing "Reference + Interface" - (is= (t/intersection|spec t/char-seq? t/string?) - t/string?) - (is= (t/intersection|spec t/string? t/char-seq?) - t/string?) - (is= (t/intersection|spec t/char-seq? t/object?) - t/char-seq?) - (is= (t/intersection|spec t/object? t/char-seq?) - t/char-seq?))) - (testing "disjointness" - (testing "Primitive + Primitive" - (is= (t/intersection|spec t/long? t/int?) - nil)))) - -(deftest test|union|spec - (testing "equality" - (is= (t/union|spec t/long? t/long?) - t/long?)) - (testing "specificity" - (testing "Primitive + Reference" - (is= (t/union|spec t/object? t/int?) - t/object?) - (is= (t/union|spec t/int? t/object?) - t/object?)) - (testing "Reference + Reference" - (is= (t/union|spec t/object? t/string?) - t/object?) - (is= (t/union|spec t/string? t/object?) - t/object?)) - (testing "Reference + Interface" - (is= (t/union|spec t/char-seq? t/string?) - t/char-seq?) - (is= (t/union|spec t/string? t/char-seq?) - t/char-seq?) - (is= (t/union|spec t/char-seq? t/object?) - t/object?) - (is= (t/union|spec t/object? t/char-seq?) - t/object?))) - (testing "disjointness" - (testing "Primitive + Primitive" - (is= (t/union|spec t/long? t/int?) - #{t/long? t/int?})))) - -(deftest test|or - (testing "simplification" - (testing "via single-arg" - (is= (t/or t/long?) - t/long?)) - (testing "via identity" - (is= (t/or t/long? t/long?) - t/long?)) - (testing "nested" - (is= (t/or (t/or t/long? t/long?) t/long?) - t/long?)) - (testing "#{⊂+ =} -> #{⊂+}" - (is= (.-args (t/or a+b⊂ a⊂0 a)) - [a+b⊂ a⊂0])) - (testing "#{⊂+ ⊃+} -> #{⊂+}" - (is= (.-args (t/or a+b⊂ a⊂0 a+b⊃ a⊃0)) - [a+b⊂ a⊂0])) - (testing "#{⊃+ =} -> #{=}" - (is= (t/or a+b⊃ a⊃0 a) - a)) - (testing "#{⊂+ ⊃+ ∅+} -> #{⊂+ ∅+}" - (is= (.-args (t/or a+b⊂ a⊂0 a+b⊃ a⊃0 ∅0 ∅1)) - [a+b⊂ a⊂0 ∅0 ∅1])) - (testing "#{⊂+ =+ ⊃+ ∅+} -> #{⊂+ ∅+}" - (is= (.-args (t/or a+b⊂ a⊂0 a a+b⊃ a⊃0 ∅0 ∅1)) - [a+b⊂ a⊂0 ∅0 ∅1]))) - -(deftest test|and - ;; TODO return `(constantly false)` when impossible intersection - (testing "simplification" - (testing "via single-arg" - (is= (t/and t/long?) - t/long?)) - (testing "via identity" - (is= (t/and t/long? t/long?) - t/long?)) - (testing "nested" - (is= (t/and (t/and t/long? t/long?) t/long?) - t/long?) - (is= (.-args (t/or (t/or t/string? t/double?) - (t/or t/double? t/string?))) - [t/string? t/double?]) - (is= (.-args (t/or (t/or t/string? t/double?) - t/double?)) - [t/string? t/double?]) - ;; TODO this is failing with (t/or (t/or t/string? t/double?) t/char-seq?) - (is= (.-args (t/or (t/or t/string? t/double?) - t/char-seq?)) - [t/char-seq? t/double?]) - (is= (.-args (t/or (t/or t/string? t/double?) - (t/or t/double? t/char-seq?))) - [t/double? t/char-seq?]) - (is= (.-args (t/or (t/or t/string? t/double?) - (t/or t/char-seq? t/number?))) - [t/char-seq? t/number?])) - (testing "#{⊂+ =} -> #{=}" - - (is= (t/and a+b⊂ a⊂0 a) - a)) - (testing "#{⊃+ =+} -> #{⊃+}" - (is= (.-args (t/and a+b⊃ a⊃0 a)) - [a+b⊃ a⊃0])) - (testing "#{⊂+ ⊃+} -> #{⊃+}" - (is= (.-args (t/and a+b⊂ a⊂0 a+b⊃ a⊃0)) - [a+b⊃ a⊃0])) - (testing "#{⊂+ ⊃+ ∅+} -> #{⊃+ ∅+}" - (is= (.-args (t/and a+b⊂ a⊂0 a+b⊃ a⊃0 ∅0 ∅1)) - [a+b⊃ a⊃0 ∅0 ∅1])) - (testing "#{⊂+ =+ ⊃+ ∅+} -> #{⊃+ ∅+}" - (is= (.-args (t/and a+b⊂ a⊂0 a a+b⊃ a⊃0 ∅0 ∅1)) - [a+b⊃ a⊃0 ∅0 ∅1])))) diff --git a/test/quantum/test/core/vars.cljc b/test/quantum/test/core/vars.cljc index acb13c6f..0300a69c 100644 --- a/test/quantum/test/core/vars.cljc +++ b/test/quantum/test/core/vars.cljc @@ -34,7 +34,7 @@ (defn test:reset-var! [var-0 val-f]) -(defn test:swap-var! +(defn test:update-var! ([var-0 f]) ([var-0 f & args])) @@ -65,4 +65,4 @@ (defn test:namespace-exists? [ns-sym])) -(defn test:unqualify [sym]) \ No newline at end of file +(defn test:unqualify [sym]) diff --git a/test/quantum/test/numeric/core.cljc b/test/quantum/test/numeric/core.cljc index 509b4c42..87e6469f 100644 --- a/test/quantum/test/numeric/core.cljc +++ b/test/quantum/test/numeric/core.cljc @@ -25,7 +25,7 @@ (dotimes [i 100] ; doubles might be off by a little bit — TODO have tests for doubles (let [target-sum (rationalize (rand))] (is (= (->> (repeatedly (rand/int-between 5 20) #(rationalize (rand))) - (<- ns/normalize-sum-to target-sum) + (<- (ns/normalize-sum-to target-sum)) (apply +)) target-sum))))) diff --git a/test/quantum/test/untyped/core/analyze.cljc b/test/quantum/test/untyped/core/analyze.cljc new file mode 100644 index 00000000..e8ee20e7 --- /dev/null +++ b/test/quantum/test/untyped/core/analyze.cljc @@ -0,0 +1,553 @@ +(ns quantum.test.untyped.core.analyze + (:require + [quantum.test.untyped.core.type :as tt] + [quantum.untyped.core.analyze :as self] + [quantum.untyped.core.analyze.ast :as uast] + [quantum.untyped.core.collections :as uc] + [quantum.untyped.core.collections.logic + :refer [seq-and-2]] + [quantum.untyped.core.data.map :as umap] + [quantum.untyped.core.data.reactive :as urx] + [quantum.untyped.core.fn + :refer [<-]] + [quantum.untyped.core.loops + :refer [reduce-2]] + [quantum.untyped.core.test + :refer [deftest is is= testing throws]] + [quantum.untyped.core.type :as t] + [quantum.untyped.core.type.reifications :as utr])) + +;; Simulates a typed fn +(defn- >long-checked {:quantum.core.type/type (t/rx (t/ftype [t/string? :> tt/long?]))} []) + +(defn- dummy {:quantum.core.type/type (t/rx (t/ftype [(t/or tt/short? tt/char?)]))} []) + +;; For this fn, the input types combine when applying `t/or` (`(t/or t/nil? t/val?)`) +(defn- input-types-combine + {:quantum.core.type/type + (t/rx (t/ftype [t/nil? tt/byte?] + [t/nil? tt/char?] + [(t/ref t/val?) tt/byte?] + [(t/ref t/val?) tt/char?]))} + []) + +(defn- transform-ana [ana] + (->> ana + (mapv #(vector (->> % :env :opts :arg-env deref (uc/map-vals' :type)) + (-> % :output-type-node :type))))) + +;; More dependent type tests in `quantum.test.untyped.core.type.defnt` but those are more like +;; integration tests +(deftest test|dependent-type + (testing "Output type dependent on non-splittable input" + (testing "Not nested within another type" + #_"1. Analyze `x` = `tt/boolean?` + -> Put `x` in env as `(t/isa? Boolean)` + 2. Analyze out-type = `(t/type x)` + -> `(t/isa? Boolean)`" + (let [ana (self/analyze-arg-syms '{x tt/boolean?} '(t/type x))] + (is= (transform-ana ana) + [[{'x tt/boolean?} tt/boolean?]]))) + (testing "Nested within another type" + (testing "Without arg shadowing" + #_"1. Analyze `x` = `tt/boolean?` + -> Put `x` in env as `(t/isa? Boolean)` + 2. Analyze out-type = `(t/or t/byte? (t/type x))` + 1. Analyze `(t/type x)` + -> `(t/isa? Boolean)` + -> `(t/or (t/isa? Byte) (t/isa? Boolean))`" + (let [ana (self/analyze-arg-syms '{x tt/boolean?} '(t/or tt/byte? (t/type x)))] + (is= (transform-ana ana) + [[{'x tt/boolean?} (t/or tt/byte? tt/boolean?)]]))) + (testing "With arg shadowing" + #_"1. Analyze `x` = `tt/boolean?` + -> Put `x` in env as `(t/isa? Boolean)` + 2. Analyze out-type = `(let [x (>long-checked \"123\")] + (t/or t/number? (t/type x)))` + 1. Analyze `(>long-checked \"123\")` + -> Put `x` in env as `(t/isa? Long)` + 2. Analyze `(t/or t/number? (t/type x))` + 1. Analyze `(t/type x)` + -> `(t/isa? Long)` + -> `(t/or (t/isa? Byte) (t/isa? Long))" + (let [ana (self/analyze-arg-syms + '{x tt/boolean?} + '(let [x (>long-checked "123")] + (t/or (t/isa? Byte) (t/type x))))] + (is= (transform-ana ana) + [[{'x tt/boolean?} (t/or (t/isa? Byte) tt/long?)]]))))) + (testing "Output type dependent on splittable but non-primitive-splittable input" + #_"1. Analyze `x` = `(t/or tt/boolean? tt/string?)`. Splittable. + 2. Split `(t/or tt/boolean? tt/string?)`: + [[x tt/boolean? > (t/type x)] + [x tt/string? > (t/type x)]] + 3. Analyze split 0. + 1. Analyze `x` = `tt/boolean?` + -> Put `x` in env as `(t/isa? Boolean)` + 2. Analyze out-type = `(t/type x)` + -> `(t/isa? Boolean)` + 4. Analyze split 1. + 1. Analyze `x` = `tt/string?` + -> Put `x` in env as `(t/isa? String)` + 2. Analyze out-type = `(t/type x)` + -> `(t/isa? String)`" + (let [ana (self/analyze-arg-syms + {'x '(t/or tt/boolean? tt/string?)} + '(t/type x))] + (is= (transform-ana ana) + [[{'x tt/boolean?} tt/boolean?] + [{'x tt/string?} tt/string?]]))) + (testing "Output type dependent on primitive-splittable input" + #_"1. Analyze `x` = `t/any?`. Primitive-splittable. + 2. Split `t/any?`: + [[x tt/boolean? > (t/type x)] + [x ... > (t/type x)]] + 3. Analyze split 0. + 1. Analyze `x` = `tt/boolean?` + -> Put `x` in env as `(t/isa? Boolean)` + 2. Analyze out-type = `(t/type x)` + -> `(t/isa? Boolean)` + 4. Analyze rest of splits in the same way." + (let [ana (self/analyze-arg-syms {'x 't/any?} '(t/type x))] + (is= (transform-ana ana) + [[{'x tt/boolean?} tt/boolean?] + [{'x tt/byte?} tt/byte?] + [{'x tt/short?} tt/short?] + [{'x tt/char?} tt/char?] + [{'x tt/int?} tt/int?] + [{'x tt/long?} tt/long?] + [{'x tt/float?} tt/float?] + [{'x tt/double?} tt/double?] + [{'x t/any?} t/any?]]))) + (testing "Input type dependent on other input type" + (testing "Dependent type is not for first input" + #_"1. Analyze `a` = `tt/byte?` + -> Put `a` in env as `(t/isa? Byte)` + 2. Analyze `b` = `(t/type a)` + -> Put `b` in env as `(t/isa? Byte)`" + (let [ana (self/analyze-arg-syms '{a tt/byte?, b (t/type a)} 't/any?)] + (is= (transform-ana ana) + [[{'a tt/byte? 'b tt/byte?} t/any?]]))) + (testing "Dependent type is for first input" + #_"1. Analyze `a` = `(t/type b)`. + 2. Analyze `b` = `tt/byte?` + -> Put `b` in env as `(t/isa? Byte)` + -> Put `a` in env as `(t/isa? Byte)`" + (let [ana (self/analyze-arg-syms '{a (t/type b) b tt/byte?} 't/any?)] + (is= (transform-ana ana) + [[{'a (t/isa? Byte) 'b (t/isa? Byte)} t/any?]])))) + (testing "Output type dependent on input type which is dependent on other input type" + (testing "First input not splittable; second input not splittable" + #_"1. Analyze `a` = `tt/byte?` + -> Put `a` in env as `(t/isa? Byte)` + 2. Analyze `b` = `(t/type a)` + -> Put `b` in env as `(t/isa? Byte)` + 3. Analyze out-type = `(t/type b)` + -> `(t/isa? Byte)`" + (is= (-> (self/analyze-arg-syms '{a tt/byte? b (t/type a)} '(t/type b)) + transform-ana) + [[{'a (t/isa? Byte) 'b (t/isa? Byte)} (t/isa? Byte)]])) + (testing "First input splittable; second input not splittable" + #_"1. Analyze `a` = `(t/or tt/boolean? tt/byte?)`. Splittable. + 2. Split: + [[a tt/boolean?, b (t/type a) > (t/type b)] + [a tt/byte? , b (t/type a) > (t/type b)]] + 3. Analyze split 0. + 1. Analyze `a` = `tt/boolean?` + -> Put `a` in env as `(t/isa? Boolean)` + 2. Analyze `b` = `(t/type a)` + -> Put `b` in env as `(t/isa? Boolean)` + 3. Analyze out-type = `(t/type b)` + -> `(t/isa? Boolean)` + 4. Analyze split 1 in the same way." + (is= (-> (self/analyze-arg-syms '{a (t/or tt/boolean? tt/byte?) b (t/type a)} '(t/type b)) + transform-ana) + [[{'a (t/isa? Boolean) 'b (t/isa? Boolean)} (t/isa? Boolean)] + [{'a (t/isa? Byte) 'b (t/isa? Byte)} (t/isa? Byte)]])) + (testing "Two input types directly depend on each other" + (testing "Symbolically" + #_"1. Analyze `a` = `(t/type b)` + - Put `a` on queue + 1. Analyze `b` = `(t/type a)` + - Put `b` on queue + -> ERROR: `a` not in environment and `a` already on queue; circular + dependency detected" + (throws (self/analyze-arg-syms '{a (t/type b) b (t/type a)} 't/any?))) + (testing "Non-symbolically" + #_"1. Analyze `a` = `(t/type b)` + - Put `a` on queue + 1. Analyze `b` = `(t/type [a])` + - Put `b` on queue + 1. Analyze `[a]` + 1. Analyze `a` + -> ERROR: `a` not in environment and `a` already on queue; + circular dependency detected" + (throws (self/analyze-arg-syms '{a (t/type b) b (t/type [a])} 't/any?)))) + (testing "Two input types indirectly depend on each other" + #_"1. Analyze `a` = `(t/type b)` + 1. Analyze `b` = `(t/type c)` + 1. Analyze `c` = `(t/type a)` + -> ERROR `a` not in environment and `a` already in queue; circular + dependency detected" + (throws (self/analyze-arg-syms '{a (t/type b) b (t/type c) c (t/type a)} 't/any?))) + (testing "Complex test for `t/type` and simple test for `t/input`" + ;; This test overview was put up in ~30 minutes on 9/30/2018 during a seemingly random walk of + ;; thoughts without any testing or research whatsoever that happened to actually coalesce + ;; into a working, clear, simple algorithm for handling dependent types. Not sure if + ;; listening to Bach's Passacaglia & Fugue In C Minor for organ and then orchestra helped, + ;; but there you go :) + #_"1. Analyze `a` = `(t/or tt/boolean? (t/type b))` + - Put `a` on queue + 1. Analyze `tt/boolean?` + -> `(t/isa? Boolean)` + 2. Analyze `(t/type b)` + 1. Analyze `b` = `(t/or tt/byte? (t/type d))` + - Put `b` on queue + 1. Analyze `tt/byte?` + -> `(t/isa? Byte)` + 2. Analyze `(t/type d)` + 1. Analyze `d` = `(let [b (t/- tt/char? tt/long?)] + (t/or tt/char? (t/type b) (t/type c)))` + - Put `d` on queue + 1. Analyze `b` = `(t/- tt/char? tt/long?)` + -> Put `b` in env as `t/none?` + 2. Analyze `(t/or tt/char? (t/type b) (t/type c))` + 1. Analyze `tt/char?` + -> `(t/isa? Character)` + 2. Analyze `(t/type b)` + -> `t/none-type?` <-- be careful of this + 3. Analyze `(t/type c)` + 1. Analyze `c` = `(t/or tt/short? tt/char?)` + 1. Analyze `tt/short?` + -> `(t/isa? Short)` + 2. Analyze `tt/char?` + -> `(t/isa? Character)` + -> `c` candidate is: + `(t/or (t/isa? Short) (t/isa? Character))` + Splittable. + - Split: + [[a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/isa? Short) + d (let [b (t/- tt/char? tt/long?)] + (t/or tt/char? (t/type b) (t/type c))) + > (t/or (t/type b) (t/type d))] + [a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/isa? Character) + d (let [b (t/- tt/char? tt/long?)] + (t/or tt/char? (t/type b) (t/type c))) + > (t/or (t/type b) (t/type d))]] + - We continue with only Split 0 for brevity. Other + splits should be handled the same. + -> Put `c` in env as `(t/isa? Short)` + -> `(t/isa? Short)` + -> `(t/or (t/isa? Character) + t/none-type? + (t/isa? Short))` + - Remove `b` from env + - Remove `d` from queue + -> `d` candidate is: + `(t/or (t/isa? Character) + t/none-type? + (t/isa? Short))`. + Splittable. + - Split: + [[a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/isa? Short) + d (t/isa? Character) + > (t/or (t/type b) (t/type d))] + [a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/isa? Short) + d t/none-type? + > (t/or (t/type b) (t/type d))] + [a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/isa? Short) + d (t/isa? Short) + > (t/or (t/type b) (t/type d))]] + - We continue with only Split 0 for brevity. Other splits + should be handled the same. + -> Put `d` in env as `(t/isa? Character)` + -> `(t/isa? Character)` + -> `(t/isa? Character)` + - Remove `b` from queue + -> `b` candidate is: + `(t/or (t/isa? Byte) (t/isa? Character))` + Splittable. + - Split: + [[a (t/or tt/boolean? (t/type b)) + b (t/isa? Byte) + c (t/isa? Short) + d (t/isa? Character) + > (t/or (t/type b) (t/type d))] + [a (t/or tt/boolean? (t/type b)) + b (t/isa? Character) + c (t/isa? Short) + d (t/isa? Character) + > (t/or (t/type b) (t/type d))]] + - We continue with only Split 0 for brevity. Other splits should be + handled the same. + -> Put `b` in env as `(t/isa? Byte)` + -> `(t/isa? Byte)` + - Remove `a` from queue + -> `a` candidate is: + `(t/or (t/isa? Boolean) (t/isa? Byte))` + Splittable. + - Split: + [[a (t/isa? Boolean) + b (t/isa? Byte) + c (t/isa? Short) + d (t/isa? Character) + > (t/or (t/type b) (t/type d))] + [a (t/isa? Byte) + b (t/isa? Character) + c (t/isa? Short) + d (t/isa? Character) + > (t/or (t/type b) (t/type d))]] + - We continue with only Split 0 for brevity. Other splits should be handled + the same. + -> Put `a` in env as `(t/isa? Boolean)` + 2. Analyze out-type = `(t/or (t/type b) (t/type d))` + -> (Cutting obvious corners) `(t/or (t/isa? Byte) (t/isa? Character))` + - No splitting necessary because out-type + - All input types are in env and output-type was analyzed. DONE" + (let [ret [[{'a (t/isa? Boolean) + 'b (t/isa? Byte) + 'c (t/isa? Short) + 'd (t/isa? Short)} + (t/or (t/isa? Byte) (t/isa? Short))] + [{'a (t/isa? Byte) + 'b (t/isa? Byte) + 'c (t/isa? Short) + 'd (t/isa? Short)} + (t/or (t/isa? Byte) (t/isa? Short))] + [{'a (t/isa? Boolean) + 'b (t/isa? Short) + 'c (t/isa? Short) + 'd (t/isa? Short)} + (t/isa? Short)] + [{'a (t/isa? Short) + 'b (t/isa? Short) + 'c (t/isa? Short) + 'd (t/isa? Short)} + (t/isa? Short)] + [{'a (t/isa? Boolean) + 'b (t/isa? Byte) + 'c (t/isa? Short) + 'd (t/isa? Character)} + (t/or (t/isa? Byte) (t/isa? Character))] + [{'a (t/isa? Byte) + 'b (t/isa? Byte) + 'c (t/isa? Short) + 'd (t/isa? Character)} + (t/or (t/isa? Byte) (t/isa? Character))] + [{'a (t/isa? Boolean) + 'b (t/isa? Character) + 'c (t/isa? Short) + 'd (t/isa? Character)} + (t/isa? Character)] + [{'a (t/isa? Character) + 'b (t/isa? Character) + 'c (t/isa? Short) + 'd (t/isa? Character)} + (t/isa? Character)] + [{'a (t/isa? Boolean) + 'b (t/isa? Byte) + 'c (t/isa? Short) + 'd (t/value (t/isa? Character))} + (t/or (t/isa? Byte) (t/value (t/isa? Character)))] + [{'a (t/isa? Byte) + 'b (t/isa? Byte) + 'c (t/isa? Short) + 'd (t/value (t/isa? Character))} + (t/or (t/isa? Byte) (t/value (t/isa? Character)))] + [{'a (t/isa? Boolean) + 'b (t/value (t/isa? Character)) + 'c (t/isa? Short) + 'd (t/value (t/isa? Character))} + (t/value (t/isa? Character))] + [{'a (t/value (t/isa? Character)) + 'b (t/value (t/isa? Character)) + 'c (t/isa? Short) + 'd (t/value (t/isa? Character))} + (t/value (t/isa? Character))] + [{'a (t/isa? Boolean) + 'b (t/isa? Byte) + 'c (t/isa? Character) + 'd (t/isa? Character)} + (t/or (t/isa? Byte) (t/isa? Character))] + [{'a (t/isa? Byte) + 'b (t/isa? Byte) + 'c (t/isa? Character) + 'd (t/isa? Character)} + (t/or (t/isa? Byte) (t/isa? Character))] + [{'a (t/isa? Boolean) + 'b (t/isa? Character) + 'c (t/isa? Character) + 'd (t/isa? Character)} + (t/isa? Character)] + [{'a (t/isa? Character) + 'b (t/isa? Character) + 'c (t/isa? Character) + 'd (t/isa? Character)} + (t/isa? Character)] + [{'a (t/isa? Boolean) + 'b (t/isa? Byte) + 'c (t/isa? Character) + 'd (t/value (t/isa? Character))} + (t/or (t/isa? Byte) (t/value (t/isa? Character)))] + [{'a (t/isa? Byte) + 'b (t/isa? Byte) + 'c (t/isa? Character) + 'd (t/value (t/isa? Character))} + (t/or (t/isa? Byte) (t/value (t/isa? Character)))] + [{'a (t/isa? Boolean) + 'b (t/value (t/isa? Character)) + 'c (t/isa? Character) + 'd (t/value (t/isa? Character))} + (t/value (t/isa? Character))] + [{'a (t/value (t/isa? Character)) + 'b (t/value (t/isa? Character)) + 'c (t/isa? Character) + 'd (t/value (t/isa? Character))} + (t/value (t/isa? Character))]]] + (is= (-> (self/analyze-arg-syms + '{a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/or tt/short? tt/char?) + d (let [b (t/- tt/char? tt/long?)] + (t/or tt/char? (t/type b) (t/type c)))} + '(t/or (t/type b) (t/type d))) + transform-ana) + ret) + (is= (-> (self/analyze-arg-syms + '{a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/input dummy :?) + d (let [b (t/- tt/char? tt/long?)] + (t/or tt/char? (t/type b) (t/type c)))} + '(t/or (t/type b) (t/type d))) + transform-ana) + ret))) + ;; TODO add multiple tests for this (`input-types-combine`) + (testing "`t/input` + `t/type`" + (is= (-> (self/analyze-arg-syms + '{a (t/or (t/input input-types-combine :? (t/type c)) tt/string?) + b (t/and (t/input input-types-combine :? (t/type c)) tt/long?) + c (t/or tt/byte? tt/char?)} + 'tt/int?) + transform-ana) + [[{'a (t/or (t/isa? String) (t/value nil)) + 'b (t/isa? Long) + 'c (t/isa? Byte)} + (t/isa? Integer)] + [{'a (t/or (t/isa? String) (t/value nil)) + 'b t/none? + 'c (t/isa? Byte)} + (t/isa? Integer)] + [{'a (t/ref (t/not (t/value nil))) + 'b (t/isa? Long) + 'c (t/isa? Byte)} + (t/isa? Integer)] + [{'a (t/ref (t/not (t/value nil))) + 'b t/none? + 'c (t/isa? Byte)} + (t/isa? Integer)] + [{'a (t/or (t/isa? String) (t/value nil)) + 'b (t/isa? Long) + 'c (t/isa? Character)} + (t/isa? Integer)] + [{'a (t/or (t/isa? String) (t/value nil)) + 'b t/none? + 'c (t/isa? Character)} + (t/isa? Integer)] + [{'a (t/ref (t/not (t/value nil))) + 'b (t/isa? Long) + 'c (t/isa? Character)} + (t/isa? Integer)] + [{'a (t/ref (t/not (t/value nil))) + 'b t/none? + 'c (t/isa? Character)} + (t/isa? Integer)]])) + (testing "input to `t/input` depends on another `t/input`; `t/output` depends on + other `t/input`s" + (is= (-> (self/analyze-arg-syms + '{a (t/input tt/fake-compare :? :_) + b (t/input tt/fake-compare (t/type a) :?)} + '(t/output tt/fake-compare (t/type a) (t/type b))) + transform-ana) + [;; Directly from `[t/long? t/long?]` + [{'a (t/isa? Long) 'b (t/isa? Long)} (t/isa? Integer)] + ;; Because arg0 is `t/long?`, is `t/<=` `(t/ref t/val?)`, and so this is from + ;; `[(t/ref t/val?) t/nil?]` + [{'a (t/isa? Long) 'b (t/value nil)} (t/isa? Integer)] + ;; Directly from `[t/nil? t/nil?]` + [{'a (t/value nil) 'b (t/value nil)} (t/isa? Integer)] + ;; Directly from `[t/nil? (t/ref t/val?)]` + [{'a (t/value nil) 'b (t/ref (t/not (t/value nil)))} (t/isa? Integer)] + ;; Directly from `[(t/ref t/val?) t/nil?]` + [{'a (t/ref (t/not (t/value nil))) 'b (t/value nil)} (t/isa? Integer)]]) + (is= (-> (self/analyze-arg-syms + '{a (t/input tt/fake-compare :? :_) + b (t/input tt/fake-compare [= (t/type a)] :?)} + '(t/output tt/fake-compare (t/type a) (t/type b))) + transform-ana) + [;; Directly from `[t/long? t/long?]` + [{'a (t/isa? Long) 'b (t/isa? Long)} (t/isa? Integer)] + ;; Directly from `[t/nil? t/nil?]` + [{'a (t/value nil) 'b (t/value nil)} (t/isa? Integer)] + ;; Directly from `[t/nil? (t/ref t/val?)]` + [{'a (t/value nil) 'b (t/ref (t/not (t/value nil)))} (t/isa? Integer)] + ;; Directly from `[(t/ref t/val?) t/nil?]` + [{'a (t/ref (t/not (t/value nil))) 'b (t/value nil)} (t/isa? Integer)]])))) + +(defn- rx=* [a b] + (if (and (utr/rx-type? a) + (utr/rx-type? b)) + (= (urx/norx-deref a) (urx/norx-deref b)) + (= a b))) + +(defn- rx= [a b] + (seq-and-2 + (fn [[input-types-0 output-type-0] [input-types-1 output-type-1]] + (and (rx=* output-type-1 output-type-1) + (seq-and-2 rx=* (->> input-types-0 (sort-by key) (map val)) + (->> input-types-1 (sort-by key) (map val))))) + a b)) + +(deftest test|arglist-forms>arglist-basis + (is= (-> (self/analyze-arg-syms + '{a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/or tt/short? tt/char?) + d (let [b (t/- tt/char? tt/long?)] + (t/or tt/char? (t/type b) (t/type c)))} + '(t/or (t/type b) (t/type d)) + false) + transform-ana) + (let [c (t/or tt/short? tt/char?) + d (t/or tt/char? (t/value (t/- tt/char? tt/long?)) c) + b (t/or tt/byte? d) + a (t/or tt/boolean? b)] + [[{'a a 'b b 'c c 'd d} (t/or b d)]])) + (is (rx= (-> (self/analyze-arg-syms + '{a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/or tt/short? tt/char?) + d (let [b (t/- tt/char? tt/long?)] + (t/or tt/char? (t/type b) (t/input >long-checked :?) (t/type c)))} + '(t/or (t/type b) (t/type d)) + false) + transform-ana) + (let [c (t/or tt/short? tt/char?) + d (t/or tt/char? + (t/value (t/- tt/char? tt/long?)) + (t/rx (t/input* + (-> #'>long-checked meta :quantum.core.type/type deref) [:?])) + c) + b (t/or tt/byte? d) + a (t/or tt/boolean? b)] + [[{'a a 'b b 'c c 'd d} (t/or b d)]])))) diff --git a/test/quantum/test/untyped/core/analyze/expr.cljc b/test/quantum/test/untyped/core/analyze/expr.cljc new file mode 100644 index 00000000..f40a711a --- /dev/null +++ b/test/quantum/test/untyped/core/analyze/expr.cljc @@ -0,0 +1,7 @@ +(ns quantum.test.core.untyped.analyze.expr + (:require + [quantum.core.test :as test + :refer [deftest testing is is= throws]] + [quantum.core.untyped.analyze.ast :as ast] + [quantum.core.untyped.analyze.expr :as self] + [quantum.core.untyped.type :as t])) diff --git a/test/quantum/test/untyped/core/collections.cljc b/test/quantum/test/untyped/core/collections.cljc new file mode 100644 index 00000000..f7e19034 --- /dev/null +++ b/test/quantum/test/untyped/core/collections.cljc @@ -0,0 +1,67 @@ +(ns quantum.test.untyped.core.collections + (:require + [quantum.untyped.core.collections :as self] + [quantum.untyped.core.fn + :refer [aritoid fn']] + [quantum.untyped.core.test + :refer [deftest is is= testing]])) + +(deftest test|flatten + (is= (self/flatten [[0 1] [2 3 4]] 0) + [[0 1] [2 3 4]]) + + (is= (self/flatten [[0 1] [2 3 4]] 1) + [0 1 2 3 4]) + + (is= (self/flatten [[[0 1]] [[2 3 4]]] 2) + [0 1 2 3 4])) + +(def conj|map (aritoid (fn' {}) identity conj)) + +(def conj|!vec (aritoid (fn [] (transient [])) persistent! conj!)) + +(deftest test|group-deep-by-into + (is= (self/group-deep-by (fn [i x] (get x i)) [[1 4] [3 2] [1 2]]) + {1 {2 [[1 2]], 4 [[1 4]]}, 3 {2 [[3 2]]}}) + (is= (self/group-deep-by (fn [i x] (get x i)) [[1 4] [3 2] [1 2] [3 2 5]]) + {1 {4 {nil [[1 4]]} + 2 {nil [[1 2]]}} + 3 {2 {nil [[3 2]] + 5 [[3 2 5]]}}})) + +(deftest test|>combinatoric-tree + (let [in '[[0 [a b a]] + [1 [a b c]] + [2 [a c d]] + [3 [c b a]] + [4 [c c a]] + [5 [d a a]]] + vec-result '[[a [[b [[a 0] + [c 1]]] + [c [[d 2]]]]] + [c [[b [[a 3]]] + [c [[a 4]]]]] + [d [[a [[a 5]]]]]]] + (is= (self/>combinatoric-tree 3 in) vec-result) + (testing "All arities of the combinatory fns are exercised" + (is= (self/>combinatoric-tree 3 = conj|!vec conj|!vec + (fn ([] (transient [])) + ([ret] (persistent! ret)) + ([ret [k [x*]]] (conj! ret [x* k]))) + in))) + (is= (self/>combinatoric-tree 3 = conj|map conj|map + (fn ([] {}) ([ret] ret) ([ret [k [x*]]] (assoc ret x* k))) in) + '{a {b {a 0 + c 1} + c {d 2}} + c {b {a 3} + c {a 4}} + d {a {a 5}}}) + (is= (self/>combinatoric-tree 3 = conj|map conj + (fn ([] []) ([ret] ret) ([ret [k [x*]]] (conj ret [x* k]))) in) + '{a {b [[a 0] + [c 1]] + c [[d 2]]} + c {b [[a 3]] + c [[a 4]]} + d {a [[a 5]]}}))) diff --git a/test/quantum/test/untyped/core/data/reactive.cljc b/test/quantum/test/untyped/core/data/reactive.cljc new file mode 100644 index 00000000..ce5706d4 --- /dev/null +++ b/test/quantum/test/untyped/core/data/reactive.cljc @@ -0,0 +1,446 @@ +(ns quantum.test.untyped.core.data.reactive + "Tests adapted from `reagenttest.testratom`." + {:todo #{"Adapt tests from https://github.com/reagent-project/reagent/blob/master/test/reagenttest/testratomasync.cljs" + "Adapt tests from https://github.com/reagent-project/reagent/blob/master/test/reagenttest/testtrack.cljs"}} + (:require + [quantum.untyped.core.test :as utest + :refer [deftest is is= testing]] + [quantum.untyped.core.data.vector :as uvec] + [quantum.untyped.core.data.reactive :as urx + :refer [! !eager-rx !run-rx !rx >!rx dispose! flush!]] + [quantum.untyped.core.refs :as uref])) + +(defn with-debug [f] + (flush! urx/global-queue) + (binding [urx/*debug?* true] (f))) + +(utest/use-fixtures :once with-debug) + +(defn- running [] @@#'urx/*running) + +(defn test-perf [] + ;; (set! debug? false) ; yes but we need to think about CLJ + (dotimes [_ 10] + (let [a (! 0) + f (fn [] (quot (long @a) 10)) + q (uvec/alist) + mid (>!rx f {:queue q}) + res (urx/>track! (fn [] (inc (long @mid))) [] {:queue q})] + @res + (time (dotimes [_ 100000] ; ~70ms per 100K in CLJ so 0.0007ms for one (0.7 µs or 700 ns) + (uref/update! a inc) + (@#'urx/flush! q))) + (dispose! res)))) + +(deftest basic-atom + (binding [urx/*enqueue!* uvec/alist-conj!] + (let [runs (running) + start (! 0) + sv (!eager-rx @start) + comp (!eager-rx @sv (+ 2 @sv)) + c2 (!eager-rx (inc @comp)) + ct (! 0) + out (! 0) + res (!eager-rx (uref/update! ct inc) @sv @c2 @comp) + const (!run-rx (uref/set! out @res))] + (is (= @ct 1) "constrain ran") + (is (= @out 2)) + (uref/set! start 1) + (flush! urx/global-queue) + (is (= @out 3)) ; not correct; showing 2 + (is (<= 2 @ct 3)) + (dispose! const) + (is (= (running) runs))))) + +(deftest double-dependency + (let [runs (running) + start (! 0) + c3-count (! 0) + c1 (!eager-rx @start 1) + c2 (!eager-rx @start) + c3 (!rx (uref/update! c3-count inc) + (+ @c1 @c2))] + (flush! urx/global-queue) + (is (= @c3-count 0)) + (is (= @c3 1)) + (is (= @c3-count 1) "t1") + (uref/update! start inc) + (flush! urx/global-queue) + (is (= @c3-count 2) "t2") + (is (= @c3 2)) + (is (= @c3-count 2) "t3") + (dispose! c3) + (is (= (running) runs)))) + +(deftest test-from-reflex ; https://github.com/lynaghk/reflex + (let [runs (running)] + (let [*counter (! 0) + *signal (! "All I do is change") + co (!run-rx @*signal (uref/update! *counter inc))] + (is (= 1 @*counter) "Constraint run on init") + (uref/set! *signal "foo") + (flush! urx/global-queue) + (is (= 2 @*counter) + "Counter auto updated") + (dispose! co)) + (let [*x (! 0) + *co (!rx (inc @*x))] + (is (= 1 @*co) "CO has correct value on first deref") + (uref/update! *x inc) + (is (= 2 @*co) "CO auto-updates") + (dispose! *co)) + (is (= (running) runs)))) + +(deftest test-unsubscribe + (dotimes [x 10] + (let [runs (running) + a (! 0) + a1 (!eager-rx (inc @a)) + a2 (!eager-rx @a) + b-changed (! 0) + c-changed (! 0) + b (!eager-rx + (uref/update! b-changed inc) + (inc @a1)) + c (!eager-rx + (uref/update! c-changed inc) + (+ 10 @a2)) + res (!run-rx (if (< @a2 1) @b @c))] + (is (= @res (+ 2 @a))) + (is (= @b-changed 1)) + (is (= @c-changed 0)) + + (uref/set! a -1) + (is (= @res (+ 2 @a))) + (is (= @b-changed 2)) + (is (= @c-changed 0)) + + (uref/set! a 2) + (is (= @res (+ 10 @a))) + (is (<= 2 @b-changed 3)) + (is (= @c-changed 1)) + + (uref/set! a 3) + (is (= @res (+ 10 @a))) + (is (<= 2 @b-changed 3)) + (is (= @c-changed 2)) + + (uref/set! a 3) + (is (= @res (+ 10 @a))) + (is (<= 2 @b-changed 3)) + (is (= @c-changed 2)) + + (uref/set! a -1) + (is (= @res (+ 2 @a))) + (dispose! res) + (is (= (running) runs))))) + +(deftest maybe-broken + (let [runs (running)] + (let [runs (running) + a (! 0) + b (!eager-rx (inc @a)) + c (!eager-rx (dec @a)) + d (!eager-rx (str @b)) + res (! 0) + cs (!run-rx (uref/set! res @d))] + (is (= @res "1")) + (dispose! cs)) + ;; should be broken according to https://github.com/lynaghk/reflex/issues/1 + ;; but isnt + (let [a (! 0) + b (!eager-rx (inc @a)) + c (!eager-rx (dec @a)) + d (!run-rx [@b @c])] + (is (= @d [1 -1])) + (dispose! d)) + (let [a (! 0) + b (!eager-rx (inc @a)) + c (!eager-rx (dec @a)) + d (!run-rx [@b @c]) + res (! 0)] + (is (= @d [1 -1])) + (let [e (!run-rx (uref/set! res @d))] + (is (= @res [1 -1])) + (dispose! e)) + (dispose! d)) + (is (= (running) runs)))) + +(deftest test-dispose + (binding [urx/*enqueue!* uvec/alist-conj!] + (dotimes [x 10] + (let [runs (running) + a (! 0) + disposed (! nil) + disposed-c (! nil) + disposed-cns (! nil) + count-b (! 0) + b (>!rx (fn [] (uref/update! count-b inc) (inc @a)) + {:always-recompute? true + :on-dispose (fn [r] (uref/set! disposed true)) + :queue urx/global-queue}) + c (>!rx #(if (< @a 1) (inc @b) (dec @a)) + {:always-recompute? true + :on-dispose (fn [r] (uref/set! disposed-c true)) + :queue urx/global-queue}) + res (! nil) + cns (>!rx #(uref/set! res @c) + {:on-dispose (fn [r] (uref/set! disposed-cns true)) + :queue urx/global-queue})] + @cns + (is (= @res 2)) + (is (= (+ 4 runs) (running))) + (is (= @count-b 1)) + (uref/set! a -1) + (flush! urx/global-queue) + (is (= @res 1)) + (is (= @disposed nil)) + (is (= @count-b 2)) + (is (= (+ 4 runs) (running)) "still running") + (uref/set! a 2) + (flush! urx/global-queue) + (is (= @res 1)) + (is (= @disposed true)) + (is (= (+ 2 runs) (running)) "less running count") + + (uref/set! disposed nil) + (uref/set! a -1) + (flush! urx/global-queue) + ;; This fails sometimes on node. I have no idea why. + (is (= 1 @res) "should be one again") + (is (= @disposed nil)) + (uref/set! a 2) + (flush! urx/global-queue) + (is (= @res 1)) + (is (= @disposed true)) + (dispose! cns) + (is (= @disposed-c true)) + (is (= @disposed-cns true)) + (is (= runs (running))))))) + +(deftest test-add-dispose + (dotimes [x 10] + (let [runs (running) + a (! 0) + disposed (! nil) + disposed-c (! nil) + disposed-cns (! nil) + count-b (! 0) + b (!eager-rx (uref/update! count-b inc) (inc @a)) + c (!eager-rx (if (< @a 1) (inc @b) (dec @a))) + res (! nil) + cns (!rx (uref/set! res @c))] + (urx/add-on-dispose! b (fn [r] + (is (= r b)) + (uref/set! disposed true))) + (urx/add-on-dispose! c (fn [r] (uref/set! disposed-c true))) + (urx/add-on-dispose! cns (fn [r] (uref/set! disposed-cns true))) + @cns + (is (= @res 2)) + (is (= (+ 4 runs) (running))) + (is (= @count-b 1)) + (uref/set! a -1) + (flush! urx/global-queue) + (is (= @res 1)) + (is (= @disposed nil)) + (is (= @count-b 2)) + (is (= (+ 4 runs) (running)) "still running") + (uref/set! a 2) + (flush! urx/global-queue) + (is (= @res 1)) + (is (= @disposed true)) + (is (= (+ 2 runs) (running)) "less running count") + + (uref/set! disposed nil) + (uref/set! a -1) + (flush! urx/global-queue) + (is (= 1 @res) "should be one again") + (is (= @disposed nil)) + (uref/set! a 2) + (flush! urx/global-queue) + (is (= @res 1)) + (is (= @disposed true)) + (dispose! cns) + (is (= @disposed-c true)) + (is (= @disposed-cns true)) + (is (= runs (running)))))) + +(deftest non-reactive-deref + (let [runs (running) + a (! 0) + b (!eager-rx (+ 5 @a))] + (is (= @b 5)) + (is (= runs (running))) + + (uref/set! a 1) + (is (= @b 6)) + (is (= runs (running))))) + +(deftest reset-in-reaction + (let [runs (running) + state (! {}) + c1 (!eager-rx (get-in @state [:data :a])) + c2 (!eager-rx (get-in @state [:data :b])) + rxn (!rx (let [cc1 @c1, cc2 @c2] + (uref/update! state assoc :derived (+ (or cc1 0) (or cc2 0))) + nil))] + @rxn + (is (= (:derived @state) 0)) + (uref/update! state assoc :data {:a 1 :b 2}) + (flush! urx/global-queue) + (is (= (:derived @state) 3)) + (uref/update! state assoc :data {:a 11 :b 22}) + (flush! urx/global-queue) + (is (= (:derived @state) 33)) + (dispose! rxn) + (is (= runs (running))))) + +(deftest exception-recover + (let [runs (running) + state (! 1) + count (! 0) + r (!run-rx + (uref/update! count inc) + (when (> @state 1) (throw (ex-info "oops" {}))))] + (is (= @count 1)) + (is (thrown? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + (do (uref/update! state inc) + (flush! urx/global-queue)))) + (is (= @count 2)) + (uref/update! state dec) + (flush! urx/global-queue) + (is (= @count 3)) + (dispose! r) + (is (= runs (running))))) + +(deftest exception-recover-indirect + (let [runs (running) + state (! 1) + count (! 0) + ref (!eager-rx (when (= @state 2) + (throw (ex-info "err" {})))) + r (!run-rx + (uref/update! count inc) + @ref)] + (is (= @count 1)) + (is (thrown? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + (do (uref/update! state inc) + (flush! urx/global-queue)))) + (is (= @count 2)) + (is (thrown? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) @ref)) + (uref/update! state inc) + (flush! urx/global-queue) + (is (= @count 3)) + (dispose! r) + (is (= runs (running))))) + +(deftest exception-side-effect + (binding [urx/*enqueue!* uvec/alist-conj!] + (let [runs (running) + state (! {:val 1}) + rstate (!eager-rx @state) + spy (atom nil) + r1 (!run-rx @rstate) + r2 (let [val (!eager-rx (:val @rstate))] + (!run-rx + (reset! spy @val) + (is (some? @val)))) + r3 (!run-rx + (when (:error? @rstate) + (throw (ex-info "Error detected!" {}))))] + (uref/update! state assoc :val 2) + (flush! urx/global-queue) + (uref/update! state assoc :error? true) + (is (thrown? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + (flush! urx/global-queue))) + (flush! urx/global-queue) + (flush! urx/global-queue) + (dispose! r1) + (dispose! r2) + (dispose! r3) + (is (= runs (running)))))) + +(deftest exception-reporting + (binding [urx/*enqueue!* uvec/alist-conj!] + (let [runs (running) + state (! {:val 1}) + rstate (!eager-rx (:val @state)) + r1 (!run-rx + (when (= @rstate 13) + (throw (ex-info "fail" {}))))] + (uref/update! state assoc :val 13) + (is (thrown? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + (flush! urx/global-queue))) + (uref/update! state assoc :val 2) + (flush! urx/global-queue) + (dispose! r1) + (is (= runs (running)))))) + +(deftest atom-with-meta + (let [value {:val 1} + meta-value {:meta-val 1} + state (with-meta (! value) meta-value)] + (is (= (meta state) meta-value)) + (is (= @state value)))) + +(deftest test-eager-vs-lazy-reaction + (let [a (! 123) + b-ct (atom 0) + b (!eager-rx (swap! b-ct inc) (+ @a 2)) + c-ct (atom 0) + c (!eager-rx (swap! c-ct inc) (* @b -1)) + b-lazy-ct (atom 0) + b-lazy (!rx (swap! b-lazy-ct inc) (+ @a 2)) + c-lazy-ct (atom 0) + c-lazy (!rx (swap! c-lazy-ct inc) (* @b-lazy -1))] + (testing "eager" + @c + (is= @b-ct 1) + (is= @c-ct 1) + @c + (is= @b-ct 2) + (is= @c-ct 2) + @c + (is= @b-ct 3) + (is= @c-ct 3) + + (uref/set! a 234) + + @c + (is= @b-ct 4) + (is= @c-ct 4)) + + (testing "lazy" + @c-lazy + (is= @b-lazy-ct 1) + (is= @c-lazy-ct 1) + @c-lazy + (is= @b-lazy-ct 1) + (is= @c-lazy-ct 1) + @c-lazy + (is= @b-lazy-ct 1) + (is= @c-lazy-ct 1) + + (uref/set! a 234) ; resetting to the same state + + @c-lazy + (is= @b-lazy-ct 2) + (is= @c-lazy-ct 1) + + (uref/set! a 123) + + @c-lazy + (is= @b-lazy-ct 3) + (is= @c-lazy-ct 2) + @c-lazy + (is= @b-lazy-ct 3) + (is= @c-lazy-ct 2)))) + +(deftest test-interceptors + (let [a (! 1)] + (uref/add-interceptor! a :inc inc) + (uref/set! a 4) + (is= @a 5) + (uref/add-interceptor! a :+23 (fn [x] (+ x 23))) + (uref/set! a 8) + (is= @a 32)) diff --git a/test/quantum/test/untyped/core/data/set.cljc b/test/quantum/test/untyped/core/data/set.cljc new file mode 100644 index 00000000..4e4f7029 --- /dev/null +++ b/test/quantum/test/untyped/core/data/set.cljc @@ -0,0 +1,36 @@ +(ns quantum.untyped.test.core.data.set + (:require + [quantum.untyped.core.compare :as ucomp] + [quantum.untyped.core.data.set :as uset] + [quantum.untyped.core.test :as test + :refer [deftest is is= testing]])) + +#?(:clj +(defmacro test-comparison|set + "Performs a `t/compare` on `a` and `b`, ensuring that their relationship is symmetric, and that + the inputs are internally commutative if applicable (e.g. if `a` is an `AndType`, ensures that + it is commutative). + The basis comparison is the first input." + [c #_uset/comparisons a #_set? b #_set?] + `(let [c# ~c, a# ~a, b# ~b] + ;; Symmetry + (is= c# (uset/compare a# b#)) + (is= (uset/invert-comparison c#) (uset/compare b# a#))))) + +(deftest test|set + (testing "< , >" + (test-comparison|set -1 #{} #{1}) + (test-comparison|set -1 #{} #{1 2}) + (test-comparison|set -1 #{1} #{1 2}) + (test-comparison|set -1 #{1 2} #{1 2 3})) + (testing "=" + (test-comparison|set 0 #{} #{}) + (test-comparison|set 0 #{1} #{1}) + (test-comparison|set 0 #{1 2} #{1 2})) + (testing "><" + (test-comparison|set 2 #{1 2} #{1 3}) + (test-comparison|set 2 #{1 2} #{1 3}) + (test-comparison|set 2 #{1 2 3} #{1 4})) + (testing "<>" + (test-comparison|set 3 #{1} #{2}) + (test-comparison|set 3 #{3} #{1 2}))) diff --git a/test/quantum/test/untyped/core/defnt.cljc b/test/quantum/test/untyped/core/defnt.cljc new file mode 100644 index 00000000..5ca768c7 --- /dev/null +++ b/test/quantum/test/untyped/core/defnt.cljc @@ -0,0 +1,166 @@ +(ns quantum.test.untyped.core.defnt + (:require + [clojure.spec.alpha :as s] + [clojure.spec.gen.alpha :as gen] + [clojure.spec.test.alpha :as stest] + [clojure.test.check.clojure-test + :refer [defspec]] + [quantum.untyped.core.defnt :as self] + [quantum.untyped.core.spec :as us] + [quantum.untyped.core.test + :refer [defspec-test]])) + +;; Implicit compilation tests +(self/defns abcde "Documentation" {:metadata "fhgjik"} + ([a number? > number?] (inc a)) + ([a pos-int?, b pos-int? + | (> a b) + > (s/and number? #(> % a) #(> % b))] (+ a b)) + ([a #{"a" "b" "c"} + b boolean? + {:as c + :keys [ca keyword? cb string?] + {:as cc + {:as cca + :keys [ccaa keyword?] + [[ccabaa some? {:as ccabab :keys [ccababa some?]} some?] some? ccabb some? & ccabc some? :as ccab] + [:ccab seq?]} + [:cca map?]} + [:cc map?]} + #(-> % count (= 3)) + [da double? & db seq? :as d] sequential? + [ea symbol?] ^:gen? (s/coll-of symbol? :kind vector?) + & [fa #{"a" "b" "c"} :as f] seq? + | (and (> da 50) (contains? c a) + a b c ca cb cc cca ccaa ccab ccabaa ccabab ccababa ccabb ccabc d da db ea f fa) + > number?] 0)) + +(self/defns basic [a number? > number?] (rand)) + +(defspec-test test|basic `basic) + +(self/defns equality [a number? > #(= % a)] a) + +(defspec-test test|equality `equality) + +(self/defns pre-post [a number? | (> a 3) > #(> % 4)] (inc a)) + +(defspec-test test|pre-post `pre-post) + +(self/defns gen|seq|0 [[a number? b number? :as b] ^:gen? (s/tuple double? double?)]) + +(defspec-test test|gen|seq|0 `gen|seq|0) + +(self/defns gen|seq|1 + [[a number? b number? :as b] ^:gen? (s/nonconforming (s/cat :a double? :b double?))]) + +(defspec-test test|gen|seq|1 `gen|seq|1) + +(self/defns fn-wide-and-overload-specific-post + > number? + [> integer?] 123) + +(defspec-test test|fn-wide-and-overload-specific-post `fn-wide-and-overload-specific-post) + +;; TODO assert that the below 2 things are equivalent + +#_(self/defns abcde "Documentation" {:metadata "abc"} + ([a number? > number?] (inc a)) + ([a pos-int?, b pos-int? + | (> a b) + > (s/and number? #(> % a) #(> % b))] (+ a b)) + ([a #{"a" "b" "c"} + b boolean? + {:as c + :keys [ca keyword? cb string?] + {:as cc + {:as cca + :keys [ccaa keyword?] + [[ccabaa some? {:as ccabab :keys [ccababa some?]} some?] some? ccabb some? & ccabc some? :as ccab] + [:ccab seq?]} + [:cca map?]} + [:cc map?]} + #(-> % count (= 3)) + [da double? & db seq? :as d] sequential? + [ea symbol?] ^:gen? (s/coll-of symbol? :kind vector?) + & [fa #{"a" "b" "c"} :as f] seq? + | (and (> da 50) (contains? c a) + a b c ca cb cc cca ccaa ccab ccabaa ccabab ccababa ccabb ccabc d da db ea f fa) + > number?] 0)) + +#_(s/fdef abcde + :args + (s/or + :arity-1 (s/cat :a number?) + :arity-2 (s/and (s/cat :a pos-int? + :b pos-int?) + (fn [{a :a b :b}] (> a b))) + :arity-varargs + (s/and + (s/cat + :a #{"a" "b" "c"} + :b boolean? + :c (self/map-destructure #(-> % count (= 3)) + {:ca keyword? + :cb string? + :cc (self/map-destructure map? + {:cca (self/map-destructure map? + {:ccaa keyword? + :ccab (self/seq-destructure seq? + [:arg-0 (self/seq-destructure some? + [:ccabaa some? + :ccabab (self/map-destructure some? {:ccababa some?})]) + :ccabb some?] + [:ccabc some?])})})}) + :d (self/seq-destructure sequential? [:da double?] [:db seq?]) + :arg-4# (self/seq-destructure ^{:gen? true} (s/coll-of symbol? :kind vector?) [:ea symbol?] ) + :f (self/seq-destructure seq? [:fa #{"a" "b" "c"}])) + (fn [{a :a + b :b + {:as c + :keys [ca cb] + {:as cc + {:as cca + :keys [ccaa] + [[ccabaa {:as ccabab :keys [ccababa]}] ccabb & ccabc :as ccab] :ccab} :cca} :cc} :c + [da & db :as d] :d + [ea] :arg-4# + [fa :as f] :f :as X}] + (and (> da 50) (= a fa) + a b c ca cb cc cca ccaa ccab ccabaa ccabab ccababa ccabb ccabc d da db ea f fa)))) + :fn + (us/with-gen-spec (fn [{ret# :ret}] ret#) + (fn [{[arity-kind# args#] :args}] + (case arity-kind# + :arity-1 + (let [{a :a} args#] (s/spec number?)) + :arity-2 + (let [{a :a b :b} args#] (s/spec (s/and number? #(> % a) #(> % b)))) + :arity-varargs + (let [{a :a + b :b + {:as c + :keys [ca cb] + {:as cc + {:as cca + :keys [ccaa] + [[ccabaa {:as ccabab :keys [ccababa]}] ccabb & ccabc :as ccab] :ccab} :cca} :cc} :c + [da & db :as d] :d + [ea] :arg-4# + [fa :as f] :f} args#] (s/spec number?)))))) + +#_(defn abcde "Documentation" {:metadata "abc"} + ([a] (inc a)) + ([a b] (+ a b)) + ([a b + {:as c, + :keys [ca cb], + {:as cc, + {:as cca, + :keys [ccaa], + [[ccabaa {:as ccabab, :keys [ccababa]}] ccabb & ccabc :as ccab] :ccab} :cca} :cc} + [da & db :as d] + [ea] + & + [fa :as f]] + 0)) diff --git a/test/quantum/test/untyped/core/identifiers.cljc b/test/quantum/test/untyped/core/identifiers.cljc new file mode 100644 index 00000000..c5d350cd --- /dev/null +++ b/test/quantum/test/untyped/core/identifiers.cljc @@ -0,0 +1,37 @@ +(ns quantum.test.untyped.core.identifiers + (:require + [quantum.untyped.core.identifiers :as self + #?@(:cljs [:refer [DelimitedIdent]])] + [quantum.untyped.core.test :as test + :refer [deftest testing is is= throws]]) + #?(:clj (:import quantum.untyped.core.identifiers.DelimitedIdent))) + +(deftest test|>ident + (is= (self/>delim-ident "a|b|c|d") (DelimitedIdent. ["a" "b" "c" "d"])) + + (is= (self/>delim-ident String) (DelimitedIdent. ["java" "lang" "String"])) + + (testing "Symbol" + (is= (self/>delim-ident 'a) (DelimitedIdent. ["a"])) + (is= (self/>delim-ident 'a/b) (DelimitedIdent. ["a" "b"])) + (is= (self/>delim-ident 'a|b/c) (DelimitedIdent. ["a" "b" "c"])) + (is= (self/>delim-ident 'a|b|c) (DelimitedIdent. ["a" "b" "c"])) + (is= (self/>delim-ident 'a/b|c) (DelimitedIdent. ["a" "b" "c"])) + (is= (self/>delim-ident 'a|b/c|d) (DelimitedIdent. ["a" "b" "c" "d"])) + (is= (self/>delim-ident 'a.b/c.d) (DelimitedIdent. ["a" "b" "c" "d"]))) + + (testing "Keyword" + (is= (self/>delim-ident :a) (DelimitedIdent. ["a"])) + (is= (self/>delim-ident :a/b) (DelimitedIdent. ["a" "b"])) + (is= (self/>delim-ident :a|b/c) (DelimitedIdent. ["a" "b" "c"])) + (is= (self/>delim-ident :a|b|c) (DelimitedIdent. ["a" "b" "c"])) + (is= (self/>delim-ident :a/b|c) (DelimitedIdent. ["a" "b" "c"])) + (is= (self/>delim-ident :a|b/c|d) (DelimitedIdent. ["a" "b" "c" "d"])) + (is= (self/>delim-ident :a.b/c.d) (DelimitedIdent. ["a" "b" "c" "d"]))) + + (is= (self/>delim-ident (find-ns 'quantum.untyped.core.test)) + (DelimitedIdent. ["quantum" "untyped" "core" "test"])) + (is= (self/>delim-ident #'count) + (DelimitedIdent. ["clojure" "core" "count"])) + (is= (self/>delim-ident count) + (DelimitedIdent. ["clojure" "core" "count"]))) diff --git a/test/quantum/test/untyped/core/type.cljc b/test/quantum/test/untyped/core/type.cljc new file mode 100644 index 00000000..c2777b36 --- /dev/null +++ b/test/quantum/test/untyped/core/type.cljc @@ -0,0 +1,627 @@ +(ns quantum.test.untyped.core.type + (:refer-clojure :exclude + [boolean? char? double? float? fn? ifn? int? ratio? string? symbol?]) + (:require + [clojure.core :as core] + [quantum.untyped.core.data.map :as umap] + [quantum.untyped.core.test + :refer [deftest testing is is= throws]] + [quantum.untyped.core.type :as t + :refer [& | !]] + [quantum.untyped.core.type.reifications :as utr + #?@(:cljs [:refer [UniversalSetType EmptySetType + NotType OrType AndType + ProtocolType ClassType + ValueType]])]) +#?(:clj (:import + [quantum.untyped.core.type.reifications + UniversalSetType EmptySetType + NotType OrType AndType + ProtocolType ClassType + ValueType]))) + +;; ===== Type predicates ===== ;; +;; Declared here instead of in `quantum.untyped.core.type` to avoid dependency + +#?(:clj (def boolean? (t/isa? #?(:clj Boolean :cljs js/Boolean)))) +#?(:clj (def byte? (t/isa? Byte))) +#?(:clj (def short? (t/isa? Short))) +#?(:clj (def char? (t/isa? Character))) +#?(:clj (def int? (t/isa? Integer))) +#?(:clj (def long? (t/isa? Long))) +#?(:clj (def float? (t/isa? Float))) + (def double? (t/isa? #?(:clj Double :cljs js/Number))) + + (def primitive? (t/or boolean? #?@(:clj [byte? short? char? int? long? float?]) double?)) + +#?(:clj (def comparable-primitive? (t/- primitive? boolean?))) + +#?(:clj (def ratio? (t/isa? clojure.lang.Ratio))) + +#?(:clj (def char-seq? (t/isa? CharSequence))) + (def string? (t/isa? #?(:clj String :cljs js/String))) + + (def symbol? t/symbol?) + + (def fn? t/fn?) + (def ifn? t/ifn?) + +#?(:clj (def comparable? (t/isa? Comparable))) +#?(:clj (def java-set? (t/isa? java.util.Set))) + +;; ----- Simulated typed fns ----- ;; + +(defn fake-compare + {:quantum.core.type/type + (t/rx (t/ftype t/int? [t/nil? t/nil?] + [t/nil? (t/ref t/val?)] + [(t/ref t/val?) t/nil?] + [t/long? t/long?]))} + []) + +;; ----- Example interface hierarchy ----- ;; + +(do + +(gen-interface :name i.>a+b) +(gen-interface :name i.>a0) +(gen-interface :name i.>a1) +(gen-interface :name i.>b0) +(gen-interface :name i.>b1) + +(gen-interface :name i.a :extends [i.>a0 i.>a1 i.>a+b]) +(gen-interface :name i.b :extends [i.>b0 i.>b1 i.>a+b]) + +(gen-interface :name i.<0) +(gen-interface :name i.><1) +(gen-interface :name i.><2) + +(t/def i|>a+b (t/isa? i.>a+b)) +(t/def i|>a0 (t/isa? i.>a0)) +(t/def i|>a1 (t/isa? i.>a1)) +(t/def i|>b0 (t/isa? i.>b0)) +(t/def i|>b1 (t/isa? i.>b1)) +(t/def i|a (t/isa? i.a)) +(t/def i|b (t/isa? i.b)) +(t/def i|<0 (t/isa? i.><0)) +(t/def i|><1 (t/isa? i.><1)) +(t/def i|><2 (t/isa? i.><2)) + +) + +;; ----- Hierarchy within existing non-interfaces ----- ;; + +(do (t/def >a+b (t/isa? java.util.AbstractCollection)) + (t/def >a (t/isa? java.util.AbstractList)) + (t/def >b (t/isa? java.util.AbstractSet)) + (t/def a (t/isa? java.util.ArrayList)) + (t/def b (t/isa? java.util.HashSet)) + (t/def <0 byte?) + (t/def ><1 short?) + (t/def ><2 long?)) + +(t/def Uc (t/isa? java.lang.Object)) + +;; ----- Example protocols ----- ;; + +(do + +(defprotocol AProtocolAll (a-protocol-all [this])) + +(extend-protocol AProtocolAll + nil (a-protocol-all [this]) + Object (a-protocol-all [this])) + +(defprotocol AProtocolCharSeq (a-protocol-char-seq [this])) + +(extend-protocol AProtocolCharSeq + java.lang.CharSequence (a-protocol-char-seq [this])) + +(defprotocol AProtocolString (a-protocol-string [this])) + +(extend-protocol AProtocolString + java.lang.String (a-protocol-string [this])) + +(defprotocol AProtocolNonNil (a-protocol-non-nil [this])) + +(extend-protocol AProtocolNonNil + Object (a-protocol-non-nil [this])) + +(defprotocol AProtocolOnlyNil (a-protocol-only-nil [this])) + +(extend-protocol AProtocolOnlyNil + nil (a-protocol-only-nil [this])) + +(defprotocol AProtocolNone (a-protocol-none [this])) + +(def protocol-types + (->> [AProtocolAll AProtocolString AProtocolNonNil AProtocolOnlyNil AProtocolNone] + (map t/isa?) set)) + +) + + +(def C java.util.AbstractCollection) ; concrete class +(def A java.util.AbstractCollection) ; abstract class +(def I Comparable) ; interface +(def P AProtocolAll) ; protocol + +;; ===== End type predicates ===== ;; + +(defn- test-equality [genf] + (let [a (genf) b (genf)] + (testing "structural equality (`c/=`)" + (is= a b)) + (testing "hash(eq) equality" + (is= (hash a) (hash b))) + #?(:clj (testing "hash(code) equality" + (is= (.hashCode ^Object a) (.hashCode ^Object b)))) + (testing "collection equality" + (is= 1 (count (hash-set a b)))))) + +(defn- gen-meta [] {(rand) (rand)}) + +(deftest test|universal-set + (test-equality #(UniversalSetType. nil)) + (test-equality #(UniversalSetType. (gen-meta)))) + +(deftest test|empty-set + (test-equality #(EmptySetType. nil)) + (test-equality #(EmptySetType. (gen-meta)))) + +(deftest test|not + (test-equality #(! (t/value 1))) + (testing "simplification" + (testing "universal/null set" + (is= (! t/universal-set) + t/empty-set) + (is= (! t/empty-set) + t/universal-set)) + (testing "universal class-set" + (is= (! t/val?) + t/nil?) + (is= (! t/val|by-class?) + t/nil?)) + (testing "DeMorgan's Law" + (is= (! (| i|a i|b)) + (& (! i|a) (! i|b))) + (is= (! (& i|a i|b)) + (| (! i|a) (! i|b))) + (is= (! (| (! i|a) (! i|b))) + (& i|a i|b)) + (is= (! (& (! i|a) (! i|b))) + (| i|a i|b))))) + +(deftest test|- + (testing "=" + (is= (t/- a a) + t/empty-set)) + (testing "<" + (is= (t/- a >a) + t/empty-set)) + (testing "<>" + (is= (t/- a b) + a)) + (testing ">" + (is= (t/- (| a b) a) + b) + (is= (t/- (| a b long?) a) + (| b long?))) + (testing "><" + )) + +(deftest test|or + (test-equality #(| a b)) + (test-equality #(| (t/value 1) (t/value 2))) + (testing "simplification" + (testing "via single-arg" + (is= (| a) + a)) + (testing "via identity" + (is= (| a a) + a) + (is= (| (| a a) a) + a) + (is= (| a (| a a)) + a) + (is= (| (| a b) (| b a)) + (| a b)) + (is= (| (| a b ><0) (| a ><0 b)) + (| a b ><0))) + (testing "via universal class + nil" + (is= t/universal-set (| (t/isa? Object) (t/value nil))) + (is= t/universal-set (| (t/value nil) (t/isa? Object))) + (is= t/universal-set (| (t/isa? Object) (t/value nil) (t/value 1))) + (is= t/universal-set (| (t/isa? Object) (t/value 1) (t/value nil))) + (is= t/universal-set (| (t/value nil) (t/isa? Object) (t/value 1))) + (is= t/universal-set (| (t/value nil) (t/value 1) (t/isa? Object))) + (is= t/universal-set (| (t/value 1) (t/isa? Object) (t/value nil))) + (is= t/universal-set (| (t/value 1) (t/value nil) (t/isa? Object)))) + (testing "nested `or` is expanded" + (is= (| (| a b) (| ><0 ><1)) + (| a b ><0 ><1)) + (is= (| (| a b) (| ><0 ><1)) + (| a b ><0 ><1))) + (testing "via `not`" + (is= (| a (! a)) + t/universal-set) + (is= (| a b (! a)) + t/universal-set) + (is= (| a b (| (! a) (! b))) + t/universal-set)) + (testing "nested" + (is= (utr/or-type>args (| (| string? double?) + char-seq?)) + [double? char-seq?]) + (is= (utr/or-type>args (| (| string? double?) + (| double? char-seq?))) + [double? char-seq?]) + (is= (utr/or-type>args (| (| string? double?) + (| char-seq? (t/isa? Number)))) + [char-seq? (t/isa? Number)])) + (testing "#{<+ =} -> #{<+}" + (is= (utr/or-type>args (| i|>a+b i|>a0 i|a)) + [i|>a+b i|>a0])) + (testing "#{<+ >+} -> #{<+}" + (is= (utr/or-type>args (| i|>a+b i|>a0 i|a+b i|>a0])) + (testing "#{>+ =} -> #{=}" + (is= (| i|+ ><+} -> #{<+ ><+}" + (is= (utr/or-type>args (| i|>a+b i|>a0 i|<0 i|><1)) + [i|>a+b i|>a0 i|><0 i|><1])) + (testing "#{<+ >+ <>+} -> #{<+ <>+}" + (is= (utr/or-type>args (| >a <0 ><1)) + [>a ><0 ><1])) + (testing "#{<+ =+ >+ ><+} -> #{<+ ><+}" + (is= (utr/or-type>args (| i|>a+b i|>a0 i|a i|<0 i|><1)) + [i|>a+b i|>a0 i|><0 i|><1])) + (testing "#{<+ =+ >+ <>+} -> #{<+ <>+}" + (is= (utr/or-type>args (| >a a <0 ><1)) + [>a ><0 ><1])))) + +(deftest test|and + (test-equality #(& i|a i|b)) + (testing "null set / universal set" + (is= (& t/universal-set t/universal-set) + t/universal-set) + (is= (& t/universal-set t/empty-set) + t/empty-set) + (is= (& t/empty-set t/universal-set) + t/empty-set) + (is= (& t/universal-set t/empty-set t/universal-set) + t/empty-set) + (is= (& t/universal-set string?) + string?) + (is= (& t/universal-set char-seq? string?) + string?) + (is= (& t/universal-set string? char-seq?) + string?) + (is= (& t/empty-set string?) + t/empty-set) + (is= (& t/empty-set char-seq? string?) + t/empty-set) + (is= (& t/empty-set string? char-seq?) + t/empty-set)) + (testing "simplification" + (testing "via single-arg" + (is= (& a) + a)) + (testing "via identity" + (is= (& a a) + a) + (is= (& (! a) (! a)) + (! a)) + (is= (& (& a a) a) + a) + (is= (& a (& a a)) + a) + (is= (& (| string? byte?) (| byte? string?)) + (| string? byte?)) + (is= (& (| a b) (| b a)) + (| a b)) + (is= (& (| a b ><0) (| a ><0 b)) + (| a b ><0))) + (testing "" + (is= (utr/and-type>args (& i|a i|b)) + [i|a i|b])) + (testing "empty-set" + (is= (& a b) + t/empty-set) + (is= (& string? byte?) + t/empty-set) + (is= (& a ><0) + t/empty-set) + (is= (& a ><0 ><1) + t/empty-set)) + (testing "nested `and` is expanded" + (is= (& (& a b) (& ><0 ><1)) + (& a b ><0 ><1)) + (is= (& (& a b) (& ><0 ><1)) + (& a b ><0 ><1))) + (testing "and + not" + (is= (& a (! a)) + t/empty-set) + (is= (& a (! b)) + a) + (is= (& (! b) a) + a) + (testing "+ or" + (is= (& (! a) a b) + t/empty-set) + (is= (& a (! a) b) + t/empty-set) + (is= (& a b (! a)) + t/empty-set) + (is= (& (| a b) (! a)) + b) + ;; TODO fix impls + #_(is= (& (! a) (| a b)) + b) + (is= (& (| a b) (! b) (| b a)) + a) + (is= (& (| a b) (! b) (| ><0 b)) + t/empty-set)) + (is= (& primitive? (! boolean?)) + (| byte? short? char? int? long? float? double?))) + (testing "#{<+ =} -> #{=}" + (is= (& i|>a+b i|>a0 i|a) + i|a)) + (testing "#{>+ =+} -> #{>+}" + (is= (utr/and-type>args (& i|+} -> #{>+}" + (is= (utr/and-type>args (& i|>a+b i|>a0 i|+ ∅+} -> #{>+ ∅+}" + (is= (utr/and-type>args (& i|>a+b i|>a0 i|<0 i|><1)) + [i|<0 i|><1])) + (testing "#{<+ =+ >+ ∅+} -> #{>+ ∅+}" + (is= (utr/and-type>args (& i|>a+b i|>a0 i|a i|<0 i|><1)) + [i|<0 i|><1])))) + +(deftest test|isa?|protocol + (test-equality #(@#'t/isa?|protocol P))) + +(deftest test|isa?|class + (test-equality #(@#'t/isa?|class C)) + (test-equality #(@#'t/isa?|class A)) + (test-equality #(@#'t/isa?|class I))) + +(deftest test|isa?|direct + (test-equality #(t/isa?|direct C)) + (test-equality #(t/isa?|direct A)) + (test-equality #(t/isa?|direct I)) + (test-equality #(t/isa?|direct P)) + #?(:clj (is (= (t/isa?|direct P) (t/isa? quantum.test.untyped.core.type.AProtocolAll))))) + +(deftest test|isa? + (test-equality #(t/isa? C)) + (test-equality #(t/isa? A)) + (test-equality #(t/isa? I)) + (test-equality #(t/isa? P))) + +(defn- test-basic-finite [f] + (is= true ((f []) nil)) + (is= true ((f []) [])) + (is= true ((f []) #{})) + (is= true ((f []) {})) + (is= true ((f) nil)) + (is= true ((f) [])) + (is= true ((f) #{})) + (is= true ((f) {})) + (is= false ((f [boolean?]) nil)) + (is= false ((f [boolean?]) [])) + (is= false ((f [boolean?]) #{})) + (is= false ((f [boolean?]) {})) + (is= true ((f [boolean?]) [true])) + (is= true ((f [boolean?]) #{true})) + (is= false ((f [boolean?]) {true true})) + (is= false ((f boolean?) nil)) + (is= false ((f boolean?) [])) + (is= false ((f boolean?) #{})) + (is= false ((f boolean?) {})) + (is= true ((f boolean?) [true])) + (is= true ((f boolean?) #{true})) + (is= false ((f boolean?) {true true})) + (is= true ((f [(t/ordered boolean? boolean?)]) {true true})) + (is= true ((f (t/ordered boolean? boolean?)) {true true})) + (is= true ((f [(t/ordered boolean? boolean?)]) [[true true]])) + (is= true ((f (t/ordered boolean? boolean?)) [[true true]])) + (testing "`indexed?` is treated distinctly from `lookup?` with `integer?` keys" + (is= true ((f [(t/ordered long? boolean?)]) [[0 true]])) + (is= true ((f (t/ordered long? boolean?)) [[0 true]])) + (is= false ((f [(t/ordered long? boolean?)]) [true])) + (is= false ((f (t/ordered long? boolean?)) [true])) + (is= true ((f [(t/ordered long? boolean?)]) {0 true})) + (is= true ((f (t/ordered long? boolean?)) {0 true})))) + +(deftest test|unordered + (test-basic-finite t/unordered) + (testing "Order should not matter; only frequency" + (is= true ((t/unordered (t/value 1) (t/value 2) (t/value 3) (t/value 4) (t/value 5) (t/value 6)) + [1 2 3 4 5 6])) + (testing "Frequency of 1" + (dotimes [i 100] + (is= true ((t/unordered (t/value 1) (t/value 2) (t/value 3) + (t/value 4) (t/value 5) (t/value 6)) (shuffle [1 2 3 4 5 6]))))) + (testing "Frequency of 2" + (dotimes [i 100] + (is= false ((t/unordered (t/value 1) (t/value 2) (t/value 3) + (t/value 4) (t/value 5) (t/value 6)) (shuffle [1 2 3 4 5 6 6]))) + (is= true ((t/unordered (t/value 1) (t/value 2) (t/value 3) (t/value 4) (t/value 5) + (t/value 6) (t/value 6)) (shuffle [1 2 3 4 5 6 6]))))) + (is= true ((t/unordered (t/value 1) (t/value 2) (t/value 3) (t/value 4) (t/value 5) (t/value 6)) + #{1 2 3 4 5 6})) + (is= true ((t/unordered (t/ordered (t/value :a) (t/value :b)) + (t/ordered (t/value :c) (t/value :d)) + (t/ordered (t/value :e) (t/value :f)) + (t/ordered (t/value :g) (t/value :h)) + (t/ordered (t/value :i) (t/value :j))) + {:a :b :c :d :e :f :g :h :i :j})) + (let [t (t/unordered (t/unordered (t/value :a) (t/value :b)) + (t/unordered (t/value :c) (t/value :d)) + (t/unordered (t/value :e) (t/value :f)) + (t/unordered (t/value :g) (t/value :h)) + (t/unordered (t/value :i) (t/value :j)))] + (is= true (t (->> {:a :b :c :d :e :f :g :h :i :j} (map shuffle) (into {})))))) + (testing "Internally should sort types deterministically" + (let [ts (->> (concat (range 15) (range 15)) (map t/value)) + t (t/unordered ts)] + (dotimes [i 100] + (is= t (t/unordered (shuffle ts)))))) + ;; This may be too computationally expensive though, given the `O(n!)` nature of it + #_(testing "Combinatoric equality between `t/ordered` and `t/unordered`" + (test-comparison =ident + (t/unordered (t/value 1) (t/value 2)) + (t/or (t/ordered (t/value 1) (t/value 2)) + (t/ordered (t/value 2) (t/value 1)))) + (test-comparison =ident + (t/unordered (t/unordered (t/value 1) (t/value 2)) + (t/unordered (t/value 1) (t/value 2))) + (t/or (t/ordered (t/ordered (t/value 1) (t/value 2)) + (t/ordered (t/value 1) (t/value 2))) + (t/ordered (t/ordered (t/value 1) (t/value 2)) + (t/ordered (t/value 2) (t/value 1))) + (t/ordered (t/ordered (t/value 2) (t/value 1)) + (t/ordered (t/value 1) (t/value 2))) + (t/ordered (t/ordered (t/value 2) (t/value 1)) + (t/ordered (t/value 2) (t/value 1))))))) + +(deftest test|ordered + (test-basic-finite t/ordered) + (testing "Order should matter" + (is= true ((t/ordered (t/value 1) (t/value 2) (t/value 3) (t/value 4) (t/value 5) (t/value 6)) + [1 2 3 4 5 6])) + (is= false ((t/ordered (t/value 1) (t/value 2) (t/value 3) (t/value 4) (t/value 5) (t/value 6)) + #{1 2 3 4 5 6})) + (let [t (t/ordered (t/ordered (t/value :a) (t/value :b)) + (t/ordered (t/value :c) (t/value :d)) + (t/ordered (t/value :e) (t/value :f)) + (t/ordered (t/value :g) (t/value :h)) + (t/ordered (t/value :i) (t/value :j)))] + (is= false (t (->> {:a :b :c :d :e :f :g :h :i :j} seq shuffle (into {})))) + (is= true (t (umap/om :a :b :c :d :e :f :g :h :i :j))) + (is= true (t (sorted-map :a :b :c :d :e :f :g :h :i :j)))) + (let [t (t/ordered (t/unordered (t/value :a) (t/value :b)) + (t/unordered (t/value :c) (t/value :d)) + (t/unordered (t/value :e) (t/value :f)) + (t/unordered (t/value :g) (t/value :h)) + (t/unordered (t/value :i) (t/value :j)))] + (dotimes [i 100] + (let [base [[:a :b] [:c :d] [:e :f] [:g :h] [:i :j]] + shuffled (->> base (map shuffle) shuffle (into {}))] + (if (= base (->> shuffled (map sort))) + (is= true (t shuffled)) + (is= false (t shuffled)))) + (is= true (t (->> (umap/om :a :b :c :d :e :f :g :h :i :j) + (map shuffle) (into (umap/om))))) + (is= true (t (->> (sorted-map :a :b :c :d :e :f :g :h :i :j) + (map shuffle) (into (sorted-map))))))))) + +(deftest test|value + (test-equality #(t/value 1)) + (testing "hash equality" + (is= (hash (t/value 1)) (hash (t/value 1))) + (is= 1 (count (hash-set (t/value 1) + (t/value 1)))))) + +(def >namespace|type (t/ftype string? [string?] [symbol?])) + +(def reduce|type (t/ftype t/any? [fn? t/any? string? :> char-seq?] + [ifn? t/any? java-set? :> comparable?])) + +(deftest test|input-type|meta-or + (is= (t/input|meta-or + (-> #'fake-compare meta :quantum.core.type/type deref) + [(t/not (t/value nil)) :?]) + ;; i.e., not `long?` + (t/meta-or [(t/value nil)])) + (is= (t/input|meta-or + (-> #'fake-compare meta :quantum.core.type/type deref) + [long? :?]) + (t/meta-or + ;; Because arg0 is `long?`, is `t/<=` `(t/ref t/val?)`, and so this is from + ;; `[(t/ref t/val?) t/nil?]` + [(t/value nil) + long?])) + (is= (t/input|meta-or + (-> #'fake-compare meta :quantum.core.type/type deref) + [[= long?] :?]) + (t/meta-or [long?]))) + +(deftest test|input-type|or + (is= (t/or string? symbol?) (t/input|or >namespace|type [:?])) + (is= (t/or string? java-set?) (t/input|or reduce|type [:_ :_ :?]))) + (is= fn? (t/input|or reduce|type [:? :_ string?])) + +(deftest test|output-type|or + (is= string? (t/output|or >namespace|type)) + (is= (t/or char-seq? comparable?) (t/output|or reduce|type)) + (is= char-seq? (t/output|or reduce|type [:_ :_ string?]))) + +(deftest test|rx + (testing "=" + ;; TODO use a generator + (doseq [gen-t [#(t/isa? #?(:clj Double :cljs js/Number)) + #(do t/empty-set) + #(do t/universal-set) + #(t/value 1) + #(t/value "abc") + #(t/or (t/isa? #?(:clj Double :cljs js/Number)) (t/value "abc"))]] + (is= @(t/rx (gen-t)) @(t/rx (gen-t)))))) + +(deftest test|meta-or + (testing "+ `t/or`" + (is= (t/or (t/meta-or [byte? short? char?]) string?) + (t/meta-or [(t/or byte? string?) + (t/or short? string?) + (t/or char? string?)])) + (is= (t/or (t/meta-or [long? t/any?]) + (t/meta-or [byte? short? char?])) + (t/meta-or [(t/or long? byte?) + (t/or long? short?) + (t/or long? char?) + t/any?]))) + (testing "+ `t/and`" + (is= (t/and (t/meta-or [long? t/any?]) + (t/meta-or [byte? short? char?])) + (t/meta-or [t/none? byte? short? char?]))) + (testing "+ `t/-`" + (is= (t/- (t/meta-or [i|a i|b]) i|><0) + (t/meta-or [(t/- i|a i|><0) (t/- i|b i|><0)])) + (is= (t/- i|><0 (t/meta-or [i|a i|b])) + (t/meta-or [(t/- i|><0 i|a) (t/- i|><0 i|b)])) + (is= (t/- (t/meta-or [i|a i|b]) (t/meta-or [i|><0 i|><1])) + (t/meta-or [(t/- i|a i|><0) (t/- i|a i|><1) (t/- i|b i|><0) (t/- i|b i|><1)]))) + (testing "Reactive types" + (is= @(t/meta-or [(t/rx string?) byte?]) + (t/meta-or [byte? string?]))) + (testing "Structural deduplication" + (is= (t/meta-or [string? string?]) + (t/meta-or [string?]) + string?) + (is= (t/meta-or [(t/value 1) + (t/value true) + (t/value false) + (t/value true) + (t/value 1)]) + (t/meta-or [(t/value 1) + (t/value true) + (t/value false)])))) diff --git a/test/quantum/test/untyped/core/type/compare.cljc b/test/quantum/test/untyped/core/type/compare.cljc new file mode 100644 index 00000000..73242fe0 --- /dev/null +++ b/test/quantum/test/untyped/core/type/compare.cljc @@ -0,0 +1,1617 @@ +(ns quantum.test.untyped.core.type.compare + (:require + [clojure.core :as core] + [quantum.test.untyped.core.type :as tt + :refer [i|>a+b i|>a0 i|>a1 i|>b0 i|>b1 + i|a i|b + i|<0 i|><1 i|><2 + + >a+b >a >b + a b + <0 ><1 ><2 + + AProtocolAll AProtocolCharSeq AProtocolString AProtocolNonNil AProtocolOnlyNil + AProtocolNone + protocol-types + + Uc C A I P]] + [quantum.untyped.core.analyze.expr :as xp + :refer [>expr]] + [quantum.untyped.core.collections :as c] + [quantum.untyped.core.compare :as ucomp] + [quantum.untyped.core.data.hash :as uhash] + [quantum.untyped.core.data.set :as uset + :refer [ident >ident]] + [quantum.untyped.core.defnt + :refer [defns]] + [quantum.untyped.core.fn + :refer [fn1]] + [quantum.untyped.core.logic + :refer [ifs]] + [quantum.untyped.core.numeric :as unum] + [quantum.untyped.core.numeric.combinatorics :as ucombo] + [quantum.untyped.core.spec :as s] + [quantum.untyped.core.test + :refer [deftest testing is is= throws]] + [quantum.untyped.core.type :as t + :refer [& | !]] + [quantum.untyped.core.type.compare :as utcomp] + [quantum.untyped.core.type.reifications :as utr])) + +;; Here, `NotType` labels on `testing` mean such *after* simplification + +#?(:clj +(defmacro test-comparisons>comparisons [[_ _ a b]] + `[[~@(for [a* (rest a)] + `(t/compare ~a* ~b))] + [~@(for [b* (rest b)] + `(t/compare ~b* ~a))]])) + +;; TODO come back to this +#_(do (is= -1 (t/compare (t/value 1) t/numerically-byte?)) + + (is= (& t/long? (>expr (fn1 = 1))) + (t/value 1)) + + (is= (& (t/value 1) (>expr unum/integer-value?)) + (t/value 1)) + + (t/compare (t/value 1) (>expr unum/integer-value?)) + + (is= 0 (t/compare (t/value 1) (>expr (fn1 =|long 1)))) + (is= 0 (t/compare (t/value 1) (>expr (fn [^long x] (= x 1))))) + (is= 0 (t/compare (t/value 1) (>expr (fn [^long x] (== x 1))))) + (is= 0 (t/compare (t/value 1) (>expr (fn [x] (core/== (long x) 1))))) + (is= 0 (t/compare (t/value 1) (>expr (fn [x] (= (long x) 1)))))) + +;; TESTS ;; + +(defns type>type-combos + "To generate all commutative possibilities for a given type." + [t t/type? > (s/seq-of t/type?)] + (ifs (t/and-type? t) (->> t utr/and-type>args ucombo/permutations + (map #(utr/->AndType uhash/default uhash/default nil nil (vec %) + (atom nil)))) + (t/or-type? t) (->> t utr/or-type>args ucombo/permutations + (map #(utr/->OrType uhash/default uhash/default nil nil (vec %) + (atom nil)))) + [t])) + +#?(:clj +(defmacro test-comparison + "Performs a `t/compare` on `a` and `b`, ensuring that their relationship is symmetric, and that + the inputs are internally commutative if applicable (e.g. if `a` is an `AndType`, ensures that + it is commutative). + The basis comparison is the first input." + [c #_t/comparisons a #_t/type? b #_t/type?] + `(let [c# ~c] + (doseq ;; Commutativity + [a*# (type>type-combos ~a) + b*# (type>type-combos ~b)] + ;; Symmetry + (is= c# (t/compare a*# b*#)) + (is= (uset/invert-comparison c#) (t/compare b*# a*#)))))) + +#?(:clj +(defmacro test-comparison|fn + "Performs a `t/compare|in` and `t/compare|out` on `a` and `b`, ensuring that the + comparison-relationship between `a` and `b` is symmetric. + The basis comparison is the first input." + [[c|in #_t/comparisons, c|out #_t/comparisons] #__, a #_t/type? b #_t/type?] + `(let [c|out# ~c|out, c|in# ~c|in, a# ~a, b# ~b] + ;; Symmetry + (is= c|in# (t/compare|in a# b#)) + (is= (uset/invert-comparison c|in#) (t/compare|in b# a#)) + (is= c|out# (t/compare|out a# b#)) + (is= (uset/invert-comparison c|out#) (t/compare|out b# a#))))) + +(def comparison-combinations + ["#{<}" + "#{< =}" + "#{< = >}" + "#{< = > ><}" + "#{< = > >< <>}" + "#{< = > <>}" + "#{< = ><}" + "#{< = >< <>}" + "#{< = <>}" + "#{< >}" + "#{< > ><}" + "#{< > >< <>}" + "#{< > <>}" + "#{< ><}" + "#{< >< <>}" + "#{< <>}" + "#{=}" + "#{= >}" + "#{= > ><}" + "#{= > >< <>}" + "#{= > <>}" + "#{= ><}" + "#{= >< <>}" + "#{= <>}" + "#{>}" + "#{> ><}" + "#{> >< <>}" + "#{> <>}" + "#{><}" + "#{>< <>}" + "#{<>}"]) + +(deftest test|in|compare + (testing "UniversalSetType" + (testing "+ UniversalSetType" + (test-comparison =ident t/universal-set t/universal-set)) + (testing "+ EmptySetType" + (test-comparison >ident t/universal-set t/empty-set)) + (testing "+ NotType" + (test-comparison >ident t/universal-set (! a))) + (testing "+ OrType" + (test-comparison >ident t/universal-set (| ><0 ><1))) + (testing "+ AndType" + (test-comparison >ident t/universal-set (& i|><0 i|><1))) + (testing "+ Expression") + (testing "+ ProtocolType" + (doseq [t protocol-types] + (test-comparison >ident t/universal-set t))) + (testing "+ ClassType") + (testing "+ ValueType" + (doseq [t [(t/value t/universal-set) + (t/value t/empty-set) + (t/value 0) + (t/value nil)]] + (test-comparison >ident t/universal-set t)))) + ;; The null set is considered to always (vacuously) be a subset of any set + (testing "EmptySetType" + (testing "+ EmptySetType" + (test-comparison =ident t/empty-set t/empty-set)) + (testing "+ NotType" + (testing "Inner ClassType" + (test-comparison <>ident t/empty-set (! a))) + (testing "Inner ValueType" + (test-comparison <>ident t/empty-set (! (t/value 1))))) + (testing "+ OrType" + (test-comparison <>ident t/empty-set (| ><0 ><1))) + (testing "+ AndType" + (test-comparison <>ident t/empty-set (& i|><0 i|><1))) + (testing "+ Expression") + (testing "+ ProtocolType" + (doseq [t protocol-types] + (test-comparison <>ident t/empty-set t))) + (testing "+ ClassType") + (testing "+ ValueType" + (test-comparison <>ident t/empty-set (t/value t/empty-set)) + (test-comparison <>ident t/empty-set (t/value 0)))) + (testing "NotType" + (testing "+ NotType" + (test-comparison =ident (! a) (! a)) + (test-comparison >ident (! a) (! >a)) + (test-comparison }") ; impossible for `OrType` + #_(testing "#{< = > ><}") ; impossible for `OrType` + #_(testing "#{< = > >< <>}") ; impossible for `OrType` + #_(testing "#{< = > <>}") ; impossible for `OrType` + #_(testing "#{< = ><}") ; impossible for `OrType` + #_(testing "#{< = >< <>}") ; impossible for `OrType` + #_(testing "#{< = <>}") ; impossible for `OrType` + #_(testing "#{< >}") ; impossible for `OrType` + #_(testing "#{< > ><}") ; impossible for `OrType` + #_(testing "#{< > >< <>}") ; impossible for `OrType` + #_(testing "#{< > <>}") ; impossible for `OrType` + (testing "#{< ><}" + #_(test-comparison a+b i|>a0 i|><0 i|><1)) + #_(test-comparison a0 (| i|>a+b i|>a0))) + (testing "#{< >< <>}" + #_(test-comparison a+b i|>a0 i|><0 i|><1 t/string?))) + (testing "#{< <>}" + #_(test-comparison a ><0 ><1))) + #_(testing "#{=}") ; impossible for `OrType` + #_(testing "#{= >}") ; impossible for `OrType` + #_(testing "#{= > ><}") ; impossible for `OrType` + #_(testing "#{= > >< <>}") ; impossible for `OrType` + #_(testing "#{= > <>}") ; impossible for `OrType` + (testing "#{= ><}" + (test-comparison <0 i|><1)) + (test-comparison <0 i|><1))) + (testing "#{= >< <>}" + #_(test-comparison <0 i|><1 t/string?))) + (testing "#{= <>}" + (test-comparison }" + #_(test-comparison >ident a (| ident i|a (| i| ><}" + #_(test-comparison ><0 i|><1))) + (testing "#{> >< <>}" + #_(test-comparison ><0 i|><1 t/string?))) + (testing "#{> <>}" + (test-comparison ><0) (| ><0 ><1)) + (test-comparison ><1) (| ><1 ><0))) + (testing "#{><}" + #_(test-comparison ><0 i|><1))) + (testing "#{>< <>}" + #_(test-comparison ><0 i|><1 t/string?))) + (testing "#{<>}" + (test-comparison <>ident (! a) (| }" + (test-comparison ... (! a) (& a (! b))))) + (testing "+ Expression") + (testing "+ ProtocolType") + (testing "+ ClassType" + (test-comparison <>ident (! a) a) ; inner = + (test-comparison <>ident (! i|a) i|a) ; inner = + (test-comparison <>ident (! a) + (test-comparison <>ident (! i|a) i| + (test-comparison >a) ; inner < + (test-comparison >a0) ; inner >< + (test-comparison >ident (! a ) ><0) ; inner <> + (test-comparison ><0) ; inner >< + (test-comparison >a) ; inner < + (test-comparison >a0) ; inner < + (test-comparison >ident (! <0) ; inner <> + (test-comparison ><0) ; inner >< + (test-comparison >ident (! >a) a) ; inner > + (test-comparison <>ident (! i|>a0) i|a) ; inner > + (test-comparison <>ident (! >a) + (test-comparison <>ident (! i|>a0) i| + (test-comparison >ident (! >a) ><0) ; inner <> + (test-comparison >a0) i|><0) ; inner >< + (test-comparison >a) Uc) ; inner < + (test-comparison >a0) Uc) ; inner < + (test-comparison >ident (! ><0) a) ; inner <> + (test-comparison ><0) i|a) ; inner >< + (test-comparison >ident (! ><0) + (test-comparison ><0) i|< + (test-comparison >ident (! ><0) >a) ; inner <> + (test-comparison ><0) i|>a0) ; inner >< + (test-comparison ><0) Uc) ; inner < + (test-comparison ><0) Uc) ; inner < + (testing "+ ValueType" + (test-comparison ident (t/value "") (! t/string?)))) + (testing "OrType" + (testing "+ OrType" + ;; Comparison annotations achieved by first comparing each element of the first/left + ;; to the entire second/right, then comparing each element of the second/right to the + ;; entire first/left + ;; TODO fill in these comparisons + (testing "#{<}" + (testing "+ #{<}" + ;; comparisons: < < < < + (test-comparison =ident (| a b) (| a b)) + ;; comparisons: < < < < + (test-comparison =ident (| i|>a+b i|>a0) (| i|>a+b i|>a0))) + #_(testing "+ #{< =}") ; impossible for `OrType` + #_(testing "+ #{< = >}") ; impossible for `OrType` + #_(testing "+ #{< = > ><}") ; impossible for `OrType` + #_(testing "+ #{< = > >< <>}") ; impossible for `OrType` + #_(testing "+ #{< = > <>}") ; impossible for `OrType` + #_(testing "+ #{< = ><}") ; impossible for `OrType` + #_(testing "+ #{< = >< <>}") ; impossible for `OrType` + #_(testing "+ #{< = <>}") ; impossible for `OrType` + #_(testing "+ #{< >}") ; impossible for `OrType` + #_(testing "+ #{< > ><}") ; impossible for `OrType` + #_(testing "+ #{< > >< <>}") ; impossible for `OrType` + #_(testing "+ #{< > <>}") ; impossible for `OrType` + (testing "+ #{< ><}" + ;; comparisons: < < < < >< >< + (test-comparison a+b i|>a0) (| i|>a+b i|>a0 i|><0 i|><1)) + ;; comparisons: < < < < >< >< >< + (test-comparison a+b i|>a0) (| i|>a+b i|>a0 i|>a1 i|><0 i|><1)) + ;; comparisons: < < < < < < >< >< + (test-comparison a+b i|>a0 i|>a1) (| i|>a+b i|>a0 i|>a1 i|><0 i|><1))) + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `OrType` + #_(testing "+ #{= >}") ; impossible for `OrType` + #_(testing "+ #{= > ><}") ; impossible for `OrType` + #_(testing "+ #{= > >< <>}") ; impossible for `OrType` + #_(testing "+ #{= > <>}") ; impossible for `OrType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + #_(testing "#{< =}") ; impossible for `OrType` + #_(testing "#{< = >}") ; impossible for `OrType` + #_(testing "#{< = > ><}") ; impossible for `OrType` + #_(testing "#{< = > >< <>}") ; impossible for `OrType` + #_(testing "#{< = > <>}") ; impossible for `OrType` + #_(testing "#{< = ><}")) ; impossible for `OrType` + #_(testing "#{< = >< <>}") ; impossible for `OrType` + #_(testing "#{< = <>}") ; impossible for `OrType` + #_(testing "#{< >}") ; impossible for `OrType` + #_(testing "#{< > ><}") ; impossible for `OrType` + #_(testing "#{< > >< <>}") ; impossible for `OrType` + #_(testing "#{< > <>}") ; impossible for `OrType` + (testing "#{< ><}" + (testing "+ #{<}" + ;; comparisons: < < >< < < + (test-comparison >ident (| i|>a+b i|>a0 i|>a1) (| i|>a+b i|>a0)) + ;; comparisons: >< < < < < + (test-comparison >ident (| i|a i|><0 i|><1) (| i|><0 i|><1))) + #_(testing "+ #{< =}") ; impossible for `OrType` + #_(testing "+ #{< = >}") ; impossible for `OrType` + #_(testing "+ #{< = > ><}") ; impossible for `OrType` + #_(testing "+ #{< = > >< <>}") ; impossible for `OrType` + #_(testing "+ #{< = > <>}") ; impossible for `OrType` + #_(testing "+ #{< = ><}") ; impossible for `OrType` + #_(testing "+ #{< = >< <>}") ; impossible for `OrType` + #_(testing "+ #{< = <>}") ; impossible for `OrType` + #_(testing "+ #{< >}") ; impossible for `OrType` + #_(testing "+ #{< > ><}") ; impossible for `OrType` + #_(testing "+ #{< > >< <>}") ; impossible for `OrType` + #_(testing "+ #{< > <>}") ; impossible for `OrType` + (testing "+ #{< ><}" + ;; comparisons: < >< < >< + (test-comparison >a+b i|>a0) (| i|>a+b i|><0)) + ;; comparisons: < >< >< < >< >< + (test-comparison >a+b i|>a0 i|>a1) (| i|>a+b i|><0 i|><1)) + ;; comparisons: < < >< < < >< >< + (test-comparison >a+b i|>a0 i|>a1) (| i|>a+b i|>a0 i|><0 i|><1)) + ;; comparisons: < < >< < >< + (test-comparison >a+b i|>a0) (| i|a i|><0)) + ;; comparisons: < >< >< < >< >< + (test-comparison >a+b i|>a0) (| i|a i|><0 i|><1)) + ;; comparisons: >< < < >< + (test-comparison ><0) (| i|><0 i|><1)) + ;; comparisons: >< < >< >< < + (test-comparison ><1 i|><2) (| i|><0 i|><1)) + ;; comparisons: >< >< < < >< + (test-comparison ><0 i|><1) (| i|><1 i|><2))) + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `OrType` + #_(testing "+ #{= >}") ; impossible for `OrType` + #_(testing "+ #{= > ><}") ; impossible for `OrType` + #_(testing "+ #{= > >< <>}") ; impossible for `OrType` + #_(testing "+ #{= > <>}") ; impossible for `OrType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}" + ;; comparisons: < >< >< >< + (test-comparison ><0) (| i|>a+b i|>a0)) + ;; comparisons: < >< >< >< >< + (test-comparison ><0 i|><1) (| i|>a+b i|>a0)) + ;; comparisons: < >< >< >< >< + (test-comparison ><0) (| i|>a+b i|>a0 i|>a1)) + ;; comparisons: < >< >< >< >< >< + (test-comparison ><0 i|><1) (| i|>a+b i|>a0 i|>a1))) + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + (testing "#{< >< <>}") + (testing "#{< <>}" + (testing "+ #{<}") + #_(testing "+ #{< =}") ; impossible for `OrType` + #_(testing "+ #{< = >}") ; impossible for `OrType` + #_(testing "+ #{< = > ><}") ; impossible for `OrType` + #_(testing "+ #{< = > >< <>}") ; impossible for `OrType` + #_(testing "+ #{< = > <>}") ; impossible for `OrType` + #_(testing "+ #{< = ><}") ; impossible for `OrType` + #_(testing "+ #{< = >< <>}") ; impossible for `OrType` + #_(testing "+ #{< = <>}") ; impossible for `OrType` + #_(testing "+ #{< >}") ; impossible for `OrType` + #_(testing "+ #{< > ><}") ; impossible for `OrType` + #_(testing "+ #{< > >< <>}") ; impossible for `OrType` + #_(testing "+ #{< > <>}") ; impossible for `OrType` + (testing "+ #{< ><}") + (testing "+ #{< >< <>}") + (testing "+ #{< <>}" + ;; comparisons: < <> < <> + (test-comparison ><1)) + ;; comparisons: <> < < <> + (test-comparison ><1))) + #_(testing "+ #{=}") ; impossible for `OrType` + #_(testing "+ #{= >}") ; impossible for `OrType` + #_(testing "+ #{= > ><}") ; impossible for `OrType` + #_(testing "+ #{= > >< <>}") ; impossible for `OrType` + #_(testing "+ #{= > <>}") ; impossible for `OrType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}" + ;; comparisons: <, <> >< <> <> + (test-comparison >a ><0 ><1))) + (testing "+ #{<>}")) + #_(testing "#{=}") ; impossible for `OrType` + #_(testing "#{= >}") ; impossible for `OrType` + #_(testing "#{= > ><}") ; impossible for `OrType` + #_(testing "#{= > >< <>}") ; impossible for `OrType` + #_(testing "#{= > <>}") ; impossible for `OrType` + (testing "#{= ><}") + (testing "#{= >< <>}") + (testing "#{= <>}") + (testing "#{>}") + (testing "#{> ><}") + (testing "#{> >< <>}") + (testing "#{> <>}") + (testing "#{><}" + (testing "+ #{<}") + #_(testing "+ #{< =}") ; impossible for `OrType` + #_(testing "+ #{< = >}") ; impossible for `OrType` + #_(testing "+ #{< = > ><}") ; impossible for `OrType` + #_(testing "+ #{< = > >< <>}") ; impossible for `OrType` + #_(testing "+ #{< = > <>}") ; impossible for `OrType` + #_(testing "+ #{< = ><}") ; impossible for `OrType` + #_(testing "+ #{< = >< <>}") ; impossible for `OrType` + #_(testing "+ #{< = <>}") ; impossible for `OrType` + #_(testing "+ #{< >}") ; impossible for `OrType` + #_(testing "+ #{< > ><}") ; impossible for `OrType` + #_(testing "+ #{< > >< <>}") ; impossible for `OrType` + #_(testing "+ #{< > <>}") ; impossible for `OrType` + (testing "+ #{<, ><}" + ;; comparisons: >< >< >< < >< >< + (test-comparison >a+b i|>a0) (| i|<0 i|><1)) + ;; comparisons: >< >< >< >< < >< >< + (test-comparison >a+b i|>a0 i|>a1) (| i|<0 i|><1)) + ;; comparisons: >< >< >< < < >< >< + (test-comparison >a+b i|>a0) (| i|<0 i|><1)) + ;; comparisons: >< >< >< >< < < >< >< + (test-comparison >a+b i|>a0 i|>a1) (| i|<0 i|><1)) + ;; comparisons: >< >< >< < < < >< >< + (test-comparison >a+b i|>a0) (| i|<0 i|><1)) + ;; comparisons: >< >< >< >< < < < >< >< + (test-comparison >a+b i|>a0 i|>a1) (| i|<0 i|><1))) + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `OrType` + #_(testing "+ #{= >}") ; impossible for `OrType` + #_(testing "+ #{= > ><}") ; impossible for `OrType` + #_(testing "+ #{= > >< <>}") ; impossible for `OrType` + #_(testing "+ #{= > <>}") ; impossible for `OrType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}" + ;; comparisons: >< >< >< >< + (test-comparison ><2) (| i|><0 i|><1)) + ;; comparisons: >< >< >< >< + (test-comparison ><0) (| i|><1 i|><2))) + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + (testing "#{>< <>}") + (testing "#{<>}" + (testing "+ #{<}") + #_(testing "+ #{< =}") ; impossible for `OrType` + #_(testing "+ #{< = >}") ; impossible for `OrType` + #_(testing "+ #{< = > ><}") ; impossible for `OrType` + #_(testing "+ #{< = > >< <>}") ; impossible for `OrType` + #_(testing "+ #{< = > <>}") ; impossible for `OrType` + #_(testing "+ #{< = ><}") ; impossible for `OrType` + #_(testing "+ #{< = >< <>}") ; impossible for `OrType` + #_(testing "+ #{< = <>}") ; impossible for `OrType` + #_(testing "+ #{< >}") ; impossible for `OrType` + #_(testing "+ #{< > ><}") ; impossible for `OrType` + #_(testing "+ #{< > >< <>}") ; impossible for `OrType` + #_(testing "+ #{< > <>}") ; impossible for `OrType` + (testing "+ #{< ><}") + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `OrType` + #_(testing "+ #{= >}") ; impossible for `OrType` + #_(testing "+ #{= > ><}") ; impossible for `OrType` + #_(testing "+ #{= > >< <>}") ; impossible for `OrType` + #_(testing "+ #{= > <>}") ; impossible for `OrType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}" + ;; comparisons: <> <> <> <> + (test-comparison <>ident (| a b) (| ><0 ><1))))) + ;; TODO complete comparisons + ;; NOTE don't eliminate symmetric comparisons here as they compare different types + (testing "+ AndType" + ;; Comparison annotations achieved by first comparing each element of the first/left to the + ;; entire second/right, then comparing each element of the second/right to the entire + ;; first/left + (testing "#{<}" + (testing "+ #{<}") + #_(testing "+ #{< =}") ; impossible for `AndType` + #_(testing "+ #{< = >}") ; impossible for `AndType` + #_(testing "+ #{< = > ><}") ; impossible for `AndType` + #_(testing "+ #{< = > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = > <>}") ; impossible for `AndType` + #_(testing "+ #{< = ><}") ; impossible for `AndType` + #_(testing "+ #{< = >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = <>}") ; impossible for `AndType` + #_(testing "+ #{< >}") ; impossible for `AndType` + #_(testing "+ #{< > ><}") ; impossible for `AndType` + #_(testing "+ #{< > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< > <>}") ; impossible for `AndType` + (testing "+ #{< ><}") + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `AndType` + #_(testing "+ #{= >}") ; impossible for `AndType` + #_(testing "+ #{= > ><}") ; impossible for `AndType` + #_(testing "+ #{= > >< <>}") ; impossible for `AndType` + #_(testing "+ #{= > <>}") ; impossible for `AndType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + #_(testing "#{< =}") ; impossible for `OrType` + #_(testing "#{< = >}") ; impossible for `OrType` + #_(testing "#{< = > ><}") ; impossible for `OrType` + #_(testing "#{< = > >< <>}") ; impossible for `OrType` + #_(testing "#{< = > <>}") ; impossible for `OrType` + #_(testing "#{< = ><}") ; impossible for `OrType` + #_(testing "#{< = >< <>}") ; impossible for `OrType` + #_(testing "#{< = <>}") ; impossible for `OrType` + #_(testing "#{< >}") ; impossible for `OrType` + #_(testing "#{< > ><}") ; impossible for `OrType` + #_(testing "#{< > >< <>}") ; impossible for `OrType` + #_(testing "#{< > <>}") ; impossible for `OrType` + (testing "#{< ><}") + (testing "#{< >< <>}") + (testing "#{< <>}") + #_(testing "#{=}") ; impossible for `OrType` + #_(testing "#{= >}") ; impossible for `OrType` + #_(testing "#{= > ><}") ; impossible for `OrType` + #_(testing "#{= > >< <>}") ; impossible for `OrType` + #_(testing "#{= > <>}") ; impossible for `OrType` + (testing "#{= ><}") + (testing "#{= >< <>}") + (testing "#{= <>}") + (testing "#{>}" + (testing "+ #{<}" + ;; comparisons: > > < < + (test-comparison >ident (| i|>a+b i|>a0) (& i|>a+b i|>a0)) + ;; comparisons: > > > < < < + (test-comparison >ident (| i|>a+b i|>a0 i|>a1) (& i|>a+b i|>a0 i|>a1))) + #_(testing "+ #{< =}") ; impossible for `AndType` + #_(testing "+ #{< = >}") ; impossible for `AndType` + #_(testing "+ #{< = > ><}") ; impossible for `AndType` + #_(testing "+ #{< = > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = > <>}") ; impossible for `AndType` + #_(testing "+ #{< = ><}") ; impossible for `AndType` + #_(testing "+ #{< = >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = <>}") ; impossible for `AndType` + #_(testing "+ #{< >}") ; impossible for `AndType` + #_(testing "+ #{< > ><}") ; impossible for `AndType` + #_(testing "+ #{< > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< > <>}") ; impossible for `AndType` + (testing "+ #{< ><}" + ;; comparisons: > > < < >< + (test-comparison >ident (| i|>a+b i|>a0) (& i|>a+b i|>a0 i|>a1)) + ;; comparisons: > > < >< + (test-comparison >ident (| i|>a+b i|>a0) (& i|a i|><0)) + ;; comparisons: > > < >< >< + (test-comparison >ident (| i|>a+b i|>a0) (& i|a i|><0 i|><1))) + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `AndType` + #_(testing "+ #{= >}") ; impossible for `AndType` + #_(testing "+ #{= > ><}") ; impossible for `AndType` + #_(testing "+ #{= > >< <>}") ; impossible for `AndType` + #_(testing "+ #{= > <>}") ; impossible for `AndType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + (testing "#{> ><}" + (testing "+ #{<}" + ;; comparisons: > > >< < < + (test-comparison >ident (| i|>a+b i|>a0 i|>a1) (& i|>a+b i|>a0))) + #_(testing "+ #{< =}") ; impossible for `AndType` + #_(testing "+ #{< = >}") ; impossible for `AndType` + #_(testing "+ #{< = > ><}") ; impossible for `AndType` + #_(testing "+ #{< = > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = > <>}") ; impossible for `AndType` + #_(testing "+ #{< = ><}") ; impossible for `AndType` + #_(testing "+ #{< = >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = <>}") ; impossible for `AndType` + #_(testing "+ #{< >}") ; impossible for `AndType` + #_(testing "+ #{< > ><}") ; impossible for `AndType` + #_(testing "+ #{< > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< > <>}") ; impossible for `AndType` + (testing "+ #{< ><}") + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `AndType` + #_(testing "+ #{= >}") ; impossible for `AndType` + #_(testing "+ #{= > ><}") ; impossible for `AndType` + #_(testing "+ #{= > >< <>}") ; impossible for `AndType` + #_(testing "+ #{= > <>}") ; impossible for `AndType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + (testing "#{> >< <>}") + (testing "#{> <>}" + (testing "+ #{<}") + #_(testing "+ #{< =}") ; impossible for `AndType` + #_(testing "+ #{< = >}") ; impossible for `AndType` + #_(testing "+ #{< = > ><}") ; impossible for `AndType` + #_(testing "+ #{< = > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = > <>}") ; impossible for `AndType` + #_(testing "+ #{< = ><}") ; impossible for `AndType` + #_(testing "+ #{< = >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = <>}") ; impossible for `AndType` + #_(testing "+ #{< >}") ; impossible for `AndType` + #_(testing "+ #{< > ><}") ; impossible for `AndType` + #_(testing "+ #{< > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< > <>}") ; impossible for `AndType` + (testing "+ #{< ><}" + ;; comparisons: > <> < >< + (test-comparison >ident (| i|>a+b t/nil?) (& i|a i|><1))) + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `AndType` + #_(testing "+ #{= >}") ; impossible for `AndType` + #_(testing "+ #{= > ><}") ; impossible for `AndType` + #_(testing "+ #{= > >< <>}") ; impossible for `AndType` + #_(testing "+ #{= > <>}") ; impossible for `AndType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + (testing "#{><}" + (testing "+ #{<}") + #_(testing "+ #{< =}") ; impossible for `AndType` + #_(testing "+ #{< = >}") ; impossible for `AndType` + #_(testing "+ #{< = > ><}") ; impossible for `AndType` + #_(testing "+ #{< = > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = > <>}") ; impossible for `AndType` + #_(testing "+ #{< = ><}") ; impossible for `AndType` + #_(testing "+ #{< = >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = <>}") ; impossible for `AndType` + #_(testing "+ #{< >}") ; impossible for `AndType` + #_(testing "+ #{< > ><}") ; impossible for `AndType` + #_(testing "+ #{< > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< > <>}") ; impossible for `AndType` + (testing "+ #{< ><}") + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `AndType` + #_(testing "+ #{= >}") ; impossible for `AndType` + #_(testing "+ #{= > ><}") ; impossible for `AndType` + #_(testing "+ #{= > >< <>}") ; impossible for `AndType` + #_(testing "+ #{= > <>}") ; impossible for `AndType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}" + ;; comparisons: >< >< >< >< >< + (test-comparison >a+b i|>a0) (& i|><0 i|><1))) + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + (testing "#{>< <>}") + (testing "#{<>}") + + + ;; FIXME incorporate the below + ;; - the comparisons need to be assessed + ;; - non `i|`s should become `i|`s + #_(testing "#{<}" + (testing "+ #{<+ ∅+}" + ;; comparisons: ; [-1, 3], [-1, 3, 3] + (test-comparison #_<>ident (| i|>a+b i|>a0) (& i|>a+b i|><0 i|><1)) + ;; comparisons: ; [-1, 3, 3], [-1, 3, 3] + (test-comparison #_<>ident (| i|>a+b i|>a0 i|>a1) (& i|>a+b i|><0 i|><1)) + ;; comparisons: ; [-1, -1], [-1, -1, 3, 3] + (test-comparison #_<>ident (| i|>a+b i|>a0) (& i|>a+b i|>a0 i|><0 i|><1)) + ;; comparisons: ; [-1, -1, 3], [-1, -1, 3, 3] + (test-comparison #_<>ident (| i|>a+b i|>a0 i|>a1) (& i|>a+b i|>a0 i|><0 i|><1)) + ;; comparisons: ; [-1, -1], [-1, -1, 3, 3, 3] + (test-comparison #_<>ident (| i|>a+b i|>a0) (& i|>a+b i|>a0 i|>a1 i|><0 i|><1)) + ;; comparisons: ; [-1, -1, -], [-1, -1, -1, 3, 3] + (test-comparison #_<>ident (| i|>a+b i|>a0 i|>a1) (& i|>a+b i|>a0 i|>a1 i|><0 i|><1))) + (testing "+ #{>+ ∅+}" (t/compare i|a (& i|a i|><0 i|><1)) + ;; comparisons: ; [3, 3], [-1, 3, 3] + (test-comparison #_<>ident (| a >a+b >a0) (& <0 ><1)) + ;; comparisons: ; [3, 3, 3], [-1, 3, 3] + (test-comparison #_<>ident (| a >a+b >a0 >a1) (& <0 ><1)) + ;; comparisons: ; [3, 3], [-1, -1, 3, 3] + (test-comparison #_<>ident (| a >a+b >a0) (& <0 ><1)) + ;; comparisons: ; [3, 3, 3], [-1, -1, 3, 3] + (test-comparison #_<>ident (| a >a+b >a0 >a1) (& <0 ><1)) + ;; comparisons: ; [3, 3], [-1, -1, 3, 3, 3] + (test-comparison #_<>ident (| a >a+b >a0) (& <0 ><1)) + ;; comparisons: ; [3, 3, 3], [-1, -1, -1, 3, 3] + (test-comparison #_<>ident (| a >a+b >a0 >a1) (& <0 ><1))))) + (testing "+ Expression") + (testing "+ ProtocolType") + (testing "+ ClassType" + (testing "#{<}" + (test-comparison a+b i|>a0 i|>a1))) + #_(testing "#{< =}") ; impossible for `OrType` + #_(testing "#{< = >}") ; impossible for `OrType` + #_(testing "#{< = > ><}") ; impossible for `OrType` + #_(testing "#{< = > >< <>}") ; impossible for `OrType` + #_(testing "#{< = > <>}") ; impossible for `OrType` + #_(testing "#{< = ><}") ; impossible for `OrType` + #_(testing "#{< = >< <>}") ; impossible for `OrType` + #_(testing "#{< = <>}") ; impossible for `OrType` + #_(testing "#{< >}") ; impossible for `OrType` + #_(testing "#{< > ><}") ; impossible for `OrType` + #_(testing "#{< > >< <>}") ; impossible for `OrType` + #_(testing "#{< > <>}") ; impossible for `OrType` + (testing "#{< ><}" + (test-comparison a+b i|>a0 i|><0 i|><1)) + (test-comparison a0 (| i|>a+b i|>a0))) + (testing "#{< >< <>}" + (test-comparison a+b i|>a0 i|><0 i|><1 t/string?))) + (testing "#{< <>}" + (test-comparison a ><0 ><1))) + #_(testing "#{=}") ; impossible for `OrType` + #_(testing "#{= >}") ; impossible for `OrType` + #_(testing "#{= > ><}") ; impossible for `OrType` + #_(testing "#{= > >< <>}") ; impossible for `OrType` + #_(testing "#{= > <>}") ; impossible for `OrType` + (testing "#{= ><}" + (test-comparison <0 i|><1))) + (testing "#{= >< <>}" + (test-comparison <0 i|><1 t/string?))) + (testing "#{= <>}" + (test-comparison <0 ><1))) + (testing "#{>}" + (test-comparison >ident a (| ident i|a (| i| ><}" + (test-comparison ><0 i|><1))) + (testing "#{> >< <>}" + (test-comparison ><0 i|><1 t/string?))) + (testing "#{> <>}" + (test-comparison ><0 ><1))) + (testing "#{><}" + (test-comparison ><0 i|><1))) + (testing "#{>< <>}" + (test-comparison ><0 i|><1 t/string?))) + (testing "#{<>}" + (test-comparison <>ident a (| ><0 ><1))) + (testing "Nilable" + (testing "< nilabled: #{< <>}" + (test-comparison }" + (test-comparison nilabled: #{> <>}" + (test-comparison >< nilabled: #{>< <>}" + (test-comparison > nilabled: #{<>}" + (test-comparison <>ident t/long? (t/? t/string?))))) + (testing "+ UnorderedType") + (testing "+ OrderedType") + (testing "+ ValueType" + (testing "arg <" + (testing "+ arg <") + (testing "+ arg =") + (testing "+ arg >") + (testing "+ arg ><") + (testing "+ arg <>" + (test-comparison " + (test-comparison " + (test-comparison " + (testing "+ arg <>" + (test-comparison <>ident (t/value "a") (| t/byte? t/long?)) + (test-comparison <>ident (t/value 3) (| (t/value 1) (t/value 2))))))) + (testing "AndType" + ;; TODO eliminate duplicate symmetric comparisons here + (testing "+ AndType" + (testing "#{<}" + (testing "+ #{<}" + ) + #_(testing "+ #{< =}") ; impossible for `AndType` + #_(testing "+ #{< = >}") ; impossible for `AndType` + #_(testing "+ #{< = > ><}") ; impossible for `AndType` + #_(testing "+ #{< = > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = > <>}") ; impossible for `AndType` + #_(testing "+ #{< = ><}") ; impossible for `AndType` + #_(testing "+ #{< = >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = <>}") ; impossible for `AndType` + #_(testing "+ #{< >}") ; impossible for `AndType` + #_(testing "+ #{< > ><}") ; impossible for `AndType` + #_(testing "+ #{< > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< > <>}") ; impossible for `AndType` + (testing "+ #{< ><}") + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `AndType` + #_(testing "+ #{= >}") ; impossible for `AndType` + #_(testing "+ #{= > ><}") ; impossible for `AndType` + #_(testing "+ #{= > >< <>}") ; impossible for `AndType` + #_(testing "+ #{= > <>}") ; impossible for `AndType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + #_(testing "#{< =}") ; impossible for `OrType` + #_(testing "#{< = >}") ; impossible for `OrType` + #_(testing "#{< = > ><}") ; impossible for `OrType` + #_(testing "#{< = > >< <>}") ; impossible for `OrType` + #_(testing "#{< = > <>}") ; impossible for `OrType` + #_(testing "#{< = ><}") ; impossible for `OrType` + #_(testing "#{< = >< <>}") ; impossible for `OrType` + #_(testing "#{< = <>}") ; impossible for `OrType` + #_(testing "#{< >}") ; impossible for `OrType` + #_(testing "#{< > ><}") ; impossible for `OrType` + #_(testing "#{< > >< <>}") ; impossible for `OrType` + #_(testing "#{< > <>}") ; impossible for `OrType` + (testing "#{< ><}") + (testing "#{< >< <>}") + (testing "#{< <>}") + #_(testing "#{=}") ; impossible for `OrType` + #_(testing "#{= >}") ; impossible for `OrType` + #_(testing "#{= > ><}") ; impossible for `OrType` + #_(testing "#{= > >< <>}") ; impossible for `OrType` + #_(testing "#{= > <>}") ; impossible for `OrType` + (testing "#{= ><}") + (testing "#{= >< <>}") + (testing "#{= <>}") + (testing "#{>}" + (testing "+ #{<}") + #_(testing "+ #{< =}") ; impossible for `AndType` + #_(testing "+ #{< = >}") ; impossible for `AndType` + #_(testing "+ #{< = > ><}") ; impossible for `AndType` + #_(testing "+ #{< = > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = > <>}") ; impossible for `AndType` + #_(testing "+ #{< = ><}") ; impossible for `AndType` + #_(testing "+ #{< = >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = <>}") ; impossible for `AndType` + #_(testing "+ #{< >}") ; impossible for `AndType` + #_(testing "+ #{< > ><}") ; impossible for `AndType` + #_(testing "+ #{< > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< > <>}") ; impossible for `AndType` + (testing "+ #{< ><}") + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `AndType` + #_(testing "+ #{= >}") ; impossible for `AndType` + #_(testing "+ #{= > ><}") ; impossible for `AndType` + #_(testing "+ #{= > >< <>}") ; impossible for `AndType` + #_(testing "+ #{= > <>}") ; impossible for `AndType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}" + ;; comparisons: > > > > + (test-comparison =ident (& i|a i|b) (& i|a i|b))) + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + (testing "#{> ><}" + (testing "+ #{<}") + #_(testing "+ #{< =}") ; impossible for `AndType` + #_(testing "+ #{< = >}") ; impossible for `AndType` + #_(testing "+ #{< = > ><}") ; impossible for `AndType` + #_(testing "+ #{< = > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = > <>}") ; impossible for `AndType` + #_(testing "+ #{< = ><}") ; impossible for `AndType` + #_(testing "+ #{< = >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = <>}") ; impossible for `AndType` + #_(testing "+ #{< >}") ; impossible for `AndType` + #_(testing "+ #{< > ><}") ; impossible for `AndType` + #_(testing "+ #{< > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< > <>}") ; impossible for `AndType` + (testing "+ #{< ><}") + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `AndType` + #_(testing "+ #{= >}") ; impossible for `AndType` + #_(testing "+ #{= > ><}") ; impossible for `AndType` + #_(testing "+ #{= > >< <>}") ; impossible for `AndType` + #_(testing "+ #{= > <>}") ; impossible for `AndType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}" + ;; comparisons: > > >< > > + (test-comparison <0) (& i|a i|b))) + (testing "+ #{> ><}" + ;; comparisons: > >< > >< + (test-comparison ><0) (& i|a i|b))) + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + (testing "#{> >< <>}") + (testing "#{> <>}" + (testing "+ #{<}") + #_(testing "+ #{< =}") ; impossible for `AndType` + #_(testing "+ #{< = >}") ; impossible for `AndType` + #_(testing "+ #{< = > ><}") ; impossible for `AndType` + #_(testing "+ #{< = > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = > <>}") ; impossible for `AndType` + #_(testing "+ #{< = ><}") ; impossible for `AndType` + #_(testing "+ #{< = >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = <>}") ; impossible for `AndType` + #_(testing "+ #{< >}") ; impossible for `AndType` + #_(testing "+ #{< > ><}") ; impossible for `AndType` + #_(testing "+ #{< > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< > <>}") ; impossible for `AndType` + (testing "+ #{< ><}") + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `AndType` + #_(testing "+ #{= >}") ; impossible for `AndType` + #_(testing "+ #{= > ><}") ; impossible for `AndType` + #_(testing "+ #{= > >< <>}") ; impossible for `AndType` + #_(testing "+ #{= > <>}") ; impossible for `AndType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + (testing "#{><}" + (testing "+ #{<}") + #_(testing "+ #{< =}") ; impossible for `AndType` + #_(testing "+ #{< = >}") ; impossible for `AndType` + #_(testing "+ #{< = > ><}") ; impossible for `AndType` + #_(testing "+ #{< = > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = > <>}") ; impossible for `AndType` + #_(testing "+ #{< = ><}") ; impossible for `AndType` + #_(testing "+ #{< = >< <>}") ; impossible for `AndType` + #_(testing "+ #{< = <>}") ; impossible for `AndType` + #_(testing "+ #{< >}") ; impossible for `AndType` + #_(testing "+ #{< > ><}") ; impossible for `AndType` + #_(testing "+ #{< > >< <>}") ; impossible for `AndType` + #_(testing "+ #{< > <>}") ; impossible for `AndType` + (testing "+ #{< ><}") + (testing "+ #{< >< <>}") + (testing "+ #{< <>}") + #_(testing "+ #{=}") ; impossible for `AndType` + #_(testing "+ #{= >}") ; impossible for `AndType` + #_(testing "+ #{= > ><}") ; impossible for `AndType` + #_(testing "+ #{= > >< <>}") ; impossible for `AndType` + #_(testing "+ #{= > <>}") ; impossible for `AndType` + (testing "+ #{= ><}") + (testing "+ #{= >< <>}") + (testing "+ #{= <>}") + (testing "+ #{>}") + (testing "+ #{> ><}") + (testing "+ #{> >< <>}") + (testing "+ #{> <>}") + (testing "+ #{><}") + (testing "+ #{>< <>}") + (testing "+ #{<>}")) + (testing "#{>< <>}") + (testing "#{<>}")) + (testing "+ Expression") + (testing "+ ProtocolType") + (testing "+ ClassType" + (testing "#{<}" + (test-comparison a0 i|>a1)) + (testing "Boxed Primitive" + (test-comparison a0 i|>a1)))) + #_(testing "#{< =}") ; impossible for `AndType` + #_(testing "#{< = >}") ; impossible for `AndType` + #_(testing "#{< = > ><}") ; impossible for `AndType` + #_(testing "#{< = > >< <>}") ; impossible for `AndType` + #_(testing "#{< = > <>}") ; impossible for `AndType` + #_(testing "#{< = ><}") ; impossible for `AndType` + #_(testing "#{< = >< <>}") ; impossible for `AndType` + #_(testing "#{< = <>}") ; impossible for `AndType` + #_(testing "#{< >}") ; impossible for `AndType` + #_(testing "#{< > ><}") ; impossible for `AndType` + #_(testing "#{< > >< <>}") ; impossible for `AndType` + #_(testing "#{< > <>}") ; impossible for `AndType` + (testing "#{< ><}" + (test-comparison >a+b i|>a0 i|>a1 i|><0 i|><1))) + (testing "#{< >< <>}" + (test-comparison >}" + (test-comparison <>ident t/string? (& tt/char-seq? tt/java-set?)) + (test-comparison <>ident ><0 (& (! ><1) (! ><0))) + (test-comparison <>ident a (& (! a) (! b)))) + #_(testing "#{=}") ; impossible for `AndType` + #_(testing "#{= >}") ; impossible for `AndType` + #_(testing "#{= > ><}") ; impossible for `AndType` + #_(testing "#{= > >< <>}") ; impossible for `AndType` + #_(testing "#{= > <>}") ; impossible for `AndType` + (testing "#{= ><}" + (test-comparison >ident i|a (& i|a i|><0 i|><1)) + (test-comparison >ident tt/char-seq? (& tt/char-seq? tt/java-set?)) + (test-comparison >ident tt/char-seq? (& tt/char-seq? tt/java-set? a))) + (testing "#{= >< <>}") ; <- TODO comparison should be >ident + ;; TODO fix + (testing "#{= <>}" + (test-comparison >ident a (& a tt/java-set?))) + (testing "#{>}" + (test-comparison >ident i|a (& i| ><}" + (test-comparison >ident i|a (& i|<0 i|><1)) + (test-comparison >ident a (& (t/isa? javax.management.AttributeList) tt/java-set?)) + (test-comparison >ident tt/comparable? (& (t/isa? java.nio.ByteBuffer) tt/java-set?))) + (testing "#{> >< <>}" + (test-comparison >ident i|a (& i|<0 a))) + (testing "#{> <>}") ; <- TODO comparison should be 1 + (testing "#{><}" + (test-comparison ><0 i|><1)) + (test-comparison >< <>}") ; <- TODO comparison should be 3 + (testing "#{<>}" + (test-comparison <>ident t/string? (& a tt/java-set?)))) + (testing "+ ValueType" + (testing "#{<}" + (test-comparison }") ; impossible for `AndType`; `>` impossible for `ValueType` + #_(testing "#{< = > ><}") ; impossible for `AndType`; `>` and `><` impossible for `ValueType` + #_(testing "#{< = > >< <>}") ; impossible for `AndType`; `>` and `><` impossible for `ValueType` + #_(testing "#{< = > <>}") ; impossible for `AndType`; `>` impossible for `ValueType` + #_(testing "#{< = ><}") ; impossible for `AndType`; `><` impossible for `ValueType` + #_(testing "#{< = >< <>}") ; impossible for `AndType`; `><` impossible for `ValueType` + #_(testing "#{< = <>}") ; impossible for `AndType` + #_(testing "#{< >}") ; impossible for `AndType`; `>` impossible for `ValueType` + #_(testing "#{< > ><}") ; impossible for `AndType`; `>` and `><` impossible for `ValueType` + #_(testing "#{< > >< <>}") ; impossible for `AndType`; `>` and `><` impossible for `ValueType` + #_(testing "#{< > <>}") ; impossible for `AndType`; `>` impossible for `ValueType` + #_(testing "#{< ><}") ; `><` impossible for `ValueType` + #_(testing "#{< >< <>}") ; `><` impossible for `ValueType` + (testing "#{< <>}" + (test-comparison <>ident (t/value "a") (& tt/char-seq? a)) + (test-comparison <>ident (t/value "a") (& tt/char-seq? tt/java-set?))) + #_(testing "#{=}") ; impossible for `AndType` + #_(testing "#{= >}") ; impossible for `AndType`; `>` impossible for `ValueType` + #_(testing "#{= > ><}") ; impossible for `AndType`; `>` and `><` impossible for `ValueType` + #_(testing "#{= > >< <>}") ; impossible for `AndType`; `>` and `><` impossible for `ValueType` + #_(testing "#{= > <>}") ; impossible for `AndType`; `>` impossible for `ValueType` + #_(testing "#{= ><}") ; `><` impossible for `ValueType` + #_(testing "#{= >< <>}") ; `><` impossible for `ValueType` + (testing "#{= <>}") + #_(testing "#{>}") ; `>` impossible for `ValueType` + #_(testing "#{> ><}") ; `>` and `><` impossible for `ValueType` + #_(testing "#{> >< <>}") ; `>` and `><` impossible for `ValueType` + #_(testing "#{> <>}") ; `>` impossible for `ValueType` + #_(testing "#{><}") ; `><` impossible for `ValueType` + #_(testing "#{>< <>}") ; `><` impossible for `ValueType` + (testing "#{<>}" + (test-comparison <>ident (t/value "a") (& a tt/java-set?))))) + (testing "Expression" + (testing "+ Expression") + (testing "+ ProtocolType") + (testing "+ ClassType") + (testing "+ ValueType")) + (testing "ProtocolType" + (testing "+ ProtocolType" + (test-comparison =ident (t/isa? AProtocolAll) (t/isa? AProtocolAll)) + (test-comparison ident (t/isa? AProtocolNone) (t/isa? AProtocolAll)) + (test-comparison =ident (t/isa? AProtocolNonNil) (t/isa? AProtocolNonNil)) + (test-comparison <>ident (t/isa? AProtocolOnlyNil) (t/isa? AProtocolNonNil)) + (test-comparison ident (t/isa? AProtocolNone) (t/isa? AProtocolNonNil)) + (test-comparison =ident (t/isa? AProtocolOnlyNil) (t/isa? AProtocolOnlyNil)) + (test-comparison <>ident (t/isa? AProtocolCharSeq) (t/isa? AProtocolOnlyNil)) + (test-comparison <>ident (t/isa? AProtocolString) (t/isa? AProtocolOnlyNil)) + (test-comparison <>ident (t/isa? AProtocolNone) (t/isa? AProtocolOnlyNil)) + (test-comparison =ident (t/isa? AProtocolCharSeq) (t/isa? AProtocolCharSeq)) + (test-comparison ident (t/isa? AProtocolNone) (t/isa? AProtocolCharSeq)) + (test-comparison =ident (t/isa? AProtocolString) (t/isa? AProtocolString)) + (test-comparison <>ident (t/isa? AProtocolNone) (t/isa? AProtocolString))) + (testing "+ ClassType" + (testing "universal class" + (test-comparison ident (t/isa? Object) (t/isa? AProtocolOnlyNil)) + (test-comparison >ident (t/isa? Object) (t/isa? AProtocolCharSeq)) + (test-comparison >ident (t/isa? Object) (t/isa? AProtocolString)) + (test-comparison <>ident (t/isa? Object) (t/isa? AProtocolNone))) + (testing "interface" + (test-comparison ident (t/isa? CharSequence) (t/isa? AProtocolOnlyNil)) + (test-comparison =ident (t/isa? CharSequence) (t/isa? AProtocolCharSeq)) + (test-comparison >ident (t/isa? CharSequence) (t/isa? AProtocolString)) + (test-comparison <>ident (t/isa? CharSequence) (t/isa? AProtocolNone))) + (testing "concrete class" + (test-comparison ident (t/isa? String) (t/isa? AProtocolOnlyNil)) + (test-comparison ident (t/isa? String) (t/isa? AProtocolNone)))) + (testing "+ ValueType" + (let [values #{t/universal-set t/empty-set nil {} 1 "" AProtocolAll + quantum.test.untyped.core.type.AProtocolAll}] + (doseq [v values] + (test-comparison ident (t/value v) (t/isa? AProtocolString))) + (doseq [v (disj values nil)] + (test-comparison ident (t/value v) (t/isa? AProtocolNonNil))) + (doseq [v [nil]] + (test-comparison ident (t/value v) (t/isa? AProtocolOnlyNil))) + (doseq [v values] + (test-comparison <>ident (t/value v) (t/isa? AProtocolNone)))))) + (testing "ClassType" + (testing "+ ClassType" + (testing "Boxed Primitive + Boxed Primitive" + (test-comparison =ident tt/long? tt/long?) + (test-comparison <>ident tt/long? tt/int?)) + (testing "Boxed Primitive + Final Concrete" + (test-comparison <>ident tt/long? t/string?)) + (testing "Boxed Primitive + Extensible Concrete" + (testing "< , >" + (test-comparison " + (test-comparison <>ident tt/long? (t/isa? Thread)))) + (testing "Boxed Primitive + Abstract" + (test-comparison <>ident tt/long? (t/isa? java.util.AbstractCollection))) + (testing "Boxed Primitive + Interface" + (test-comparison <>ident tt/long? tt/char-seq?)) + (testing "Final Concrete + Final Concrete" + (test-comparison =ident tt/string? tt/string?)) + (testing "Final Concrete + Extensible Concrete" + (testing "< , >" + (test-comparison " + (test-comparison <>ident t/string? a))) + (testing "Final Concrete + Abstract") + (testing "Final Concrete + Interface" + (testing "< , >" + (test-comparison " + (test-comparison <>ident t/string? (t/isa? java.util.Collection)))) + (testing "Extensible Concrete + Extensible Concrete" + (test-comparison =ident t/object? t/object?) + (testing "< , >" + (test-comparison " + (test-comparison <>ident a (t/isa? Thread)))) + (testing "Extensible Concrete + Abstract" + (testing "< , >" + (test-comparison " + (test-comparison <>ident (t/isa? Thread) (t/isa? java.util.AbstractCollection)) + (test-comparison <>ident (t/isa? java.util.AbstractCollection) (t/isa? Thread)))) + (testing "Extensible Concrete + Interface" + (test-comparison >" + (test-comparison " + (test-comparison <>ident (t/isa? java.util.AbstractList) (t/isa? java.util.AbstractQueue)))) + (testing "Abstract + Interface" + (testing "< , >" + (test-comparison <" + (test-comparison >", + (test-comparison <" + (test-comparison >" + (test-comparison <>ident (t/value "a") t/byte?)))) + (testing "ValueType" + (testing "+ ValueType" + (testing "=" + (test-comparison =ident (t/value nil) (t/value nil)) + (test-comparison =ident (t/value 1 ) (t/value 1 )) + (test-comparison =ident (t/value "a") (t/value "a"))) + (testing "=, non-strict" + (test-comparison =ident (t/value (vector) ) (t/value (list) )) + (test-comparison =ident (t/value (vector (vector))) (t/value (vector (list)))) + (test-comparison =ident (t/value (hash-map) ) (t/value (sorted-map) ))) + (testing "<>" + (test-comparison <>ident (t/value 1 ) (t/value 2 )) + (test-comparison <>ident (t/value "a") (t/value "b")) + (test-comparison <>ident (t/value 1 ) (t/value "a")) + (test-comparison <>ident (t/value nil) (t/value "a")))))) + +(deftest test|= + ;; Takes an inordinately long time to do `test-comparison 0 ...` even without instrumentation + (is= (| tt/byte? tt/char? tt/short? tt/int? tt/long? tt/float? tt/double?) + (& (| tt/boolean? tt/byte? tt/char? tt/short? tt/int? tt/long? tt/float? tt/double?) + (! tt/boolean?))) + (test-comparison 0 t/any? t/universal-set) + (testing "universal class(-set) identity" + (is (t/= t/val? (& t/any? t/val?))))) + +(deftest test|ftype + #_"When we compare a t/ftype to another t/ftype, we are comparing set extensionality, as always. + If we take the Wiener–Hausdorff–Kuratowski definition of a function as our definition of + choice, then we may model a function as a set of ordered pairs, each of whose first element + consists of an ordered tuple of inputs, and whose second element consists of one output. Thus + under this model, if we wish to compare the extension of two functions, it would be in error + to compare the extension of their inputs and the extension of their outputs separately. + + That said, it's not clear how useful this sort of comparison is. + Furthermore, is it the case that `(t/< [[] t/any?] (t/ftype []))`? Intuitively it + doesn't seem like it should be, but under the WHK model it nevertheless seems to be the case. + + So we opt to make `t/ftype`s `t/compare`-able only with what its underlying function object is + `t/compare`-able with, and introduce instead a `t/compare|input` and `t/compare|output`. + See `quantum.test.untyped.core.type.compare` for how these sorts of comparisons are supposed + to behave. + " + ;; [0 1 2] means t/compare|input is 0, t/compare|output is 1, and t/compare is 2 + "Contract satisfaction / 'Growth' (which is the opposite of contract non-satisfaction / + 'Breakage') is: + - For inputs: + - In the language of the type system: + - `t/<=` for inputs w.r.t. declared input type + - `t/>=|input` for fns w.r.t. declared type of an fn-input + - In the language of Liskov’s Substitution Principle: + - preconditions cannot be strengthened + - contravariance of input types + - In the language of 'Growth vs. Breakage': + - you cannot require more, but you can accept more + - Examples + - Comparing inputs directly + - We require a grain and we are provided a wheat (<) : good + - We require a grain and we are provided any edible thing (> / ><) : bad + - We require a grain and we are provided a sheep (<>) : bad + - Comparing inputs of contracts / fns (note that 'old contract' also works for 'declared + type of fn-input' and 'new contract' also works for 'actual type of fn-input') + - Old contract requires grain; new contract requires wheat (<) : bad + - Old contract requires grain; new contract requires any edible thing (>) : good + - Old contract requires grain; new contract requires a sheep (<>) : bad + - For outputs: + - In the language of the type system: + - `t/<=` for outputs w.r.t. declared output type + - `t/<=|output` for fns w.r.t. declared type of an fn-input + - In the language of Liskov’s Substitution Principle: + - postconditions cannot be weakened + - covariance of output types + - In the language of 'Growth vs. Breakage': + - you cannot guarantee less, but you can provide more + - Examples + - Comparing outputs directly + - We guarantee a grain and we provide a wheat (<) : good + - We guarantee a grain and we provide any edible thing (> / ><) : bad + - We guarantee a grain and we provide a sheep (<>) : bad + - Intuitively, if the contract says, output a grain, and it outputs a wheat and a sheep, + that seems good but is it? What does it mean to 'output a wheat and a sheep'? + - Is it `(t/unordered wheat? sheep?)`? If so, `(t/unordered wheat? sheep?)` is not `t/<` + `(t/unordered grain?)` and so that's bad. + - Is it `(t/map :grain wheat? :sheep sheep?)` (an 'open container')? If so, then *that* + is `t/<` `(t/map :grain wheat?)` and so that's good. + - This 'open container' is partially what the Growth vs. Breakage talk is referring to. + If I require a grain and you provide a wheat and a sheep, it has to be in an + acceptable open container of some sort (generally a map) because the consumer is not + guaranteed to know how to handle it otherwise. + - If we don't deal in open containers, that's like if you require a grain (and only + have space for a grain, and no availability/means to acquire more space or make it + someone else's problem) but someone leaves a wheat and 200 sheep on your doorstep, + that's not great. Yes, you got what you asked for, but you have nowhere to put the + sheep and no time to deal with the problem. + - Comparing outputs of contracts / fns (note that 'old contract' also works for 'declared + type of fn-input' and 'new contract' also works for 'actual type of fn-input') + - Old contract guarantees grain; new contract guarantees wheat (<) : good + - Old contract guarantees grain; new contract guarantees any edible thing (>) : bad + - Old contract guarantees grain; new contract guarantees a sheep (<>) : bad" + ;; We can think of the first `ftype` input to `test-comparison|fn` as the "new contract" or + ;; actual type of fn-input", and the second `ftype` input as the "old contract" or "declared type + ;; of fn-input". + (testing "input arities <" + (testing "same-arity input types <" + (testing "output <" + ;; it accepts fewer (<) things than it is required (>=) to accept — bad + ;; it provides fewer (<) things than it is allowed (<=) to provide — good + (test-comparison|fn [ t/boolean?]) + (t/ftype [] [t/any? :> t/long?]))) + (testing "output =") + (testing "output >" + ;; it accepts fewer (<) things than it is required (>=) to accept — bad + ;; it provides more (>) things than it is allowed (<=) to provide — bad + (test-comparison|fn [ ident] + (t/ftype [t/boolean?]) + (t/ftype [:> t/boolean?] [t/any? :> t/boolean?]))) + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types =" + (testing "output <" + (test-comparison|fn [ t/boolean?]) + (t/ftype [] [t/any?]))) + (testing "output =" + ;; it accepts fewer (<) things than it is required (>=) to accept — bad + ;; it provides the same (=) things as it is allowed (<=) to provide — good + (test-comparison|fn [ " + (test-comparison|fn [ ident] + (t/ftype []) + (t/ftype [:> t/boolean?] [t/any? :> t/long?]))) + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types >" + (testing "output <" + (test-comparison|fn [> t/boolean?]) + (t/ftype [] [t/boolean?]))) + (testing "output =" + (test-comparison|fn [>") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types ><" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types <>" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>"))) + (testing "input arities =" + (testing "same-arity input types <" + (testing "output <" + (test-comparison|fn [ t/boolean?]) + (t/ftype [t/any?]))) + (testing "output =" + (test-comparison|fn [ " + (test-comparison|fn [ ident] + (t/ftype [t/boolean?]) + (t/ftype [t/any? :> t/boolean?]))) + (testing "output ><" + (test-comparison|fn [ i|><0]) + (t/ftype [t/any? :> i|><1]))) + (testing "output <>" + (test-comparison|fn [ ident] + (t/ftype [t/boolean? :> ><0]) + (t/ftype [t/any? :> ><1])))) + (testing "same-arity input types =" + (testing "output <" + (test-comparison|fn [ =ident >ident] + (t/ftype []) + (t/ftype [:> t/boolean?]))) + (testing "output =" + (test-comparison|fn [ =ident =ident] + (t/ftype []) + (t/ftype []))) + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types >" + (testing "output <" + ;; it accepts more (>) things than it is required (>=) to accept — good + ;; it provides fewer (<) things than it is allowed (<=) to provide — good + (test-comparison|fn [ >ident t/boolean?]) + (t/ftype [t/boolean?]))) + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types ><" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types <>" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>"))) + (testing "input arities >" + (testing "same-arity input types <" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types =" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types >" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types ><" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types <>" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>"))) + (testing "input arities ><" + (testing "same-arity input types <" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types =" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types >" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types ><" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types <>" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>"))) + (testing "input arities <>" + (testing "same-arity input types <" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types =" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types >" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types ><" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")) + (testing "same-arity input types <>" + (testing "output <") + (testing "output =") + (testing "output >") + (testing "output ><") + (testing "output <>")))) diff --git a/test/quantum/test/untyped/core/type/defnt.cljc b/test/quantum/test/untyped/core/type/defnt.cljc new file mode 100644 index 00000000..3ce7bb81 --- /dev/null +++ b/test/quantum/test/untyped/core/type/defnt.cljc @@ -0,0 +1,3384 @@ +(ns quantum.test.untyped.core.type.defnt + (:refer-clojure :exclude + [> count get identity name seq some? zero?]) + (:require + [clojure.core :as core] + [quantum.core.type + :refer [dotyped]] + [quantum.test.untyped.core.type :as tt] + [quantum.untyped.core.analyze :as uana + :refer [aget* aset*]] + [quantum.untyped.core.data.array + :refer [*<> *<>|sized]] + [quantum.untyped.core.form + :refer [$ code=]] + [quantum.untyped.core.form.evaluate + :refer [case-env env-lang macroexpand-all]] + [quantum.untyped.core.form.type-hint + :refer [tag]] + [quantum.untyped.core.logic + :refer [ifs]] + [quantum.untyped.core.spec :as s] + [quantum.untyped.core.test :as utest + :refer [deftest is is= is-code= testing throws]] + [quantum.untyped.core.type :as t] + [quantum.untyped.core.type.defnt :as self + :refer [unsupported!]] + [quantum.untyped.core.type.reifications :as utr] + [quantum.untyped.core.vars + :refer [defmeta-from]]) + (:import + [clojure.lang ASeq ISeq LazySeq Named Reduced RT Seqable] + [quantum.core.data Array] + [quantum.core Numeric Primitive] + [quantum.untyped.core.type.reifications TypedFn])) + +;; TODO test `:inline` + +(do (require '[orchestra.spec.test :as st]) + (clojure.spec.test.alpha/unstrument) + (orchestra.spec.test/unstrument) + (orchestra.spec.test/instrument)) + +(do + +(defn B [form] (tag "boolean" form)) +(defn Y [form] (tag "byte" form)) +(defn S [form] (tag "short" form)) +(defn C [form] (tag "char" form)) +(defn I [form] (tag "int" form)) +(defn L [form] (tag "long" form)) +(defn F [form] (tag "float" form)) +(defn D [form] (tag "double" form)) +(defn O [form] (tag "java.lang.Object" form)) +(defn O<> [form] (tag "[Ljava.lang.Object;" form)) +(defn ST [form] (tag "java.lang.String" form)) + +(defn cstr [x] + (if (-> x resolve class?) + (str x) + (str (core/namespace x) "." (core/name x)))) + +(defn csym [x] (-> x cstr symbol)) + +(defn >__O [form] (tag (cstr `__O) form)) +(defn >B__B [form] (tag (cstr `B__B) form)) +(defn >B__O [form] (tag (cstr `B__O) form)) +(defn >Y__Y [form] (tag (cstr `Y__Y) form)) +(defn >Y__O [form] (tag (cstr `Y__O) form)) +(defn >S__S [form] (tag (cstr `S__S) form)) +(defn >S__O [form] (tag (cstr `S__O) form)) +(defn >C__C [form] (tag (cstr `C__C) form)) +(defn >C__O [form] (tag (cstr `C__O) form)) +(defn >I__I [form] (tag (cstr `I__I) form)) +(defn >L__L [form] (tag (cstr `L__L) form)) +(defn >F__F [form] (tag (cstr `F__F) form)) +(defn >D__D [form] (tag (cstr `D__D) form)) +(defn >D__O [form] (tag (cstr `D__O) form)) +(defn >O__F [form] (tag (cstr `O__F) form)) +(defn >O__O [form] (tag (cstr `O__O) form)) + +(def &ts (O<> 'ts0__)) +(def &fs (O<> 'fs0__)) +(def &this '&this) + +) + +#?(:clj +(deftest test|pid + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn pid [> (t/? t/string?)] + (->> ^:val (java.lang.management.ManagementFactory/getRuntimeMXBean) + (.getName))))) + expected + ($ (do (defmeta-from ~'pid + (let* [~'pid|__fs (*<>|sized 1) + ~'pid (new TypedFn + {:quantum.core.type/type pid|__type} + ;; [[0 0 false [] (t/or t/nil? t/string?)]] + pid|__ts ; defined/created within `t/defn` ; FIXME make it so the arrays are shown here + ~'pid|__fs + (fn* ([~&ts ~&fs] (. ~(>__O (aget* &fs 0)) ~'invoke))))] + ~(aset* 'pid|__fs 0 + `(reify* [~(csym `__O)] + (~(O 'invoke) [~'_0__] + ~(ST (list '. + (tag "java.lang.management.RuntimeMXBean" + '(. java.lang.management.ManagementFactory getRuntimeMXBean)) + 'getName))))) + ~'pid))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do (is (t/string? (pid))) + (throws (pid 1)))))))) + +(deftest test|identity + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn ^:inline identity ([x t/any? > (t/type x) #_"TODO TYPED (t/== x)"] x)))) + expected + (case (env-lang) + :clj + ($ (do [[0 0 true [t/boolean?] t/boolean?] + [1 1 true [t/byte?] t/byte?] + [2 2 true [t/short?] t/short?] + [3 3 true [t/char?] t/char?] + [4 4 true [t/int?] t/int?] + [5 5 true [t/long?] t/long?] + [6 6 true [t/float?] t/float?] + [7 7 true [t/double?] t/double?] + [8 8 true [t/any?] t/any?]] + (defmeta-from ~'identity + (let* [~'identity|__fs (*<>|sized 9) + ~'identity + (new TypedFn + {:quantum.core.type/type identity|__type} + identity|__ts + ~'identity|__fs + (fn* ([~&ts ~&fs ~'x00__] + (ifs (~(aget* (O<> (aget* &ts 0)) 0) ~'x00__) + (. ~(>B__B (aget* &fs 0)) ~'invoke ~'x00__) + (~(aget* (O<> (aget* &ts 1)) 0) ~'x00__) + (. ~(>Y__Y (aget* &fs 1)) ~'invoke ~'x00__) + (~(aget* (O<> (aget* &ts 2)) 0) ~'x00__) + (. ~(>S__S (aget* &fs 2)) ~'invoke ~'x00__) + (~(aget* (O<> (aget* &ts 3)) 0) ~'x00__) + (. ~(>C__C (aget* &fs 3)) ~'invoke ~'x00__) + (~(aget* (O<> (aget* &ts 4)) 0) ~'x00__) + (. ~(>I__I (aget* &fs 4)) ~'invoke ~'x00__) + (~(aget* (O<> (aget* &ts 5)) 0) ~'x00__) + (. ~(>L__L (aget* &fs 5)) ~'invoke ~'x00__) + (~(aget* (O<> (aget* &ts 6)) 0) ~'x00__) + (. ~(>F__F (aget* &fs 6)) ~'invoke ~'x00__) + (~(aget* (O<> (aget* &ts 7)) 0) ~'x00__) + (. ~(>D__D (aget* &fs 7)) ~'invoke ~'x00__) + (~(aget* (O<> (aget* &ts 8)) 0) ~'x00__) + (. ~(>O__O (aget* &fs 8)) ~'invoke ~'x00__) + ;; TODO no need for `unsupported!` because it will + ;; always get a valid branch + (unsupported! `identity [~'x00__] 0)))))] + ;; [x t/any?] + + ~(aset* 'identity|__fs 0 + `(reify* [~(csym `B__B)] (~(B 'invoke) [~'_0__ ~(B 'x)] ~'x))) + ~(aset* 'identity|__fs 1 + `(reify* [~(csym `Y__Y)] (~(Y 'invoke) [~'_1__ ~(Y 'x)] ~'x))) + ~(aset* 'identity|__fs 2 + `(reify* [~(csym `S__S)] (~(S 'invoke) [~'_2__ ~(S 'x)] ~'x))) + ~(aset* 'identity|__fs 3 + `(reify* [~(csym `C__C)] (~(C 'invoke) [~'_3__ ~(C 'x)] ~'x))) + ~(aset* 'identity|__fs 4 + `(reify* [~(csym `I__I)] (~(I 'invoke) [~'_4__ ~(I 'x)] ~'x))) + ~(aset* 'identity|__fs 5 + `(reify* [~(csym `L__L)] (~(L 'invoke) [~'_5__ ~(L 'x)] ~'x))) + ~(aset* 'identity|__fs 6 + `(reify* [~(csym `F__F)] (~(F 'invoke) [~'_6__ ~(F 'x)] ~'x))) + ~(aset* 'identity|__fs 7 + `(reify* [~(csym `D__D)] (~(D 'invoke) [~'_7__ ~(D 'x)] ~'x))) + ~(aset* 'identity|__fs 8 + `(reify* [~(csym `O__O)] (~(O 'invoke) [~'_8__ ~(O 'x)] ~(O 'x)))) + ~'identity)))) + :cljs + ;; Direct dispatch will be simple functions, not `reify`s + ($ (do (defn ~'identity [~'x] ~'x))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do (is= (identity 1) (dotyped (identity 1)) (core/identity 1)) + (is= (identity "") (dotyped (identity "")) (core/identity ""))))))) + +(deftest test|name + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn #_:inline name > t/string? + ([x t/string?] x) + #?(:clj ([x (t/isa? Named) > (t/run t/string?)] (.getName x)) + :cljs ([x (t/isa? INamed) > (t/run t/string?)] (-name x)))))) + expected + (case (env-lang) + :clj + ($ (do (declare ~'name) + + ;; [x t/string?] + + (def ~(>O__O 'name|__0) + (reify* [~(csym `O__O)] (~(O 'invoke) [~'_0__ ~(O 'x)] ~(ST 'x)))) + + ;; [x (t/isa? Named)] > (t/run t/string?) + + (def ~(>O__O 'name|__1) + (reify* [~(csym `O__O)] + (~(O 'invoke) [~'_1__ ~(O 'x)] + (t/validate ~(ST (list '. (tag "clojure.lang.Named" 'x) 'getName)) + ~'(t/run t/string?))))) + + [{:id 0 :index 0 :arg-types [(t/isa? String)] :output-type (t/isa? String)} + {:id 1 :index 1 :arg-types [(t/isa? Named)] :output-type (t/run (t/isa? String))}] + + (defmeta ~'name + {:quantum.core.type/type name|__type} + (fn* ([~'x00__] + (ifs ((Array/get name|__0|types 0) ~'x00__) (. name|__0 ~'invoke ~'x00__) + ((Array/get name|__1|types 0) ~'x00__) (. name|__1 ~'invoke ~'x00__) + (unsupported! `name [~'x00__] 0))))))) + :cljs + ($ (do (defn ~'name [~'x00__] + (ifs (t/string? x) x + (satisfies? INamed x) (-name x) + (unsupported! `name [~'x00__] 0))))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do (is= (name "") (core/name "")) + (is= (name "abc") (core/name "abc")) + (is= (name :abc) (core/name :abc)) + (is= (name 'abc) (core/name 'abc)) + (is= (name :abc/def) (core/name :abc/def)) + (is= (name 'abc/def) (core/name 'abc/def)) + (throws (name nil)) + (throws (name 1))))))) + +(deftest test|some? + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn #_:inline some? > t/boolean? + ([x t/nil?] false) + ;; Implicitly, `(- t/any? t/nil?)`, so `t/val?` + ([x t/any?] true)))) + expected + (case (env-lang) + :clj + ($ (do (declare ~'some?) + + ;; [x t/nil?] + + (def ~(tag (cstr `O__B) 'some?|__0) + (reify* [~(csym `O__B)] (~(B 'invoke) [~'_0__ ~(O 'x)] false))) + + ;; [x t/any?] + + (def ~(>B__B 'some?|__1) + (reify* [~(csym `B__B)] (~(B 'invoke) [~'_1__ ~(B 'x)] true))) + (def ~(>Y__B 'some?|__2) + (reify* [~(csym `Y__B)] (~(B 'invoke) [~'_2__ ~(Y 'x)] true))) + (def ~(>S__B 'some?|__3) + (reify* [~(csym `S__B)] (~(B 'invoke) [~'_3__ ~(S 'x)] true))) + (def ~(>C__B 'some?|__4) + (reify* [~(csym `C__B)] (~(B 'invoke) [~'_4__ ~(C 'x)] true))) + (def ~(>I__B 'some?|__5) + (reify* [~(csym `I__B)] (~(B 'invoke) [~'_5__ ~(I 'x)] true))) + (def ~(>L__B 'some?|__6) + (reify* [~(csym `L__B)] (~(B 'invoke) [~'_6__ ~(L 'x)] true))) + (def ~(>F__B 'some?|__7) + (reify* [~(csym `F__B)] (~(B 'invoke) [~'_7__ ~(F 'x)] true))) + (def ~(>D__B 'some?|__8) + (reify* [~(csym `D__B)] (~(B 'invoke) [~'_8__ ~(D 'x)] true))) + (def ~(>O__B 'some?|__9) + (reify* [~(csym `O__B)] (~(B 'invoke) [~'_9__ ~(O 'x)] true))) + + [{:id 0 :index 0 :arg-types [(t/value nil)] :output-type (t/isa? Boolean)} + {:id 1 :index 1 :arg-types [(t/isa? Boolean)] :output-type (t/isa? Boolean)} + {:id 2 :index 2 :arg-types [(t/isa? Byte)] :output-type (t/isa? Boolean)} + {:id 3 :index 3 :arg-types [(t/isa? Short)] :output-type (t/isa? Boolean)} + {:id 4 :index 4 :arg-types [(t/isa? Character)] :output-type (t/isa? Boolean)} + {:id 5 :index 5 :arg-types [(t/isa? Integer)] :output-type (t/isa? Boolean)} + {:id 6 :index 6 :arg-types [(t/isa? Long)] :output-type (t/isa? Boolean)} + {:id 7 :index 7 :arg-types [(t/isa? Float)] :output-type (t/isa? Boolean)} + {:id 8 :index 8 :arg-types [(t/isa? Double)] :output-type (t/isa? Boolean)} + {:id 9 :index 9 :arg-types [t/any?] :output-type (t/isa? Boolean)}] + + (defmeta ~'some? + {:quantum.core.type/type some?|__type} + (fn* + ([~'x00__] + (ifs ((Array/get some?|__0|types 0) ~'x00__) (. some?|__0 ~'invoke ~'x00__) + ;; TODO eliminate these checks below because they're not needed + ((Array/get some?|__1|types 0) ~'x00__) (. some?|__1 ~'invoke ~'x00__) + ((Array/get some?|__2|types 0) ~'x00__) (. some?|__2 ~'invoke ~'x00__) + ((Array/get some?|__3|types 0) ~'x00__) (. some?|__3 ~'invoke ~'x00__) + ((Array/get some?|__4|types 0) ~'x00__) (. some?|__4 ~'invoke ~'x00__) + ((Array/get some?|__5|types 0) ~'x00__) (. some?|__5 ~'invoke ~'x00__) + ((Array/get some?|__6|types 0) ~'x00__) (. some?|__6 ~'invoke ~'x00__) + ((Array/get some?|__7|types 0) ~'x00__) (. some?|__7 ~'invoke ~'x00__) + ((Array/get some?|__8|types 0) ~'x00__) (. some?|__8 ~'invoke ~'x00__) + ((Array/get some?|__9|types 0) ~'x00__) (. some?|__9 ~'invoke ~'x00__) + (unsupported! `some? [~'x00__] 0))))))) + :cljs + ($ (do (defn ~'some?| [~'x] + (ifs (nil? x) false + true)))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do (throws (some?)) + (is= (some? 123) (core/some? 123)) + (is= (some? true) (core/some? true)) + (is= (some? false) (core/some? false)) + (is= (some? nil) (core/some? nil))))))) + +(deftest test|reduced? + (let [actual + ;; Perhaps silly in ClojureScript, but avoids boxing in Clojure + (macroexpand ' + (self/defn #_:inline reduced?|test + ([x (t/isa? Reduced)] true) + ;; Implicitly, `(- t/any? (t/isa? Reduced))` + ([x t/any? ] false))) + expected + (case (env-lang) + :clj + ($ (do ;; [x (t/isa? Reduced)] + + (def ~'reduced?|test|__0|0 + (reify* [~(csym `O__B)] + (~(B 'invoke) [~'_0__ ~(O 'x)] + (let* [~(tag "clojure.lang.Reduced" 'x) ~'x] true)))) + + ;; [x t/any?] + + (def ~'reduced?|test|__1|0 + (reify* [~@(map csym `[O__B B__B Y__B S__B C__B I__B L__B F__B D__B])] + (~(B 'invoke) [~'_1__ ~(O 'x)] false) + (~(B 'invoke) [~'_2__ ~(B 'x)] false) + (~(B 'invoke) [~'_3__ ~(Y 'x)] false) + (~(B 'invoke) [~'_4__ ~(S 'x)] false) + (~(B 'invoke) [~'_5__ ~(C 'x)] false) + (~(B 'invoke) [~'_6__ ~(I 'x)] false) + (~(B 'invoke) [~'_7__ ~(L 'x)] false) + (~(B 'invoke) [~'_8__ ~(F 'x)] false) + (~(B 'invoke) [~'_9__ ~(D 'x)] false))) + + (defmeta ~'reduced?|test + {:quantum.core.type/type + (t/fn t/any? + ~'[(t/isa? Reduced)] + ~'[t/any?])} + (fn* ([~'x00__] + (ifs ((Array/get ~'reduced?|test|__0|input0|types 0) ~'x00__) + (.invoke reduced?|test|__0|0 ~'x00__) + ;; TODO eliminate this check because it's not needed (`t/any?`) + ((Array/get ~'reduced?|test|__1|input0|types 0) ~'x00__) + (.invoke reduced?|test|__1|0 ~'x00__) + (unsupported! `reduced?|test [~'x00__] 0))))))) + :cljs + ($ (do (defn ~'reduced?|test [~'x] + (ifs (instance? Reduced x) true false)))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do (throws (reduced?|test)) + (is= (reduced?|test 123) (reduced? 123)) + (is= (reduced?|test true) (reduced? true)) + (is= (reduced?|test false) (reduced? false)) + (is= (reduced?|test nil) (reduced? nil)) + (is= (reduced?|test (reduced 123)) (reduced? (reduced 123))) + (is= (reduced?|test (reduced true)) (reduced? (reduced true))) + (is= (reduced?|test (reduced false)) (reduced? (reduced false))) + (is= (reduced?|test (reduced nil)) (reduced? (reduced nil)))))))) + +(deftest test|>boolean + (let [actual + (macroexpand ' + (self/defn #_:inline >boolean + ([x tt/boolean?] x) + ([x t/nil?] false) + ([x t/any?] true))) + expected + (case (env-lang) + :clj + ($ (do ;; [x tt/boolean?] + + (def ~(O<> '>boolean|__0|input0|types) + (*<> (t/isa? Boolean))) + (def ~'>boolean|__0|0 + (reify* [~(csym `B__B)] + (~(B 'invoke) [~'_0__ ~(B 'x)] ~'x))) + + ;; [x t/nil? -> (- t/nil? tt/boolean?)] + + (def ~(O<> '>boolean|__1|input0|types) + (*<> (t/value nil))) + (def ~'>boolean|__1|0 + (reify* [~(csym `O__B)] + (~(B 'invoke) [~'_1__ ~(O 'x)] false))) + + ;; [x t/any? -> (- t/any? t/nil? tt/boolean?)] + + (def ~(O<> '>boolean|__2|input0|types) + (*<> t/any?)) + (def ~'>boolean|__2|0 + (reify* [~@(map csym `[O__B B__B Y__B S__B C__B I__B L__B F__B D__B])] + (~(B 'invoke) [~'_2__ ~(O 'x)] true) + (~(B 'invoke) [~'_3__ ~(B 'x)] true) + (~(B 'invoke) [~'_4__ ~(Y 'x)] true) + (~(B 'invoke) [~'_5__ ~(S 'x)] true) + (~(B 'invoke) [~'_6__ ~(C 'x)] true) + (~(B 'invoke) [~'_7__ ~(I 'x)] true) + (~(B 'invoke) [~'_8__ ~(L 'x)] true) + (~(B 'invoke) [~'_9__ ~(F 'x)] true) + (~(B 'invoke) [~'_10__ ~(D 'x)] true))) + + (defn ~'>boolean + {:quantum.core.type/type + (t/fn t/any? + ~'[tt/boolean?] + ~'[t/nil?] + ~'[t/any?])} + ([~'x00__] + (ifs ((Array/get ~'>boolean|__0|input0|types 0) ~'x00__) + (.invoke ~(tag (cstr `B__B) '>boolean|__0|0) ~'x00__) + ((Array/get ~'>boolean|__1|input0|types 0) ~'x00__) + (.invoke ~(tag (cstr `O__B) '>boolean|__1|0) ~'x00__) + ;; TODO eliminate this check because it's not needed (`t/any?`) + ((Array/get ~'>boolean|__2|input0|types 0) ~'x00__) + (.invoke ~(tag (cstr `O__B) '>boolean|__2|0) ~'x00__) + (unsupported! `>boolean [~'x00__] 0)))))) + :cljs + ($ (do (defn ~'>boolean [~'x] + (ifs (tt/boolean? x) x + (nil? x) false + true)))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do (throws (>boolean)) + (is= (>boolean true) (boolean true)) + (is= (>boolean false) (boolean false)) + (is= (>boolean nil) (boolean nil)) + (is= (>boolean 123) (boolean 123))))))) + +;; Let's say you have (t/| t/string? t/number?) in one `fnt` overload. +;; This means that you *can't* have a reify with two O__O overloads and expect it to work +;; at all. +;; Therefore, each `fnt` overload necessarily has a one-to-many relationship with `reify`s. +;; Only the primitivized overloads belong grouped together in one `reify`. + +(deftest test|>int* + (let [actual + (macroexpand ' + ;; Auto-upcasts to long or double (because 64-bit) unless you tell it otherwise + ;; Will error if not all return values can be safely converted to the return spec + (self/defn #_:inline >int* > tt/int? + ([x (t/- tt/primitive? tt/boolean?)] (Primitive/uncheckedIntCast x)) + ([x (t/ref (t/isa? Number))] (.intValue x)))) + expected + (case (env-lang) + :clj + ($ (do ;; [x (t/- tt/primitive? tt/boolean?)] + + ;; These are non-primitivized + (def ~(O<> '>int*|__0|input0|types) + (*<> (t/isa? java.lang.Byte) + (t/isa? java.lang.Short) + (t/isa? java.lang.Character) + (t/isa? java.lang.Integer) + (t/isa? java.lang.Long) + (t/isa? java.lang.Float) + (t/isa? java.lang.Double))) + (def ~'>int*|__0|0 + (reify* [~(csym `Y__I)] + (~(I 'invoke) [~'_0__ ~(Y 'x)] ~'(. Primitive uncheckedIntCast x)))) + (def ~'>int*|__0|1 + (reify* [~(csym `S__I)] + (~(I 'invoke) [~'_1__ ~(S 'x)] ~'(. Primitive uncheckedIntCast x)))) + (def ~'>int*|__0|2 + (reify* [~(csym `C__I)] + (~(I 'invoke) [~'_2__ ~(C 'x)] ~'(. Primitive uncheckedIntCast x)))) + (def ~'>int*|__0|3 + (reify* [~(csym `I__I)] + (~(I 'invoke) [~'_3__ ~(I 'x)] ~'(. Primitive uncheckedIntCast x)))) + (def ~'>int*|__0|4 + (reify* [~(csym `L__I)] + (~(I 'invoke) [~'_4__ ~(L 'x)] ~'(. Primitive uncheckedIntCast x)))) + (def ~'>int*|__0|5 + (reify* [~(csym `F__I)] + (~(I 'invoke) [~'_5__ ~(F 'x)] ~'(. Primitive uncheckedIntCast x)))) + (def ~'>int*|__0|6 + (reify* [~(csym `D__I)] + (~(I 'invoke) [~'_6__ ~(D 'x)] ~'(. Primitive uncheckedIntCast x)))) + + ;; [x (t/ref (t/isa? Number)) + ;; -> (t/- (t/ref (t/isa? Number)) (t/- tt/primitive? tt/boolean?))] + + (def ~(O<> '>int*|__1|input0|types) + (*<> (t/ref (t/isa? Number)))) + (def ~'>int*|__1|0 + (reify* [~(csym `O__I)] + (~(I 'invoke) [~'_7__ ~(O 'x)] + (let* [~(tag "java.lang.Number" 'x) ~'x] ~'(. x intValue))))) + + (defn ~'>int* + {:quantum.core.type/type + (t/fn ~'tt/int? + ~'[(t/- tt/primitive? tt/boolean?)] + ~'[(t/ref (t/isa? Number))])} + ([~'x00__] + (ifs ((Array/get ~'>int*|__0|input0|types 0) ~'x00__) + (.invoke ~(tag (cstr `Y__I) '>int*|__0|0) ~'x00__) + ((Array/get ~'>int*|__0|input0|types 1) ~'x00__) + (.invoke ~(tag (cstr `S__I) '>int*|__0|1) ~'x00__) + ((Array/get ~'>int*|__0|input0|types 2) ~'x00__) + (.invoke ~(tag (cstr `C__I) '>int*|__0|2) ~'x00__) + ((Array/get ~'>int*|__0|input0|types 3) ~'x00__) + (.invoke ~(tag (cstr `I__I) '>int*|__0|3) ~'x00__) + ((Array/get ~'>int*|__0|input0|types 4) ~'x00__) + (.invoke ~(tag (cstr `L__I) '>int*|__0|4) ~'x00__) + ((Array/get ~'>int*|__0|input0|types 5) ~'x00__) + (.invoke ~(tag (cstr `F__I) '>int*|__0|5) ~'x00__) + ((Array/get ~'>int*|__0|input0|types 6) ~'x00__) + (.invoke ~(tag (cstr `D__I) '>int*|__0|6) ~'x00__) + ((Array/get ~'>int*|__1|input0|types 0) ~'x00__) + (.invoke ~(tag (cstr `O__I) '>int*|__1|0) ~'x00__) + (unsupported! `>int* [~'x00__] 0)))))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do (throws (>int*)) + (throws (>int* nil)) + (throws (>int* "")) + (is (identical? (>int* 1) (clojure.lang.RT/uncheckedIntCast 1))) + (is (identical? (>int* 1.0) (clojure.lang.RT/uncheckedIntCast 1.0))) + (is (identical? (>int* 1.1) (clojure.lang.RT/uncheckedIntCast 1.1))) + (is (identical? (>int* -1) (clojure.lang.RT/uncheckedIntCast -1))) + (is (identical? (>int* -1.0) (clojure.lang.RT/uncheckedIntCast -1.0))) + (is (identical? (>int* -1.1) (clojure.lang.RT/uncheckedIntCast -1.1))) + (is (identical? (>int* (byte 1)) (clojure.lang.RT/uncheckedIntCast (byte 1))))))))) + +;; Because "Method code too large" error +(def >|types-form + ($ [{:id 0 :index 0 :arg-types [(t/isa? Byte) (t/isa? Byte) ] + :output-type (t/isa? Boolean)} + {:id 1 :index 1 :arg-types [(t/isa? Byte) (t/isa? Short) ] + :output-type (t/isa? Boolean)} + {:id 2 :index 2 :arg-types [(t/isa? Byte) (t/isa? Character)] + :output-type (t/isa? Boolean)} + {:id 3 :index 3 :arg-types [(t/isa? Byte) (t/isa? Integer) ] + :output-type (t/isa? Boolean)} + {:id 4 :index 4 :arg-types [(t/isa? Byte) (t/isa? Long) ] + :output-type (t/isa? Boolean)} + {:id 5 :index 5 :arg-types [(t/isa? Byte) (t/isa? Float) ] + :output-type (t/isa? Boolean)} + {:id 6 :index 6 :arg-types [(t/isa? Byte) (t/isa? Double) ] + :output-type (t/isa? Boolean)} + {:id 7 :index 7 :arg-types [(t/isa? Short) (t/isa? Byte) ] + :output-type (t/isa? Boolean)} + {:id 8 :index 8 :arg-types [(t/isa? Short) (t/isa? Short) ] + :output-type (t/isa? Boolean)} + {:id 9 :index 9 :arg-types [(t/isa? Short) (t/isa? Character)] + :output-type (t/isa? Boolean)} + {:id 10 :index 10 :arg-types [(t/isa? Short) (t/isa? Integer) ] + :output-type (t/isa? Boolean)} + {:id 11 :index 11 :arg-types [(t/isa? Short) (t/isa? Long) ] + :output-type (t/isa? Boolean)} + {:id 12 :index 12 :arg-types [(t/isa? Short) (t/isa? Float) ] + :output-type (t/isa? Boolean)} + {:id 13 :index 13 :arg-types [(t/isa? Short) (t/isa? Double) ] + :output-type (t/isa? Boolean)} + {:id 14 :index 14 :arg-types [(t/isa? Character) (t/isa? Byte) ] + :output-type (t/isa? Boolean)} + {:id 15 :index 15 :arg-types [(t/isa? Character) (t/isa? Short) ] + :output-type (t/isa? Boolean)} + {:id 16 :index 16 :arg-types [(t/isa? Character) (t/isa? Character)] + :output-type (t/isa? Boolean)} + {:id 17 :index 17 :arg-types [(t/isa? Character) (t/isa? Integer) ] + :output-type (t/isa? Boolean)} + {:id 18 :index 18 :arg-types [(t/isa? Character) (t/isa? Long) ] + :output-type (t/isa? Boolean)} + {:id 19 :index 19 :arg-types [(t/isa? Character) (t/isa? Float) ] + :output-type (t/isa? Boolean)} + {:id 20 :index 20 :arg-types [(t/isa? Character) (t/isa? Double) ] + :output-type (t/isa? Boolean)} + {:id 21 :index 21 :arg-types [(t/isa? Integer) (t/isa? Byte) ] + :output-type (t/isa? Boolean)} + {:id 22 :index 22 :arg-types [(t/isa? Integer) (t/isa? Short) ] + :output-type (t/isa? Boolean)} + {:id 23 :index 23 :arg-types [(t/isa? Integer) (t/isa? Character)] + :output-type (t/isa? Boolean)} + {:id 24 :index 24 :arg-types [(t/isa? Integer) (t/isa? Integer) ] + :output-type (t/isa? Boolean)} + {:id 25 :index 25 :arg-types [(t/isa? Integer) (t/isa? Long) ] + :output-type (t/isa? Boolean)} + {:id 26 :index 26 :arg-types [(t/isa? Integer) (t/isa? Float) ] + :output-type (t/isa? Boolean)} + {:id 27 :index 27 :arg-types [(t/isa? Integer) (t/isa? Double) ] + :output-type (t/isa? Boolean)} + {:id 28 :index 28 :arg-types [(t/isa? Long) (t/isa? Byte) ] + :output-type (t/isa? Boolean)} + {:id 29 :index 29 :arg-types [(t/isa? Long) (t/isa? Short) ] + :output-type (t/isa? Boolean)} + {:id 30 :index 30 :arg-types [(t/isa? Long) (t/isa? Character)] + :output-type (t/isa? Boolean)} + {:id 31 :index 31 :arg-types [(t/isa? Long) (t/isa? Integer) ] + :output-type (t/isa? Boolean)} + {:id 32 :index 32 :arg-types [(t/isa? Long) (t/isa? Long) ] + :output-type (t/isa? Boolean)} + {:id 33 :index 33 :arg-types [(t/isa? Long) (t/isa? Float) ] + :output-type (t/isa? Boolean)} + {:id 34 :index 34 :arg-types [(t/isa? Long) (t/isa? Double) ] + :output-type (t/isa? Boolean)} + {:id 35 :index 35 :arg-types [(t/isa? Float) (t/isa? Byte) ] + :output-type (t/isa? Boolean)} + {:id 36 :index 36 :arg-types [(t/isa? Float) (t/isa? Short) ] + :output-type (t/isa? Boolean)} + {:id 37 :index 37 :arg-types [(t/isa? Float) (t/isa? Character)] + :output-type (t/isa? Boolean)} + {:id 38 :index 38 :arg-types [(t/isa? Float) (t/isa? Integer) ] + :output-type (t/isa? Boolean)} + {:id 39 :index 39 :arg-types [(t/isa? Float) (t/isa? Long) ] + :output-type (t/isa? Boolean)} + {:id 40 :index 40 :arg-types [(t/isa? Float) (t/isa? Float) ] + :output-type (t/isa? Boolean)} + {:id 41 :index 41 :arg-types [(t/isa? Float) (t/isa? Double) ] + :output-type (t/isa? Boolean)} + {:id 42 :index 42 :arg-types [(t/isa? Double) (t/isa? Byte) ] + :output-type (t/isa? Boolean)} + {:id 43 :index 43 :arg-types [(t/isa? Double) (t/isa? Short) ] + :output-type (t/isa? Boolean)} + {:id 44 :index 44 :arg-types [(t/isa? Double) (t/isa? Character)] + :output-type (t/isa? Boolean)} + {:id 45 :index 45 :arg-types [(t/isa? Double) (t/isa? Integer) ] + :output-type (t/isa? Boolean)} + {:id 46 :index 46 :arg-types [(t/isa? Double) (t/isa? Long) ] + :output-type (t/isa? Boolean)} + {:id 47 :index 47 :arg-types [(t/isa? Double) (t/isa? Float) ] + :output-type (t/isa? Boolean)} + {:id 48 :index 48 :arg-types [(t/isa? Double) (t/isa? Double) ] + :output-type (t/isa? Boolean)}])) + +(def >|dynamic-dispatch-form + ($ (defmeta ~'> + {:quantum.core.type/type >|__type} + (fn* ([~'x00__ ~'x10__] + (ifs + ((Array/get >|__0|types 0) ~'x00__) + (ifs + ((Array/get >|__0|types 1) ~'x10__) + (. >|__0 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__1|types 1) ~'x10__) + (. >|__1 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__2|types 1) ~'x10__) + (. >|__2 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__3|types 1) ~'x10__) + (. >|__3 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__4|types 1) ~'x10__) + (. >|__4 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__5|types 1) ~'x10__) + (. >|__5 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__6|types 1) ~'x10__) + (. >|__6 ~'invoke ~'x00__ ~'x10__) + (unsupported! `> [~'x00__ ~'x10__] 1)) + ((Array/get >|__7|types 0) ~'x00__) + (ifs + ((Array/get >|__7|types 1) ~'x10__) + (. >|__7 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__8|types 1) ~'x10__) + (. >|__8 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__9|types 1) ~'x10__) + (. >|__9 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__10|types 1) ~'x10__) + (. >|__10 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__11|types 1) ~'x10__) + (. >|__11 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__12|types 1) ~'x10__) + (. >|__12 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__13|types 1) ~'x10__) + (. >|__13 ~'invoke ~'x00__ ~'x10__) + (unsupported! `> [~'x00__ ~'x10__] 1)) + ((Array/get >|__14|types 0) ~'x00__) + (ifs + ((Array/get >|__14|types 1) ~'x10__) + (. >|__14 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__15|types 1) ~'x10__) + (. >|__15 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__16|types 1) ~'x10__) + (. >|__16 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__17|types 1) ~'x10__) + (. >|__17 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__18|types 1) ~'x10__) + (. >|__18 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__19|types 1) ~'x10__) + (. >|__19 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__20|types 1) ~'x10__) + (. >|__20 ~'invoke ~'x00__ ~'x10__) + (unsupported! `> [~'x00__ ~'x10__] 1)) + ((Array/get >|__21|types 0) ~'x00__) + (ifs + ((Array/get >|__21|types 1) ~'x10__) + (. >|__21 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__22|types 1) ~'x10__) + (. >|__22 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__23|types 1) ~'x10__) + (. >|__23 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__24|types 1) ~'x10__) + (. >|__24 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__25|types 1) ~'x10__) + (. >|__25 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__26|types 1) ~'x10__) + (. >|__26 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__27|types 1) ~'x10__) + (. >|__27 ~'invoke ~'x00__ ~'x10__) + (unsupported! `> [~'x00__ ~'x10__] 1)) + ((Array/get >|__28|types 0) ~'x00__) + (ifs + ((Array/get >|__28|types 1) ~'x10__) + (. >|__28 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__29|types 1) ~'x10__) + (. >|__29 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__30|types 1) ~'x10__) + (. >|__30 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__31|types 1) ~'x10__) + (. >|__31 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__32|types 1) ~'x10__) + (. >|__32 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__33|types 1) ~'x10__) + (. >|__33 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__34|types 1) ~'x10__) + (. >|__34 ~'invoke ~'x00__ ~'x10__) + (unsupported! `> [~'x00__ ~'x10__] 1)) + ((Array/get >|__35|types 0) ~'x00__) + (ifs + ((Array/get >|__35|types 1) ~'x10__) + (. >|__35 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__36|types 1) ~'x10__) + (. >|__36 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__37|types 1) ~'x10__) + (. >|__37 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__38|types 1) ~'x10__) + (. >|__38 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__39|types 1) ~'x10__) + (. >|__39 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__40|types 1) ~'x10__) + (. >|__40 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__41|types 1) ~'x10__) + (. >|__41 ~'invoke ~'x00__ ~'x10__) + (unsupported! `> [~'x00__ ~'x10__] 1)) + ((Array/get >|__42|types 0) ~'x00__) + (ifs + ((Array/get >|__42|types 1) ~'x10__) + (. >|__42 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__43|types 1) ~'x10__) + (. >|__43 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__44|types 1) ~'x10__) + (. >|__44 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__45|types 1) ~'x10__) + (. >|__45 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__46|types 1) ~'x10__) + (. >|__46 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__47|types 1) ~'x10__) + (. >|__47 ~'invoke ~'x00__ ~'x10__) + ((Array/get >|__48|types 1) ~'x10__) + (. >|__48 ~'invoke ~'x00__ ~'x10__) + (unsupported! `> [~'x00__ ~'x10__] 1)) + (unsupported! `> [~'x00__ ~'x10__] 0))))))) + +(deftest test|> + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn #_:inline > > tt/boolean? + #?(:clj ([a tt/comparable-primitive? b tt/comparable-primitive? > tt/boolean?] + (Numeric/gt a b)) + :cljs ([a tt/double? b tt/double? > (t/assume tt/boolean?)] + (cljs.core/> a b)))))) + expected + (case (env-lang) + :clj + ($ (do (declare ~'>) + + ;; [a t/comparable-primitive? b t/comparable-primitive? > tt/boolean?] + + (def ~(tag (cstr `YY__B) '>|__0) + (reify* [~(csym ~YY__B)] + (~(B 'invoke) [~'_0__ ~(Y 'a) ~(Y 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `YS__B) '>|__1) + (reify* [~(csym ~YS__B)] + (~(B 'invoke) [~'_1__ ~(Y 'a) ~(S 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `YC__B) '>|__2) + (reify* [~(csym ~YC__B)] + (~(B 'invoke) [~'_2__ ~(Y 'a) ~(C 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `YI__B) '>|__3) + (reify* [~(csym ~YI__B)] + (~(B 'invoke) [~'_3__ ~(Y 'a) ~(I 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `YL__B) '>|__4) + (reify* [~(csym ~YL__B)] + (~(B 'invoke) [~'_4__ ~(Y 'a) ~(L 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `YF__B) '>|__5) + (reify* [~(csym ~YF__B)] + (~(B 'invoke) [~'_5__ ~(Y 'a) ~(F 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `YD__B) '>|__6) + (reify* [~(csym ~YD__B)] + (~(B 'invoke) [~'_6__ ~(Y 'a) ~(D 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `SY__B) '>|__7) + (reify* [~(csym `SY__B)] + (~(B 'invoke) [~'_7__ ~(S 'a) ~(Y 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `SS__B) '>|__8) + (reify* [~(csym `SS__B)] + (~(B 'invoke) [~'_8__ ~(S 'a) ~(S 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `SC__B) '>|__9) + (reify* [~(csym `SC__B)] + (~(B 'invoke) [~'_9__ ~(S 'a) ~(C 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `SI__B) '>|__10) + (reify* [~(csym `SI__B)] + (~(B 'invoke) [~'_10__ ~(S 'a) ~(I 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `SL__B) '>|__11) + (reify* [~(csym `SL__B)] + (~(B 'invoke) [~'_11__ ~(S 'a) ~(L 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `SF__B) '>|__12) + (reify* [~(csym `SF__B)] + (~(B 'invoke) [~'_12__ ~(S 'a) ~(F 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `SD__B) '>|__13) + (reify* [~(csym `SD__B)] + (~(B 'invoke) [~'_13__ ~(S 'a) ~(D 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `CY__B) '>|__14) + (reify* [~(csym `CY__B)] + (~(B 'invoke) [~'_14__ ~(C 'a) ~(Y 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `CS__B) '>|__15) + (reify* [~(csym `CS__B)] + (~(B 'invoke) [~'_15__ ~(C 'a) ~(S 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `CC__B) '>|__16) + (reify* [~(csym `CC__B)] + (~(B 'invoke) [~'_16__ ~(C 'a) ~(C 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `CI__B) '>|__17) + (reify* [~(csym `CI__B)] + (~(B 'invoke) [~'_17__ ~(C 'a) ~(I 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `CL__B) '>|__18) + (reify* [~(csym `CL__B)] + (~(B 'invoke) [~'_18__ ~(C 'a) ~(L 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `CF__B) '>|__19) + (reify* [~(csym `CF__B)] + (~(B 'invoke) [~'_19__ ~(C 'a) ~(F 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `CD__B) '>|__20) + (reify* [~(csym `CD__B)] + (~(B 'invoke) [~'_20__ ~(C 'a) ~(D 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `IY__B) '>|__21) + (reify* [~(csym `IY__B)] + (~(B 'invoke) [~'_21__ ~(I 'a) ~(Y 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `IS__B) '>|__22) + (reify* [~(csym `IS__B)] + (~(B 'invoke) [~'_22__ ~(I 'a) ~(S 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `IC__B) '>|__23) + (reify* [~(csym `IC__B)] + (~(B 'invoke) [~'_23__ ~(I 'a) ~(C 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `II__B) '>|__24) + (reify* [~(csym `II__B)] + (~(B 'invoke) [~'_24__ ~(I 'a) ~(I 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `IL__B) '>|__25) + (reify* [~(csym `IL__B)] + (~(B 'invoke) [~'_25__ ~(I 'a) ~(L 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `IF__B) '>|__26) + (reify* [~(csym `IF__B)] + (~(B 'invoke) [~'_26__ ~(I 'a) ~(F 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `ID__B) '>|__27) + (reify* [~(csym `ID__B)] + (~(B 'invoke) [~'_27__ ~(I 'a) ~(D 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `LY__B) '>|__28) + (reify* [~(csym `LY__B)] + (~(B 'invoke) [~'_28__ ~(L 'a) ~(Y 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `LS__B) '>|__29) + (reify* [~(csym `LS__B)] + (~(B 'invoke) [~'_29__ ~(L 'a) ~(S 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `LC__B) '>|__30) + (reify* [~(csym `LC__B)] + (~(B 'invoke) [~'_30__ ~(L 'a) ~(C 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `LI__B) '>|__31) + (reify* [~(csym `LI__B)] + (~(B 'invoke) [~'_31__ ~(L 'a) ~(I 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `LL__B) '>|__32) + (reify* [~(csym `LL__B)] + (~(B 'invoke) [~'_32__ ~(L 'a) ~(L 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `LF__B) '>|__33) + (reify* [~(csym `LF__B)] + (~(B 'invoke) [~'_33__ ~(L 'a) ~(F 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `LD__B) '>|__34) + (reify* [~(csym `LD__B)] + (~(B 'invoke) [~'_34__ ~(L 'a) ~(D 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `FY__B) '>|__35) + (reify* [~(csym `FY__B)] + (~(B 'invoke) [~'_35__ ~(F 'a) ~(Y 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `FS__B) '>|__36) + (reify* [~(csym `FS__B)] + (~(B 'invoke) [~'_36__ ~(F 'a) ~(S 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `FC__B) '>|__37) + (reify* [~(csym `FC__B)] + (~(B 'invoke) [~'_37__ ~(F 'a) ~(C 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `FI__B) '>|__38) + (reify* [~(csym `FI__B)] + (~(B 'invoke) [~'_38__ ~(F 'a) ~(I 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `FL__B) '>|__39) + (reify* [~(csym `FL__B)] + (~(B 'invoke) [~'_39__ ~(F 'a) ~(L 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `FF__B) '>|__40) + (reify* [~(csym `FF__B)] + (~(B 'invoke) [~'_40__ ~(F 'a) ~(F 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `FD__B) '>|__41) + (reify* [~(csym `FD__B)] + (~(B 'invoke) [~'_41__ ~(F 'a) ~(D 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `DY__B) '>|__42) + (reify* [~(csym `DY__B)] + (~(B 'invoke) [~'_42__ ~(D 'a) ~(Y 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `DS__B) '>|__43) + (reify* [~(csym `DS__B)] + (~(B 'invoke) [~'_43__ ~(D 'a) ~(S 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `DC__B) '>|__44) + (reify* [~(csym `DC__B)] + (~(B 'invoke) [~'_44__ ~(D 'a) ~(C 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `DI__B) '>|__45) + (reify* [~(csym `DI__B)] + (~(B 'invoke) [~'_45__ ~(D 'a) ~(I 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `DL__B) '>|__46) + (reify* [~(csym `DL__B)] + (~(B 'invoke) [~'_46__ ~(D 'a) ~(L 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `DF__B) '>|__47) + (reify* [~(csym `DF__B)] + (~(B 'invoke) [~'_47__ ~(D 'a) ~(F 'b)] ~'(. Numeric gt a b)))) + (def ~(tag (cstr `DD__B) '>|__48) + (reify* [~(csym `DD__B)] + (~(B 'invoke) [~'_48__ ~(D 'a) ~(D 'b)] ~'(. Numeric gt a b)))) + + ~>|types-form + ~>|dynamic-dispatch-form)) + :cljs + ($ (do (defn ~'> + ([a0 a1] + (ifs (double? a0) + (ifs (double? a1) + (let* [a a0 b a1] (cljs.core/> a b)) + (unsupported! `> [a0 a1] 1)) + (unsupported! `> [a0 a1] 0)))))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do (is= (> 0 1) (core/> 0 1)) + (is= (> 1 0) (core/> 1 0)) + (is= (> 1.0 0) (core/> 1.0 0)))))) + +(deftest test|>long* + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn ^:inline >long* + {:source "clojure.lang.RT.uncheckedLongCast"} + > tt/long? + ([x (t/- tt/primitive? tt/boolean?)] (Primitive/uncheckedLongCast x)) + ([x (t/ref (t/isa? Number))] (.longValue x))))) + expected + (case (env-lang) + :clj ($ (do (declare ~'>long*) + + ;; [x (t/- tt/primitive? tt/boolean?)] + + (def ~(tag (cstr `Y__L) '>long*|__0) + (reify* [~(csym `Y__L)] + (~(L 'invoke) [~'_0__ ~(Y 'x)] + ~'(. Primitive uncheckedLongCast x)))) + (def ~(tag (cstr `S__L) '>long*|__1) + (reify* [~(csym `S__L)] + (~(L 'invoke) [~'_1__ ~(S 'x)] + ~'(. Primitive uncheckedLongCast x)))) + (def ~(tag (cstr `C__L) '>long*|__2) + (reify* [~(csym `C__L)] + (~(L 'invoke) [~'_2__ ~(C 'x)] + ~'(. Primitive uncheckedLongCast x)))) + (def ~(tag (cstr `I__L) '>long*|__3) + (reify* [~(csym `I__L)] + (~(L 'invoke) [~'_3__ ~(I 'x)] + ~'(. Primitive uncheckedLongCast x)))) + (def ~(tag (cstr `L__L) '>long*|__4) + (reify* [~(csym `L__L)] + (~(L 'invoke) [~'_4__ ~(L 'x)] + ~'(. Primitive uncheckedLongCast x)))) + (def ~(tag (cstr `F__L) '>long*|__5) + (reify* [~(csym `F__L)] + (~(L 'invoke) [~'_5__ ~(F 'x)] + ~'(. Primitive uncheckedLongCast x)))) + (def ~(tag (cstr `D__L) '>long*|__6) + (reify* [~(csym `D__L)] + (~(L 'invoke) [~'_6__ ~(D 'x)] + ~'(. Primitive uncheckedLongCast x)))) + + ;; [x (t/ref (t/isa? Number))] + + (def ~(tag (cstr `O__L) '>long*|__7) + (reify* [~(csym `O__L)] + (~(L 'invoke) [~'_7__ ~(O 'x)] + (. ~(tag "java.lang.Number" 'x) ~'longValue)))) + + [[0 0 true [t/byte?] t/long?] + [1 1 true [t/short?] t/long?] + [2 2 true [t/char?] t/long?] + [3 3 true [t/int?] t/long?] + [4 4 true [t/long?] t/long?] + [5 5 true [t/float?] t/long?] + [6 6 true [t/double?] t/long?] + [7 7 true [(t/ref (t/isa? Number))] t/long?]] + + (defmeta ~'>long* + {:source "clojure.lang.RT.uncheckedLongCast" + :quantum.core.type/type >long*|__type} + (fn* ([~'x00__] + (ifs + ((Array/get >long*|__0|types 0) ~'x00__) + (. >long*|__0 ~'invoke ~'x00__) + ((Array/get >long*|__1|types 0) ~'x00__) + (. >long*|__1 ~'invoke ~'x00__) + ((Array/get >long*|__2|types 0) ~'x00__) + (. >long*|__2 ~'invoke ~'x00__) + ((Array/get >long*|__3|types 0) ~'x00__) + (. >long*|__3 ~'invoke ~'x00__) + ((Array/get >long*|__4|types 0) ~'x00__) + (. >long*|__4 ~'invoke ~'x00__) + ((Array/get >long*|__5|types 0) ~'x00__) + (. >long*|__5 ~'invoke ~'x00__) + ((Array/get >long*|__6|types 0) ~'x00__) + (. >long*|__6 ~'invoke ~'x00__) + ((Array/get >long*|__7|types 0) ~'x00__) + (. >long*|__7 ~'invoke ~'x00__) + (unsupported! `>long* [~'x00__] 0))))))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval + '(do (throws (>long*)) + (throws (>long* nil)) + (throws (>long* "")) + (is (identical? (>long* 1) (clojure.lang.RT/uncheckedLongCast 1))) + (is (identical? (>long* 1.0) (clojure.lang.RT/uncheckedLongCast 1.0))) + (is (identical? (>long* 1.1) (clojure.lang.RT/uncheckedLongCast 1.1))) + (is (identical? (>long* -1) (clojure.lang.RT/uncheckedLongCast -1))) + (is (identical? (>long* -1.0) (clojure.lang.RT/uncheckedLongCast -1.0))) + (is (identical? (>long* -1.1) (clojure.lang.RT/uncheckedLongCast -1.1))) + (is (identical? (>long* (byte 1)) (clojure.lang.RT/uncheckedLongCast (byte 1))))))))) + +#?(:clj +(deftest ref-output-type-test + "Tests whether refs are output when requested instead of primitives" + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn ref-output-type + ([x tt/boolean? > (t/ref tt/boolean?)] (Boolean. x)) + ([x tt/byte? > (t/ref tt/byte?)] (Byte. x))))) + expected + ($ (do (declare ~'ref-output-type) + + ;; [x tt/boolean? > (t/ref tt/boolean?)] + + (def ~(tag (cstr `B__O) 'ref-output-type|__0) + (reify* [~(csym `B__O)] (~(O 'invoke) [~'_0__ ~(B 'x)] (new ~'Boolean ~'x)))) + + ;; [x tt/byte? > (t/ref tt/byte?)] + + (def ~(tag (cstr `Y__O) 'ref-output-type|__1) + (reify* [~(csym `Y__O)] (~(O 'invoke) [~'_1__ ~(Y 'x)] (new ~'Byte ~'x)))) + + [[0 0 nil [(t/isa? Boolean)] (t/ref (t/isa? Boolean))] + [1 1 nil [(t/isa? Byte)] (t/ref (t/isa? Byte))]] + + (defmeta ~'ref-output-type + {:quantum.core.type/type ref-output-type|__type} + (fn* ([~'x00__] + (ifs + ((Array/get ref-output-type|__0|types 0) ~'x00__) + (. ref-output-type|__0 ~'invoke ~'x00__) + ((Array/get ref-output-type|__1|types 0) ~'x00__) + (. ref-output-type|__1 ~'invoke ~'x00__) + (unsupported! `ref-output-type [~'x00__] 0)))))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" (eval actual))))) + +(self/defn >big-integer > (t/isa? java.math.BigInteger) + ([x tt/ratio? > (t/run (t/isa? java.math.BigInteger))] (.bigIntegerValue x))) + +;; NOTE would use `>long` but that's already an interface +(deftest test|>long-checked + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn >long-checked + {:source "clojure.lang.RT.longCast"} + > tt/long? + ;; TODO multi-arity `t/-` + ([x (t/- tt/primitive? tt/boolean? tt/float? tt/double?)] (>long* x)) + ([x (t/and (t/or tt/double? tt/float?) + ;; TODO add this back in + #_(t/fn [x (t/or t/double? t/float?)] (and (>= x Long/MIN_VALUE) (<= x Long/MAX_VALUE))))] + (>long* x)) + ([x (t/and (t/isa? clojure.lang.BigInt) + ;; TODO add this back in + #_(t/fn [x (t/isa? clojure.lang.BigInt)] (t/nil? (.bipart x))))] + (.lpart x)) + ([x (t/and (t/isa? java.math.BigInteger) + ;; TODO add this back in + #_(t/fn [x (t/isa? java.math.BigInteger)] (< (.bitLength x) 64)))] + (.longValue x)) + ;; FIXME it doesn't know what `>long-checked`'s type is i.e. what it + ;; has defined so far + ([x tt/ratio?] 5 (-> x >big-integer >long-checked)) + ([x (t/value true)] 1) + ([x (t/value false)] 0) + ([x t/string?] (Long/parseLong x)) + ([x t/string?, radix tt/int?] (Long/parseLong x radix))))) + expected + (case (env-lang) + :clj ($ (do #_[x (t/- tt/boolean? tt/boolean? float? double?)] + + #_(def ~'>long|__0|input-types (*<> byte?)) + (def ~'>long|__0 + (reify Y__L + (~(L 'invoke) [_## ~(Y 'x)] + ;; Resolved from `(>long* x)` + (. >long*|__0 invoke ~'x)))) + + #_(def ~'>long|__1|input-types (*<> short?)) + (def ~'>long|__1 + (reify S__L + (~(L 'invoke) [_## ~(C 'x)] + ;; Resolved from `(>long* x)` + (. >long*|__1 invoke ~'x)))) + + #_(def ~'>long|__2|input-types (*<> char?)) + (def ~'>long|__2 + (reify C__L + (~(L 'invoke) [_## ~(S 'x)] + ;; Resolved from `(>long* x)` + (. >long*|__2 invoke ~'x)))) + + #_(def ~'>long|__3|input-types (*<> tt/int?)) + (def ~'>long|__3 + (reify I__L + (~(L 'invoke) [_## ~(I 'x)] + ;; Resolved from `(>long* x)` + (. >long*|__3 invoke ~'x)))) + + #_(def ~'>long|__4|input-types (*<> tt/long?)) + (def ~'>long|__4 + (reify L__L + (~(L 'invoke) [_## ~(L 'x)] + ;; Resolved from `(>long* x)` + (. >long*|__4 invoke ~'x)))) + + #_[x (t/and (t/or double? float?) + (t/fn [x (t/or double? float?)] + (and (>= x Long/MIN_VALUE) (<= x Long/MAX_VALUE))))] + + #_(def ~'>long|__5|input-types + (*<> (t/and double? + (t/fn [x (t/or double? float?)] + (and (>= x Long/MIN_VALUE) (<= x Long/MAX_VALUE)))))) + (def ~'>long|__5 + (reify D__L + (~(L 'invoke) [_## ~(D 'x)] + ;; Resolved from `(>long* x)` + (. >long*|__6 invoke ~'x)))) + + #_(def ~'>long|__6|input-types + (*<> (t/and t/float? + (t/fn [x (t/or double? float?)] + (and (>= x Long/MIN_VALUE) (<= x Long/MAX_VALUE)))))) + (def ~'>long|__6 + (reify F__L + (~(L 'invoke) [_## ~(F 'x)] + ;; Resolved from `(>long* x)` + (. >long*|__6 invoke ~'x)))) + + #_[(t/and (t/isa? clojure.lang.BigInt) + (t/fn [x (t/isa? clojure.lang.BigInt)] (t/nil? (.bipart x))))] + + #_(def ~'>long|__7|input-types + (*<> (t/and (t/isa? clojure.lang.BigInt) + (t/fn [x (t/isa? clojure.lang.BigInt)] (t/nil? (.bipart x)))))) + (def ~'>long|__7 + (reify O__L + (~(L 'invoke) [_## ~(O 'x)] + (let* [~(tag "clojure.lang.BigInt" 'x) ~'x] ~'(.lpart x))))) + + #_[x (t/and (t/isa? java.math.BigInteger) + (t/fn [x (t/isa? java.math.BigInteger)] (< (.bitLength x) 64)))] + + #_(def ~'>long|__8|input-types + (*<> (t/and (t/isa? java.math.BigInteger) + (t/fn [x (t/isa? java.math.BigInteger)] (< (.bitLength x) 64))))) + (def ~'>long|__8 + (reify O__L + (~(L 'invoke) [_## ~(O 'x)] + (let* [~(tag "java.math.BigInteger" 'x) ~'x] ~'(.longValue x))))) + + #_[x ratio?] + + #_(def ~'>long|__9|input-types + (*<> ratio?)) + #_(def ~'>long|__9|conditions + (*<> (-> long|__8|input-types (core/get 0) utr/and-type>args (core/get 1)))) + (def ~'>long|__9 + (reify O__L + (~(L 'invoke) [_## ~(O 'x)] + (let* [~(tag "clojure.lang.Ratio" 'x) ~'x] + ;; Resolved from `(>long (.bigIntegerValue x))` + ;; In this case, `(t/compare (t/type-of '(.bigIntegerValue x)) overload-type)`: + ;; - `(t/- tt/boolean? tt/boolean? float? double?)` -> t/<> + ;; - `(t/and (t/or double? float?) ...)` -> t/<> + ;; - `(t/and (t/isa? clojure.lang.BigInt) ...)` -> t/<> + ;; - `(t/and (t/isa? java.math.BigInteger) ...)` -> t/> + ;; - `ratio?` -> t/<> + ;; - `(t/value true)` -> t/<> + ;; - `(t/value false)` -> t/<> + ;; - `t/string?` -> t/<> + ;; + ;; Since there is no overload that results in t/<, no compile-time match can + ;; be found, but a possible runtime match lies in the overload that results in + ;; t/>. The remaining uncertainty will have to be resolved at compile time. + ;; Note that if there had been multiple overloads with t/>, we would have had + ;; to dispatch on that and resolve accordingly. + (let [x## ~'(.bigIntegerValue x)] + (if ((Array/get >long|__9|conditions 0) x##) + (.invoke >long|__8 x##) + (unsupported! `>long x##))))))) + + #_[x (t/value true)] + + #_(def ~'>long|__10|input-types + (*<> (t/value true))) + (def ~'>long|__10 + (reify boolean>long + (~(L 'invoke) [_## ~(B 'x)] 1))) + + #_[x (t/value false)] + + #_(def ~'>long|__11|input-types + (*<> (t/value false))) + (def ~'>long|__11 + (reify boolean>long + (~(L 'invoke) [_## ~(B 'x)] 0))) + + #_[x t/string?] + + #_(def ~'>long|__12|input-types + (*<> t/string?)) + (def ~'>long|__12 + (reify O__L + (~(L 'invoke) [_## ~(O 'x)] + ~'(Long/parseLong x)))) + + #_[x t/string?] + + #_(def ~'>long|__13|input-types + (*<> t/string? tt/int?)) + (def ~'>long|__13 + (reify OI__L + (~(L 'invoke) [_## ~(O 'x) ~(I 'radix)] + ~'(Long/parseLong x radix)))) + + #_(defn >long + {:quantum.core.type/type + (t/fn + [(t/- tt/boolean? tt/boolean? float? double?)] + [(t/and (t/or t/double? t/float?) + (t/fn [x (t/or double? float?)] + (and (>= x Long/MIN_VALUE) (<= x Long/MAX_VALUE))))] + [(t/and (t/isa? clojure.lang.BigInt) + (t/fn [x (t/isa? clojure.lang.BigInt)] (t/nil? (.bipart x))))] + [(t/and (t/isa? java.math.BigInteger) + (t/fn [x (t/isa? java.math.BigInteger)] (< (.bitLength x) 64)))] + [ratio?] + [(t/value true)] + [(t/value false)] + [t/string?] + [t/string? tt/int?])} + ([x0##] (ifs ((Array/get >long|__0|input-types 0) x0##) + (.invoke >long|__0 x0##) + ((Array/get >long|__1|input-types 0) x0##) + (.invoke >long|__0 x0##) + ((Array/get >long|__2|input-types 0) x0##) + (.invoke >long|__2 x0##))) + ([x0## x1##] ...)))))] + ;; TODO fix this + #_(testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval + '(do (throws (>long-checked)) + (throws (>long-checked nil)) + (throws (>long-checked "")) + (is (identical? (>long-checked 1) (clojure.lang.RT/longCast 1))) + (is (identical? (>long-checked 1.0) (clojure.lang.RT/longCast 1.0))) + (is (identical? (>long-checked 1.1) (clojure.lang.RT/longCast 1.1))) + (is (identical? (>long-checked -1) (clojure.lang.RT/longCast -1))) + (is (identical? (>long-checked -1.0) (clojure.lang.RT/longCast -1.0))) + (is (identical? (>long-checked -1.1) (clojure.lang.RT/longCast -1.1))) + (is (identical? (>long-checked (byte 1)) (clojure.lang.RT/longCast (byte 1))))))))) + +(deftest test|!str + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn !str > #?(:clj (t/isa? StringBuilder) + :cljs (t/isa? StringBuffer)) + ([] #?(:clj (StringBuilder.) :cljs (StringBuffer.))) + ;; If we had combined this arity, `t/or`ing the `t/string?` means it wouldn't have been + ;; handled any differently than `t/char-seq?` + #?(:clj ([x t/string?] (StringBuilder. x))) + ([x #?(:clj (t/or tt/char-seq? tt/int?) + :cljs t/val?)] + #?(:clj (StringBuilder. x) :cljs (StringBuffer. x)))))) + expected + (case (env-lang) + :clj ($ (do (def ~'!str|__0|0 + (reify* [~(csym `__O)] + (~(O 'invoke) [~'_0__] + ~(tag "java.lang.StringBuilder" '(new StringBuilder))))) + + (def ~(O<> '!str|__1|input0|types) + (*<> (t/isa? java.lang.String))) + (def ~'!str|__1|0 + (reify* [~(csym `O__O)] + (~(O 'invoke) [~'_1__ ~(O 'x)] + (let* [~(ST 'x) ~'x] + ~(tag "java.lang.StringBuilder" + (list 'new 'StringBuilder (ST 'x))))))) + + (def ~(O<> '!str|__2|input0|types) + (*<> (t/isa? java.lang.CharSequence) + (t/isa? java.lang.Integer))) + (def ~'!str|__2|0 + (reify* [~(csym `O__O)] + (~(O 'invoke) [~'_2__ ~(O 'x)] + (let* [~(tag "java.lang.CharSequence" 'x) ~'x] + ~(tag "java.lang.StringBuilder" + (list 'new 'StringBuilder + (tag "java.lang.CharSequence" 'x))))))) + (def ~'!str|__2|1 + (reify* [~(csym `I__O)] + (~(O 'invoke) [~'_3__ ~(I 'x)] + ~(tag "java.lang.StringBuilder" '(new StringBuilder x))))) + + (defn ~'!str + {:quantum.core.type/type + (t/fn ~'(t/isa? StringBuilder) + ~'[] + ~'[t/string?] + ~'[(t/or tt/char-seq? tt/int?)])} + ([] (.invoke ~(tag "quantum.core.test.defnt_equivalences.__O" + '!str|__0|0))) + ([~'x00__] + (ifs + ((Array/get ~'!str|__1|input0|types 0) ~'x00__) + (.invoke ~(tag "quantum.core.test.defnt_equivalences.O__O" + '!str|__1|0) ~'x00__) + ((Array/get ~'!str|__2|input0|types 0) ~'x00__) + (.invoke ~(tag "quantum.core.test.defnt_equivalences.O__O" + '!str|__2|0) ~'x00__) + ((Array/get ~'!str|__2|input0|types 1) ~'x00__) + (.invoke ~(tag "quantum.core.test.defnt_equivalences.I__O" + '!str|__2|1) ~'x00__) + (unsupported! `!str [~'x00__] 0)))))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval + '(do (is (instance? StringBuilder (!str))) + (is (instance? StringBuilder (!str "asd"))) + (is (instance? StringBuilder (!str (int 123)))) + (is (instance? StringBuilder (!str (.subSequence "abc" 0 1))))))))) + +(deftest defn-reference-test + (testing "`t/defn` references itself" + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn defn-self-reference + ([> tt/double?] 2.0) + ([x tt/long? > tt/double?] (defn-self-reference))))) + expected + (case (env-lang) + :clj ($ (do (declare ~'defn-self-reference) + + ;; [> tt/double?] + + (def ~'defn-self-reference|__0 + (reify* [~(csym `__D)] + (~(O 'invoke) [~'_0__] 2.0))) + + ;; [x tt/long? > tt/double?] + + (def ~'defn-self-reference|__1 + (reify* [~(csym `L__D)] + (~(O 'invoke) [~'_1__ ~'x] (~'defn-self-reference)))) + + [{:id 0 :index 0 :arg-types [] :output-type (t/isa? Double)} + {:id 1 :index 1 :arg-types [(t/isa? Long) :output-type (t/isa? Double)]}] + + (defmeta ~'defn-self-reference + {:quantum.core.type/type defn-self-reference|__type} + ([] (. ~'defn-self-reference|__0 invoke)) + ([~'x00__] + (ifs + ((Array/get ~'defn-self-reference|__1|types 0) ~'x00__) + (. defn-self-reference|__1 invoke ~'x00__) + (unsupported! `defn-self-reference [~'x00__] 0)))))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do (is= (defn-self-reference) 2.0)))))) + (testing "`t/defn` references other `t/defn`" + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn defn-reference + ([> tt/long?] (>long* 1))))) + expected + (case (env-lang) + :clj ($ (do (declare ~'defn-reference) + (def ~(tag (cstr `>long) 'defn-reference|__0) + ( [>long] (~(L 'invoke) [~'_0__] ~'(>long* 1)))) + + [{:id 0 :index 0 :arg-types [] :output-type (t/isa? Long)}] + + (defmeta ~'defn-reference + {:quantum.core.type/type defn-reference|__type} + (fn* ([] (. defn-reference|__0 ~'invoke)))))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do (is (identical? (defn-reference) 1)))))))) + +(deftest defn-assume-test + "Tests that t/assume works properly in the context of `t/defn`" + (throws (eval '(self/defn defn-assume-0 [> (t/assume tt/int?)] "asd"))) + (throws (eval '(self/defn defn-assume-1 [> (t/assume tt/int?)] nil))) + (is= nil (do (eval '(self/defn defn-assume-2 [> (t/assume tt/int?)] (Object.))) + nil)) + (is= nil (do (eval '(self/defn defn-assume-3 [> (t/assume tt/int?)] (or (Object.) nil))) + nil))) + +(deftest dependent-type-test + (testing "t/type") ;; tested in `extend-defn!` test + (testing "t/input" + (let [actual + (macroexpand ' + (self/defn input-type-test + [> (t/output >long-checked [t/string?])] 1)) + expected + (case (env-lang) + :clj + ($ (do ...)))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '(do ...)))))) + +;; ----- expanded code ----- ;; + +`(do (swap! fn->spec assoc #'!str + (t/fn :> #?(:clj (t/isa? StringBuilder) + :cljs (t/isa? StringBuffer)) + [] + #?(:clj [t/string?]) + [#?(:clj (t/or t/char-seq? tt/int?) + :cljs t/val?)])) + + ~(case-env + :clj `(do (def ^__O !str|__0 + (reify __O + (^java.lang.Object invoke [_#] + (StringBuilder.)))) + ;; `t/string?` + (def ^O__O !str|__1 ; `t/string?` + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'x] + (let* [^String x x] (StringBuilder. x))))) + ;; `(t/or t/char-seq? tt/int?)` + (def ^O__O !str|__2 ; `t/char-seq?` + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'x] + (let* [^CharSequence x x] (StringBuilder. x))))) + (def ^I__O !str|__3 ; `tt/int?` + (reify I__O (^java.lang.Object invoke [_# ^int ~'x] + (StringBuilder. x)))) + + (defn !str ([ ] (.invoke !str|__0)) + ([a0] (ifs (tt/string? a0) (.invoke !str|__1 a0) + (tt/char-seq? a0) (.invoke !str|__2 a0) + (tt/int? a0) (.invoke !str|__3 a0))))) + :cljs `(do (defn !str ([] (StringBuffer.)) + ([a0] (let* [x a0] (StringBuffer. x))))))) + +;; =====|=====|=====|=====|===== ;; + +;; TODO handle inline +(macroexpand ' +(self/defn #_:inline str|test > t/string? + ([] "") + ([x t/nil?] "") + ;; could have inferred but there may be other objects who have overridden .toString + #?(#_:clj #_([x (t/isa? Object) > (t/run t/string?)] (.toString x)) + ;; Can't infer that it returns a string (without a pre-constructed list of built-in fns) + ;; As such, must explicitly mark + :cljs ([x t/any? > (t/assume t/string?)] (.join #js [x] ""))) + ;; TODO only one variadic arity allowed currently; theoretically could dispatch on at + ;; least pre-variadic args, if not variadic + ;; TODO should have automatic currying? + ;; TODO need to handle varargs + #_([x (t/fn> str|test t/any?) & xs (? (t/seq-of t/any?)) + #?@(:cljs [> (t/assume t/string?)])] + (let* [sb (-> x str|test !str)] ; determined to be StringBuilder + ;; TODO is `doseq` the right approach, or using reduction? + (doseq [x' xs] (.append sb (str x'))) + (.toString sb)))) +) + +;; ----- expanded code ----- ;; + +`(do ~(case-env + :clj `(do (def str|__0 + (reify __O (^java.lang.Object invoke [_# ] ""))) + (def str|__1 ; `nil?` + (reify O__O (^java.lang.Object invoke [_# ^java.lang.Object ~'x] ""))) + (def str|__2 ; `Object` + (reify O__O (^java.lang.Object invoke [_# ^java.lang.Object ~'x] (.toString x)))) + + (defn str + {:quantum.core.type/type + (t/fn :> t/string? + [] + [t/nil?] + #?(:clj [(t/isa? Object)]) + #?(:cljs [t/any? :> (t/assume t/string?)]) + [(t/fn> str t/any?) :& (? (t/seq-of t/any?)) #?@(:cljs [:> (t/assume t/string?)])])} + ([ ] (.invoke !str|__0)) + ([a0] (ifs (nil? x) (.invoke !str|__1) + (.invoke !str|__2 a0))) + ([x & xs] + (let* [sb (!str (str x))] + (doseq [x' xs] (.append sb (str x'))) ; TODO is `doseq` the right approach? + (.toString sb))))) + :cljs `(do (defn str + ([ ] "") + ([a0] (ifs (nil? x) "" + (.join #js [x] ""))) + ([x & xs] + (let* [sb (!str (str x))] + (doseq [x' xs] (.append sb (str x'))) ; TODO is `doseq` the right approach? + (.toString sb))))))) + +;; =====|=====|=====|=====|===== ;; + +;; TODO enable the disabled parts of this +(macroexpand ' +(self/defn #_:inline count #_> #_t/nneg-integer? + ([xs t/array? #_> #_t/nneg-int?] (.length xs)) + #_([xs t/string? > #?(:clj t/nneg-int? :cljs (t/assume t/nneg-int?))] + (#?(:clj .length :cljs .-length) xs)) + #_([xs !+vector? > t/nneg-int?] (#?(:clj count :cljs (do (TODO) 0)) xs))) +) + +;; ----- expanded code ----- ;; + +`(do (swap! fn->spec assoc #'count + (t/fn :> t/pos-integer? + [t/array? :> t/nneg-int?] + [t/string? :> #?(:clj t/nneg-int? :cljs (t/assume t/nneg-int?))] + [!+vector? :> t/nneg-int?])) + + ~(case-env + :clj `(do ;; `array?` + (def count|__0__1 (reify O__I (^int invoke [_# ^java.lang.Object ~'xs] (Array/count ^"[B" xs)))) + ...) + :cljs `(do ...))) + +;; =====|=====|=====|=====|===== ;; + +(macroexpand ' +(self/defn #_:inline get + ;; TODO `t/numerically + ([xs t/array? , k #_(t/numerically tt/int?)] (#?(:clj Array/get :cljs aget) xs k)) + ([xs t/string?, k #_(t/numerically tt/int?)] (.charAt xs k)) + ([xs !+vector?, k t/any?] #?(:clj (.valAt xs k) :cljs (TODO)))) +) +;; ----- expanded code ----- ;; + +`(do (swap! fn->spec assoc #'count + (t/fn :> t/pos-integer? + [t/array? (t/numerically tt/int?)] + [t/string? (t/numerically tt/int?)] + [!+vector? t/any?])) + + ...) + +;; =====|=====|=====|=====|===== ;; + +(self/defn zero? > tt/boolean? + ([x (t/- tt/primitive? tt/boolean?)] (Numeric/isZero x))) + +; TODO CLJS version will come after +#?(:clj +(macroexpand ' +(self/defn seq + "Taken from `clojure.lang.RT/seq`" + > (t/? (t/isa? ISeq)) + ([xs t/nil?] nil) + ([xs (t/isa? ASeq)] xs) + ([xs (t/or (t/isa? LazySeq) (t/isa? Seqable))] (.seq xs)) + ([xs t/iterable?] (clojure.lang.RT/chunkIteratorSeq (.iterator xs))) + ([xs t/char-seq?] (clojure.lang.StringSeq/create xs)) + ([xs (t/isa? java.util.Map)] (seq (.entrySet xs))) + ([xs t/array? > (t/run (t/? (t/isa? ISeq)))] + ;; We do this only because `clojure.lang.ArraySeq/createFromObject` is private but perhaps it + ;; would be wise from a performance perspective to bypass that with e.g. a fast version of + ;; reflection + (clojure.core/seq xs)))) +) + +;; ----- expanded code ----- ;; + +#?(:clj +`(do ~(case-env + :clj + `(do ;; [t/nil?] + + (def seq|__0|input-types (*<> t/nil?)) + (def ^O__O seq|__0 + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] + ;; Notice, no casting for nil input + nil))) + + ;; [(t/isa? ASeq)] + + (def seq|__2|input-types (*<> (t/isa? ASeq))) + (def ^O__O seq|__2 + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] + (let* [^ASeq xs xs] xs)))) + + ;; [(t/or (t/isa? LazySeq) (t/isa? Seqable))] + + (def seq|__3|input-types (*<> (t/isa? LazySeq))) + (def ^O__O seq|__3 + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] + (let* [^LazySeq xs xs] (.seq xs))))) + + (def seq|__4|input-types (*<> (t/isa? Seqable))) + (def ^O__O seq|__4 + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] + (let* [^Seqable xs xs] (.seq xs))))) + + ;; [t/iterable?] + + (def seq|__5|input-types (*<> t/iterable?)) + (def ^O__O seq|__5 + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] + (let* [^Iterable xs xs] (clojure.lang.RT/chunkIteratorSeq (.iterator xs)))))) + + ;; [t/char-seq?] + + (def seq|__6|input-types (*<> t/iterable?)) + (def ^O__O seq|__6 + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] + (let* [^CharSequence xs xs] (StringSeq/create xs))))) + + ;; [(t/isa? Map)] + + (def seq|__7|input-types (*<> (t/isa? Map))) + (def ^O__O seq|__7 + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] + ;; This is after expansion; it's the first one that matches the overload + ;; If no overload is found it'll have to be dispatched at runtime (protocol or + ;; equivalent) and potentially a configurable warning can be emitted + (let [^Map xs xs] (.invoke seq|__4__0 (.entrySet xs)))))) + + ;; [t/array?] + + ;; TODO perhaps at some point figure out that it doesn't need to create any more + ;; overloads here than just one? + (def seq|__8|input-types (*<> (t/isa? (Class/forName "[Z")))) + (def ^O__O seq|__8 + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] + (let* [^"[Z" xs xs] (ArraySeq/createFromObject xs))))) + + (def seq|__9|input-types (*<> (t/isa? (Class/forName "[B")))) + (def ^O__O seq|__9 + (reify O__O + (^java.lang.Object invoke [_# ^java.lang.Object ~'xs] + (let* [^"[B" xs xs] (ArraySeq/createFromObject xs))))) + ... + + (defn seq + "Taken from `clojure.lang.RT/seq`" + {:quantum.core.type/type + (t/ftype (t/? (t/isa? ISeq)) + [t/nil?] + [(t/isa? ASeq)] + [(t/or (t/isa? LazySeq) (t/isa? Seqable))] + [t/iterable?] + [t/char-seq?] + [(t/isa? Map)] + [t/array?])} + [a0] + (ifs ((Array/get seq|__0|input-types 0) a0) (.invoke seq|__0 a0) + ((Array/get seq|__1|input-types 0) a0) (.invoke seq|__1 a0) + ... + ((Array/get seq|__30|input-types 0) a0) (.invoke seq|__30 a0) + ((Array/get seq|__31|input-types 0) a0) (.invoke seq|__31 a0) + ((Array/get seq|__32|input-types 0) a0) (.invoke seq|__32 a0) + ((Array/get seq|__33|input-types 0) a0) (.invoke seq|__33 a0) + ((Array/get seq|__34|input-types 0) a0) (.invoke seq|__34 a0) + ((Array/get seq|__35|input-types 0) a0) (.invoke seq|__35 a0) + (unsupported! `seq [a0] 0))) + )) + :cljs + `(do ...)))) + +;; =====|=====|=====|=====|===== ;; + +(macroexpand ' +(self/defn first + ([xs t/nil? ] nil) + ([xs (t/and t/sequential? t/indexed?)] (get xs 0)) + ([xs (t/isa? ISeq) ] (.first xs)) + ([xs ... ] (-> xs seq first)))) + +#?(:clj +`(do (swap! fn->spec assoc #'seq + (t/fn + [t/nil?] + [(t/and t/sequential? t/indexed?)] + [(t/isa? ISeq)] + [...])) + + ~(case-env + :clj `(do ...) + :cljs `(do ...)))) + +;; ----- expanded code ----- ;; + +;; =====|=====|=====|=====|===== ;; + +(macroexpand ' +(self/defn next > (? ISeq) + "Taken from `clojure.lang.RT/next`" + ([xs t/nil?] nil) + ([xs (t/isa? ISeq)] (.next xs)) + ([xs ...] (-> xs seq next))) +) + +;; ----- expanded code ----- ;; + +`(do (swap! fn->spec assoc #'next + (t/fn + [t/nil?] + [(t/isa? ISeq)] + [...])) + + ...) + +;; =====|=====|=====|=====|===== ;; + +;; TODO: conditionally optional arities etc. for t/fn + +(t/def rf? "Reducing function" + (t/ftype "seed arity" [] + "completing arity" [t/any?] + "reducing arity" [t/any? t/any?])) + +;; ----- expanded code ----- ;; + + +; ================================================ ; + +(self/defn ^:inline custom + [x (s/if double? + (t/or (s/fnt [x ?] (> x 3)) ; uses the above-defined `>` + (s/fnt [x ?] (< x 0.1))) + (t/or str? !str?)) + y ?] (str x (name y))) ; uses the above-defined `name` + + +;; ===== `extend-defn!` tests ===== ;; + +(def dependent-extensible|direct-dispatch|codelist + `[(def ~(tag (cstr `BYSS__O) 'dependent-extensible|__0) + (reify* [~(csym `BYSS__O)] + (~(O 'invoke) [~'_0__ ~(B 'a) ~(Y 'b) ~(S 'c) ~(S 'd)] 1))) + (def ~(tag (cstr `BYSC__O) 'dependent-extensible|__1) + (reify* [~(csym `BYSC__O)] + (~(O 'invoke) [~'_1__ ~(B 'a) ~(Y 'b) ~(S 'c) ~(C 'd)] 1))) + (def ~(tag (cstr `BYSO__O) 'dependent-extensible|__2) + (reify* [~(csym `BYSO__O)] + (~(O 'invoke) [~'_2__ ~(B 'a) ~(Y 'b) ~(S 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `BYOC__O) 'dependent-extensible|__3) + (reify* [~(csym `BYOC__O)] + (~(O 'invoke) [~'_3__ ~(B 'a) ~(Y 'b) ~(O 'c) ~(C 'd)] 1))) + (def ~(tag (cstr `BYOO__O) 'dependent-extensible|__4) + (reify* [~(csym `BYOO__O)] + (~(O 'invoke) [~'_4__ ~(B 'a) ~(Y 'b) ~(O 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `BYOO__O) 'dependent-extensible|__5) + (reify* [~(csym `BYOO__O)] + (~(O 'invoke) [~'_5__ ~(B 'a) ~(Y 'b) ~(O 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `BSSS__O) 'dependent-extensible|__6) + (reify* [~(csym `BSSS__O)] + (~(O 'invoke) [~'_6__ ~(B 'a) ~(S 'b) ~(S 'c) ~(S 'd)] 1))) + (def ~(tag (cstr `BCSC__O) 'dependent-extensible|__7) + (reify* [~(csym `BCSC__O)] + (~(O 'invoke) [~'_7__ ~(B 'a) ~(C 'b) ~(S 'c) ~(C 'd)] 1))) + (def ~(tag (cstr `BCOC__O) 'dependent-extensible|__8) + (reify* [~(csym `BCOC__O)] + (~(O 'invoke) [~'_8__ ~(B 'a) ~(C 'b) ~(O 'c) ~(C 'd)] 1))) + (def ~(tag (cstr `BOSO__O) 'dependent-extensible|__9) + (reify* [~(csym `BOSO__O)] + (~(O 'invoke) [~'_9__ ~(B 'a) ~(O 'b) ~(S 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `BOOO__O) 'dependent-extensible|__10) + (reify* [~(csym `BOOO__O)] + (~(O 'invoke) [~'_10__ ~(B 'a) ~(O 'b) ~(O 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `BOOO__O) 'dependent-extensible|__11) + (reify* [~(csym `BOOO__O)] + (~(O 'invoke) [~'_11__ ~(B 'a) ~(O 'b) ~(O 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `YYSS__O) 'dependent-extensible|__12) + (reify* [~(csym `YYSS__O)] + (~(O 'invoke) [~'_12__ ~(Y 'a) ~(Y 'b) ~(S 'c) ~(S 'd)] 1))) + (def ~(tag (cstr `YYSC__O) 'dependent-extensible|__13) + (reify* [~(csym `YYSC__O)] + (~(O 'invoke) [~'_13__ ~(Y 'a) ~(Y 'b) ~(S 'c) ~(C 'd)] 1))) + (def ~(tag (cstr `YYSO__O) 'dependent-extensible|__14) + (reify* [~(csym `YYSO__O)] + (~(O 'invoke) [~'_14__ ~(Y 'a) ~(Y 'b) ~(S 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `YYOC__O) 'dependent-extensible|__15) + (reify* [~(csym `YYOC__O)] + (~(O 'invoke) [~'_15__ ~(Y 'a) ~(Y 'b) ~(O 'c) ~(C 'd)] 1))) + (def ~(tag (cstr `YYOO__O) 'dependent-extensible|__16) + (reify* [~(csym `YYOO__O)] + (~(O 'invoke) [~'_16__ ~(Y 'a) ~(Y 'b) ~(O 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `YYOO__O) 'dependent-extensible|__17) + (reify* [~(csym `YYOO__O)] + (~(O 'invoke) [~'_17__ ~(Y 'a) ~(Y 'b) ~(O 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `SSSS__O) 'dependent-extensible|__18) + (reify* [~(csym `SSSS__O)] + (~(O 'invoke) [~'_18__ ~(S 'a) ~(S 'b) ~(S 'c) ~(S 'd)] 1))) + (def ~(tag (cstr `CCSC__O) 'dependent-extensible|__19) + (reify* [~(csym `CCSC__O)] + (~(O 'invoke) [~'_19__ ~(C 'a) ~(C 'b) ~(S 'c) ~(C 'd)] 1))) + (def ~(tag (cstr `CCOC__O) 'dependent-extensible|__20) + (reify* [~(csym `CCOC__O)] + (~(O 'invoke) [~'_20__ ~(C 'a) ~(C 'b) ~(O 'c) ~(C 'd)] 1))) + (def ~(tag (cstr `OOSO__O) 'dependent-extensible|__21) + (reify* [~(csym `OOSO__O)] + (~(O 'invoke) [~'_21__ ~(O 'a) ~(O 'b) ~(S 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `OOOO__O) 'dependent-extensible|__22) + (reify* [~(csym `OOOO__O)] + (~(O 'invoke) [~'_22__ ~(O 'a) ~(O 'b) ~(O 'c) ~(O 'd)] 1))) + (def ~(tag (cstr `OOOO__O) 'dependent-extensible|__23) + (reify* [~(csym `OOOO__O)] + (~(O 'invoke) [~'_23__ ~(O 'a) ~(O 'b) ~(O 'c) ~(O 'd)] 1)))]) + +(def dependent-extensible|fn|form + `(fn* ([~'x00__ ~'x10__ ~'x20__ ~'x30__] + (ifs ((Array/get dependent-extensible|__0|types 0) ~'x00__) + (ifs ((Array/get dependent-extensible|__0|types 1) ~'x10__) + (ifs ((Array/get dependent-extensible|__0|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__0|types 3) ~'x30__) + (. dependent-extensible|__0 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + ((Array/get dependent-extensible|__1|types 3) ~'x30__) + (. dependent-extensible|__1 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + ((Array/get dependent-extensible|__2|types 3) ~'x30__) + (. dependent-extensible|__2 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + ((Array/get dependent-extensible|__3|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__3|types 3) ~'x30__) + (. dependent-extensible|__3 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + ((Array/get dependent-extensible|__4|types 3) ~'x30__) + (. dependent-extensible|__4 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + ((Array/get dependent-extensible|__5|types 3) ~'x30__) + (. dependent-extensible|__5 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 2)) + ((Array/get dependent-extensible|__6|types 1) ~'x10__) + (ifs ((Array/get dependent-extensible|__6|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__6|types 3) ~'x30__) + (. dependent-extensible|__6 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 2)) + ((Array/get dependent-extensible|__7|types 1) ~'x10__) + (ifs ((Array/get dependent-extensible|__7|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__7|types 3) ~'x30__) + (. dependent-extensible|__7 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + ((Array/get dependent-extensible|__8|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__8|types 3) ~'x30__) + (. dependent-extensible|__8 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 2)) + ((Array/get dependent-extensible|__9|types 1) ~'x10__) + (ifs ((Array/get dependent-extensible|__9|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__9|types 3) ~'x30__) + (. dependent-extensible|__9 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + ((Array/get dependent-extensible|__10|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__10|types 3) ~'x30__) + (. dependent-extensible|__10 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 2)) + ((Array/get dependent-extensible|__11|types 1) ~'x10__) + (ifs ((Array/get dependent-extensible|__11|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__11|types 3) ~'x30__) + (. dependent-extensible|__11 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 2)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 1)) + ((Array/get dependent-extensible|__12|types 0) ~'x00__) + (ifs ((Array/get dependent-extensible|__12|types 1) ~'x10__) + (ifs ((Array/get dependent-extensible|__12|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__12|types 3) ~'x30__) + (. dependent-extensible|__12 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + ((Array/get dependent-extensible|__13|types 3) ~'x30__) + (. dependent-extensible|__13 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + ((Array/get dependent-extensible|__14|types 3) ~'x30__) + (. dependent-extensible|__14 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + ((Array/get dependent-extensible|__15|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__15|types 3) ~'x30__) + (. dependent-extensible|__15 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + ((Array/get dependent-extensible|__16|types 3) ~'x30__) + (. dependent-extensible|__16 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + ((Array/get dependent-extensible|__17|types 3) ~'x30__) + (. dependent-extensible|__17 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 2)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 1)) + ((Array/get dependent-extensible|__18|types 0) ~'x00__) + (ifs ((Array/get dependent-extensible|__18|types 1) ~'x10__) + (ifs ((Array/get dependent-extensible|__18|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__18|types 3) ~'x30__) + (. dependent-extensible|__18 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 2)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 1)) + ((Array/get dependent-extensible|__19|types 0) ~'x00__) + (ifs ((Array/get dependent-extensible|__19|types 1) ~'x10__) + (ifs ((Array/get dependent-extensible|__19|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__19|types 3) ~'x30__) + (. dependent-extensible|__19 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + ((Array/get dependent-extensible|__20|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__20|types 3) ~'x30__) + (. dependent-extensible|__20 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 2)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 1)) + ((Array/get dependent-extensible|__21|types 0) ~'x00__) + (ifs ((Array/get dependent-extensible|__21|types 1) ~'x10__) + (ifs ((Array/get dependent-extensible|__21|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__21|types 3) ~'x30__) + (. dependent-extensible|__21 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + ((Array/get dependent-extensible|__22|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__22|types 3) ~'x30__) + (. dependent-extensible|__22 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 2)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 1)) + ((Array/get dependent-extensible|__23|types 0) ~'x00__) + (ifs ((Array/get dependent-extensible|__23|types 1) ~'x10__) + (ifs ((Array/get dependent-extensible|__23|types 2) ~'x20__) + (ifs ((Array/get dependent-extensible|__23|types 3) ~'x30__) + (. dependent-extensible|__23 ~'invoke ~'x00__ ~'x10__ ~'x20__ ~'x30__) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 3)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 2)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 1)) + (unsupported! `dependent-extensible [~'x00__ ~'x10__ ~'x20__ ~'x30__] 0))))) + +(deftest extend-defn!|test + (testing "simple test" + (testing "definition" + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn extensible + ([a t/double?])))) + expected + (case (env-lang) + :clj ($ (do (declare ~'extensible) + (def ~(tag (cstr `D__O) 'extensible|__0) + ( [D__O] (~(O 'invoke) [~'_0__ ~(D 'a)] nil))) + + [{:id 0 :index 0 :arg-types [(t/isa? Double)] :output-type t/any?}] + + (defmeta ~'extensible + {:quantum.core.type/type extensible|__type} + (fn* ([~'x00__] + (ifs ((Array/get extensible|__0|types 0) ~'x00__) + (. extensible|__0 ~'invoke ~'x00__) + (unsupported! `extensible [~'x00__] 0))))))))] + (testing "code equivalence" (is-code= actual expected)) + (eval actual))) + (testing "extension" + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/extend-defn! extensible + ([a t/boolean?])))) + expected + (case (env-lang) + :clj ($ (do (def ~(tag (cstr `B__O) 'extensible|__1) + (reify* [~(csym `B__O)] + (~(O 'invoke) [~'_0__ ~(B 'a)] nil))) + + [{:id 1 :index 0 :arg-types [(t/isa? Boolean)] :output-type t/any?} + {:id 0 :index 1 :arg-types [(t/isa? Double)] :output-type t/any?}] + + (doto (intern '~(ns-name *ns*) '~'extensible + ~(with-meta + `(fn* ([~'x00__] + (ifs ((Array/get extensible|__1|types 0) ~'x00__) + (. extensible|__1 ~'invoke ~'x00__) + ((Array/get extensible|__0|types 0) ~'x00__) + (. extensible|__0 ~'invoke ~'x00__) + (unsupported! `extensible [~'x00__] 0)))) + `{:quantum.core.type/type extensible|__type})) + (alter-meta! merge + {:quantum.core.type/type extensible|__type})))))] + (testing "code equivalence" (is-code= actual expected)) + (eval actual))) + (testing "re-extension" + ;; TODO figure out whether we just want to have nothing happen, or whether we want to + ;; re-evaluate + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/extend-defn! extensible ([a t/boolean?])))) + expected + (case (env-lang) + :clj ($ (do [{:id 1 :index 0 :arg-types [(t/isa? Boolean)] :output-type t/any?} + {:id 0 :index 1 :arg-types [(t/isa? Double)] :output-type t/any?}] + + (doto (intern '~(ns-name *ns*) '~'extensible + ~(with-meta + `(fn* ([~'x00__] + (ifs ((Array/get extensible|__1|types 0) ~'x00__) + (. extensible|__1 ~'invoke ~'x00__) + ((Array/get extensible|__0|types 0) ~'x00__) + (. extensible|__0 ~'invoke ~'x00__) + (unsupported! `extensible [~'x00__] 0)))) + `{:quantum.core.type/type extensible|__type})) + (alter-meta! merge + {:quantum.core.type/type extensible|__type})))))] + (testing "code equivalence" (is-code= actual expected)) + (eval actual)))) + (testing "dependent type" + (testing "definition" + (let [actual + (doto (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn dependent-extensible + [a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/or tt/short? tt/string?) + d (let [b (t/- tt/int? tt/long?)] + (t/or tt/char? (t/type b) (t/type c))) + > (t/or (t/type b) (t/type d) tt/long?)] 1))) + eval) + expected + (case (env-lang) + :clj + ($ (do (declare ~'dependent-extensible) + ~@dependent-extensible|direct-dispatch|codelist + [{:id 0 :index 0 + :arg-types [(t/isa? Boolean) (t/isa? Byte) (t/isa? Short) (t/isa? Short)] + :output-type (t/or (t/isa? Byte) (t/isa? Short) (t/isa? Long))} + {:id 1 :index 1 + :arg-types [(t/isa? Boolean) (t/isa? Byte) (t/isa? Short) (t/isa? Character)] + :output-type (t/or (t/isa? Byte) (t/isa? Character) (t/isa? Long))} + {:id 2 :index 2 + :arg-types [(t/isa? Boolean) (t/isa? Byte) (t/isa? Short) + (t/value (t/isa? Integer))] + :output-type (t/or (t/isa? Byte) (t/value (t/isa? Integer)) (t/isa? Long))} + {:id 3 :index 3 + :output-type (t/or (t/isa? Byte) (t/isa? Character) (t/isa? Long)) + :arg-types [(t/isa? Boolean) (t/isa? Byte) (t/isa? String) (t/isa? Character)]} + {:id 4 :index 4 + :arg-types [(t/isa? Boolean) (t/isa? Byte) (t/isa? String) + (t/value (t/isa? Integer))] + :output-type (t/or (t/isa? Byte) (t/value (t/isa? Integer)) (t/isa? Long))} + {:id 5 :index 5 + :arg-types [(t/isa? Boolean) (t/isa? Byte) (t/isa? String) (t/isa? String)] + :output-type (t/or (t/isa? Byte) (t/isa? String) (t/isa? Long))} + {:id 6 :index 6 + :arg-types [(t/isa? Boolean) (t/isa? Short) (t/isa? Short) (t/isa? Short)] + :output-type (t/or (t/isa? Short) (t/isa? Long))} + {:id 7 :index 7 + :arg-types [(t/isa? Boolean) (t/isa? Character) (t/isa? Short) + (t/isa? Character)] + :output-type (t/or (t/isa? Character) (t/isa? Long))} + {:id 8 :index 8 + :arg-types [(t/isa? Boolean) (t/isa? Character) (t/isa? String) + (t/isa? Character)] + :output-type (t/or (t/isa? Character) (t/isa? Long))} + {:id 9 :index 9 + :arg-types [(t/isa? Boolean) (t/value (t/isa? Integer)) (t/isa? Short) + (t/value (t/isa? Integer))] + :output-type (t/or (t/value (t/isa? Integer)) (t/isa? Long))} + {:id 10 :index 10 + :arg-types [(t/isa? Boolean) (t/value (t/isa? Integer)) (t/isa? String) + (t/value (t/isa? Integer))] + :output-type (t/or (t/value (t/isa? Integer)) (t/isa? Long))} + {:id 11 :index 11 + :arg-types [(t/isa? Boolean) (t/isa? String) (t/isa? String) (t/isa? String)] + :output-type (t/or (t/isa? String) (t/isa? Long))} + {:id 12 :index 12 + :arg-types [(t/isa? Byte) (t/isa? Byte) (t/isa? Short) (t/isa? Short)] + :output-type (t/or (t/isa? Byte) (t/isa? Short) (t/isa? Long))} + {:id 13 :index 13 + :arg-types [(t/isa? Byte) (t/isa? Byte) (t/isa? Short) (t/isa? Character)] + :output-type (t/or (t/isa? Byte) (t/isa? Character) (t/isa? Long))} + {:id 14 :index 14 + :arg-types [(t/isa? Byte) (t/isa? Byte) (t/isa? Short) + (t/value (t/isa? Integer))] + :output-type (t/or (t/isa? Byte) (t/value (t/isa? Integer)) (t/isa? Long))} + {:id 15 :index 15 + :arg-types [(t/isa? Byte) (t/isa? Byte) (t/isa? String) (t/isa? Character)] + :output-type (t/or (t/isa? Byte) (t/isa? Character) (t/isa? Long))} + {:id 16 :index 16 + :arg-types [(t/isa? Byte) (t/isa? Byte) (t/isa? String) + (t/value (t/isa? Integer))] + :output-type (t/or (t/isa? Byte) (t/value (t/isa? Integer)) (t/isa? Long))} + {:id 17 :index 17 + :arg-types [(t/isa? Byte) (t/isa? Byte) (t/isa? String) (t/isa? String)] + :output-type (t/or (t/isa? Byte) (t/isa? String) (t/isa? Long))} + {:id 18 :index 18 + :arg-types [(t/isa? Short) (t/isa? Short) (t/isa? Short) (t/isa? Short)] + :output-type (t/or (t/isa? Short) (t/isa? Long))} + {:id 19 :index 19 + :arg-types [(t/isa? Character) (t/isa? Character) (t/isa? Short) + (t/isa? Character)] + :output-type (t/or (t/isa? Character) (t/isa? Long))} + {:id 20 :index 20 + :arg-types [(t/isa? Character) (t/isa? Character) (t/isa? String) + (t/isa? Character)] + :output-type (t/or (t/isa? Character) (t/isa? Long))} + {:id 21 :index 21 + :arg-types [(t/value (t/isa? Integer)) (t/value (t/isa? Integer)) + (t/isa? Short) (t/value (t/isa? Integer))] + :output-type (t/or (t/value (t/isa? Integer)) (t/isa? Long))} + {:id 22 :index 22 + :arg-types [(t/value (t/isa? Integer)) (t/value (t/isa? Integer)) + (t/isa? String) (t/value (t/isa? Integer))] + :output-type (t/or (t/value (t/isa? Integer)) (t/isa? Long))} + {:id 23 :index 23 + :arg-types [(t/isa? String) (t/isa? String) (t/isa? String) (t/isa? String)] + :output-type (t/or (t/isa? String) (t/isa? Long))}] + (defmeta ~'dependent-extensible + {:quantum.core.type/type dependent-extensible|__type} + ~dependent-extensible|fn|form))))] + (testing "code equivalence" (is-code= actual expected))))) + (testing "reactive type" + (testing "definition" + (let [actual + (doto (binding [self/*compilation-mode* :test] + [(macroexpand ' + (self/defn simple-reactive-dependee ([a tt/char?] 1))) + (macroexpand ' + (self/defn simple-reactive-dependent + ([a (t/input simple-reactive-dependee :?)] "abc")))]) + eval) + expected + (case (env-lang) + :clj ($ [(do (declare ~'simple-reactive-dependee) + (def ~(tag (cstr `C__O) 'simple-reactive-dependee|__0) + (reify* [~(csym `C__O)] (~(O 'invoke) [~'_0__ ~(C 'a)] 1))) + [{:id 0 :index 0 :arg-types [(t/isa? Character)] :output-type t/any?}] + (defmeta ~'simple-reactive-dependee + {:quantum.core.type/type simple-reactive-dependee|__type} + (fn* ([~'x00__] + (ifs ((Array/get simple-reactive-dependee|__0|types 0) ~'x00__) + (. simple-reactive-dependee|__0 ~'invoke ~'x00__) + (unsupported! `simple-reactive-dependee [~'x00__] 0)))))) + (do (declare ~'simple-reactive-dependent) + (def ~(tag (cstr `C__O) 'simple-reactive-dependent|__0) + (reify* [~(csym `C__O)] (~(O 'invoke) [~'_0__ ~(C 'a)] "abc"))) + [{:id 0 :index 0 :arg-types [(t/isa? Character)] :output-type t/any?}] + (defmeta ~'simple-reactive-dependent + {:quantum.core.type/type simple-reactive-dependent|__type} + (fn* ([~'x00__] + (ifs ((Array/get simple-reactive-dependent|__0|types 0) ~'x00__) + (. simple-reactive-dependent|__0 ~'invoke ~'x00__) + (unsupported! `simple-reactive-dependent [~'x00__] 0))))))]))] + (testing "code equivalence" (is-code= actual expected)))) + (testing "advanced (with dependent types) definition" + (let [actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn reactive-extensible + ([a (t/input dependent-extensible :?)]))))]))) + ;; TODO make this into an actual test + (doto (macroexpand '(self/extend-defn! dependent-extensible ([] 5))) + eval)) + +;; ===== Reactive types ===== ;; + +([a (t/or tt/boolean? (t/type b)) + b (t/or tt/byte? (t/type d)) + c (t/or tt/short? tt/string?) + d (let [b (t/- tt/int? tt/long?)] + (t/or tt/char? (t/type b) (t/type c))) + > (t/or (t/type b) (t/type d))]) +-> +;; Imagine this with `let`s, essentially — reference sharing. This is just written out +;; This is just to capture what will require type-recomputation +;; We will still have to analyze the arglist and body every time; we leave as an enhancement a +;; clever way to avoid reanalyzing the arglist every time. It seems that we will have to analyze the +;; body every time though, at least to some extent. + ([a (t/rx (t/or tt/boolean? + (t/arglist-type ; t/arglist-type is always t/>< + (t/or tt/byte? + (t/arglist-type + (t/or tt/char? + (t/- @(t/input* abcde :?) tt/long?) + (t/arglist-type (t/or tt/short? tt/string?)))))))) + b (t/rx (t/or tt/byte? + (t/arglist-type + (t/or tt/char? + (t/- @(t/input* abcde :?) tt/long?) + (t/arglist-type (t/or tt/short? tt/string?)))))) + c (t/or tt/short? tt/string?) + d (t/rx (t/or tt/char? + (t/- @(t/input* abcde :?) tt/long?) + (t/arglist-type (t/or tt/short? tt/string?)))) + > (t/rx (t/or (t/arglist-type + (t/or tt/byte? + (t/arglist-type + (t/or tt/char? + (t/- @(t/input* abcde :?) tt/long?) + (t/arglist-type (t/or tt/short? tt/string?)))))) + (t/or tt/char? + (t/- @(t/input* abcde :?) tt/long?) + (t/arglist-type (t/or tt/short? tt/string?)))))])) + +- Suppose you have: + - (defn- expand-rx-types [rx-types] + (->> rx-types + (c/map+ (fn [{:keys [arg-types out-type]}] + {:arg-types (mapv ?deref arg-types) :out-type (?deref out-type)})) + expand-types)) + - overloads>overload-types + - Shouldn't re-analyze + - Attaches `:overload` for newly analyzed overloads + - (defn- overload-queue-interceptor [_ _ oldv newv] + (let [first-new-id (count oldv)] + (->> newv + (uc/map (fn [x] + (if (-> x :id (>= first-new-id)) + (do (alist-conj! defnt/overload-queue (:overload x)) + ;; to save memory + (dissoc x :overload)) + x)))))) + - (t/defn abcde [a t/int? > t/long?] ...) ; in `ns0` + - Resulting in `abcde`'s compile-time-emission code (assuming no :test mode) as: + - (do ;; These are append-only + ;; TODO need to analyze these bodies in the proper context. Thus can't do `t/defn` + ;; (properly) unless in most "exterior" part of namespace + ;; Yes we could drop `:body` for non-reactive, non-inline overloads but it's fine for + ;; now; we will optimize later after correctness is achieved + ;; Needs to maintain previous fully-derefed version so `overloads>type-decl` knows which + ;; reactive overloads have changed + (intern 'ns0 'abcde|__bases ; CLJS compiler needs this to perform analysis + (rx/! {:norx-prev nil + :current + [{:ns 'ns0 + :args-form nil + :arg-types-basis [t/int?] + :output-type-form nil + :output-type-basis t/long? + :body [...] + :dependent? false + :reactive? false}]})) + ;; Will not re-analyze overload basis if it is identical (`=`?) to the previous version + ;; of that overload (when derefing everything) + ;; Must include the :body and :defined-in-ns of each one in order to analyze and create + ;; new overloads when putting on the overload queue + ;; Internally rx-derefs reactive overloads + ;; CLJS compiler needs this to perform analysis + (intern 'ns0 'abcde|__types + (doto (!rx (overload-bases>type-decl @ns0/abcde|__bases)) + (uref/add-interceptor! :overload-queue overload-queue-interceptor) + urx/norx-deref)) + (intern 'ns0 'abcde|__type + (let [out-type t/any?] + (t/rx (type-data>ftype @ns0/abcde|__types (?deref out-type))))) + ;; Each of these types should be completely unreactive. + (when (= lang :clj) + (intern 'ns0 'abcde|__types|0 + (overload-types>arg-types (rx/norx-deref ns0/abcde|__types) 0)))) + - Resulting in `abcde`'s runtime-emission code in CLJ as: + - (do (def abcde|__0 (reify* [~(csym `I__L)] (invoke ([x00__ a] ...)))) + (defn abcde [x00__] + (ifs ((Array/get ns0/abcde|__types|0 0) x00__) ... + (unsupported! ...)))) + - Resulting in `abcde`'s runtime-emission code in CLJS (assuming runtime type data elision i.e. + no type decl or reactivity etc.) as: + - (do (def abcde|__types|0 (array t/int?)) + (def abcde|__0 (do (deftype* A [] nil (extend-type A Object (invoke ([x00__ a] ...)))) + (new A))) + (defn abcde [x00__] + (ifs ((aget ns0/abcde|__types|0 0) x00__) ... + (unsupported! ...)))) + - (t/defn fghij ; in `ns1` + ([b t/string? > (t/type b)] ...) + ([c (t/input ns0/abcde :?) > (t/output ns0/abcde (t/type c))] ...)) + - Resulting in `fghij`'s compile-time-emission code (assuming no :test mode) as: + - (do (intern 'ns1 'fghij|__bases + (rx/! {:norx-prev nil + :current + [(let [t0 t/string?] + {:ns 'ns1 + :args-form nil + :arg-types-basis [t0] + :output-type|form nil + :output-type|basis t0 + ;; used for inline, and reactive, but could be nil'ed out once it's used + ;; by `overload-bases>type-decl` + :body-codelist [...] + :dependent? true + :reactive? false}) + (let [t0 (t/rx (t/input* @ns0/abcde|__type :?))] + {:ns 'ns1 + ;; This is only present when there is at least one dependent type in the + ;; arglist / output + :args-form (om 'c '(t/input ns0/abcde :?)) + :arg-types-basis [t0] + ;; This is only present when there is at least one dependent type in the + ;; arglist / output + :output-type|form '(t/output ns0/abcde (t/type c)) + :output-type|basis (t/rx (t/output* @ns0/abcde|__type @t0)) + :body-codelist [...] + :dependent? true + :reactive? true})]})) + (intern 'ns1 'fghij|__types + (doto (!rx (overload-bases>type-decl @ns1/fghij|__bases)) + (uref/add-interceptor! :overload-queue overload-queue-interceptor) + urx/norx-deref)) + (intern 'ns1 'fghij|__type + (let [out-type t/any?] + (t/rx (type-data>ftype @ns1/fghij|__types (?deref out-type))))) + ;; Consuming the overload queue in `direct-dispatch` + (when (= lang :clj) + (intern 'ns1 'fghij|__types|0 + (overload-types>arg-types (rx/norx-deref ns1/fghij|__types) 0)))) + - Resulting in `fghij`'s runtime-emission code in CLJ as: + - (do (def fghij|__0 (reify* [~(csym `I__L)] (invoke ([x00__ b] ...)))) + (def fghij|__1 (reify* [~(csym `O__O)] (invoke ([x00__ c] ...)))) + (defn fghij [x00__] + (ifs ((Array/get ns0/fghij|__types|0 0) x00__) (. ns0/fghij|__0 invoke x00__) + (unsupported! ...)))) + - Resulting in `abcde`'s runtime-emission code in CLJS (assuming runtime type data elision i.e. + no type decl or reactivity etc.) as: + - (do (def fghij|__types|0 (array t/int?)) + (def fghij|__0 (do (deftype* B [] nil (extend-type A Object (invoke ([x00__ b] ...)))) + (new B))) + (def fghij|__1 (do (deftype* C [] nil (extend-type A Object (invoke ([x00__ c] ...)))) + (new C))) + (defn fghij [x00__] + (ifs ((aget ns1/fghij|__types|0 0) x00__) (. ns1/fghij|__0 invoke x00__) + (unsupported! ...)))) + - (t/extend-defn! abcde [d t/byte? > t/char?] ...) ; in `ns2` + - Resulting in `abcde`'s compile-time-emission code (assuming no :test mode) as: + - (do (uref/update! ns0/abcde|__bases + (fn [overloads] + {:norx-prev overloads + :current + (join overloads + [{:ns ns2 + :arg-types [t/byte?] + :output-type t/char? + :body-codelist [...] + :dependent? false + :reactive? false}])})) + ;; Not explicitly executed, but this is what happens reactively as + ;; `abcde|__bases` is `update!`ed: + ;; Reactively due to `abcde|__bases` changing + (rx-set! ns0/abcde|__types + [{:id 1 :ns 'ns2 :arg-types [t/byte?] :output-type t/char? :body [...]} + {:id 0 :ns 'ns0 :arg-types [t/int?] :output-type t/long? :body [...]}]) + ;; Reactively in `:overload-queue` watch on `abcde|__types` + (alist-conj! defnt/overload-queue + ['ns0/abcde {:id 1 :ns 'ns2 :arg-types [t/byte?] :output-type t/char? :body [...]}]) + ;; Reactively due to `abcde|__types` changing + (rx-set! ns0/abcde|__type (ftype t/any? [t/byte? :> t/char?] [t/int? :> t/long?])) + ;; Reactively due to `abcde|__type` changing + (rx-set! ns1/fghij|__types + [{:id 2 :ns 'ns1 :arg-types [t/byte?] :output-type t/char? :body [...]} + {:id 0 :ns 'ns1 :arg-types [t/int?] :output-type t/long? :body [...]} + {:id 1 :ns 'ns1 :arg-types [t/string?] :output-type t/string? :body [...]}]) + ;; Reactively in `:overload-queue` watch on `fghij|__types` + (alist-conj! defnt/overload-queue + ['ns1/fghij {:id 2 :ns 'ns1 :arg-types [t/byte?] :output-type t/char? :body [...]}]) + ;; Reactively due to `fghij|__types` changing + (rx-set! fghij|__type (ftype t/any? [t/byte? :> t/char?] [t/int? :> t/long?])) + ;; Consuming the `defnt/overload-queue` (iterate then clear, not incremental pop) + (when (= lang :clj) + (intern 'ns2 'abcde|__types|1 + (overload-types>arg-types (rx/norx-deref ns0/abcde|__types) 1)) + (intern 'ns2 'fghij|__types|2 + (overload-types>arg-types (rx/norx-deref ns1/fghij|__types) 2)))) + - Resulting in `abcde`'s runtime-emission code in CLJ as (easy to adapt for CLJS): + - (do ;; Consuming the `defnt/overload-queue` (iterate then clear, not incremental pop) + (intern 'ns2 'abcde|__1 (reify* [...] (invoke ([x00__ d] ...)))) + (intern 'ns0 'abcde + (fn [x00__] + (ifs ((Array/get ns0/abcde|__types|0 0) x00__) (. ns0/abcde|__0 invoke x00__) + ((Array/get ns2/abcde|__types|1 1) x00__) (. ns2/abcde|__1 invoke x00__) + (unsupported! ...)))) + (intern 'ns2 'fghij|__2 (reify* [...] (invoke ([x00__ b] ...)))) + (intern 'ns1 'fghij + (fn [x00__] + (ifs ((Array/get ns2/fghij|__types|2 0) x00__) (. ns2/fghij|__2 invoke x00__) + ((Array/get ns1/fghij|__types|0 0) x00__) (. ns1/fghij|__0 invoke x00__) + ((Array/get ns1/fghij|__types|1 0) x00__) (. ns1/fghij|__1 invoke x00__) + (unsupported! ...)))) + (var ns0/abcde)) + + + +(deftest test|sort-overload-types + (is-code= (self/sort-overload-types core/identity + [[(t/isa? Boolean) (t/value nil)] + [(t/isa? Double) (t/isa? Byte)] + [(t/isa? Double) (t/isa? Short)] + [(t/isa? Double) (t/isa? Character)] + [(t/isa? Double) (t/isa? Integer)] + [(t/isa? Double) (t/isa? Long)] + [(t/isa? Double) (t/isa? Float)] + [(t/isa? Double) (t/isa? Double)] + [(t/isa? Double) (t/ref (t/isa? Comparable))] + [(t/isa? Double) (t/value nil)] + [(t/value nil) (t/isa? Boolean)] + [(t/value nil) (t/isa? Byte)] + [(t/value nil) (t/isa? Short)] + [(t/value nil) (t/isa? Character)] + [(t/value nil) (t/isa? Integer)] + [(t/value nil) (t/isa? Long)] + [(t/value nil) (t/isa? Float)] + [(t/value nil) (t/isa? Double)] + [(t/value nil) (t/value nil)] + [(t/value nil) (t/not (t/value nil))] + [(t/value true) (t/value false)] + [(t/value true) (t/value true)] + [(t/value false) (t/value false)] + [(t/value false) (t/value true)] + [(t/ref (t/isa? Comparable)) (t/isa? Byte)] + [(t/ref (t/isa? Comparable)) (t/isa? Short)] + [(t/ref (t/isa? Comparable)) (t/isa? Character)] + [(t/ref (t/isa? Comparable)) (t/isa? Integer)] + [(t/ref (t/isa? Comparable)) (t/isa? Long)] + [(t/ref (t/isa? Comparable)) (t/isa? Float)] + [(t/ref (t/isa? Comparable)) (t/isa? Double)] + [(t/ref (t/isa? Comparable)) (t/ref (t/isa? Comparable))]]) + [[(t/value nil) (t/value nil)] + [(t/value nil) (t/isa? Boolean)] + [(t/value nil) (t/isa? Byte)] + [(t/value nil) (t/isa? Short)] + [(t/value nil) (t/isa? Character)] + [(t/value nil) (t/isa? Integer)] + [(t/value nil) (t/isa? Long)] + [(t/value nil) (t/isa? Float)] + [(t/value nil) (t/isa? Double)] + [(t/value nil) (t/not (t/value nil))] + [(t/isa? Boolean) (t/value nil)] + [(t/isa? Double) (t/value nil)] + [(t/isa? Double) (t/isa? Byte)] + [(t/isa? Double) (t/isa? Short)] + [(t/isa? Double) (t/isa? Character)] + [(t/isa? Double) (t/isa? Integer)] + [(t/isa? Double) (t/isa? Long)] + [(t/isa? Double) (t/isa? Float)] + [(t/isa? Double) (t/isa? Double)] + [(t/value true) (t/value true)] + [(t/value true) (t/value false)] + [(t/value false) (t/value true)] + [(t/value false) (t/value false)] + [(t/ref (t/isa? Comparable)) (t/isa? Byte)] + [(t/ref (t/isa? Comparable)) (t/isa? Short)] + [(t/isa? Double) (t/ref (t/isa? Comparable))] + [(t/ref (t/isa? Comparable)) (t/isa? Character)] + [(t/ref (t/isa? Comparable)) (t/isa? Integer)] + [(t/ref (t/isa? Comparable)) (t/isa? Long)] + [(t/ref (t/isa? Comparable)) (t/isa? Float)] + [(t/ref (t/isa? Comparable)) (t/isa? Double)] + [(t/ref (t/isa? Comparable)) (t/ref (t/isa? Comparable))]])) + +(defn- test|fn|gen-dynf [n hintf0 hintf1 unsupported-sym] + (let [ts (O<> (symbol (str "ts" n "__"))) + fs (O<> (symbol (str "fs" n "__"))) + x (symbol (str "x0" n "__"))] + `(fn* ([~(O<> ts) ~(O<> fs) ~x] + (ifs (~(aget* (O<> (aget* ts 0)) 0) ~x) + (. ~(hintf0 (aget* (O<> fs) 0)) ~'invoke ~x) + (~(aget* (O<> (aget* ts 1)) 0) ~x) + (. ~(hintf1 (aget* (O<> fs) 1)) ~'invoke ~x) + (unsupported! ~(list 'quote unsupported-sym) [~x] 0)))))) + +(defn- test|fn|reify-body [hintf0 i0 hintf1 i1] + (O `(do ~'b + ~(O `(. ~(hintf0 (aget* `(. ~(tag (cstr `TypedFn) 'f1|test) ~'getFs) i0)) ~'invoke ~'a)) + ~(O `(. ~(hintf1 (aget* `(. ~(tag (cstr `TypedFn) 'f1|test) ~'getFs) i1)) ~'invoke ~'c))))) + +(deftest test|fn + (testing "Nested fns" + (let [actual (binding [self/*compilation-mode* :test] + (macroexpand ' + ;: FIXME this contract is not being held up when returning nil + (self/defn f0|test [a (t/or tt/boolean? tt/double?) + ;> (t/ftype [tt/byte? :> (t/ftype [tt/char?])]) + ] + ;; TODO this fits into a larger scheme of, should we have output types be + ;; `(t/and actual declared)` or should we just have them be `declared`? The + ;; latter is easier but it seems like the `t/fn` dispatch forces our hand + ;; towards the former. We need to think about this more. + (self/fn [b (t/or tt/byte? tt/char?) + ;> (t/ftype [(t/or (t/type a) tt/short?)]) + ] + (self/fn f1|test [c (t/or (t/type a) tt/short?)] + b (f1|test a) (f1|test c)))))) + expected + (case (env-lang) + :clj + ($ (do (defmeta-from ~'f0|test + (let* [~'f0|test|__fs (*<>|sized 2) + ~'f0|test + (new TypedFn + {:quantum.core.type/type f0|test|__type} + f0|test|__ts + ~'f0|test|__fs + ~(test|fn|gen-dynf 6 >B__O >D__O `f0|test))] + ~(aset* 'f0|test|__fs 0 + `(reify* [~(csym `B__O)] + (~(O 'invoke) [~'_12__ ~(B 'a)] + ;; From `(self/fn [b ...])` + (let* [~'__anon0__|__fs (*<>|sized 2) + ~'__anon0__ + (new TypedFn nil + (*<> (*<> t/byte?) (*<> t/char?)) + ~'__anon0__|__fs + ~(test|fn|gen-dynf 2 >Y__O >C__O '))] + ~(aset* '__anon0__|__fs 0 + `(reify* [~(csym `Y__O)] + (~(O 'invoke) [~'_4__ ~(Y 'b)] + ;; From `(self/fn [c ...])` + (let* [~'f1|test|__fs (*<>|sized 2) + ~'f1|test + (new TypedFn nil + (*<> (*<> t/boolean?) (*<> t/short?)) + ~'f1|test|__fs + ~(test|fn|gen-dynf 0 >B__O >S__O 'f1|test))] + ~(aset* 'f1|test|__fs 0 + `(reify* [~(csym `B__O)] + (~(O 'invoke) [~'_0__ ~(B 'c)] + ~(test|fn|reify-body >B__O 0 >B__O 0)))) + ~(aset* 'f1|test|__fs 1 + `(reify* [~(csym `S__O)] + (~(O 'invoke) [~'_1__ ~(S 'c)] + ~(test|fn|reify-body >B__O 0 >S__O 1)))) + ~'f1|test)))) + ~(aset* '__anon0__|__fs 1 + `(reify* [~(csym `C__O)] + (~(O 'invoke) [~'_5__ ~(C 'b)] + ;; From `(self/fn [c ...])` + (let* [~'f1|test|__fs (*<>|sized 2) + ~'f1|test + (new TypedFn nil + (*<> (*<> t/boolean?) (*<> t/short?)) + ~'f1|test|__fs + ~(test|fn|gen-dynf 1 >B__O >S__O 'f1|test))] + ~(aset* 'f1|test|__fs 0 + `(reify* [~(csym `B__O)] + (~(O 'invoke) [~'_2__ ~(B 'c)] + ~(test|fn|reify-body >B__O 0 >B__O 0)))) + ~(aset* 'f1|test|__fs 1 + `(reify* [~(csym `S__O)] + (~(O 'invoke) [~'_3__ ~(S 'c)] + ~(test|fn|reify-body >B__O 0 >S__O 1)))) + ~'f1|test)))) + ~'__anon0__)))) + ~(aset* 'f0|test|__fs 1 + `(reify* [~(csym `D__O)] + (~(O 'invoke) [~'_13__ ~(D 'a)] + ;; From `(self/fn [b ...])` + (let* [~'__anon3__|__fs (*<>|sized 2) + ~'__anon3__ + (new TypedFn nil + (*<> (*<> t/byte?) (*<> t/char?)) + ~'__anon3__|__fs + ~(test|fn|gen-dynf 5 >Y__O >C__O '))] + ~(aset* '__anon3__|__fs 0 + `(reify* [~(csym `Y__O)] + (~(O 'invoke) [~'_10__ ~(Y 'b)] + ;; From `(self/fn [c ...])` + (let* [~'f1|test|__fs (*<>|sized 2) + ~'f1|test + (new TypedFn nil + (*<> (*<> t/short?) (*<> t/double?)) + ~'f1|test|__fs + ~(test|fn|gen-dynf 3 >S__O >D__O 'f1|test))] + ~(aset* 'f1|test|__fs 0 + `(reify* [~(csym `S__O)] + (~(O 'invoke) [~'_6__ ~(S 'c)] + ~(test|fn|reify-body >D__O 1 >S__O 0)))) + ~(aset* 'f1|test|__fs 1 + `(reify* [~(csym `D__O)] + (~(O 'invoke) [~'_7__ ~(D 'c)] + ~(test|fn|reify-body >D__O 1 >D__O 1)))) + ~'f1|test)))) + ~(aset* '__anon3__|__fs 1 + `(reify* [~(csym `C__O)] + (~(O 'invoke) [~'_11__ ~(C 'b)] + ;; From `(self/fn [c ...])` + (let* [~'f1|test|__fs (*<>|sized 2) + ~'f1|test + (new TypedFn nil + (*<> (*<> t/short?) (*<> t/double?)) + ~'f1|test|__fs + ~(test|fn|gen-dynf 4 >S__O >D__O 'f1|test))] + ~(aset* 'f1|test|__fs 0 + `(reify* [~(csym `S__O)] + (~(O 'invoke) [~'_8__ ~(S 'c)] + ~(test|fn|reify-body >D__O 1 >S__O 0)))) + ~(aset* 'f1|test|__fs 1 + `(reify* [~(csym `D__O)] + (~(O 'invoke) [~'_9__ ~(D 'c)] + ~(test|fn|reify-body >D__O 1 >D__O 1)))) + ~'f1|test)))) + ~'__anon3__)))) + ~'f0|test)))))] + (testing "code equivalence" (is-code= actual expected)) + (testing "functionality" + (eval actual) + (eval '((f0|test true) \A))))) + (testing "Calling fns" + (eval '(self/defn g|test [f0 (t/ftype [tt/long? :> tt/float?]) > tt/float?] (f0 5))) + (eval '(self/defn h|test [f0 (t/ftype [tt/string? :> tt/char?]) > (t/type f0)] f0)) + (eval '(self/defn i|test [f0 (t/ftype' [tt/string? :> tt/char?]) > (t/type f0)] f0)) + (let [j|test|actual + (binding [self/*compilation-mode* :test] + (macroexpand ' + (self/defn j|test [f0 (t/ftype [tt/long? :> tt/float?] + [tt/string? :> tt/char?]) + f1 (t/ftype [tt/byte? :> tt/boolean?] + [tt/long? :> tt/char?] + [tt/string? :> tt/char?]) + f2 (t/ftype' [tt/long? :> tt/float?]) + > tt/char?] + (f0 7) + (f1 21) + (g|test f0) + ((h|test f0) "63") + ;; This won't compile + #_((i|test f0) "98") + ((i|test ^:wrap f0) "98") + (j|test f1 f0) + ;; FIXME for `t/ftype` comparison: what if `f1` also has the overload + ;; `[(t/and tt/string? (fn-> count (= 2))) :> tt/double?]`? + ;; Then yes `f1` accepts at least `tt/string?`, which outputs no more than + ;; `tt/boolean?`, but it's not clear whether `tt/double?` or `tt/char?` gets + ;; output + (f1 "11")))) + expected + (case (env-lang) + :clj + ($ (do (defmeta-from ~'g|test + (let* [~'g|test|__fs (*<>|sized 1) + ~'g|test + (new TypedFn + {:quantum.core.type/type ~'g|__type} + ... + ~'g|test|__fs + (fn* ([~&ts ~&fs ~'x00] + (ifs (~(aget* (aget* &ts 0) 0) ~'x00__) + (. ~(aget* &fs 0) ~'invoke ~'x00__) + (unsupported! `g|test [~'x00__] 0)))))] + ~(aset* g|test|__fs 0 + `(reify* [~(csym `OI__F)] + (~'invoke [~&this ~(O 'f0)] (~'f0 5)))) + ~'g|test)) + (defmeta-from ~'h|test + (let* [~'h|test|__fs (*<>|sized 1) + ~'h|test + (new TypedFn + {:quantum.core.type/type ~'h|__type} + ... + ~'h|test|__fs + (fn* ([~&ts ~&fs ~'x00] + (ifs (~(aget* (aget* &ts 0) 0) ~'x00__) + (. ~(aget* &fs 0) ~'invoke ~'x00__) + (unsupported! `h|test [~'x00__] 0)))))] + ~(aset* h|test|__fs 0 + `(reify* [~(csym `O__O)] + (~'invoke [~&this ~(O 'f0)] f0))) + ~'h|test)) + (defmeta-from ~'i|test + (let* [~'i|test|__fs (*<>|sized 1) + ~'i|test + (new TypedFn + {:quantum.core.type/type ~'i|__type} + ... + ~'i|test|__fs + (fn* ([~&ts ~&fs ~'x00] + (ifs (~(aget* (aget* &ts 0) 0) ~'x00__) + (. ~(aget* &fs 0) ~'invoke ~'x00__) + (unsupported! `i|test [~'x00__] 0)))))] + ~(aset* i|test|__fs 0 + `(reify* [~(csym `O__O)] + (~'invoke [~&this ~(O 'f0)] f0))) + ~'i|test)) + ;; to avoid var indirection + (let* [~'g|test|__ (deref ~(list 'var `g|test)) + ~'h|test|__ (deref ~(list 'var `h|test)) + ~'i|test|__ (deref ~(list 'var `i|test))] + (defmeta-from ~'j|test + (let* [~'j|test|__fs (*<>|sized 1) + ~'j|test + (new TypedFn + {:quantum.core.type/type ~'j|__type} + ... + ~'j|test|__fs + (fn* ([~&ts ~&fs ~'x00__ ~'x01__] + (ifs (~(aget* (aget* &ts 0) 0) ~'x00__) + (ifs (~(aget* (aget* &ts 0) 1) ~'x00__) + (. ~(aget* &fs 0) ~'invoke ~'x00__ ~'x01__) + (unsupported! `j|test [~'x00__ ~'x01__] 1)) + (unsupported! `j|test [~'x00__ ~'x01__] 0)))))] + ;; NOTE we could accommodate for the situation in which a reify overload gets + ;; redefined (same ID): to ensure the interface stays the same, we could + ;; ensure that each interface has (arbitrarily) up to 10 extra params, with an + ;; int array as the last extra param which is then unpacked. However, this + ;; would not accommodate for the facts that 1) the meaning of each int param + ;; could change, and even if this were able to be controlled, 2) existing call + ;; sites using that overload would either have too many or few params. Of + ;; course, we could add a default interface implementation for every supported + ;; arity, each one of which would curry in the params to the actually + ;; implemented arity (there are other ways too probably). But it just seems + ;; like a lot of overhead with not too much gain. + ;; (reify* [~(csym `OOIII__C)] + ;; (~'invoke [~&this ~(O 'f0) ~(O 'f1) + ;; ~(I 'i__0) ; overload ID of `f0` : `[tt/long?]` + ;; ~(I 'i__2) ; overload ID of `f1` : `[tt/long?]` + ;; ~(I 'i__5)] ; overload ID of `f1` : `[tt/string?]` + ;; ...)) + ~(aset* j|test|__fs 0 + `(reify* [~(csym `OO__C)] + (~'invoke [~&this ~(O 'f0) ~(O 'f1)] + (~'f0 7) + (. ~(aget* `(. ~'f2 ~'fs) 0) ~'invoke 21) + ;; - It doesn't just refer to `g|test|__fs` or whatever because the fn + ;; in question (`g|test`) is extensible. Otherwise it would skip the + ;; ceremony of `(aget* `(. ~'g|test|__ ~'fs) 0)` and just do e.g. + ;; `g|test|__0`. + (. ~(aget* `(. ~'g|test|__ ~'fs) 0) ~'invoke ~'f0) + ;; We need to know how to call the resulting fn and the callee can't + ;; provide that information to all callers. So we have to make this call + ;; dynamic, sadly. + ((. ~(aget* `(. ~'h|test|__ ~'fs) 0) ~'invoke ~'f0) "63") + (. ~(aget* `(. ~(aget* `(. ~'i|test|__ ~'fs) 0) ~'invoke + ;; Two arrays (`ts` — two arrays, `fs` — two `reify`s), + ;; one `TypedFunction` object. Not super cheap + (self/fn ([~'x0__ tt/long? ~'> tt/float?] (f0 x0__)) + ([~'x0__ tt/string? ~'> tt/char?] (f0 x0__)))) + 1) + ~'invoke "98") + ;; - It doesn't just refer to `j|test|__fs` because the fn in question + ;; (`j|test`) is extensible. Otherwise it would skip the ceremony of + ;; `(aget* `(. ~'j|test|__f ~'fs) 0)` and just do e.g. `j|test|__0`. + (. ~(aget* `(. ~'j|test ~'fs) 0) ~'invoke ~'f1 ~'f0) + ;; - Knows that calling `f1` with `["11"]` means: + ;; - We need to know overload ID of `f1` with input types + ;; `[tt/string?]` + (f1 "11")))) + ~'j|test)))))))] + ...))) + +;; Automatically analyzes the body of `fnt?`s which have at least one input of `t/fn?` +;; Meaning, the body is analyzed as if inline, but if not marked `inline`, will intern a separate fn +;; for the purpose +(t/defn- apply* [f (t/meta-or t/fnt? t/fn?), !xs !alist?] + (case (count !xs) + 0 (f !xs) + 1 (f (get !xs 0)) + 2 (f (get !xs 0) (get !xs 1)) + 3 (f (get !xs 0) (get !xs 1) (get !xs 2)) + 4 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3)) + 5 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4)) + 6 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5)) + 7 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6)) + 8 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7)) + 9 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 8)) + 10 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 8) (get !xs 9)) + 11 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 8) (get !xs 9) + (get !xs 10)) + 12 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 8) (get !xs 9) + (get !xs 10) (get !xs 11)) + 13 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 9) (get !xs 10) + (get !xs 10) (get !xs 11) (get !xs 12)) + 14 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 9) (get !xs 10) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13)) + 15 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 9) (get !xs 10) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13) (get !xs 14)) + 16 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 9) (get !xs 10) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13) (get !xs 14) + (get !xs 15)) + 17 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 9) (get !xs 10) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13) (get !xs 14) + (get !xs 15) (get !xs 16)) + 18 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 9) (get !xs 10) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13) (get !xs 14) + (get !xs 15) (get !xs 16) (get !xs 17)) + 19 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 9) (get !xs 10) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13) (get !xs 14) + (get !xs 15) (get !xs 16) (get !xs 17) (get !xs 18)) + 20 (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 8) (get !xs 9) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13) (get !xs 14) + (get !xs 15) (get !xs 16) (get !xs 17) (get !xs 18) (get !xs 19)) + (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 8) (get !xs 9) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13) (get !xs 14) + (get !xs 15) (get !xs 16) (get !xs 17) (get !xs 18) (get !xs 19) + (let [variadic-ct (-> !xs count (- 20)) + !variadics (<>*|ct variadic-ct)] + (loops/dotimes [i variadic-ct] + (assoc! !variadics i (get !xs i))))))) + +;; Assuming collections.core is available +(t/defn ^:inline apply + ([f fn?, xs reducible?] + (apply* f (>!alist xs))) + ([f fn?, x0 ?, xs reducible?] + (apply* f (join! (!alist x0) xs))) + ([f fn?, x0 ?, x1 ?, xs reducible?] + (apply* f (join! (!alist x0 x1) xs))) + ([f fn?, x0 ?, x1 ?, x2 ?, xs reducible?] + (apply* f (join! (!alist x0 x1 x2) xs))) + ([f fn?, x0 ?, x1 ?, x2 ?, x3 ? & xs reducible?] + (apply* f (join! (!alist x0 x1 x2 x3) xs)))) + +;; Now *this* is where type inference would come in handy... +(self/defn comp + (^:inline [> (t/value identity)] identity) + (^:inline [f0 t/fnt? > (t/type f0)] f0) + ([f0 (t/ftype [(t/output f1 :any)]), f1 t/fnt?] + (self/fn + ([] + (f0 (f1))) + ([x0 (t/input f1 :?)] + (f0 (f1 x0))) + ([x0 (t/input f1 :? :_), x1 (t/input g (t/type x0) :?)] + (f0 (f1 x0 x1))) + ([x0 (t/input f1 :? :_ :_) + x1 (t/input f1 (t/type x0) :? :_) + x2 (t/input f1 (t/type x0) (t/type x1) :?)] + (f0 (f1 x0 x1 x2))) + ([x0 (t/input f1 :? :&) + x1 (t/input f1 (t/type x0) :? :&) + x2 (t/input f1 (t/type x0) (t/type x1) :? :&) + & xs (t/input f1 (t/type x0) (t/type x1) (t/type x2) :?&)] + (f0 (apply f1 x0 x1 x2 xs))))) + ([f0 f1 & fs] (reduce1 comp (list* f0 f1 fs)))) + +(self/defn comp + ;; `> ?` is everywhere implied + (^:inline [] identity) + (^:inline [f0 t/fnt?] f0) + ([f0 ?, f1 ?] + (self/fn + ([] (f0 (f1))) + ([x0 ?] (f0 (f1 x0))) + ([x0 ?, x1 ?] (f0 (f1 x0 x1))) + ([x0 ?, x1 ?, x2 ?] (f0 (f1 x0 x1 x2))) + ([x0 ?, x1 ?, x2 ?, xs ?] (f0 (apply f1 x0 x1 x2 xs)))))) + +;; Type inference would come in handy here too +(self/defn aritoid + ([f0 (t/ftype []) + > (t/ftype [:> (t/output f0)])] + (self/fn ([> (t/output f0)] (f0)))) + ([f0 (t/ftype []) + f1 (t/ftype [t/eps?]) ; needs to be `t/eps?` meaning just an 'epsilon' above `t/none?` in order to be a valid input, but still `t/<` w.r.t. everything else + > (t/ftype [:> (t/output f0)] + [:> (t/output f1 :_)])] + (self/fn ([> (t/output f0)] (f0)) + ([x0 (t/input f1 :?) + > (t/output f1 (t/type x0))] (f1 x0)))) + ([f0 (t/ftype []) + f1 (t/ftype [t/none?]) + f2 (t/ftype [t/none? t/none?]) + > (t/ftype [:> (t/output f0)] + [:> (t/output f1 :_)] + [:> (t/output f2 :_ :_)])] + (self/fn ([> (t/output f0)] (f0)) + ([x0 (t/input f1 :?) + > (t/output f1 (t/type x0))] (f1 x0)) + ([x0 (t/input f2 :? :_) + x1 (t/input f2 (t/type x0) :?) + > (t/output f1 (t/type x0) (t/type x1))] (f2 x0 x1))))) + +(self/defn aritoid + ;; `> ?` is everywhere implied + ([f0 ?] + (self/fn ([] (f0)))) + ([f0 ?, f1 ?] + (self/fn ([] (f0)) + ([x0 ?] (f1 x0)))) + ([f0 ?, f1 ?, f2 ?] + (self/fn ([] (f0)) + ([x0 ?] (f1 x0)) + ([x0 ?, x1 ?] (f2 x0 x1))))) + +;; ===== Inner expansion ===== ;; + +(t/dotyped (apply inc [1])) +-> (let* [f inc, xs [1]] + (apply* f (>!alist xs))) +-> (let* [f inc, xs [1]] + (let* [!xs (>!alist xs)] + ;; This part isn't really analyzed in whole; just `(count !xs)` first + (case (count !xs) ; figures out that the count is 1 + 0 (f !xs) + 1 (f (get !xs 0)) + ...))) +-> (let* [f inc, xs [1]] + (let* [f f, !xs (>!alist xs)] + (f (get !xs 0)))) ; maybe it could figure out that `(get !xs 0)` yields `1`? +A -> (let* [f inc, xs [1]] + (let* [f f, !xs (>!alist xs)] + (f (.get !xs 0)))) +B -> (let* [f inc, xs [1]] + (let* [f f, !xs (>!alist xs)] ; eliminate unused, non-side-effecting (since fn `>!alist` not marked with `:!`) param (`!xs`). Don't warn about unused param since this is only in an "inner expansion" + (f 1))) + -> (let* [f inc, xs [1]] + (let* [f f] ; eliminate iso-binding + (f 1))) + -> (let* [f inc, xs [1]] (f 1)) ; eliminate unused, non-side-effecting (since fn `>!alist` not marked with `:!`) binding (`xs`). Don't warn about unused param since this is only in an "inner expansion" + -> (inc 1) + -> 2 + +(t/dotyped (apply + (range 25))) +-> (apply + (clojure.lang.LongRange/create 25)) ; retains metadata about count, etc. +-> (let* [f +, xs (clojure.lang.LongRange/create 25)] + (apply* f (>!alist xs))) ; expanded because `(t/type f)` `t/<` `(t/type apply.f)` +-> (let* [f +, xs (clojure.lang.LongRange/create 25)] + (let* [!xs (>!alist xs)] + ;; This part isn't really analyzed in whole; just `(count !xs)` first + (case (count !xs) ; figures out that the count is 25 + ... + ;; This is not supposed to be inlined, just held out + (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 8) (get !xs 9) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13) (get !xs 14) + (get !xs 15) (get !xs 16) (get !xs 17) (get !xs 18) (get !xs 19) + (let [variadic-ct (-> !xs count (- 20)) + !variadics (<>*|ct variadic-ct)] + (loops/dotimes [i variadic-ct] + (assoc! !variadics i (get !xs i)))))))) +-> (let* [f +, xs (clojure.lang.LongRange/create 25)] + (let* [!xs (>!alist xs)] ; knows the count is 25 + ;; This is not supposed to be inlined, just held out + (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 8) (get !xs 9) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13) (get !xs 14) + (get !xs 15) (get !xs 16) (get !xs 17) (get !xs 18) (get !xs 19) + (let [variadic-ct (-> 25 (- 20)) + !variadics (<>*|ct variadic-ct)] + (loops/dotimes [i variadic-ct] + (assoc! !variadics i (get !xs i))))))) +-> (let* [f +, xs (clojure.lang.LongRange/create 25)] + (let* [!xs (>!alist xs)] ; knows the count is 25 + ;; This is not supposed to be inlined, just held out + (f (get !xs 0) (get !xs 1) (get !xs 2) (get !xs 3) (get !xs 4) + (get !xs 5) (get !xs 6) (get !xs 7) (get !xs 8) (get !xs 9) + (get !xs 10) (get !xs 11) (get !xs 12) (get !xs 13) (get !xs 14) + (get !xs 15) (get !xs 16) (get !xs 17) (get !xs 18) (get !xs 19) + (let [variadic-ct 5 + !variadics (<>*|ct variadic-ct)] + (loops/dotimes [i variadic-ct] + (assoc! !variadics i (get !xs i))))))) +-> (let* [f +, xs (clojure.lang.LongRange/create 25)] + (let* [!xs (>!alist xs)] ; knows the count is 25 + ;; - This is not supposed to be inlined, just held out + ;; - Splices in the inlined fns here + (f (. !xs get 0) (. !xs get 1) (. !xs get 2) (. !xs get 3) (. !xs get 4) + (. !xs get 5) (. !xs get 6) (. !xs get 7) (. !xs get 8) (. !xs get 9) + (. !xs get 10) (. !xs get 11) (. !xs get 12) (. !xs get 13) (. !xs get 14) + (. !xs get 15) (. !xs get 16) (. !xs get 17) (. !xs get 18) (. !xs get 19) + (let [variadic-ct 5 + !variadics (<>*|ct variadic-ct)] + (loops/dotimes [i variadic-ct] ; this will of course be expanded too + (let* [!xs !variadics] + (do (. RT aset !xs i (. !xs get i)) + !xs))))))) +;; Assumes it's at a top-level place in the ns since `dotyped` was invoked in an untyped context +-> (let* [apply*|expansion|__0 + (reify* [OO__O] + (invoke [&this f !xs] + (let* [^ArrayList !xs !xs] + (f (. !xs get 0) (. !xs get 1) (. !xs get 2) (. !xs get 3) (. !xs get 4) + (. !xs get 5) (. !xs get 6) (. !xs get 7) (. !xs get 8) (. !xs get 9) + (. !xs get 10) (. !xs get 11) (. !xs get 12) (. !xs get 13) (. !xs get 14) + (. !xs get 15) (. !xs get 16) (. !xs get 17) (. !xs get 18) (. !xs get 19) + (let [variadic-ct 5 + !variadics (<>*|ct variadic-ct)] + (loops/dotimes [i variadic-ct] ; this will of course be expanded too + (let* [!xs !variadics] + (do (. RT aset !xs i (. !xs get i)) + !xs))))))))] + (let* [f +, xs (clojure.lang.LongRange/create 25)] + (let* [!xs (>!alist xs)] + (. apply*|expansion|__0 invoke f !xs)))) + +(t/fn [] (apply + (range 25))) +-> ;; because nothing is "higher" than the `t/fn` + ;; TODO what if it's defined in an untyped context not in the ns? + (let* [apply*|expansion|__0 ...] + (reify* [...] + (invoke [...] + (let* [f +, xs (clojure.lang.LongRange/create 25)] + (let* [!xs (>!alist xs)] + (. apply*|expansion|__0 invoke f !xs)))))) + +(t/defn abc [] (t/fn [] (apply + (range 25)))) +-> ;; derives from a queue-like collection of expansions found while analyzing `abc` + (let* [apply*|expansion|__0 ...] + ... + (reify* [...] + (invoke [...] + (t/fn [] + (let* [f +, xs (clojure.lang.LongRange/create 25)] + (let* [!xs (>!alist xs)] + (. apply*|expansion|__0 invoke f !xs))))))) + + +(t/defn test|apply [xs reducible?] + (apply inc xs)) +-> (t/defn test|apply [xs reducible?] + (let* [f inc, xs xs] + (apply* inc (>!alist xs)))) +-> Not analyzed because `reducible?` (type of `xs`) is not `t/<` `reducible?` (type of `apply*.xs`) + +;; TODO Lazy compilation? Maybe just before the typed context when it gets used is when it can be compiled + +(t/defn map|transducer [f t/fnt?] + (t/fn [rf ?] + (^:inline t/fn + ([] (rf)) + ([ret ?] (rf ret)) + ([ret ?, input ?] + (rf ret (f input)))))) + +(t/defn reduce + (^:inline [rf rf?, init t/ref?, xs (t/isa? IReduce)] + (.reduce xs rf init))) ; .reduce on IReduce will be handled specially + +(t/defn transduce [xf ?, rf ?, init ?, xs ?] + (let [f (xf rf) + ret (reduce f init xs)] + (f ret))) + +(t/dotyped (transduce (map|transducer inc) conj [1 2])) +-> (transduce + ;; inner expansion + (let* [f inc] + ;; `?` are resolved + (t/fn [rf (t/ftype [] [t/any?] [t/any? (t/input f :?)])] + (^:inline t/fn + ;; We avoid resolving `?` return types since the body may change + ([] (rf)) + ([ret (t/input rf :?)] (rf ret)) + ([ret (t/input rf :? (t/output f (t/type x))), x (t/input f :?)] + (rf ret (f x)))))) + conj + [] + [1 2]) +-> ;; inner expansion + (let* [xf (let* [f inc] + (t/fn [rf (t/ftype [] [t/any?] [t/any? (t/input f :?)])] + (^:inline t/fn + ([] (rf)) + ([ret (t/input rf :?)] (rf ret)) + ([ret (t/input rf :? (t/output f (t/type x))), x (t/input f :?)] + (rf ret (f x)))))) + rf conj + init [] + xs [1 2]] + (let* [f (xf rf) + ret (reduce f init xs)] + (f ret))) +-> (let* [xf (let* [f inc] + (t/fn [rf (t/ftype [] [t/any?] [t/any? (t/input f :?)])] + (^:inline t/fn + ([] (rf)) + ([ret (t/input rf :?)] (rf ret)) + ([ret (t/input rf :? (t/output f (t/type x))), x (t/input f :?)] + (rf ret (f x)))))) + rf conj + init [] + xs [1 2]] + (let* [f ;; inner expansion + (let* [f inc] + ;; elides isobindings so no additional `let*` + (^:inline t/fn + ([] (rf)) + ([ret (t/input rf :?)] (rf ret)) + ([ret (t/input rf :? (t/output f (t/type x))), x (t/input f :?)] + (rf ret (f x))))) + ret (reduce f init xs)] + (f ret))) +-> (let* [xf (let* [f inc] + (t/fn [rf (t/ftype [] [t/any?] [t/any? (t/input f :?)])] + (^:inline t/fn + ([] (rf)) + ([ret (t/input rf :?)] (rf ret)) + ([ret (t/input rf :? (t/output f (t/type x))), x (t/input f :?)] + (rf ret (f x)))))) + rf conj + init [] + xs [1 2]] + (let* [f (let* [f inc] + (^:inline t/fn + ([] []) ; expanded from `(conj)` + ([ret (t/input rf :?)] ret) ; expanded from `(conj ret)` + ([ret (t/input rf :? (t/output f (t/type x))), x (t/input f :?)] + (rf ret (f x))))) + ret (.reduce xs f init)] ; inlined; elides isobindings so no `let*` + (f ret))) +-> (let* [xf (let* [f inc] + (t/fn [rf (t/ftype [] [t/any?] [t/any? (t/input f :?)])] + (^:inline t/fn + ([] (rf)) + ([ret (t/input rf :?)] (rf ret)) + ([ret (t/input rf :? (t/output f (t/type x))), x (t/input f :?)] + (rf ret (f x)))))) + rf conj + init [] + xs [1 2]] + (let* [f (let* [f inc] + (^:inline t/fn + ([] []) + ([ret (t/input rf :?)] ret) + ([ret (t/input rf :? (t/output f (t/type x))) + x (t/and (t/input f :?) (t/element xs))] ; throw if `t/none?` results + ;; because the class of `x` was determined + (let* [x (. Numbers uncheckedLongCast x)] + (rf ret (. Numbers inc x)))))) + ;; `.reduce` is handled specially and does type checking ahead of time on `f` to avoid + ;; runtime checks as much as possible + ret (.reduce xs + (c/fn [ret x] + (let* [x (. Numbers uncheckedLongCast x)] + (rf ret (. Numbers inc x)))) + init)] + (f ret))) +-> (let* [xf (let* [f inc] + (t/fn [rf (t/ftype [] [t/any?] [t/any? (t/input f :?)])] + (^:inline t/fn + ([] (rf)) + ([ret (t/input rf :?)] (rf ret)) + ([ret (t/input rf :? (t/output f (t/type x))), x (t/input f :?)] + (rf ret (f x)))))) + rf conj + init [] + xs [1 2]] + (let* [f (let* [f inc] + (^:inline t/fn + ([] []) + ([ret (t/input rf :?)] ret) + ([ret (t/input rf :? (t/output f (t/type x))) + x (t/and (t/input f :?) (t/element xs))] ; throw if `t/none?` results + ;; because the class of `x` was determined + (let* [x (. Numbers uncheckedLongCast x)] + (rf ret (. Numbers inc x)))))) + ;; `.reduce` is handled specially and does type checking ahead of time on `f` to avoid + ;; runtime checks as much as possible + ret (.reduce xs + (c/fn [ret x] + (let* [x (. Numbers uncheckedLongCast x)] + (rf ret (. Numbers inc x)))) + init)] + ret)) +-> (let* [xf (let* [f inc] + (t/fn [rf (t/ftype [] [t/any?] [t/any? (t/input f :?)])] + (^:inline t/fn + ([] (rf)) + ([ret (t/input rf :?)] (rf ret)) + ([ret (t/input rf :? (t/output f (t/type x))), x (t/input f :?)] + (rf ret (f x)))))) + rf conj + init [] + xs [1 2]] + (let* [f (let* [f inc] + ;; TODO need to analyze this as if we're doing: + ;; (loop [i 0, ret init] + ;; (if (>= i (count xs)) + ;; ret + ;; (let* [x (nth xs)] (recur (below-fn ret x))))) + (^:inline t/fn + ([] []) + ([;; throws if `t/none?` results + ret (t/and (t/input rf :?) + ...)] ret) + ([;; throws if `t/none?` results + ret (t/and (t/input rf :? (t/output f (t/type x))) + (t/or (t/type init) + ...)) + ;; throws if `t/none?` results + x (t/and (t/input f :?) (t/element xs))] + ;; because the class of `x` was determined + (let* [x (. Numbers uncheckedLongCast x)] + (rf ret (. Numbers inc x))))))] + (.reduce xs + (c/fn [ret x] + (let* [x (. Numbers uncheckedLongCast x)] + (. conj|__0 invoke ret (. Numbers inc x)))) + init))) +-> (let* [xf (let* [f inc] + (t/fn [rf (t/ftype [] [t/any?] [t/any? (t/input f :?)])] + (^:inline t/fn + ([] (rf)) + ([ret (t/input rf :?)] (rf ret)) + ([ret (t/input rf :? (t/output f (t/type x))), x (t/input f :?)] + (rf ret (f x)))))) + rf conj + init [] + xs [1 2]] + (.reduce xs + (c/fn [ret x] + (let* [x (. Numbers uncheckedLongCast x)] + (rf ret (. Numbers inc x)))) + init)) +-> (let* [init [] + xs [1 2]] + (.reduce xs + (c/fn [ret x] + (let* [x (. Numbers uncheckedLongCast x)] + (. conj|__0 invoke ret (. Numbers inc x)))) + init)) +-> (let* [transduce|expanded__0 + (reify* [O__O] + (invoke [&this init xs] + (.reduce xs + (c/fn [ret x] + (let* [x (. Numbers uncheckedLongCast x)] + (. conj|__0 invoke ret (. Numbers inc x)))) + init)))] + (. transduce|expanded__0 invoke [] [1 2])) +;; So, did this actually help? Yes; we were able to elide a lot of checks/dynamism/overhead. Should +;; we use it in all occasions? Unclear. It's a lot of work to implement and the compilation might be +;; slow. It may be best to leave for an "advanced compilation" enhancement later. We can afford +;; dynamism as long as it's 'fast enough' — e.g. instead of `(t/boolean? x)` we expand to +;; `(instance? Boolean x)`. Clojure has this kind of dynamism with pretty much everything anyway. +;; The real issue is when we dynamically invoke an fn that does some more complex checks. +;; We should be able to have configurable levels of dynamism: +;; 1) advanced : eliminate as much dynamism as possible +;; 2) normal : eliminate as much dynamism as possible for global fns only +;; 3) dynamic : make everything dynamic, for faster compilation and thought processes + +;; ========================= + +" +So `f1`'s declared type is `(t/ftype [t/eps?])`, meaning, it has to at least accept 1 input, whose +type is `t/>=` `t/eps?`. +Then really we're just doing arity checking here. Input and output type checks become kind of +meaningless unless you know the actual input type. + + + + +To fix this passed fn specificity problem, we could leverage a global map of the comparison of all +types to all types (`O(n^2)` worst case space, but I think we can do it in less). + +Let's say fimpl is (t/ftype [p/byte? (t/and p/string? whatever)] + [p/byte? p/string?]) +How do we get `(f a)` to recognize that it needs to go to overload 0, not 1? +We could have some sort of interval tree, or perhaps a map sorted by comparisons, in which we can +have log-time access to the right thing — like if you hand it the hash of `p/byte?` `p/string?` then +it goes to the first thing matching that. That way we don't have to rely on dynamism absolutely +everywhere. + +This still doesn't get around other issues seen in `aritoid` and `comp`. TODO +" + +" +We could do: +`(. ^TheReifyType (aget (.-ts f) ) invoke <~@args>)` +- This is all fine when `f` is `=` (perhaps `t/=`?) to the declared type, but when it's `t/<`, it + may allow for more than what the declared type requires, in which case it may have more and/or + different overloads. So do something like this: + (t/defn a [f (t/ftype [t/long?])] (f 1)) + -> (def a|__0 (reify [_ ^TypedFn f ^int f|__i] (.invoke ^L__O (RT/aget (.-overloads f) f|__i) 1))) + (t/defn b [x (t/or t/boolean? t/long?)] x) + (t/dotyped (a b)) + -> (.invoke a|__0 b|__f 1) ; meaning, use the overload at index 1. If -1 then + + This would require arglist expansion which is kind of a pain but stack allocation is always + cheaper than heap. + +TODO let's see what we can do with the expansion/inlining of `compf`. It may prove subtle/tricky? +" +{:message "No name found for typed fn corresponding to caller", + :data {:type (quantum.untyped.core.type/ftype + (quantum.untyped.core.type/isa? + java.lang.Boolean) + [(quantum.untyped.core.type/or + (quantum.untyped.core.type/isa? + java.lang.Number) + (quantum.untyped.core.type/isa? + java.lang.Character)) + (quantum.untyped.core.type/or + (quantum.untyped.core.type/isa? + java.lang.Number) + (quantum.untyped.core.type/isa? + java.lang.Character))]), + :form numeric-compf}} + +;; ===== Failed approaches ===== ;; +" +To fix this passed fn specificity problem, we could leverage either inheritance or a global map of +the comparison of all types to all types (`O(n^2)` worst case space, but I think we can do it in +less). + +For instance, +(t/defn a [f (t/ftype [p/byte? p/string?])] + (f a)) + +F = (t/ftype [p/byte? (t/and p/string? (fn-> count (= 5)))]) +- `p/byte?`'s hash is -627458773 and `(t/and p/string? (fn-> count (= 5))`'s hash is -123456 +So FClass implements _-627458773_-123456 + +G = (t/ftype [p/byte? p/string?]) +- `p/byte?`'s hash is -627458773 and `p/string?`'s hash is -1854681952 +So GClass implements _-627458773_-1854681952 + +But now _-627458773_-123456 needs to extend _-627458773_-1854681952, which requires a rewrite of all +things that use it... so I don't think inheritance is our answer. +" + +;; TODO quantum.test.untyped.core.defnt should be incorporated here — includes some destructuring