Commit ebb91bccb2b4785e527411c8c4c69515194b5ba6 - clojure

New upstream version 1.9.0 Elana Hashman 6 years ago

57 changed file(s) with 1460 addition(s) and 3476 deletion(s). Raw diff Collapse all Expand all

-9

build.xml less more

58	58	<arg value="clojure.core"/>
59	59	<arg value="clojure.core.protocols"/>
60	60	<arg value="clojure.core.server"/>
61		<arg value="clojure.core.specs"/>
62	61	<arg value="clojure.main"/>
63	62	<arg value="clojure.set"/>
64	63	<arg value="clojure.edn"/>

81	80	<arg value="clojure.string"/>
82	81	<arg value="clojure.data"/>
83	82	<arg value="clojure.reflect"/>
84		<arg value="clojure.spec.gen"/>
85		<arg value="clojure.spec.test"/>
86
87		<!-- clojure.spec must be AOT'ed last because it will reload the Spec protocol,
88		causing spec's macroexpanding checking of clojure.core specs to fail. We exclude
89		that checking inside clojure.spec, so that's ok. -->
90		<arg value="clojure.spec"/>
91	83	</java>
92	84	</target>
93	85

99	91	debug="true" source="1.6" target="1.6" includeantruntime="no"/>
100	92	<echo>Direct linking = ${directlinking}</echo>
101	93	<java classname="clojure.lang.Compile"
102		classpath="${test-classes}:${test}:${build}:${cljsrc}"
	94	classpath="${test-classes}:${test}:${build}:${cljsrc}:${maven.test.classpath}"
103	95	failonerror="true"
104	96	fork="true">
105	97	<sysproperty key="clojure.compile.path" value="${test-classes}"/>

201	193	</delete>
202	194	</target>
203	195
	196	<target name="local">
	197	<exec executable="mvn">
	198	<arg value="-Plocal"/>
	199	<arg value="-Dmaven.test.skip=true"/>
	200	<arg value="package"/>
	201	</exec>
	202	</target>
204	203	</project>

+176

-0

changes.md less more

0	0	<!-- -- mode: markdown ; mode: visual-line ; coding: utf-8 -- -->
	1
	2	# Changes to Clojure in Version 1.9
	3
	4	## 1 New and Improved Features
	5
	6	### 1.1 spec
	7
	8	spec is a new core library for describing, validating, and testing the structure of data and functions.
	9
	10	For more information, see:
	11
	12	* [About spec](https://clojure.org/about/spec)
	13	* [spec Guide](https://clojure.org/guides/spec)
	14
	15	Note that spec is in alpha state and API compatibility is not guaranteed. Also, spec and the specs for the Clojure core API are distributed as external libraries that must be included to use Clojure.
	16
	17	### 1.2 Support for working with maps with qualified keys
	18
	19	Several enhancements have been made to add support for working with maps with qualified keys:
	20
	21	* Map namespace syntax - specify the default namespace context for the keys (or symbols) in a map once - `#:car{:make "Jeep" :model "Wrangler"}`. For more information see https://clojure.org/reference/reader#_maps ([CLJ-1910](http://dev.clojure.org/jira/browse/CLJ-1910))
	22	* Destructuring support - namespaced map keys can now specified once as a namespace for :keys or :syms. For more information see https://clojure.org/reference/special_forms#_map_binding_destructuring ([CLJ-1919](http://dev.clojure.org/jira/browse/CLJ-1919))
	23	* `print-namespace-maps` - by default maps will not print with the map namespace syntax except in the clojure.main repl. This dynamic var is a flag to allow you to control whether the namespace map syntax is used.
	24
	25	### 1.3 New predicates
	26
	27	Specs rely heavily on predicates and many new type and value oriented predicates have been added to clojure.core:
	28
	29	* `boolean?`
	30	* `int?` `pos-int?` `neg-int?` `nat-int?`
	31	* `double?`
	32	* `ident?` `simple-ident?` `qualified-ident?`
	33	* `simple-symbol?` `qualified-symbol?`
	34	* `simple-keyword?` `qualified-keyword?`
	35	* `bytes?` (for `byte[]`)
	36	* `indexed?`
	37	* `uuid?` `uri?`
	38	* `seqable?`
	39	* `any?`
	40
	41	### 1.4 More support for instants
	42
	43	More support has been added for the notion of instants in time:
	44
	45	* Added a new protocol `Inst` for instant types
	46	* `Inst` is extended for `java.util.Date`
	47	* `Inst` is optionally extended for `java.time.Instant` in Java 1.8+
	48	* New functions that work for instants: `inst?`, `inst-ms`
	49
	50	### 1.5 Other new core functions
	51
	52	These are some other new functions in clojure.core:
	53
	54	* `bounded-count` - a count that avoids realizing the entire collection beyond a bound
	55	* `swap-vals!` and `reset-vals!` - new atom functions that return both the old and new values ([CLJ-1454](http://dev.clojure.org/jira/browse/CLJ-1454))
	56	* `halt-when` - new transducer that ends transduction when pred is satisfied
	57
	58	### 1.6 Other reader enhancements
	59
	60	* Can now bind `reader-resolver` to an impl of LispReader$Resolver to control the reader’s use of namespace interactions when resolving autoresolved keywords and maps.
	61	* Add new ## reader macro for symbolic values, and read/print support for double vals ##Inf, ##-Inf, ##NaN ([CLJ-1074](http://dev.clojure.org/jira/browse/CLJ-1074))
	62
	63	## 2 Enhancements
	64
	65	### 2.1 Spec syntax checking
	66
	67	If a macro has a spec defined via fdef, that spec will be checked at compile time. Specs have been defined for many clojure.core macros and errors will be reported for these based on the specs at compile time.
	68
	69	### 2.2 Documentation
	70
	71	* `doc` will now report specs for functions with specs defined using `fdef`
	72	* `doc` can now be invoked with a fully-qualified keyword representing a spec name
	73
	74	### 2.3 Performance
	75
	76	* Improved update-in performance
	77	* Optimized seq & destructuring
	78	* [CLJ-2210](http://dev.clojure.org/jira/browse/CLJ-2210)
	79	Cache class derivation in compiler to improve compiler performance
	80	* [CLJ-2188](http://dev.clojure.org/jira/browse/CLJ-2188)
	81	`slurp` - mark return type as String
	82	* [CLJ-2070](http://dev.clojure.org/jira/browse/CLJ-2070)
	83	`clojure.core/delay` - improve performance
	84	* [CLJ-1917](http://dev.clojure.org/jira/browse/CLJ-1917)
	85	Reducing seq over string should call String/length outside of loop
	86	* [CLJ-1901](http://dev.clojure.org/jira/browse/CLJ-1901)
	87	`amap` - should call alength only once
	88	* [CLJ-1224](http://dev.clojure.org/jira/browse/CLJ-1935)
	89	Record instances now cache hasheq and hashCode like maps
	90	* [CLJ-99](http://dev.clojure.org/jira/browse/CLJ-99)
	91	`min-key` and `max-key` - evaluate k on each arg at most once
	92
	93	### 2.4 Other enhancements
	94
	95	* Added Var serialization for identity, not value
	96	* `into` now has a 0-arity (returns `[]`) and 1-arity (returns the coll that's passed)
	97	* [CLJ-2184](http://dev.clojure.org/jira/browse/CLJ-2184)
	98	Propagate meta in doto forms to improve error reporting
	99	* [CLJ-1744](http://dev.clojure.org/jira/browse/CLJ-1744)
	100	Clear unused locals, which can prevent memory leaks in some cases
	101	* [CLJ-1673](http://dev.clojure.org/jira/browse/CLJ-1673)
	102	`clojure.repl/dir-fn` now works on namespace aliases
	103	* [CLJ-1423](http://dev.clojure.org/jira/browse/CLJ-1423)
	104	Allow vars to be invoked with infinite arglists (also, faster)
	105
	106	## 3 Fixes
	107
	108	### 3.1 Security
	109
	110	* [CLJ-2204](http://dev.clojure.org/jira/browse/CLJ-2204)
	111	Disable serialization of proxy classes to avoid potential issue when deserializing
	112
	113	### 3.2 Docs
	114
	115	* [CLJ-2170](http://dev.clojure.org/jira/browse/CLJ-2170)
	116	fix improperly located docstrings
	117	* [CLJ-2156](http://dev.clojure.org/jira/browse/CLJ-2156)
	118	`clojure.java.io/copy` - doc char[] support
	119	* [CLJ-2104](http://dev.clojure.org/jira/browse/CLJ-2104)
	120	`clojure.pprint` docstring - fix typo
	121	* [CLJ-2051](http://dev.clojure.org/jira/browse/CLJ-2051)
	122	`clojure.instant/validated` docstring - fix typo
	123	* [CLJ-2039](http://dev.clojure.org/jira/browse/CLJ-2039)
	124	`deftype` - fix typo in docstring
	125	* [CLJ-2028](http://dev.clojure.org/jira/browse/CLJ-2028)
	126	`filter`, `filterv`, `remove`, `take-while` - fix docstrings
	127	* [CLJ-1918](http://dev.clojure.org/jira/browse/CLJ-1918)
	128	`await` - improve docstring re `shutdown-agents`
	129	* [CLJ-1873](http://dev.clojure.org/jira/browse/CLJ-1873)
	130	`require`, `data-readers` - add .cljc files to docstrings
	131	* [CLJ-1859](http://dev.clojure.org/jira/browse/CLJ-1859)
	132	`zero?`, `pos?`, `neg?` - fix docstrings
	133	* [CLJ-1837](http://dev.clojure.org/jira/browse/CLJ-1837)
	134	`index-of`, `last-index-of` - clarify docstrings
	135	* [CLJ-1826](http://dev.clojure.org/jira/browse/CLJ-1826)
	136	`drop-last` - fix docstring
	137	* [CLJ-1159](http://dev.clojure.org/jira/browse/CLJ-1159)
	138	`clojure.java.io/delete-file` - improve docstring
	139
	140	### 3.3 Other fixes
	141
	142	* `clojure.core/Throwable->map` formerly returned `StackTraceElement`s which were later handled by the printer. Now the StackTraceElements are converted to data such that the return value is pure Clojure data, as intended.
	143	* [CLJ-2091](http://dev.clojure.org/jira/browse/CLJ-2091)
	144	`clojure.lang.APersistentVector#hashCode` is not thread-safe
	145	* [CLJ-2077](http://dev.clojure.org/jira/browse/CLJ-2077)
	146	Clojure can't be loaded from the boot classpath under java 9
	147	* [CLJ-2048](http://dev.clojure.org/jira/browse/CLJ-2048)
	148	Specify type to avoid ClassCastException when stack trace is elided by JVM
	149	* [CLJ-1914](http://dev.clojure.org/jira/browse/CLJ-1914)
	150	Fixed race condition in concurrent `range` realization
	151	* [CLJ-1887](http://dev.clojure.org/jira/browse/CLJ-1887)
	152	`IPersistentVector.length()` - implement missing method
	153	* [CLJ-1870](http://dev.clojure.org/jira/browse/CLJ-1870)
	154	Fixed reloading a `defmulti` removes metadata on the var
	155	* [CLJ-1860](http://dev.clojure.org/jira/browse/CLJ-1860)
	156	Make -0.0 hash consistent with 0.0
	157	* [CLJ-1841](http://dev.clojure.org/jira/browse/CLJ-1841)
	158	`bean` - iterator was broken
	159	* [CLJ-1793](http://dev.clojure.org/jira/browse/CLJ-1793)
	160	Clear 'this' before calls in tail position
	161	* [CLJ-1790](http://dev.clojure.org/jira/browse/CLJ-1790)
	162	Fixed error extending protocols to Java arrays
	163	* [CLJ-1714](http://dev.clojure.org/jira/browse/CLJ-1714)
	164	using a class in a type hint shouldn’t load the class
	165	* [CLJ-1705](http://dev.clojure.org/jira/browse/CLJ-1705)
	166	`vector-of` - fix NullPointerException if given unrecognized type
	167	* [CLJ-1398](http://dev.clojure.org/jira/browse/CLJ-1398)
	168	`clojure.java.javadoc/javadoc` - update doc urls
	169	* [CLJ-1371](http://dev.clojure.org/jira/browse/CLJ-1371)
	170	`Numbers.divide(Object, Object)` - add checks for NaN
	171	* [CLJ-1358](http://dev.clojure.org/jira/browse/CLJ-1358)
	172	`doc` - does not expand special cases properly (try, catch)
	173	* [CLJ-1242](http://dev.clojure.org/jira/browse/CLJ-1242)
	174	equals doesn't throw on sorted collections
	175	* [CLJ-700](http://dev.clojure.org/jira/browse/CLJ-700)
	176	`contains?`, `get`, and `find` broken for transient collections
1	177
2	178	# Changes to Clojure in Version 1.8
3	179

+75

-17

pom.xml less more

4	4	<artifactId>clojure</artifactId>
5	5	<name>clojure</name>
6	6	<packaging>jar</packaging>
7		<version>1.9.0-alpha15</version>
	7	<version>1.9.0</version>
8	8
9	9	<url>http://clojure.org/</url>
10	10	<description>Clojure core environment and runtime library.</description>

29	29	<connection>scm:git:git@github.com:clojure/clojure.git</connection>
30	30	<developerConnection>scm:git:git@github.com:clojure/clojure.git</developerConnection>
31	31	<url>git@github.com:clojure/clojure.git</url>
32		<tag>clojure-1.9.0-alpha15</tag>
	32	<tag>clojure-1.9.0</tag>
33	33	</scm>
34	34
35	35	<properties>

37	37	</properties>
38	38
39	39	<dependencies>
	40	<dependency>
	41	<groupId>org.clojure</groupId>
	42	<artifactId>spec.alpha</artifactId>
	43	<version>0.1.143</version>
	44	</dependency>
	45	<dependency>
	46	<groupId>org.clojure</groupId>
	47	<artifactId>core.specs.alpha</artifactId>
	48	<version>0.1.24</version>
	49	</dependency>
40	50	<dependency>
41	51	<groupId>org.codehaus.jsr166-mirror</groupId>
42	52	<artifactId>jsr166y</artifactId>

238	248	</configuration>
239	249	</plugin>
240	250
241		<!-- sign artifacts for deployment -->
242		<plugin>
243		<groupId>org.apache.maven.plugins</groupId>
244		<artifactId>maven-gpg-plugin</artifactId>
245		<version>1.5</version>
246		<executions>
247		<execution>
248		<id>sign-artifacts</id>
249		<phase>verify</phase>
250		<goals>
251		<goal>sign</goal>
252		</goals>
253		</execution>
254		</executions>
255		</plugin>
256	251	</plugins>
257	252	</build>
258	253

297	292	</plugins>
298	293	</build>
299	294	</profile>
	295	<profile>
	296	<!-- sign artifacts for deployment -->
	297	<id>sign</id>
	298	<build>
	299	<plugins>
	300	<plugin>
	301	<groupId>org.apache.maven.plugins</groupId>
	302	<artifactId>maven-gpg-plugin</artifactId>
	303	<version>1.5</version>
	304	<executions>
	305	<execution>
	306	<id>sign-artifacts</id>
	307	<phase>verify</phase>
	308	<goals>
	309	<goal>sign</goal>
	310	</goals>
	311	</execution>
	312	</executions>
	313	</plugin>
	314	</plugins>
	315	</build>
	316	</profile>
	317	<profile>
	318	<id>local</id>
	319	<dependencies>
	320	<dependency>
	321	<groupId>org.clojure</groupId>
	322	<artifactId>test.check</artifactId>
	323	<version>0.9.0</version>
	324	<exclusions>
	325	<exclusion>
	326	<groupId>org.clojure</groupId>
	327	<artifactId>clojure</artifactId>
	328	</exclusion>
	329	</exclusions>
	330	</dependency>
	331	</dependencies>
	332	<build>
	333	<plugins>
	334	<plugin>
	335	<groupId>org.apache.maven.plugins</groupId>
	336	<artifactId>maven-shade-plugin</artifactId>
	337	<version>3.1.0</version>
	338	<executions>
	339	<execution>
	340	<phase>package</phase>
	341	<goals>
	342	<goal>shade</goal>
	343	</goals>
	344	<configuration>
	345	<transformers>
	346	<transformer implementation="org.apache.maven.plugins.shade.resource.ManifestResourceTransformer">
	347	<mainClass>clojure.main</mainClass>
	348	</transformer>
	349	</transformers>
	350	<outputFile>clojure.jar</outputFile>
	351	</configuration>
	352	</execution>
	353	</executions>
	354	</plugin>
	355	</plugins>
	356	</build>
	357	</profile>
300	358	</profiles>
301	359	</project>

+23

-20

readme.txt less more

6	6	* the terms of this license.
7	7	* You must not remove this notice, or any other, from this software.
8	8
9		Docs: http://clojure.org
	9	Docs: https://clojure.org
10	10	Feedback: http://groups.google.com/group/clojure
11		Getting Started: http://dev.clojure.org/display/doc/Getting+Started
12
13		To run: java -cp clojure-${VERSION}.jar clojure.main
14
15		To build locally with Ant:
	11	Getting Started: https://clojure.org/guides/getting_started
	12
	13	To build and run locally with Ant:
16	14
17	15	One-time setup: ./antsetup.sh
18		To build: ant
19
20		Maven 2 build instructions:
21
22		To build: mvn package
23		The built JARs will be in target/
24
25		To build without testing: mvn package -Dmaven.test.skip=true
26
27		To build and install in local Maven repository: mvn install
28
29		To build a ZIP distribution: mvn package -Pdistribution
30		The built .zip will be in target/
31
	16	To build: ant local
	17	To run: java -jar clojure.jar
	18
	19	To build locally with Maven:
	20
	21	To build (output JARs in target/):
	22	mvn package
	23
	24	To build without testing:
	25	mvn package -Dmaven.test.skip=true
	26
	27	To build and install in local Maven repository:
	28	mvn install
	29
	30	To build a standalone jar with dependencies included:
	31	mvn -Plocal -Dmaven.test.skip=true package
	32
	33	To run with the standalone jar:
	34	java -jar clojure.jar
32	35
33	36	--------------------------------------------------------------------------
34	37	This program uses the ASM bytecode engineering library which is distributed

-2

src/clj/clojure/core/protocols.clj less more

144	144	clojure.lang.StringSeq
145	145	(internal-reduce
146	146	[str-seq f val]
147		(let [s (.s str-seq)]
	147	(let [s (.s str-seq)
	148	len (.length s)]
148	149	(loop [i (.i str-seq)
149	150	val val]
150		(if (< i (.length s))
	151	(if (< i len)
151	152	(let [ret (f val (.charAt s i))]
152	153	(if (reduced? ret)
153	154	@ret

-225

~~src/clj/clojure/core/specs.clj~~ less more

0		(ns ^{:skip-wiki true} clojure.core.specs
1		(:require [clojure.spec :as s]))
2
3		;;;; destructure
4
5		(s/def ::local-name (s/and simple-symbol? #(not= '& %)))
6
7		(s/def ::binding-form
8		(s/or :sym ::local-name
9		:seq ::seq-binding-form
10		:map ::map-binding-form))
11
12		;; sequential destructuring
13
14		(s/def ::seq-binding-form
15		(s/and vector?
16		(s/cat :elems (s/* ::binding-form)
17		:rest (s/? (s/cat :amp #{'&} :form ::binding-form))
18		:as (s/? (s/cat :as #{:as} :sym ::local-name)))))
19
20		;; map destructuring
21
22		(s/def ::keys (s/coll-of ident? :kind vector?))
23		(s/def ::syms (s/coll-of symbol? :kind vector?))
24		(s/def ::strs (s/coll-of simple-symbol? :kind vector?))
25		(s/def ::or (s/map-of simple-symbol? any?))
26		(s/def ::as ::local-name)
27
28		(s/def ::map-special-binding
29		(s/keys :opt-un [::as ::or ::keys ::syms ::strs]))
30
31		(s/def ::map-binding (s/tuple ::binding-form any?))
32
33		(s/def ::ns-keys
34		(s/tuple
35		(s/and qualified-keyword? #(-> % name #{"keys" "syms"}))
36		(s/coll-of simple-symbol? :kind vector?)))
37
38		(s/def ::map-bindings
39		(s/every (s/or :mb ::map-binding
40		:nsk ::ns-keys
41		:msb (s/tuple #{:as :or :keys :syms :strs} any?)) :into {}))
42
43		(s/def ::map-binding-form (s/merge ::map-bindings ::map-special-binding))
44
45		;; bindings
46
47		(s/def ::binding (s/cat :binding ::binding-form :init-expr any?))
48		(s/def ::bindings (s/and vector? (s/* ::binding)))
49
50		;; let, if-let, when-let
51
52		(s/fdef clojure.core/let
53		:args (s/cat :bindings ::bindings
54		:body (s/* any?)))
55
56		(s/fdef clojure.core/if-let
57		:args (s/cat :bindings (s/and vector? ::binding)
58		:then any?
59		:else (s/? any?)))
60
61		(s/fdef clojure.core/when-let
62		:args (s/cat :bindings (s/and vector? ::binding)
63		:body (s/* any?)))
64
65		;; defn, defn-, fn
66
67		(s/def ::arg-list
68		(s/and
69		vector?
70		(s/cat :args (s/* ::binding-form)
71		:varargs (s/? (s/cat :amp #{'&} :form ::binding-form)))))
72
73		(s/def ::args+body
74		(s/cat :args ::arg-list
75		:body (s/alt :prepost+body (s/cat :prepost map?
76		:body (s/+ any?))
77		:body (s/* any?))))
78
79		(s/def ::defn-args
80		(s/cat :name simple-symbol?
81		:docstring (s/? string?)
82		:meta (s/? map?)
83		:bs (s/alt :arity-1 ::args+body
84		:arity-n (s/cat :bodies (s/+ (s/spec ::args+body))
85		:attr (s/? map?)))))
86
87		(s/fdef clojure.core/defn
88		:args ::defn-args
89		:ret any?)
90
91		(s/fdef clojure.core/defn-
92		:args ::defn-args
93		:ret any?)
94
95		(s/fdef clojure.core/fn
96		:args (s/cat :name (s/? simple-symbol?)
97		:bs (s/alt :arity-1 ::args+body
98		:arity-n (s/+ (s/spec ::args+body))))
99		:ret any?)
100
101		;;;; ns
102
103		(s/def ::exclude (s/coll-of simple-symbol?))
104		(s/def ::only (s/coll-of simple-symbol?))
105		(s/def ::rename (s/map-of simple-symbol? simple-symbol?))
106		(s/def ::filters (s/keys* :opt-un [::exclude ::only ::rename]))
107
108		(s/def ::ns-refer-clojure
109		(s/spec (s/cat :clause #{:refer-clojure}
110		:filters ::filters)))
111
112		(s/def ::refer (s/or :all #{:all}
113		:syms (s/coll-of simple-symbol?)))
114
115		(s/def ::prefix-list
116		(s/spec
117		(s/cat :prefix simple-symbol?
118		:suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::prefix-list))
119		:refer (s/keys* :opt-un [::as ::refer]))))
120
121		(s/def ::ns-require
122		(s/spec (s/cat :clause #{:require}
123		:libs (s/* (s/alt :lib simple-symbol?
124		:prefix-list ::prefix-list
125		:flag #{:reload :reload-all :verbose})))))
126
127		(s/def ::package-list
128		(s/spec
129		(s/cat :package simple-symbol?
130		:classes (s/* simple-symbol?))))
131
132		(s/def ::import-list
133		(s/* (s/alt :class simple-symbol?
134		:package-list ::package-list)))
135
136		(s/def ::ns-import
137		(s/spec
138		(s/cat :clause #{:import}
139		:classes ::import-list)))
140
141		(s/def ::ns-refer
142		(s/spec (s/cat :clause #{:refer}
143		:lib simple-symbol?
144		:filters ::filters)))
145
146		(s/def ::use-prefix-list
147		(s/spec
148		(s/cat :prefix simple-symbol?
149		:suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::use-prefix-list))
150		:filters ::filters)))
151
152		(s/def ::ns-use
153		(s/spec (s/cat :clause #{:use}
154		:libs (s/* (s/alt :lib simple-symbol?
155		:prefix-list ::use-prefix-list
156		:flag #{:reload :reload-all :verbose})))))
157
158		(s/def ::ns-load
159		(s/spec (s/cat :clause #{:load}
160		:libs (s/* string?))))
161
162		(s/def ::name simple-symbol?)
163		(s/def ::extends simple-symbol?)
164		(s/def ::implements (s/coll-of simple-symbol? :kind vector?))
165		(s/def ::init symbol?)
166		(s/def ::class-ident (s/or :class simple-symbol? :class-name string?))
167		(s/def ::signature (s/coll-of ::class-ident :kind vector?))
168		(s/def ::constructors (s/map-of ::signature ::signature))
169		(s/def ::post-init symbol?)
170		(s/def ::method (s/and vector?
171		(s/cat :name simple-symbol?
172		:param-types ::signature
173		:return-type simple-symbol?)))
174		(s/def ::methods (s/coll-of ::method :kind vector?))
175		(s/def ::main boolean?)
176		(s/def ::factory simple-symbol?)
177		(s/def ::state simple-symbol?)
178		(s/def ::get simple-symbol?)
179		(s/def ::set simple-symbol?)
180		(s/def ::expose (s/keys :opt-un [::get ::set]))
181		(s/def ::exposes (s/map-of simple-symbol? ::expose))
182		(s/def ::prefix string?)
183		(s/def ::impl-ns simple-symbol?)
184		(s/def ::load-impl-ns boolean?)
185
186		(s/def ::ns-gen-class
187		(s/spec (s/cat :clause #{:gen-class}
188		:options (s/keys* :opt-un [::name ::extends ::implements
189		::init ::constructors ::post-init
190		::methods ::main ::factory ::state
191		::exposes ::prefix ::impl-ns ::load-impl-ns]))))
192
193		(s/def ::ns-clauses
194		(s/* (s/alt :refer-clojure ::ns-refer-clojure
195		:require ::ns-require
196		:import ::ns-import
197		:use ::ns-use
198		:refer ::ns-refer
199		:load ::ns-load
200		:gen-class ::ns-gen-class)))
201
202		(s/fdef clojure.core/ns
203		:args (s/cat :name simple-symbol?
204		:docstring (s/? string?)
205		:attr-map (s/? map?)
206		:clauses ::ns-clauses))
207
208		(defmacro ^:private quotable
209		"Returns a spec that accepts both the spec and a (quote ...) form of the spec"
210		[spec]
211		`(s/or :spec ~spec :quoted-spec (s/cat :quote #{'quote} :spec ~spec)))
212
213		(s/def ::quotable-import-list
214		(s/* (s/alt :class (quotable simple-symbol?)
215		:package-list (quotable ::package-list))))
216
217		(s/fdef clojure.core/import
218		:args ::quotable-import-list)
219
220		(s/fdef clojure.core/refer-clojure
221		:args (s/* (s/alt
222		:exclude (s/cat :op (quotable #{:exclude}) :arg (quotable ::exclude))
223		:only (s/cat :op (quotable #{:only}) :arg (quotable ::only))
224		:rename (s/cat :op (quotable #{:rename}) :arg (quotable ::rename)))))⏎

+100

-53

src/clj/clojure/core.clj less more

858	858	(defn zero?
859	859	"Returns true if num is zero, else false"
860	860	{
861		:inline (fn [x] `(. clojure.lang.Numbers (isZero ~x)))
	861	:inline (fn [num] `(. clojure.lang.Numbers (isZero ~num)))
862	862	:added "1.0"}
863		[x] (. clojure.lang.Numbers (isZero x)))
	863	[num] (. clojure.lang.Numbers (isZero num)))
864	864
865	865	(defn count
866	866	"Returns the number of items in the collection. (count nil) returns

1238	1238	(defn pos?
1239	1239	"Returns true if num is greater than zero, else false"
1240	1240	{
1241		:inline (fn [x] `(. clojure.lang.Numbers (isPos ~x)))
	1241	:inline (fn [num] `(. clojure.lang.Numbers (isPos ~num)))
1242	1242	:added "1.0"}
1243		[x] (. clojure.lang.Numbers (isPos x)))
	1243	[num] (. clojure.lang.Numbers (isPos num)))
1244	1244
1245	1245	(defn neg?
1246	1246	"Returns true if num is less than zero, else false"
1247	1247	{
1248		:inline (fn [x] `(. clojure.lang.Numbers (isNeg ~x)))
	1248	:inline (fn [num] `(. clojure.lang.Numbers (isNeg ~num)))
1249	1249	:added "1.0"}
1250		[x] (. clojure.lang.Numbers (isNeg x)))
	1250	[num] (. clojure.lang.Numbers (isNeg num)))
1251	1251
1252	1252	(defn quot
1253	1253	"quot[ient] of dividing numerator by denominator."

1418	1418	"Return true if x is a Double"
1419	1419	{:added "1.9"}
1420	1420	[x] (instance? Double x))
1421
1422		(defn bigdec?
1423		"Return true if x is a BigDecimal"
1424		{:added "1.9"}
1425		[x] (instance? java.math.BigDecimal x))
1426	1421
1427	1422	;;
1428	1423

1598	1593	[^clojure.lang.Named x]
1599	1594	(. x (getNamespace)))
1600	1595
	1596	(defn boolean
	1597	"Coerce to boolean"
	1598	{
	1599	:inline (fn [x] `(. clojure.lang.RT (booleanCast ~x)))
	1600	:added "1.0"}
	1601	[x] (clojure.lang.RT/booleanCast x))
	1602
1601	1603	(defn ident?
1602	1604	"Return true if x is a symbol or keyword"
1603	1605	{:added "1.9"}

1611	1613	(defn qualified-ident?
1612	1614	"Return true if x is a symbol or keyword with a namespace"
1613	1615	{:added "1.9"}
1614		[x] (and (ident? x) (namespace x) true))
	1616	[x] (boolean (and (ident? x) (namespace x) true)))
1615	1617
1616	1618	(defn simple-symbol?
1617	1619	"Return true if x is a symbol without a namespace"

1621	1623	(defn qualified-symbol?
1622	1624	"Return true if x is a symbol with a namespace"
1623	1625	{:added "1.9"}
1624		[x] (and (symbol? x) (namespace x) true))
	1626	[x] (boolean (and (symbol? x) (namespace x) true)))
1625	1627
1626	1628	(defn simple-keyword?
1627	1629	"Return true if x is a keyword without a namespace"

1631	1633	(defn qualified-keyword?
1632	1634	"Return true if x is a keyword with a namespace"
1633	1635	{:added "1.9"}
1634		[x] (and (keyword? x) (namespace x) true))
	1636	[x] (boolean (and (keyword? x) (namespace x) true)))
1635	1637
1636	1638	(defmacro locking
1637	1639	"Executes exprs in an implicit do, while holding the monitor of x.

2343	2345	([^clojure.lang.IAtom atom f x y] (.swap atom f x y))
2344	2346	([^clojure.lang.IAtom atom f x y & args] (.swap atom f x y args)))
2345	2347
	2348	(defn swap-vals!
	2349	"Atomically swaps the value of atom to be:
	2350	(apply f current-value-of-atom args). Note that f may be called
	2351	multiple times, and thus should be free of side effects.
	2352	Returns [old new], the value of the atom before and after the swap."
	2353	{:added "1.9"}
	2354	(^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f] (.swapVals atom f))
	2355	(^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f x] (.swapVals atom f x))
	2356	(^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f x y] (.swapVals atom f x y))
	2357	(^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f x y & args] (.swapVals atom f x y args)))
	2358
2346	2359	(defn compare-and-set!
2347	2360	"Atomically sets the value of atom to newval if and only if the
2348	2361	current value of the atom is identical to oldval. Returns true if

2357	2370	{:added "1.0"
2358	2371	:static true}
2359	2372	[^clojure.lang.IAtom atom newval] (.reset atom newval))
	2373
	2374	(defn reset-vals!
	2375	"Sets the value of atom to newval. Returns [old new], the value of the
	2376	atom before and after the reset."
	2377	{:added "1.9"}
	2378	^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom newval] (.resetVals atom newval))
2360	2379
2361	2380	(defn set-validator!
2362	2381	"Sets the validator-fn for a var/ref/agent/atom. validator-fn must be nil or a

2764	2783
2765	2784	(defn filter
2766	2785	"Returns a lazy sequence of the items in coll for which
2767		(pred item) returns true. pred must be free of side-effects.
	2786	(pred item) returns logical true. pred must be free of side-effects.
2768	2787	Returns a transducer when no collection is provided."
2769	2788	{:added "1.0"
2770	2789	:static true}

2797	2816
2798	2817	(defn remove
2799	2818	"Returns a lazy sequence of the items in coll for which
2800		(pred item) returns false. pred must be free of side-effects.
	2819	(pred item) returns logical false. pred must be free of side-effects.
2801	2820	Returns a transducer when no collection is provided."
2802	2821	{:added "1.0"
2803	2822	:static true}

2859	2878
2860	2879	(defn take-while
2861	2880	"Returns a lazy sequence of successive items from coll while
2862		(pred item) returns true. pred must be free of side-effects.
	2881	(pred item) returns logical true. pred must be free of side-effects.
2863	2882	Returns a transducer when no collection is provided."
2864	2883	{:added "1.0"
2865	2884	:static true}

2907	2926	"Return a lazy sequence of all but the last n (default 1) items in coll"
2908	2927	{:added "1.0"
2909	2928	:static true}
2910		([s] (drop-last 1 s))
2911		([n s] (map (fn [x _] x) s (drop n s))))
	2929	([coll] (drop-last 1 coll))
	2930	([n coll] (map (fn [x _] x) coll (drop n coll))))
2912	2931
2913	2932	(defn take-last
2914	2933	"Returns a seq of the last n items in coll. Depending on the type

3247	3266	"Blocks the current thread (indefinitely!) until all actions
3248	3267	dispatched thus far, from this thread or agent, to the agent(s) have
3249	3268	occurred. Will block on failed agents. Will never return if
3250		a failed agent is restarted with :clear-actions true."
	3269	a failed agent is restarted with :clear-actions true or shutdown-agents was called."
3251	3270	{:added "1.0"
3252	3271	:static true}
3253	3272	[& agents]

3484	3503	{:inline (fn [x] `(. clojure.lang.RT (~(if unchecked-math 'uncheckedCharCast 'charCast) ~x)))
3485	3504	:added "1.1"}
3486	3505	[x] (. clojure.lang.RT (charCast x)))
3487
3488		(defn boolean
3489		"Coerce to boolean"
3490		{
3491		:inline (fn [x] `(. clojure.lang.RT (booleanCast ~x)))
3492		:added "1.0"}
3493		[x] (clojure.lang.RT/booleanCast x))
3494	3506
3495	3507	(defn unchecked-byte
3496	3508	"Coerce to byte. Subject to rounding or truncation."

3813	3825	(let [gx (gensym)]
3814	3826	`(let [~gx ~x]
3815	3827	~@(map (fn [f]
3816		(if (seq? f)
3817		`(~(first f) ~gx ~@(next f))
3818		`(~f ~gx)))
	3828	(with-meta
	3829	(if (seq? f)
	3830	`(~(first f) ~gx ~@(next f))
	3831	`(~f ~gx))
	3832	(meta f)))
3819	3833	forms)
3820	3834	~gx)))
3821	3835

4912	4926	(^String [^String s start end] (. s (substring start end))))
4913	4927
4914	4928	(defn max-key
4915		"Returns the x for which (k x), a number, is greatest."
	4929	"Returns the x for which (k x), a number, is greatest.
	4930
	4931	If there are multiple such xs, the last one is returned."
4916	4932	{:added "1.0"
4917	4933	:static true}
4918	4934	([k x] x)
4919	4935	([k x y] (if (> (k x) (k y)) x y))
4920	4936	([k x y & more]
4921		(reduce1 #(max-key k %1 %2) (max-key k x y) more)))
	4937	(let [kx (k x) ky (k y)
	4938	[v kv] (if (> kx ky) [x kx] [y ky])]
	4939	(loop [v v kv kv more more]
	4940	(if more
	4941	(let [w (first more)
	4942	kw (k w)]
	4943	(if (>= kw kv)
	4944	(recur w kw (next more))
	4945	(recur v kv (next more))))
	4946	v)))))
4922	4947
4923	4948	(defn min-key
4924		"Returns the x for which (k x), a number, is least."
	4949	"Returns the x for which (k x), a number, is least.
	4950
	4951	If there are multiple such xs, the last one is returned."
4925	4952	{:added "1.0"
4926	4953	:static true}
4927	4954	([k x] x)
4928	4955	([k x y] (if (< (k x) (k y)) x y))
4929	4956	([k x y & more]
4930		(reduce1 #(min-key k %1 %2) (min-key k x y) more)))
	4957	(let [kx (k x) ky (k y)
	4958	[v kv] (if (< kx ky) [x kx] [y ky])]
	4959	(loop [v v kv kv more more]
	4960	(if more
	4961	(let [w (first more)
	4962	kw (k w)]
	4963	(if (<= kw kv)
	4964	(recur w kw (next more))
	4965	(recur v kv (next more))))
	4966	v)))))
4931	4967
4932	4968	(defn distinct
4933	4969	"Returns a lazy sequence of the elements of coll with duplicates removed.

5156	5192	array ret."
5157	5193	{:added "1.0"}
5158	5194	[a idx ret expr]
5159		`(let [a# ~a
	5195	`(let [a# ~a l# (alength a#)
5160	5196	~ret (aclone a#)]
5161	5197	(loop [~idx 0]
5162		(if (< ~idx (alength a#))
	5198	(if (< ~idx l#)
5163	5199	(do
5164	5200	(aset ~ret ~idx ~expr)
5165	5201	(recur (unchecked-inc ~idx)))

5762	5798	exception (Exception. message)
5763	5799	raw-trace (.getStackTrace exception)
5764	5800	boring? #(not= (.getMethodName ^StackTraceElement %) "doInvoke")
5765		trace (into-array (drop 2 (drop-while boring? raw-trace)))]
	5801	trace (into-array StackTraceElement (drop 2 (drop-while boring? raw-trace)))]
5766	5802	(.setStackTrace exception trace)
5767	5803	(throw (clojure.lang.Compiler$CompilerException.
5768	5804	file

5927	5963	'require loads a lib by loading its root resource. The root resource path
5928	5964	is derived from the lib name in the following manner:
5929	5965	Consider a lib named by the symbol 'x.y.z; it has the root directory
5930		<classpath>/x/y/, and its root resource is <classpath>/x/y/z.clj. The root
5931		resource should contain code to create the lib's namespace (usually by using
5932		the ns macro) and load any additional lib resources.
	5966	<classpath>/x/y/, and its root resource is <classpath>/x/y/z.clj, or
	5967	<classpath>/x/y/z.cljc if <classpath>/x/y/z.clj does not exist. The
	5968	root resource should contain code to create the lib's
	5969	namespace (usually by using the ns macro) and load any additional
	5970	lib resources.
5933	5971
5934	5972	Libspecs
5935	5973

6648	6686	(load "core_deftype")
6649	6687	(load "core/protocols")
6650	6688	(load "gvec")
6651		(load "instant")
	6689
	6690	(defmacro ^:private when-class [class-name & body]
	6691	`(try
	6692	(Class/forName ^String ~class-name)
	6693	~@body
	6694	(catch ClassNotFoundException _#)))
	6695
	6696	(when-class "java.sql.Timestamp"
	6697	(load "instant"))
6652	6698
6653	6699	(defprotocol Inst
6654	6700	(inst-ms* [inst]))

6658	6704	(inst-ms* [inst] (.getTime ^java.util.Date inst)))
6659	6705
6660	6706	;; conditionally extend to Instant on Java 8+
6661		(try
6662		(Class/forName "java.time.Instant")
6663		(load "core_instant18")
6664		(catch ClassNotFoundException cnfe))
	6707	(when-class "java.time.Instant"
	6708	(load "core_instant18"))
6665	6709
6666	6710	(defn inst-ms
6667	6711	"Return the number of milliseconds since January 1, 1970, 00:00:00 GMT"

6795	6839
6796	6840	(defn filterv
6797	6841	"Returns a vector of the items in coll for which
6798		(pred item) returns true. pred must be free of side-effects."
	6842	(pred item) returns logical true. pred must be free of side-effects."
6799	6843	{:added "1.4"
6800	6844	:static true}
6801	6845	[pred coll]

6817	6861	(defn slurp
6818	6862	"Opens a reader on f and reads all its contents, returning a string.
6819	6863	See clojure.java.io/reader for a complete list of supported arguments."
6820		{:added "1.0"}
	6864	{:added "1.0"
	6865	:tag String}
6821	6866	([f & opts]
6822	6867	(let [opts (normalize-slurp-opts opts)
6823	6868	sw (java.io.StringWriter.)]

7624	7669	(def ^{:added "1.4"} default-data-readers
7625	7670	"Default map of data reader functions provided by Clojure. May be
7626	7671	overridden by binding data-readers."
7627		{'inst #'clojure.instant/read-instant-date
7628		'uuid #'clojure.uuid/default-uuid-reader})
	7672	(merge
	7673	{'uuid #'clojure.uuid/default-uuid-reader}
	7674	(when-class "java.sql.Timestamp"
	7675	{'inst #'clojure.instant/read-instant-date})))
7629	7676
7630	7677	(def ^{:added "1.4" :dynamic true} data-readers
7631	7678	"Map from reader tag symbols to data reader Vars.
7632	7679
7633	7680	When Clojure starts, it searches for files named 'data_readers.clj'
7634		at the root of the classpath. Each such file must contain a literal
7635		map of symbols, like this:
	7681	and 'data_readers.cljc' at the root of the classpath. Each such file
	7682	must contain a literal map of symbols, like this:
7636	7683
7637	7684	{foo/bar my.project.foo/bar
7638	7685	foo/baz my.project/baz}

7653	7700	Reader tags without namespace qualifiers are reserved for
7654	7701	Clojure. Default reader tags are defined in
7655	7702	clojure.core/default-data-readers but may be overridden in
7656		data_readers.clj or by rebinding this Var."
	7703	data_readers.clj, data_readers.cljc, or by rebinding this Var."
7657	7704	{})
7658	7705
7659	7706	(def ^{:added "1.5" :dynamic true} default-data-reader-fn

7717	7764	(defn uri?
7718	7765	"Return true if x is a java.net.URI"
7719	7766	{:added "1.9"}
7720		[x] (instance? java.net.URI x))⏎
	7767	[x] (instance? java.net.URI x))

-2

src/clj/clojure/core_deftype.clj less more

424	424	Options are expressed as sequential keywords and arguments (in any order).
425	425
426	426	Supported options:
427		:load-ns - if true, importing the record class will cause the
428		namespace in which the record was defined to be loaded.
	427	:load-ns - if true, importing the type class will cause the
	428	namespace in which the type was defined to be loaded.
429	429	Defaults to false.
430	430
431	431	Each spec consists of a protocol or interface name followed by zero

+14

-0

src/clj/clojure/core_print.clj less more

126	126
127	127	(defmethod print-method Number [o, ^Writer w]
128	128	(.write w (str o)))
	129
	130	(defmethod print-method Double [o, ^Writer w]
	131	(cond
	132	(= Double/POSITIVE_INFINITY o) (.write w "##Inf")
	133	(= Double/NEGATIVE_INFINITY o) (.write w "##-Inf")
	134	(.isNaN ^Double o) (.write w "##NaN")
	135	:else (.write w (str o))))
	136
	137	(defmethod print-method Float [o, ^Writer w]
	138	(cond
	139	(= Float/POSITIVE_INFINITY o) (.write w "##Inf")
	140	(= Float/NEGATIVE_INFINITY o) (.write w "##-Inf")
	141	(.isNaN ^Float o) (.write w "##NaN")
	142	:else (.write w (str o))))
129	143
130	144	(defmethod print-dup Number [o, ^Writer w]
131	145	(print-ctor o

+34

-13

src/clj/clojure/core_proxy.clj less more

12	12	(import
13	13	'(clojure.asm ClassWriter ClassVisitor Opcodes Type)
14	14	'(java.lang.reflect Modifier Constructor)
	15	'(java.io Serializable NotSerializableException)
15	16	'(clojure.asm.commons Method GeneratorAdapter)
16	17	'(clojure.lang IProxy Reflector DynamicClassLoader IPersistentMap PersistentHashMap RT))
17	18

22	23	(or (some (fn [t] (when (every? #(isa? t %) rtypes) t)) rtypes)
23	24	(throw (Exception. "Incompatible return types"))))
24	25
25		(defn- group-by-sig [coll]
26		"takes a collection of [msig meth] and returns a seq of maps from return-types to meths."
	26	(defn- group-by-sig
	27	"Takes a collection of [msig meth] and returns a seq of maps from
	28	return-types to meths."
	29	[coll]
27	30	(vals (reduce1 (fn [m [msig meth]]
28	31	(let [rtype (peek msig)
29	32	argsig (pop msig)]

43	46
44	47	(defn- generate-proxy [^Class super interfaces]
45	48	(let [cv (new ClassWriter (. ClassWriter COMPUTE_MAXS))
46		cname (.replace (proxy-name super interfaces) \. \/) ;(str "clojure/lang/" (gensym "Proxy__"))
	49	pname (proxy-name super interfaces)
	50	cname (.replace pname \. \/) ;(str "clojure/lang/" (gensym "Proxy__"))
47	51	ctype (. Type (getObjectType cname))
48	52	iname (fn [^Class c] (.. Type (getType c) (getInternalName)))
49	53	fmap "__clojureFnMap"

147	151
148	152	(. gen (returnValue))
149	153	(. gen (endMethod)))))
	154	;disable serialization
	155	(when (some #(isa? % Serializable) (cons super interfaces))
	156	(let [m (. Method (getMethod "void writeObject(java.io.ObjectOutputStream)"))
	157	gen (new GeneratorAdapter (. Opcodes ACC_PRIVATE) m nil nil cv)]
	158	(. gen (visitCode))
	159	(. gen (loadThis))
	160	(. gen (loadArgs))
	161	(. gen (throwException (totype NotSerializableException) pname))
	162	(. gen (endMethod)))
	163	(let [m (. Method (getMethod "void readObject(java.io.ObjectInputStream)"))
	164	gen (new GeneratorAdapter (. Opcodes ACC_PRIVATE) m nil nil cv)]
	165	(. gen (visitCode))
	166	(. gen (loadThis))
	167	(. gen (loadArgs))
	168	(. gen (throwException (totype NotSerializableException) pname))
	169	(. gen (endMethod))))
150	170	;add IProxy methods
151	171	(let [m (. Method (getMethod "void __initClojureFnMappings(clojure.lang.IPersistentMap)"))
152	172	gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)]

394	414	snapshot (fn []
395	415	(reduce1 (fn [m e]
396	416	(assoc m (key e) ((val e))))
397		{} (seq pmap)))]
	417	{} (seq pmap)))
	418	thisfn (fn thisfn [plseq]
	419	(lazy-seq
	420	(when-let [pseq (seq plseq)]
	421	(cons (clojure.lang.MapEntry/create (first pseq) (v (first pseq)))
	422	(thisfn (rest pseq))))))]
398	423	(proxy [clojure.lang.APersistentMap]
399	424	[]
400		(iterator [] (.iterator ^Iterable pmap))
	425	(iterator [] (clojure.lang.SeqIterator. ^java.util.Iterator (thisfn (keys pmap))))
401	426	(containsKey [k] (contains? pmap k))
402	427	(entryAt [k] (when (contains? pmap k) (clojure.lang.MapEntry/create k (v k))))
403	428	(valAt ([k] (when (contains? pmap k) (v k)))

406	431	(count [] (count pmap))
407	432	(assoc [k v] (assoc (snapshot) k v))
408	433	(without [k] (dissoc (snapshot) k))
409		(seq [] ((fn thisfn [plseq]
410		(lazy-seq
411		(when-let [pseq (seq plseq)]
412		(cons (clojure.lang.MapEntry/create (first pseq) (v (first pseq)))
413		(thisfn (rest pseq)))))) (keys pmap))))))
414
415
416
	434	(seq [] (thisfn (keys pmap))))))
	435
	436
	437

+13

-6

src/clj/clojure/gvec.clj less more

248	248	(new Vec am cnt shift (.doAssoc this shift root i val) tail (meta this)))
249	249	(= i cnt) (.cons this val)
250	250	:else (throw (IndexOutOfBoundsException.))))
	251	(length [_] cnt)
251	252
252	253	clojure.lang.Reversible
253	254	(rseq [this]

473	474	:char (mk-am char)
474	475	:boolean (mk-am boolean)})
475	476
476		(defn vector-of
	477	(defmacro ^:private ams-check [t]
	478	`(let [am# (ams ~t)]
	479	(if am#
	480	am#
	481	(throw (IllegalArgumentException. (str "Unrecognized type " ~t))))))
	482
	483	(defn vector-of
477	484	"Creates a new vector of a single primitive type t, where t is one
478	485	of :int :long :float :double :byte :short :char or :boolean. The
479	486	resulting vector complies with the interface of vectors in general,

483	490	{:added "1.2"
484	491	:arglists '([t] [t & elements])}
485	492	([t]
486		(let [am ^clojure.core.ArrayManager (ams t)]
	493	(let [^clojure.core.ArrayManager am (ams-check t)]
487	494	(Vec. am 0 5 EMPTY-NODE (.array am 0) nil)))
488	495	([t x1]
489		(let [am ^clojure.core.ArrayManager (ams t)
	496	(let [^clojure.core.ArrayManager am (ams-check t)
490	497	arr (.array am 1)]
491	498	(.aset am arr 0 x1)
492	499	(Vec. am 1 5 EMPTY-NODE arr nil)))
493	500	([t x1 x2]
494		(let [am ^clojure.core.ArrayManager (ams t)
	501	(let [^clojure.core.ArrayManager am (ams-check t)
495	502	arr (.array am 2)]
496	503	(.aset am arr 0 x1)
497	504	(.aset am arr 1 x2)
498	505	(Vec. am 2 5 EMPTY-NODE arr nil)))
499	506	([t x1 x2 x3]
500		(let [am ^clojure.core.ArrayManager (ams t)
	507	(let [^clojure.core.ArrayManager am (ams-check t)
501	508	arr (.array am 3)]
502	509	(.aset am arr 0 x1)
503	510	(.aset am arr 1 x2)
504	511	(.aset am arr 2 x3)
505	512	(Vec. am 3 5 EMPTY-NODE arr nil)))
506	513	([t x1 x2 x3 x4]
507		(let [am ^clojure.core.ArrayManager (ams t)
	514	(let [^clojure.core.ArrayManager am (ams-check t)
508	515	arr (.array am 4)]
509	516	(.aset am arr 0 x1)
510	517	(.aset am arr 1 x2)

-1

src/clj/clojure/instant.clj less more

135	135	((if leap-year? dim-leap dim-norm) month))))
136	136
137	137	(defn validated
138		"Return a function which constructs and instant by calling constructor
	138	"Return a function which constructs an instant by calling constructor
139	139	after first validating that those arguments are in range and otherwise
140	140	plausible. The resulting function will throw an exception if called
141	141	with invalid arguments."

-2

src/clj/clojure/java/io.clj less more

389	389
390	390	(defn copy
391	391	"Copies input to output. Returns nil or throws IOException.
392		Input may be an InputStream, Reader, File, byte[], or String.
	392	Input may be an InputStream, Reader, File, byte[], char[], or String.
393	393	Output may be an OutputStream, Writer, or File.
394	394
395	395	Options are key/value pairs and may be one of

427	427	(reduce file (file parent child) more)))
428	428
429	429	(defn delete-file
430		"Delete file f. Raise an exception if it fails unless silently is true."
	430	"Delete file f. If silently is nil or false, raise an exception on failure, else return the value of silently."
431	431	{:added "1.2"}
432	432	[f & [silently]]
433	433	(or (.delete (file f))

-5

src/clj/clojure/java/javadoc.clj less more

19	19
20	20	(def ^:dynamic core-java-api
21	21	(case (System/getProperty "java.specification.version")
22		"1.6" "http://java.sun.com/javase/6/docs/api/"
23		"http://java.sun.com/javase/7/docs/api/"))
	22	"1.6" "http://docs.oracle.com/javase/6/docs/api/"
	23	"1.7" "http://docs.oracle.com/javase/7/docs/api/"
	24	"1.8" "http://docs.oracle.com/javase/8/docs/api/"
	25	"http://docs.oracle.com/javase/8/docs/api/"))
24	26
25	27	(def ^:dynamic remote-javadocs
26	28	(ref (sorted-map
	29	"com.google.common." "http://google.github.io/guava/releases/23.0/api/docs/"
27	30	"java." core-java-api
28	31	"javax." core-java-api
29	32	"org.ietf.jgss." core-java-api
30	33	"org.omg." core-java-api
31	34	"org.w3c.dom." core-java-api
32	35	"org.xml.sax." core-java-api
33		"org.apache.commons.codec." "http://commons.apache.org/codec/api-release/"
34		"org.apache.commons.io." "http://commons.apache.org/io/api-release/"
35		"org.apache.commons.lang." "http://commons.apache.org/lang/api-release/")))
	36	"org.apache.commons.codec." "http://commons.apache.org/proper/commons-codec/apidocs/"
	37	"org.apache.commons.io." "http://commons.apache.org/proper/commons-io/javadocs/api-release/"
	38	"org.apache.commons.lang." "http://commons.apache.org/proper/commons-lang/javadocs/api-2.6/"
	39	"org.apache.commons.lang3." "http://commons.apache.org/proper/commons-lang/javadocs/api-release/")))
36	40
37	41	(defn add-local-javadoc
38	42	"Adds to the list of local Javadoc paths."

-1

src/clj/clojure/main.clj less more

11	11	:author "Stephen C. Gilardi and Rich Hickey"}
12	12	clojure.main
13	13	(:refer-clojure :exclude [with-bindings])
	14	(:require [clojure.spec.alpha])
14	15	(:import (clojure.lang Compiler Compiler$CompilerException
15	16	LineNumberingPushbackReader RT))
16	17	;;(:use [clojure.repl :only (demunge root-cause stack-element-str)])

80	81	command-line-args command-line-args
81	82	unchecked-math unchecked-math
82	83	assert assert
83		clojure.spec/explain-out clojure.spec/explain-out
	84	clojure.spec.alpha/explain-out clojure.spec.alpha/explain-out
84	85	*1 nil
85	86	*2 nil
86	87	*3 nil

-2

src/clj/clojure/pprint/pretty_writer.clj less more

39	39	[sym]
40	40	`(~sym @@~'this))
41	41
42		(defmacro ^{:private true}
43		setf [sym new-val]
	42	(defmacro ^{:private true}
	43	setf
44	44	"Set the value of the field SYM to NEW-VAL"
	45	[sym new-val]
45	46	`(alter @~'this assoc ~sym ~new-val))
46	47
47	48	(defmacro ^{:private true}

+22

-15

src/clj/clojure/pprint/utilities.clj less more

49	49	[acc context]
50	50	(recur new-context (conj acc result))))))
51	51
52		(defn- unzip-map [m]
53		"Take a map that has pairs in the value slots and produce a pair of maps,
54		the first having all the first elements of the pairs and the second all
55		the second elements of the pairs"
	52	(defn- unzip-map
	53	"Take a map that has pairs in the value slots and produce a pair of
	54	maps, the first having all the first elements of the pairs and the
	55	second all the second elements of the pairs"
	56	[m]
56	57	[(into {} (for [[k [v1 v2]] m] [k v1]))
57	58	(into {} (for [[k [v1 v2]] m] [k v2]))])
58	59
59		(defn- tuple-map [m v1]
	60	(defn- tuple-map
60	61	"For all the values, v, in the map, replace them with [v v1]"
	62	[m v1]
61	63	(into {} (for [[k v] m] [k [v v1]])))
62	64
63		(defn- rtrim [s c]
	65	(defn- rtrim
64	66	"Trim all instances of c from the end of sequence s"
	67	[s c]
65	68	(let [len (count s)]
66	69	(if (and (pos? len) (= (nth s (dec (count s))) c))
67	70	(loop [n (dec len)]

71	74	true (recur (dec n))))
72	75	s)))
73	76
74		(defn- ltrim [s c]
	77	(defn- ltrim
75	78	"Trim all instances of c from the beginning of sequence s"
	79	[s c]
76	80	(let [len (count s)]
77	81	(if (and (pos? len) (= (nth s 0) c))
78	82	(loop [n 0]

81	85	(recur (inc n))))
82	86	s)))
83	87
84		(defn- prefix-count [aseq val]
85		"Return the number of times that val occurs at the start of sequence aseq,
86		if val is a seq itself, count the number of times any element of val occurs at the
87		beginning of aseq"
	88	(defn- prefix-count
	89	"Return the number of times that val occurs at the start of sequence aseq,
	90	if val is a seq itself, count the number of times any element of val
	91	occurs at the beginning of aseq"
	92	[aseq val]
88	93	(let [test (if (coll? val) (set val) #{val})]
89	94	(loop [pos 0]
90	95	(if (or (= pos (count aseq)) (not (test (nth aseq pos))))
91	96	pos
92	97	(recur (inc pos))))))
93	98
94		(defn- prerr [& args]
	99	(defn- prerr
95	100	"Println to err"
	101	[& args]
96	102	(binding [out err]
97	103	(apply println args)))
98
99		(defmacro ^{:private true} prlabel [prefix arg & more-args]
	104
	105	(defmacro ^{:private true} prlabel
100	106	"Print args to err in name = value format"
101		`(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %)
	107	[prefix arg & more-args]
	108	`(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %)
102	109	(cons arg (seq more-args))))))
103	110
104	111	;; Flush the pretty-print buffer without flushing the underlying stream

-1

src/clj/clojure/pprint.clj less more

31	31	a more powerful alternative to Clojure's standard format function.
32	32
33	33	See documentation for pprint and cl-format for more information or
34		complete documentation on the the clojure web site on github.",
	34	complete documentation on the Clojure web site on GitHub.",
35	35	:added "1.2"}
36	36	clojure.pprint
37	37	(:refer-clojure :exclude (deftype))

-2

src/clj/clojure/repl.clj less more

11	11	^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim"
12	12	:doc "Utilities meant to be used interactively at the REPL"}
13	13	clojure.repl
14		(:require [clojure.spec :as spec])
	14	(:require [clojure.spec.alpha :as spec])
15	15	(:import (java.io LineNumberReader InputStreamReader PushbackReader)
16	16	(clojure.lang RT Reflector)))
17	17

134	134	{:added "1.0"}
135	135	[name]
136	136	(if-let [special-name ('{& fn catch try finally try} name)]
137		(#'print-doc (#'special-doc special-name))
	137	`(#'print-doc (#'special-doc '~special-name))
138	138	(cond
139	139	(special-doc-map name) `(#'print-doc (#'special-doc '~name))
140	140	(keyword? name) `(#'print-doc {:spec '~name :doc '~(spec/describe name)})

-3

src/clj/clojure/set.clj less more

9	9	:author "Rich Hickey"}
10	10	clojure.set)
11	11
12		(defn- bubble-max-key [k coll]
13		"Move a maximal element of coll according to fn k (which returns a number)
14		to the front of coll."
	12	(defn- bubble-max-key
	13	"Move a maximal element of coll according to fn k (which returns a
	14	number) to the front of coll."
	15	[k coll]
15	16	(let [max (apply max-key k coll)]
16	17	(cons max (remove #(identical? max %) coll))))
17	18

-224

~~src/clj/clojure/spec/gen.clj~~ less more

0		; Copyright (c) Rich Hickey. All rights reserved.
1		; The use and distribution terms for this software are covered by the
2		; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
3		; which can be found in the file epl-v10.html at the root of this distribution.
4		; By using this software in any fashion, you are agreeing to be bound by
5		; the terms of this license.
6		; You must not remove this notice, or any other, from this software.
7
8		(ns clojure.spec.gen
9		(:refer-clojure :exclude [boolean bytes cat hash-map list map not-empty set vector
10		char double int keyword symbol string uuid delay]))
11
12		(alias 'c 'clojure.core)
13
14		(defn- dynaload
15		[s]
16		(let [ns (namespace s)]
17		(assert ns)
18		(require (c/symbol ns))
19		(let [v (resolve s)]
20		(if v
21		@v
22		(throw (RuntimeException. (str "Var " s " is not on the classpath")))))))
23
24		(def ^:private quick-check-ref
25		(c/delay (dynaload 'clojure.test.check/quick-check)))
26		(defn quick-check
27		[& args]
28		(apply @quick-check-ref args))
29
30		(def ^:private for-all*-ref
31		(c/delay (dynaload 'clojure.test.check.properties/for-all*)))
32		(defn for-all*
33		"Dynamically loaded clojure.test.check.properties/for-all*."
34		[& args]
35		(apply @for-all*-ref args))
36
37		(let [g? (c/delay (dynaload 'clojure.test.check.generators/generator?))
38		g (c/delay (dynaload 'clojure.test.check.generators/generate))
39		mkg (c/delay (dynaload 'clojure.test.check.generators/->Generator))]
40		(defn- generator?
41		[x]
42		(@g? x))
43		(defn- generator
44		[gfn]
45		(@mkg gfn))
46		(defn generate
47		"Generate a single value using generator."
48		[generator]
49		(@g generator)))
50
51		(defn ^:skip-wiki delay-impl
52		[gfnd]
53		;;N.B. depends on test.check impl details
54		(generator (fn [rnd size]
55		((:gen @gfnd) rnd size))))
56
57		(defmacro delay
58		"given body that returns a generator, returns a
59		generator that delegates to that, but delays
60		creation until used."
61		[& body]
62		`(delay-impl (c/delay ~@body)))
63
64		(defn gen-for-name
65		"Dynamically loads test.check generator named s."
66		[s]
67		(let [g (dynaload s)]
68		(if (generator? g)
69		g
70		(throw (RuntimeException. (str "Var " s " is not a generator"))))))
71
72		(defmacro ^:skip-wiki lazy-combinator
73		"Implementation macro, do not call directly."
74		[s]
75		(let [fqn (c/symbol "clojure.test.check.generators" (name s))
76		doc (str "Lazy loaded version of " fqn)]
77		`(let [g# (c/delay (dynaload '~fqn))]
78		(defn ~s
79		~doc
80		[& ~'args]
81		(apply @g# ~'args)))))
82
83		(defmacro ^:skip-wiki lazy-combinators
84		"Implementation macro, do not call directly."
85		[& syms]
86		`(do
87		~@(c/map
88		(fn [s] (c/list 'lazy-combinator s))
89		syms)))
90
91		(lazy-combinators hash-map list map not-empty set vector vector-distinct fmap elements
92		bind choose fmap one-of such-that tuple sample return
93		large-integer* double* frequency)
94
95		(defmacro ^:skip-wiki lazy-prim
96		"Implementation macro, do not call directly."
97		[s]
98		(let [fqn (c/symbol "clojure.test.check.generators" (name s))
99		doc (str "Fn returning " fqn)]
100		`(let [g# (c/delay (dynaload '~fqn))]
101		(defn ~s
102		~doc
103		[& ~'args]
104		@g#))))
105
106		(defmacro ^:skip-wiki lazy-prims
107		"Implementation macro, do not call directly."
108		[& syms]
109		`(do
110		~@(c/map
111		(fn [s] (c/list 'lazy-prim s))
112		syms)))
113
114		(lazy-prims any any-printable boolean bytes char char-alpha char-alphanumeric char-ascii double
115		int keyword keyword-ns large-integer ratio simple-type simple-type-printable
116		string string-ascii string-alphanumeric symbol symbol-ns uuid)
117
118		(defn cat
119		"Returns a generator of a sequence catenated from results of
120		gens, each of which should generate something sequential."
121		[& gens]
122		(fmap #(apply concat %)
123		(apply tuple gens)))
124
125		(defn- qualified? [ident] (not (nil? (namespace ident))))
126
127		(def ^:private
128		gen-builtins
129		(c/delay
130		(let [simple (simple-type-printable)]
131		{any? (one-of [(return nil) (any-printable)])
132		some? (such-that some? (any-printable))
133		number? (one-of [(large-integer) (double)])
134		integer? (large-integer)
135		int? (large-integer)
136		pos-int? (large-integer* {:min 1})
137		neg-int? (large-integer* {:max -1})
138		nat-int? (large-integer* {:min 0})
139		float? (double)
140		double? (double)
141		boolean? (boolean)
142		string? (string-alphanumeric)
143		ident? (one-of [(keyword-ns) (symbol-ns)])
144		simple-ident? (one-of [(keyword) (symbol)])
145		qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)]))
146		keyword? (keyword-ns)
147		simple-keyword? (keyword)
148		qualified-keyword? (such-that qualified? (keyword-ns))
149		symbol? (symbol-ns)
150		simple-symbol? (symbol)
151		qualified-symbol? (such-that qualified? (symbol-ns))
152		uuid? (uuid)
153		uri? (fmap #(java.net.URI/create (str "http://" % ".com")) (uuid))
154		bigdec? (fmap #(BigDecimal/valueOf %)
155		(double* {:infinite? false :NaN? false}))
156		inst? (fmap #(java.util.Date. %)
157		(large-integer))
158		seqable? (one-of [(return nil)
159		(list simple)
160		(vector simple)
161		(map simple simple)
162		(set simple)
163		(string-alphanumeric)])
164		indexed? (vector simple)
165		map? (map simple simple)
166		vector? (vector simple)
167		list? (list simple)
168		seq? (list simple)
169		char? (char)
170		set? (set simple)
171		nil? (return nil)
172		false? (return false)
173		true? (return true)
174		zero? (return 0)
175		rational? (one-of [(large-integer) (ratio)])
176		coll? (one-of [(map simple simple)
177		(list simple)
178		(vector simple)
179		(set simple)])
180		empty? (elements [nil '() [] {} #{}])
181		associative? (one-of [(map simple simple) (vector simple)])
182		sequential? (one-of [(list simple) (vector simple)])
183		ratio? (such-that ratio? (ratio))
184		bytes? (bytes)})))
185
186		(defn gen-for-pred
187		"Given a predicate, returns a built-in generator if one exists."
188		[pred]
189		(if (set? pred)
190		(elements pred)
191		(get @gen-builtins pred)))
192
193		(comment
194		(require :reload 'clojure.spec.gen)
195		(in-ns 'clojure.spec.gen)
196
197		;; combinators, see call to lazy-combinators above for complete list
198		(generate (one-of [(gen-for-pred integer?) (gen-for-pred string?)]))
199		(generate (such-that #(< 10000 %) (gen-for-pred integer?)))
200		(let [reqs {:a (gen-for-pred number?)
201		:b (gen-for-pred ratio?)}
202		opts {:c (gen-for-pred string?)}]
203		(generate (bind (choose 0 (count opts))
204		#(let [args (concat (seq reqs) (shuffle (seq opts)))]
205		(->> args
206		(take (+ % (count reqs)))
207		(mapcat identity)
208		(apply hash-map))))))
209		(generate (cat (list (gen-for-pred string?))
210		(list (gen-for-pred ratio?))))
211
212		;; load your own generator
213		(gen-for-name 'clojure.test.check.generators/int)
214
215		;; failure modes
216		(gen-for-name 'unqualified)
217		(gen-for-name 'clojure.core/+)
218		(gen-for-name 'clojure.core/name-does-not-exist)
219		(gen-for-name 'ns.does.not.exist/f)
220
221		)
222
223

-466

~~src/clj/clojure/spec/test.clj~~ less more

0		; Copyright (c) Rich Hickey. All rights reserved.
1		; The use and distribution terms for this software are covered by the
2		; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
3		; which can be found in the file epl-v10.html at the root of this distribution.
4		; By using this software in any fashion, you are agreeing to be bound by
5		; the terms of this license.
6		; You must not remove this notice, or any other, from this software.
7
8		(ns clojure.spec.test
9		(:refer-clojure :exclude [test])
10		(:require
11		[clojure.pprint :as pp]
12		[clojure.spec :as s]
13		[clojure.spec.gen :as gen]
14		[clojure.string :as str]))
15
16		(in-ns 'clojure.spec.test.check)
17		(in-ns 'clojure.spec.test)
18		(alias 'stc 'clojure.spec.test.check)
19
20		(defn- throwable?
21		[x]
22		(instance? Throwable x))
23
24		(defn ->sym
25		[x]
26		(@#'s/->sym x))
27
28		(defn- ->var
29		[s-or-v]
30		(if (var? s-or-v)
31		s-or-v
32		(let [v (and (symbol? s-or-v) (resolve s-or-v))]
33		(if (var? v)
34		v
35		(throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var")))))))
36
37		(defn- collectionize
38		[x]
39		(if (symbol? x)
40		(list x)
41		x))
42
43		(defn enumerate-namespace
44		"Given a symbol naming an ns, or a collection of such symbols,
45		returns the set of all symbols naming vars in those nses."
46		[ns-sym-or-syms]
47		(into
48		#{}
49		(mapcat (fn [ns-sym]
50		(map
51		(fn [name-sym]
52		(symbol (name ns-sym) (name name-sym)))
53		(keys (ns-interns ns-sym)))))
54		(collectionize ns-sym-or-syms)))
55
56		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
57
58		(def ^:private ^:dynamic instrument-enabled
59		"if false, instrumented fns call straight through"
60		true)
61
62		(defn- fn-spec?
63		"Fn-spec must include at least :args or :ret specs."
64		[m]
65		(or (:args m) (:ret m)))
66
67		(defmacro with-instrument-disabled
68		"Disables instrument's checking of calls, within a scope."
69		[& body]
70		`(binding [instrument-enabled nil]
71		~@body))
72
73		(defn- interpret-stack-trace-element
74		"Given the vector-of-syms form of a stacktrace element produced
75		by e.g. Throwable->map, returns a map form that adds some keys
76		guessing the original Clojure names. Returns a map with
77
78		:class class name symbol from stack trace
79		:method method symbol from stack trace
80		:file filename from stack trace
81		:line line number from stack trace
82		:var-scope optional Clojure var symbol scoping fn def
83		:local-fn optional local Clojure symbol scoping fn def
84
85		For non-Clojure fns, :scope and :local-fn will be absent."
86		[[cls method file line]]
87		(let [clojure? (contains? '#{invoke invokeStatic} method)
88		demunge #(clojure.lang.Compiler/demunge %)
89		degensym #(str/replace % #"--.*" "")
90		[ns-sym name-sym local] (when clojure?
91		(->> (str/split (str cls) #"\$" 3)
92		(map demunge)))]
93		(merge {:file file
94		:line line
95		:method method
96		:class cls}
97		(when (and ns-sym name-sym)
98		{:var-scope (symbol ns-sym name-sym)})
99		(when local
100		{:local-fn (symbol (degensym local))}))))
101
102		(defn- stacktrace-relevant-to-instrument
103		"Takes a coll of stack trace elements (as returned by
104		StackTraceElement->vec) and returns a coll of maps as per
105		interpret-stack-trace-element that are relevant to a
106		failure in instrument."
107		[elems]
108		(let [plumbing? (fn [{:keys [var-scope]}]
109		(contains? '#{clojure.spec.test/spec-checking-fn} var-scope))]
110		(sequence (comp (map StackTraceElement->vec)
111		(map interpret-stack-trace-element)
112		(filter :var-scope)
113		(drop-while plumbing?))
114		elems)))
115
116		(defn- spec-checking-fn
117		[v f fn-spec]
118		(let [fn-spec (@#'s/maybe-spec fn-spec)
119		conform! (fn [v role spec data args]
120		(let [conformed (s/conform spec data)]
121		(if (= ::s/invalid conformed)
122		(let [caller (->> (.getStackTrace (Thread/currentThread))
123		stacktrace-relevant-to-instrument
124		first)
125		ed (merge (assoc (s/explain-data* spec [role] [] [] data)
126		::s/args args
127		::s/failure :instrument)
128		(when caller
129		{::caller (dissoc caller :class :method)}))]
130		(throw (ex-info
131		(str "Call to " v " did not conform to spec:\n" (with-out-str (s/explain-out ed)))
132		ed)))
133		conformed)))]
134		(fn
135		[& args]
136		(if instrument-enabled
137		(with-instrument-disabled
138		(when (:args fn-spec) (conform! v :args (:args fn-spec) args args))
139		(binding [instrument-enabled true]
140		(.applyTo ^clojure.lang.IFn f args)))
141		(.applyTo ^clojure.lang.IFn f args)))))
142
143		(defn- no-fspec
144		[v spec]
145		(ex-info (str "Fn at " v " is not spec'ed.")
146		{:var v :spec spec ::s/failure :no-fspec}))
147
148		(defonce ^:private instrumented-vars (atom {}))
149
150		(defn- instrument-choose-fn
151		"Helper for instrument."
152		[f spec sym {over :gen :keys [stub replace]}]
153		(if (some #{sym} stub)
154		(-> spec (s/gen over) gen/generate)
155		(get replace sym f)))
156
157		(defn- instrument-choose-spec
158		"Helper for instrument"
159		[spec sym {overrides :spec}]
160		(get overrides sym spec))
161
162		(defn- instrument-1
163		[s opts]
164		(when-let [v (resolve s)]
165		(when-not (-> v meta :macro)
166		(let [spec (s/get-spec v)
167		{:keys [raw wrapped]} (get @instrumented-vars v)
168		current @v
169		to-wrap (if (= wrapped current) raw current)
170		ospec (or (instrument-choose-spec spec s opts)
171		(throw (no-fspec v spec)))
172		ofn (instrument-choose-fn to-wrap ospec s opts)
173		checked (spec-checking-fn v ofn ospec)]
174		(alter-var-root v (constantly checked))
175		(swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked})
176		(->sym v)))))
177
178		(defn- unstrument-1
179		[s]
180		(when-let [v (resolve s)]
181		(when-let [{:keys [raw wrapped]} (get @instrumented-vars v)]
182		(swap! instrumented-vars dissoc v)
183		(let [current @v]
184		(when (= wrapped current)
185		(alter-var-root v (constantly raw))
186		(->sym v))))))
187
188		(defn- opt-syms
189		"Returns set of symbols referenced by 'instrument' opts map"
190		[opts]
191		(reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))]))
192
193		(defn- fn-spec-name?
194		[s]
195		(and (symbol? s)
196		(not (some-> (resolve s) meta :macro))))
197
198		(defn instrumentable-syms
199		"Given an opts map as per instrument, returns the set of syms
200		that can be instrumented."
201		([] (instrumentable-syms nil))
202		([opts]
203		(assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys")
204		(reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
205		(keys (:spec opts))
206		(:stub opts)
207		(keys (:replace opts))])))
208
209		(defn instrument
210		"Instruments the vars named by sym-or-syms, a symbol or collection
211		of symbols, or all instrumentable vars if sym-or-syms is not
212		specified.
213
214		If a var has an :args fn-spec, sets the var's root binding to a
215		fn that checks arg conformance (throwing an exception on failure)
216		before delegating to the original fn.
217
218		The opts map can be used to override registered specs, and/or to
219		replace fn implementations entirely. Opts for symbols not included
220		in sym-or-syms are ignored. This facilitates sharing a common
221		options map across many different calls to instrument.
222
223		The opts map may have the following keys:
224
225		:spec a map from var-name symbols to override specs
226		:stub a set of var-name symbols to be replaced by stubs
227		:gen a map from spec names to generator overrides
228		:replace a map from var-name symbols to replacement fns
229
230		:spec overrides registered fn-specs with specs your provide. Use
231		:spec overrides to provide specs for libraries that do not have
232		them, or to constrain your own use of a fn to a subset of its
233		spec'ed contract.
234
235		:stub replaces a fn with a stub that checks :args, then uses the
236		:ret spec to generate a return value.
237
238		:gen overrides are used only for :stub generation.
239
240		:replace replaces a fn with a fn that checks args conformance, then
241		invokes the fn you provide, enabling arbitrary stubbing and mocking.
242
243		:spec can be used in combination with :stub or :replace.
244
245		Returns a collection of syms naming the vars instrumented."
246		([] (instrument (instrumentable-syms)))
247		([sym-or-syms] (instrument sym-or-syms nil))
248		([sym-or-syms opts]
249		(locking instrumented-vars
250		(into
251		[]
252		(comp (filter (instrumentable-syms opts))
253		(distinct)
254		(map #(instrument-1 % opts))
255		(remove nil?))
256		(collectionize sym-or-syms)))))
257
258		(defn unstrument
259		"Undoes instrument on the vars named by sym-or-syms, specified
260		as in instrument. With no args, unstruments all instrumented vars.
261		Returns a collection of syms naming the vars unstrumented."
262		([] (unstrument (map ->sym (keys @instrumented-vars))))
263		([sym-or-syms]
264		(locking instrumented-vars
265		(into
266		[]
267		(comp (filter symbol?)
268		(map unstrument-1)
269		(remove nil?))
270		(collectionize sym-or-syms)))))
271
272		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
273
274		(defn- explain-check
275		[args spec v role]
276		(ex-info
277		"Specification-based check failed"
278		(when-not (s/valid? spec v nil)
279		(assoc (s/explain-data* spec [role] [] [] v)
280		::args args
281		::val v
282		::s/failure :check-failed))))
283
284		(defn- check-call
285		"Returns true if call passes specs, otherwise returns an exception
286		with explain-data + ::s/failure."
287		[f specs args]
288		(let [cargs (when (:args specs) (s/conform (:args specs) args))]
289		(if (= cargs ::s/invalid)
290		(explain-check args (:args specs) args :args)
291		(let [ret (apply f args)
292		cret (when (:ret specs) (s/conform (:ret specs) ret))]
293		(if (= cret ::s/invalid)
294		(explain-check args (:ret specs) ret :ret)
295		(if (and (:args specs) (:ret specs) (:fn specs))
296		(if (s/valid? (:fn specs) {:args cargs :ret cret})
297		true
298		(explain-check args (:fn specs) {:args cargs :ret cret} :fn))
299		true))))))
300
301		(defn- quick-check
302		[f specs {gen :gen opts ::stc/opts}]
303		(let [{:keys [num-tests] :or {num-tests 1000}} opts
304		g (try (s/gen (:args specs) gen) (catch Throwable t t))]
305		(if (throwable? g)
306		{:result g}
307		(let [prop (gen/for-all* [g] #(check-call f specs %))]
308		(apply gen/quick-check num-tests prop (mapcat identity opts))))))
309
310		(defn- make-check-result
311		"Builds spec result map."
312		[check-sym spec test-check-ret]
313		(merge {:spec spec
314		::stc/ret test-check-ret}
315		(when check-sym
316		{:sym check-sym})
317		(when-let [result (-> test-check-ret :result)]
318		(when-not (true? result) {:failure result}))
319		(when-let [shrunk (-> test-check-ret :shrunk)]
320		{:failure (:result shrunk)})))
321
322		(defn- check-1
323		[{:keys [s f v spec]} opts]
324		(let [re-inst? (and v (seq (unstrument s)) true)
325		f (or f (when v @v))
326		specd (s/spec spec)]
327		(try
328		(cond
329		(or (nil? f) (some-> v meta :macro))
330		{:failure (ex-info "No fn to spec" {::s/failure :no-fn})
331		:sym s :spec spec}
332
333		(:args specd)
334		(let [tcret (quick-check f specd opts)]
335		(make-check-result s spec tcret))
336
337		:default
338		{:failure (ex-info "No :args spec" {::s/failure :no-args-spec})
339		:sym s :spec spec})
340		(finally
341		(when re-inst? (instrument s))))))
342
343		(defn- sym->check-map
344		[s]
345		(let [v (resolve s)]
346		{:s s
347		:v v
348		:spec (when v (s/get-spec v))}))
349
350		(defn- validate-check-opts
351		[opts]
352		(assert (every? ident? (keys (:gen opts))) "check :gen expects ident keys"))
353
354		(defn check-fn
355		"Runs generative tests for fn f using spec and opts. See
356		'check' for options and return."
357		([f spec] (check-fn f spec nil))
358		([f spec opts]
359		(validate-check-opts opts)
360		(check-1 {:f f :spec spec} opts)))
361
362		(defn checkable-syms
363		"Given an opts map as per check, returns the set of syms that
364		can be checked."
365		([] (checkable-syms nil))
366		([opts]
367		(validate-check-opts opts)
368		(reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
369		(keys (:spec opts))])))
370
371		(defn check
372		"Run generative tests for spec conformance on vars named by
373		sym-or-syms, a symbol or collection of symbols. If sym-or-syms
374		is not specified, check all checkable vars.
375
376		The opts map includes the following optional keys, where stc
377		aliases clojure.spec.test.check:
378
379		::stc/opts opts to flow through test.check/quick-check
380		:gen map from spec names to generator overrides
381
382		The ::stc/opts include :num-tests in addition to the keys
383		documented by test.check. Generator overrides are passed to
384		spec/gen when generating function args.
385
386		Returns a lazy sequence of check result maps with the following
387		keys
388
389		:spec the spec tested
390		:sym optional symbol naming the var tested
391		:failure optional test failure
392		::stc/ret optional value returned by test.check/quick-check
393
394		The value for :failure can be any exception. Exceptions thrown by
395		spec itself will have an ::s/failure value in ex-data:
396
397		:check-failed at least one checked return did not conform
398		:no-args-spec no :args spec provided
399		:no-fn no fn provided
400		:no-fspec no fspec provided
401		:no-gen unable to generate :args
402		:instrument invalid args detected by instrument
403		"
404		([] (check (checkable-syms)))
405		([sym-or-syms] (check sym-or-syms nil))
406		([sym-or-syms opts]
407		(->> (collectionize sym-or-syms)
408		(filter (checkable-syms opts))
409		(pmap
410		#(check-1 (sym->check-map %) opts)))))
411
412		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting ;;;;;;;;;;;;;;;;;;;;;;;;
413
414		(defn- failure-type
415		[x]
416		(::s/failure (ex-data x)))
417
418		(defn- unwrap-failure
419		[x]
420		(if (failure-type x)
421		(ex-data x)
422		x))
423
424		(defn- result-type
425		"Returns the type of the check result. This can be any of the
426		::s/failure keywords documented in 'check', or:
427
428		:check-passed all checked fn returns conformed
429		:check-threw checked fn threw an exception"
430		[ret]
431		(let [failure (:failure ret)]
432		(cond
433		(nil? failure) :check-passed
434		(failure-type failure) (failure-type failure)
435		:default :check-threw)))
436
437		(defn abbrev-result
438		"Given a check result, returns an abbreviated version
439		suitable for summary use."
440		[x]
441		(if (:failure x)
442		(-> (dissoc x ::stc/ret)
443		(update :spec s/describe)
444		(update :failure unwrap-failure))
445		(dissoc x :spec ::stc/ret)))
446
447		(defn summarize-results
448		"Given a collection of check-results, e.g. from 'check', pretty
449		prints the summary-result (default abbrev-result) of each.
450
451		Returns a map with :total, the total number of results, plus a
452		key with a count for each different :type of result."
453		([check-results] (summarize-results check-results abbrev-result))
454		([check-results summary-result]
455		(reduce
456		(fn [summary result]
457		(pp/pprint (summary-result result))
458		(-> summary
459		(update :total inc)
460		(update (result-type result) (fnil inc 0))))
461		{:total 0}
462		check-results)))
463
464
465

-1936

~~src/clj/clojure/spec.clj~~ less more

0		; Copyright (c) Rich Hickey. All rights reserved.
1		; The use and distribution terms for this software are covered by the
2		; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
3		; which can be found in the file epl-v10.html at the root of this distribution.
4		; By using this software in any fashion, you are agreeing to be bound by
5		; the terms of this license.
6		; You must not remove this notice, or any other, from this software.
7
8		(ns clojure.spec
9		(:refer-clojure :exclude [+ * and assert or cat def keys merge])
10		(:require [clojure.walk :as walk]
11		[clojure.spec.gen :as gen]
12		[clojure.string :as str]))
13
14		(alias 'c 'clojure.core)
15
16		(set! warn-on-reflection true)
17
18		(def ^:dynamic recursion-limit
19		"A soft limit on how many times a branching spec (or/alt/*/opt-keys/multi-spec)
20		can be recursed through during generation. After this a
21		non-recursive branch will be chosen."
22		4)
23
24		(def ^:dynamic fspec-iterations
25		"The number of times an anonymous fn specified by fspec will be (generatively) tested during conform"
26		21)
27
28		(def ^:dynamic coll-check-limit
29		"The number of elements validated in a collection spec'ed with 'every'"
30		101)
31
32		(def ^:dynamic coll-error-limit
33		"The number of errors reported by explain in a collection spec'ed with 'every'"
34		20)
35
36		(defprotocol Spec
37		(conform* [spec x])
38		(unform* [spec y])
39		(explain* [spec path via in x])
40		(gen* [spec overrides path rmap])
41		(with-gen* [spec gfn])
42		(describe* [spec]))
43
44		(defonce ^:private registry-ref (atom {}))
45
46		(defn- deep-resolve [reg k]
47		(loop [spec k]
48		(if (ident? spec)
49		(recur (get reg spec))
50		spec)))
51
52		(defn- reg-resolve
53		"returns the spec/regex at end of alias chain starting with k, nil if not found, k if k not ident"
54		[k]
55		(if (ident? k)
56		(let [reg @registry-ref
57		spec (get reg k)]
58		(if-not (ident? spec)
59		spec
60		(deep-resolve reg spec)))
61		k))
62
63		(defn- reg-resolve!
64		"returns the spec/regex at end of alias chain starting with k, throws if not found, k if k not ident"
65		[k]
66		(if (ident? k)
67		(c/or (reg-resolve k)
68		(throw (Exception. (str "Unable to resolve spec: " k))))
69		k))
70
71		(defn spec?
72		"returns x if x is a spec object, else logical false"
73		[x]
74		(when (instance? clojure.spec.Spec x)
75		x))
76
77		(defn regex?
78		"returns x if x is a (clojure.spec) regex op, else logical false"
79		[x]
80		(c/and (::op x) x))
81
82		(defn- with-name [spec name]
83		(cond
84		(ident? spec) spec
85		(regex? spec) (assoc spec ::name name)
86
87		(instance? clojure.lang.IObj spec)
88		(with-meta spec (assoc (meta spec) ::name name))))
89
90		(defn- spec-name [spec]
91		(cond
92		(ident? spec) spec
93
94		(regex? spec) (::name spec)
95
96		(instance? clojure.lang.IObj spec)
97		(-> (meta spec) ::name)))
98
99		(declare spec-impl)
100		(declare regex-spec-impl)
101
102		(defn- maybe-spec
103		"spec-or-k must be a spec, regex or resolvable kw/sym, else returns nil."
104		[spec-or-k]
105		(let [s (c/or (c/and (ident? spec-or-k) (reg-resolve spec-or-k))
106		(spec? spec-or-k)
107		(regex? spec-or-k)
108		nil)]
109		(if (regex? s)
110		(with-name (regex-spec-impl s nil) (spec-name s))
111		s)))
112
113		(defn- the-spec
114		"spec-or-k must be a spec, regex or kw/sym, else returns nil. Throws if unresolvable kw/sym"
115		[spec-or-k]
116		(c/or (maybe-spec spec-or-k)
117		(when (ident? spec-or-k)
118		(throw (Exception. (str "Unable to resolve spec: " spec-or-k))))))
119
120		(defprotocol Specize
121		(specize* [_] [_ form]))
122
123		(extend-protocol Specize
124		clojure.lang.Keyword
125		(specize* ([k] (specize* (reg-resolve! k)))
126		([k _] (specize* (reg-resolve! k))))
127
128		clojure.lang.Symbol
129		(specize* ([s] (specize* (reg-resolve! s)))
130		([s _] (specize* (reg-resolve! s))))
131
132		Object
133		(specize* ([o] (spec-impl ::unknown o nil nil))
134		([o form] (spec-impl form o nil nil))))
135
136		(defn- specize
137		([s] (c/or (spec? s) (specize* s)))
138		([s form] (c/or (spec? s) (specize* s form))))
139
140		(defn invalid?
141		"tests the validity of a conform return value"
142		[ret]
143		(identical? ::invalid ret))
144
145		(defn conform
146		"Given a spec and a value, returns :clojure.spec/invalid if value does not match spec,
147		else the (possibly destructured) value."
148		[spec x]
149		(conform* (specize spec) x))
150
151		(defn unform
152		"Given a spec and a value created by or compliant with a call to
153		'conform' with the same spec, returns a value with all conform
154		destructuring undone."
155		[spec x]
156		(unform* (specize spec) x))
157
158		(defn form
159		"returns the spec as data"
160		[spec]
161		;;TODO - incorporate gens
162		(describe* (specize spec)))
163
164		(defn abbrev [form]
165		(cond
166		(seq? form)
167		(walk/postwalk (fn [form]
168		(cond
169		(c/and (symbol? form) (namespace form))
170		(-> form name symbol)
171
172		(c/and (seq? form) (= 'fn (first form)) (= '[%] (second form)))
173		(last form)
174
175		:else form))
176		form)
177
178		(c/and (symbol? form) (namespace form))
179		(-> form name symbol)
180
181		:else form))
182
183		(defn describe
184		"returns an abbreviated description of the spec as data"
185		[spec]
186		(abbrev (form spec)))
187
188		(defn with-gen
189		"Takes a spec and a no-arg, generator-returning fn and returns a version of that spec that uses that generator"
190		[spec gen-fn]
191		(let [spec (reg-resolve spec)]
192		(if (regex? spec)
193		(assoc spec ::gfn gen-fn)
194		(with-gen* (specize spec) gen-fn))))
195
196		(defn explain-data* [spec path via in x]
197		(let [probs (explain* (specize spec) path via in x)]
198		(when-not (empty? probs)
199		{::problems probs})))
200
201		(defn explain-data
202		"Given a spec and a value x which ought to conform, returns nil if x
203		conforms, else a map with at least the key ::problems whose value is
204		a collection of problem-maps, where problem-map has at least :path :pred and :val
205		keys describing the predicate and the value that failed at that
206		path."
207		[spec x]
208		(explain-data* spec [] (if-let [name (spec-name spec)] [name] []) [] x))
209
210		(defn explain-printer
211		"Default printer for explain-data. nil indicates a successful validation."
212		[ed]
213		(if ed
214		(do
215		;;(prn {:ed ed})
216		(doseq [{:keys [path pred val reason via in] :as prob} (::problems ed)]
217		(when-not (empty? in)
218		(print "In:" (pr-str in) ""))
219		(print "val: ")
220		(pr val)
221		(print " fails")
222		(when-not (empty? via)
223		(print " spec:" (pr-str (last via))))
224		(when-not (empty? path)
225		(print " at:" (pr-str path)))
226		(print " predicate: ")
227		(pr (abbrev pred))
228		(when reason (print ", " reason))
229		(doseq [[k v] prob]
230		(when-not (#{:path :pred :val :reason :via :in} k)
231		(print "\n\t" (pr-str k) " ")
232		(pr v)))
233		(newline))
234		(doseq [[k v] ed]
235		(when-not (#{::problems} k)
236		(print (pr-str k) " ")
237		(pr v)
238		(newline))))
239		(println "Success!")))
240
241		(def ^:dynamic explain-out explain-printer)
242
243		(defn explain-out
244		"Prints explanation data (per 'explain-data') to out using the printer in explain-out,
245		by default explain-printer."
246		[ed]
247		(explain-out ed))
248
249		(defn explain
250		"Given a spec and a value that fails to conform, prints an explanation to out."
251		[spec x]
252		(explain-out (explain-data spec x)))
253
254		(defn explain-str
255		"Given a spec and a value that fails to conform, returns an explanation as a string."
256		[spec x]
257		(with-out-str (explain spec x)))
258
259		(declare valid?)
260
261		(defn- gensub
262		[spec overrides path rmap form]
263		;;(prn {:spec spec :over overrides :path path :form form})
264		(let [spec (specize spec)]
265		(if-let [g (c/or (when-let [gfn (c/or (get overrides (c/or (spec-name spec) spec))
266		(get overrides path))]
267		(gfn))
268		(gen* spec overrides path rmap))]
269		(gen/such-that #(valid? spec %) g 100)
270		(let [abbr (abbrev form)]
271		(throw (ex-info (str "Unable to construct gen at: " path " for: " abbr)
272		{::path path ::form form ::failure :no-gen}))))))
273
274		(defn gen
275		"Given a spec, returns the generator for it, or throws if none can
276		be constructed. Optionally an overrides map can be provided which
277		should map spec names or paths (vectors of keywords) to no-arg
278		generator-creating fns. These will be used instead of the generators at those
279		names/paths. Note that parent generator (in the spec or overrides
280		map) will supersede those of any subtrees. A generator for a regex
281		op must always return a sequential collection (i.e. a generator for
282		s/? should return either an empty sequence/vector or a
283		sequence/vector with one item in it)"
284		([spec] (gen spec nil))
285		([spec overrides] (gensub spec overrides [] {::recursion-limit recursion-limit} spec)))
286
287		(defn- ->sym
288		"Returns a symbol from a symbol or var"
289		[x]
290		(if (var? x)
291		(let [^clojure.lang.Var v x]
292		(symbol (str (.name (.ns v)))
293		(str (.sym v))))
294		x))
295
296		(defn- unfn [expr]
297		(if (c/and (seq? expr)
298		(symbol? (first expr))
299		(= "fn*" (name (first expr))))
300		(let [[[s] & form] (rest expr)]
301		(conj (walk/postwalk-replace {s '%} form) '[%] 'fn))
302		expr))
303
304		(defn- res [form]
305		(cond
306		(keyword? form) form
307		(symbol? form) (c/or (-> form resolve ->sym) form)
308		(sequential? form) (walk/postwalk #(if (symbol? %) (res %) %) (unfn form))
309		:else form))
310
311		(defn ^:skip-wiki def-impl
312		"Do not call this directly, use 'def'"
313		[k form spec]
314		(c/assert (c/and (ident? k) (namespace k)) "k must be namespaced keyword or resolvable symbol")
315		(let [spec (if (c/or (spec? spec) (regex? spec) (get @registry-ref spec))
316		spec
317		(spec-impl form spec nil nil))]
318		(swap! registry-ref assoc k (with-name spec k))
319		k))
320
321		(defn- ns-qualify
322		"Qualify symbol s by resolving it or using the current ns."
323		[s]
324		(if-let [ns-sym (some-> s namespace symbol)]
325		(c/or (some-> (get (ns-aliases ns) ns-sym) str (symbol (name s)))
326		s)
327		(symbol (str (.name ns)) (str s))))
328
329		(defmacro def
330		"Given a namespace-qualified keyword or resolvable symbol k, and a
331		spec, spec-name, predicate or regex-op makes an entry in the
332		registry mapping k to the spec"
333		[k spec-form]
334		(let [k (if (symbol? k) (ns-qualify k) k)]
335		`(def-impl '~k '~(res spec-form) ~spec-form)))
336
337		(defn registry
338		"returns the registry map, prefer 'get-spec' to lookup a spec by name"
339		[]
340		@registry-ref)
341
342		(defn get-spec
343		"Returns spec registered for keyword/symbol/var k, or nil."
344		[k]
345		(get (registry) (if (keyword? k) k (->sym k))))
346
347		(declare map-spec)
348
349		(defmacro spec
350		"Takes a single predicate form, e.g. can be the name of a predicate,
351		like even?, or a fn literal like #(< % 42). Note that it is not
352		generally necessary to wrap predicates in spec when using the rest
353		of the spec macros, only to attach a unique generator
354
355		Can also be passed the result of one of the regex ops -
356		cat, alt, *, +, ?, in which case it will return a regex-conforming
357		spec, useful when nesting an independent regex.
358		---
359
360		Optionally takes :gen generator-fn, which must be a fn of no args that
361		returns a test.check generator.
362
363		Returns a spec."
364		[form & {:keys [gen]}]
365		(when form
366		`(spec-impl '~(res form) ~form ~gen nil)))
367
368		(defmacro multi-spec
369		"Takes the name of a spec/predicate-returning multimethod and a
370		tag-restoring keyword or fn (retag). Returns a spec that when
371		conforming or explaining data will pass it to the multimethod to get
372		an appropriate spec. You can e.g. use multi-spec to dynamically and
373		extensibly associate specs with 'tagged' data (i.e. data where one
374		of the fields indicates the shape of the rest of the structure).
375
376		(defmulti mspec :tag)
377
378		The methods should ignore their argument and return a predicate/spec:
379		(defmethod mspec :int [_] (s/keys :req-un [::tag ::i]))
380
381		retag is used during generation to retag generated values with
382		matching tags. retag can either be a keyword, at which key the
383		dispatch-tag will be assoc'ed, or a fn of generated value and
384		dispatch-tag that should return an appropriately retagged value.
385
386		Note that because the tags themselves comprise an open set,
387		the tag key spec cannot enumerate the values, but can e.g.
388		test for keyword?.
389
390		Note also that the dispatch values of the multimethod will be
391		included in the path, i.e. in reporting and gen overrides, even
392		though those values are not evident in the spec.
393		"
394		[mm retag]
395		`(multi-spec-impl '~(res mm) (var ~mm) ~retag))
396
397		(defmacro keys
398		"Creates and returns a map validating spec. :req and :opt are both
399		vectors of namespaced-qualified keywords. The validator will ensure
400		the :req keys are present. The :opt keys serve as documentation and
401		may be used by the generator.
402
403		The :req key vector supports 'and' and 'or' for key groups:
404
405		(s/keys :req [::x ::y (or ::secret (and ::user ::pwd))] :opt [::z])
406
407		There are also -un versions of :req and :opt. These allow
408		you to connect unqualified keys to specs. In each case, fully
409		qualfied keywords are passed, which name the specs, but unqualified
410		keys (with the same name component) are expected and checked at
411		conform-time, and generated during gen:
412
413		(s/keys :req-un [:my.ns/x :my.ns/y])
414
415		The above says keys :x and :y are required, and will be validated
416		and generated by specs (if they exist) named :my.ns/x :my.ns/y
417		respectively.
418
419		In addition, the values of all namespace-qualified keys will be validated
420		(and possibly destructured) by any registered specs. Note: there is
421		no support for inline value specification, by design.
422
423		Optionally takes :gen generator-fn, which must be a fn of no args that
424		returns a test.check generator."
425		[& {:keys [req req-un opt opt-un gen]}]
426		(let [unk #(-> % name keyword)
427		req-keys (filterv keyword? (flatten req))
428		req-un-specs (filterv keyword? (flatten req-un))
429		_ (c/assert (every? #(c/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un))
430		"all keys must be namespace-qualified keywords")
431		req-specs (into req-keys req-un-specs)
432		req-keys (into req-keys (map unk req-un-specs))
433		opt-keys (into (vec opt) (map unk opt-un))
434		opt-specs (into (vec opt) opt-un)
435		gx (gensym)
436		parse-req (fn [rk f]
437		(map (fn [x]
438		(if (keyword? x)
439		`(contains? ~gx ~(f x))
440		(walk/postwalk
441		(fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y))
442		x)))
443		rk))
444		pred-exprs [`(map? ~gx)]
445		pred-exprs (into pred-exprs (parse-req req identity))
446		pred-exprs (into pred-exprs (parse-req req-un unk))
447		keys-pred `(fn* [~gx] (c/and ~@pred-exprs))
448		pred-exprs (mapv (fn [e] `(fn* [~gx] ~e)) pred-exprs)
449		pred-forms (walk/postwalk res pred-exprs)]
450		;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen)
451		`(map-spec-impl {:req '~req :opt '~opt :req-un '~req-un :opt-un '~opt-un
452		:req-keys '~req-keys :req-specs '~req-specs
453		:opt-keys '~opt-keys :opt-specs '~opt-specs
454		:pred-forms '~pred-forms
455		:pred-exprs ~pred-exprs
456		:keys-pred ~keys-pred
457		:gfn ~gen})))
458
459		(defmacro or
460		"Takes key+pred pairs, e.g.
461
462		(s/or :even even? :small #(< % 42))
463
464		Returns a destructuring spec that returns a map entry containing the
465		key of the first matching pred and the corresponding value. Thus the
466		'key' and 'val' functions can be used to refer generically to the
467		components of the tagged return."
468		[& key-pred-forms]
469		(let [pairs (partition 2 key-pred-forms)
470		keys (mapv first pairs)
471		pred-forms (mapv second pairs)
472		pf (mapv res pred-forms)]
473		(c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords")
474		`(or-spec-impl ~keys '~pf ~pred-forms nil)))
475
476		(defmacro and
477		"Takes predicate/spec-forms, e.g.
478
479		(s/and even? #(< % 42))
480
481		Returns a spec that returns the conformed value. Successive
482		conformed values propagate through rest of predicates."
483		[& pred-forms]
484		`(and-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil))
485
486		(defmacro merge
487		"Takes map-validating specs (e.g. 'keys' specs) and
488		returns a spec that returns a conformed map satisfying all of the
489		specs. Unlike 'and', merge can generate maps satisfying the
490		union of the predicates."
491		[& pred-forms]
492		`(merge-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil))
493
494		(defn- res-kind
495		[opts]
496		(let [{kind :kind :as mopts} opts]
497		(->>
498		(if kind
499		(assoc mopts :kind `~(res kind))
500		mopts)
501		(mapcat identity))))
502
503		(defmacro every
504		"takes a pred and validates collection elements against that pred.
505
506		Note that 'every' does not do exhaustive checking, rather it samples
507		coll-check-limit elements. Nor (as a result) does it do any
508		conforming of elements. 'explain' will report at most coll-error-limit
509		problems. Thus 'every' should be suitable for potentially large
510		collections.
511
512		Takes several kwargs options that further constrain the collection:
513
514		:kind - a pred/spec that the collection type must satisfy, e.g. vector?
515		(default nil) Note that if :kind is specified and :into is
516		not, this pred must generate in order for every to generate.
517		:count - specifies coll has exactly this count (default nil)
518		:min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil)
519		:distinct - all the elements are distinct (default nil)
520
521		And additional args that control gen
522
523		:gen-max - the maximum coll size to generate (default 20)
524		:into - one of [], (), {}, #{} - the default collection to generate into
525		(default: empty coll as generated by :kind pred if supplied, else [])
526
527		Optionally takes :gen generator-fn, which must be a fn of no args that
528		returns a test.check generator
529
530		See also - coll-of, every-kv
531		"
532		[pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}]
533		(let [desc (::describe opts)
534		nopts (-> opts
535		(dissoc :gen ::describe)
536		(assoc ::kind-form `'~(res (:kind opts))
537		::describe (c/or desc `'(every ~(res pred) ~@(res-kind opts)))))
538		gx (gensym)
539		cpreds (cond-> [(list (c/or kind `coll?) gx)]
540		count (conj `(= ~count (bounded-count ~count ~gx)))
541
542		(c/or min-count max-count)
543		(conj `(<= (c/or ~min-count 0)
544		(bounded-count (if ~max-count (inc ~max-count) ~min-count) ~gx)
545		(c/or ~max-count Integer/MAX_VALUE)))
546
547		distinct
548		(conj `(c/or (empty? ~gx) (apply distinct? ~gx))))]
549		`(every-impl '~pred ~pred ~(assoc nopts ::cpred `(fn* [~gx] (c/and ~@cpreds))) ~gen)))
550
551		(defmacro every-kv
552		"like 'every' but takes separate key and val preds and works on associative collections.
553
554		Same options as 'every', :into defaults to {}
555
556		See also - map-of"
557
558		[kpred vpred & opts]
559		(let [desc `(every-kv ~(res kpred) ~(res vpred) ~@(res-kind opts))]
560		`(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :into {} ::describe '~desc ~@opts)))
561
562		(defmacro coll-of
563		"Returns a spec for a collection of items satisfying pred. Unlike
564		'every', coll-of will exhaustively conform every value.
565
566		Same options as 'every'. conform will produce a collection
567		corresponding to :into if supplied, else will match the input collection,
568		avoiding rebuilding when possible.
569
570		See also - every, map-of"
571		[pred & opts]
572		(let [desc `(coll-of ~(res pred) ~@(res-kind opts))]
573		`(every ~pred ::conform-all true ::describe '~desc ~@opts)))
574
575		(defmacro map-of
576		"Returns a spec for a map whose keys satisfy kpred and vals satisfy
577		vpred. Unlike 'every-kv', map-of will exhaustively conform every
578		value.
579
580		Same options as 'every', :kind defaults to map?, with the addition of:
581
582		:conform-keys - conform keys as well as values (default false)
583
584		See also - every-kv"
585		[kpred vpred & opts]
586		(let [desc `(map-of ~(res kpred) ~(res vpred) ~@(res-kind opts))]
587		`(every-kv ~kpred ~vpred ::conform-all true :kind map? ::describe '~desc ~@opts)))
588
589
590		(defmacro *
591		"Returns a regex op that matches zero or more values matching
592		pred. Produces a vector of matches iff there is at least one match"
593		[pred-form]
594		`(rep-impl '~(res pred-form) ~pred-form))
595
596		(defmacro +
597		"Returns a regex op that matches one or more values matching
598		pred. Produces a vector of matches"
599		[pred-form]
600		`(rep+impl '~(res pred-form) ~pred-form))
601
602		(defmacro ?
603		"Returns a regex op that matches zero or one value matching
604		pred. Produces a single value (not a collection) if matched."
605		[pred-form]
606		`(maybe-impl ~pred-form '~pred-form))
607
608		(defmacro alt
609		"Takes key+pred pairs, e.g.
610
611		(s/alt :even even? :small #(< % 42))
612
613		Returns a regex op that returns a map entry containing the key of the
614		first matching pred and the corresponding value. Thus the
615		'key' and 'val' functions can be used to refer generically to the
616		components of the tagged return"
617		[& key-pred-forms]
618		(let [pairs (partition 2 key-pred-forms)
619		keys (mapv first pairs)
620		pred-forms (mapv second pairs)
621		pf (mapv res pred-forms)]
622		(c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords")
623		`(alt-impl ~keys ~pred-forms '~pf)))
624
625		(defmacro cat
626		"Takes key+pred pairs, e.g.
627
628		(s/cat :e even? :o odd?)
629
630		Returns a regex op that matches (all) values in sequence, returning a map
631		containing the keys of each pred and the corresponding value."
632		[& key-pred-forms]
633		(let [pairs (partition 2 key-pred-forms)
634		keys (mapv first pairs)
635		pred-forms (mapv second pairs)
636		pf (mapv res pred-forms)]
637		;;(prn key-pred-forms)
638		(c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords")
639		`(cat-impl ~keys ~pred-forms '~pf)))
640
641		(defmacro &
642		"takes a regex op re, and predicates. Returns a regex-op that consumes
643		input as per re but subjects the resulting value to the
644		conjunction of the predicates, and any conforming they might perform."
645		[re & preds]
646		(let [pv (vec preds)]
647		`(amp-impl ~re ~pv '~(mapv res pv))))
648
649		(defmacro conformer
650		"takes a predicate function with the semantics of conform i.e. it should return either a
651		(possibly converted) value or :clojure.spec/invalid, and returns a
652		spec that uses it as a predicate/conformer. Optionally takes a
653		second fn that does unform of result of first"
654		([f] `(spec-impl '(conformer ~(res f)) ~f nil true))
655		([f unf] `(spec-impl '(conformer ~(res f) ~(res unf)) ~f nil true ~unf)))
656
657		(defmacro fspec
658		"takes :args :ret and (optional) :fn kwargs whose values are preds
659		and returns a spec whose conform/explain take a fn and validates it
660		using generative testing. The conformed value is always the fn itself.
661
662		See 'fdef' for a single operation that creates an fspec and
663		registers it, as well as a full description of :args, :ret and :fn
664
665		fspecs can generate functions that validate the arguments and
666		fabricate a return value compliant with the :ret spec, ignoring
667		the :fn spec if present.
668
669		Optionally takes :gen generator-fn, which must be a fn of no args
670		that returns a test.check generator."
671
672		[& {:keys [args ret fn gen]}]
673		`(fspec-impl (spec ~args) '~(res args)
674		(spec ~ret) '~(res ret)
675		(spec ~fn) '~(res fn) ~gen))
676
677		(defmacro tuple
678		"takes one or more preds and returns a spec for a tuple, a vector
679		where each element conforms to the corresponding pred. Each element
680		will be referred to in paths using its ordinal."
681		[& preds]
682		(c/assert (not (empty? preds)))
683		`(tuple-impl '~(mapv res preds) ~(vec preds)))
684
685		(defn- macroexpand-check
686		[v args]
687		(let [fn-spec (get-spec v)]
688		(when-let [arg-spec (:args fn-spec)]
689		(when (invalid? (conform arg-spec args))
690		(let [ed (assoc (explain-data* arg-spec [:args]
691		(if-let [name (spec-name arg-spec)] [name] []) [] args)
692		::args args)]
693		(throw (ex-info
694		(str
695		"Call to " (->sym v) " did not conform to spec:\n"
696		(with-out-str (explain-out ed)))
697		ed)))))))
698
699		(defmacro fdef
700		"Takes a symbol naming a function, and one or more of the following:
701
702		:args A regex spec for the function arguments as they were a list to be
703		passed to apply - in this way, a single spec can handle functions with
704		multiple arities
705		:ret A spec for the function's return value
706		:fn A spec of the relationship between args and ret - the
707		value passed is {:args conformed-args :ret conformed-ret} and is
708		expected to contain predicates that relate those values
709
710		Qualifies fn-sym with resolve, or using ns if no resolution found.
711		Registers an fspec in the global registry, where it can be retrieved
712		by calling get-spec with the var or fully-qualified symbol.
713
714		Once registered, function specs are included in doc, checked by
715		instrument, tested by the runner clojure.spec.test/check, and (if
716		a macro) used to explain errors during macroexpansion.
717
718		Note that :fn specs require the presence of :args and :ret specs to
719		conform values, and so :fn specs will be ignored if :args or :ret
720		are missing.
721
722		Returns the qualified fn-sym.
723
724		For example, to register function specs for the symbol function:
725
726		(s/fdef clojure.core/symbol
727		:args (s/alt :separate (s/cat :ns string? :n string?)
728		:str string?
729		:sym symbol?)
730		:ret symbol?)"
731		[fn-sym & specs]
732		`(clojure.spec/def ~fn-sym (clojure.spec/fspec ~@specs)))
733
734		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
735		(defn- recur-limit? [rmap id path k]
736		(c/and (> (get rmap id) (::recursion-limit rmap))
737		(contains? (set path) k)))
738
739		(defn- inck [m k]
740		(assoc m k (inc (c/or (get m k) 0))))
741
742		(defn- dt
743		([pred x form] (dt pred x form nil))
744		([pred x form cpred?]
745		(if pred
746		(if-let [spec (the-spec pred)]
747		(conform spec x)
748		(if (ifn? pred)
749		(if cpred?
750		(pred x)
751		(if (pred x) x ::invalid))
752		(throw (Exception. (str (pr-str form) " is not a fn, expected predicate fn")))))
753		x)))
754
755		(defn valid?
756		"Helper function that returns true when x is valid for spec."
757		([spec x]
758		(let [spec (specize spec)]
759		(not (invalid? (conform* spec x)))))
760		([spec x form]
761		(let [spec (specize spec form)]
762		(not (invalid? (conform* spec x))))))
763
764		(defn- pvalid?
765		"internal helper function that returns true when x is valid for spec."
766		([pred x]
767		(not (invalid? (dt pred x ::unknown))))
768		([pred x form]
769		(not (invalid? (dt pred x form)))))
770
771		(defn- explain-1 [form pred path via in v]
772		;;(prn {:form form :pred pred :path path :in in :v v})
773		(let [pred (maybe-spec pred)]
774		(if (spec? pred)
775		(explain* pred path (if-let [name (spec-name pred)] (conj via name) via) in v)
776		[{:path path :pred (abbrev form) :val v :via via :in in}])))
777
778		(defn ^:skip-wiki map-spec-impl
779		"Do not call this directly, use 'spec' with a map argument"
780		[{:keys [req-un opt-un keys-pred pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn]
781		:as argm}]
782		(let [k->s (zipmap (concat req-keys opt-keys) (concat req-specs opt-specs))
783		keys->specnames #(c/or (k->s %) %)
784		id (java.util.UUID/randomUUID)]
785		(reify
786		Specize
787		(specize* [s] s)
788		(specize* [s _] s)
789
790		Spec
791		(conform* [_ m]
792		(if (keys-pred m)
793		(let [reg (registry)]
794		(loop [ret m, [[k v] & ks :as keys] m]
795		(if keys
796		(let [sname (keys->specnames k)]
797		(if-let [s (get reg sname)]
798		(let [cv (conform s v)]
799		(if (invalid? cv)
800		::invalid
801		(recur (if (identical? cv v) ret (assoc ret k cv))
802		ks)))
803		(recur ret ks)))
804		ret)))
805		::invalid))
806		(unform* [_ m]
807		(let [reg (registry)]
808		(loop [ret m, [k & ks :as keys] (c/keys m)]
809		(if keys
810		(if (contains? reg (keys->specnames k))
811		(let [cv (get m k)
812		v (unform (keys->specnames k) cv)]
813		(recur (if (identical? cv v) ret (assoc ret k v))
814		ks))
815		(recur ret ks))
816		ret))))
817		(explain* [_ path via in x]
818		(if-not (map? x)
819		[{:path path :pred 'map? :val x :via via :in in}]
820		(let [reg (registry)]
821		(apply concat
822		(when-let [probs (->> (map (fn [pred form] (when-not (pred x) (abbrev form)))
823		pred-exprs pred-forms)
824		(keep identity)
825		seq)]
826		(map
827		#(identity {:path path :pred % :val x :via via :in in})
828		probs))
829		(map (fn [[k v]]
830		(when-not (c/or (not (contains? reg (keys->specnames k)))
831		(pvalid? (keys->specnames k) v k))
832		(explain-1 (keys->specnames k) (keys->specnames k) (conj path k) via (conj in k) v)))
833		(seq x))))))
834		(gen* [_ overrides path rmap]
835		(if gfn
836		(gfn)
837		(let [rmap (inck rmap id)
838		gen (fn [k s] (gensub s overrides (conj path k) rmap k))
839		ogen (fn [k s]
840		(when-not (recur-limit? rmap id path k)
841		[k (gen/delay (gensub s overrides (conj path k) rmap k))]))
842		req-gens (map gen req-keys req-specs)
843		opt-gens (remove nil? (map ogen opt-keys opt-specs))]
844		(when (every? identity (concat req-gens opt-gens))
845		(let [reqs (zipmap req-keys req-gens)
846		opts (into {} opt-gens)]
847		(gen/bind (gen/choose 0 (count opts))
848		#(let [args (concat (seq reqs) (when (seq opts) (shuffle (seq opts))))]
849		(->> args
850		(take (c/+ % (count reqs)))
851		(apply concat)
852		(apply gen/hash-map)))))))))
853		(with-gen* [_ gfn] (map-spec-impl (assoc argm :gfn gfn)))
854		(describe* [_] (cons `keys
855		(cond-> []
856		req (conj :req req)
857		opt (conj :opt opt)
858		req-un (conj :req-un req-un)
859		opt-un (conj :opt-un opt-un)))))))
860
861
862
863
864		(defn ^:skip-wiki spec-impl
865		"Do not call this directly, use 'spec'"
866		([form pred gfn cpred?] (spec-impl form pred gfn cpred? nil))
867		([form pred gfn cpred? unc]
868		(cond
869		(spec? pred) (cond-> pred gfn (with-gen gfn))
870		(regex? pred) (regex-spec-impl pred gfn)
871		(ident? pred) (cond-> (the-spec pred) gfn (with-gen gfn))
872		:else
873		(reify
874		Specize
875		(specize* [s] s)
876		(specize* [s _] s)
877
878		Spec
879		(conform* [_ x] (let [ret (pred x)]
880		(if cpred?
881		ret
882		(if ret x ::invalid))))
883		(unform* [_ x] (if cpred?
884		(if unc
885		(unc x)
886		(throw (IllegalStateException. "no unform fn for conformer")))
887		x))
888		(explain* [_ path via in x]
889		(when (invalid? (dt pred x form cpred?))
890		[{:path path :pred (abbrev form) :val x :via via :in in}]))
891		(gen* [_ _ _ _] (if gfn
892		(gfn)
893		(gen/gen-for-pred pred)))
894		(with-gen* [_ gfn] (spec-impl form pred gfn cpred? unc))
895		(describe* [_] form)))))
896
897		(defn ^:skip-wiki multi-spec-impl
898		"Do not call this directly, use 'multi-spec'"
899		([form mmvar retag] (multi-spec-impl form mmvar retag nil))
900		([form mmvar retag gfn]
901		(let [id (java.util.UUID/randomUUID)
902		predx #(let [^clojure.lang.MultiFn mm @mmvar]
903		(c/and (.getMethod mm ((.dispatchFn mm) %))
904		(mm %)))
905		dval #((.dispatchFn ^clojure.lang.MultiFn @mmvar) %)
906		tag (if (keyword? retag)
907		#(assoc %1 retag %2)
908		retag)]
909		(reify
910		Specize
911		(specize* [s] s)
912		(specize* [s _] s)
913
914		Spec
915		(conform* [_ x] (if-let [pred (predx x)]
916		(dt pred x form)
917		::invalid))
918		(unform* [_ x] (if-let [pred (predx x)]
919		(unform pred x)
920		(throw (IllegalStateException. (str "No method of: " form " for dispatch value: " (dval x))))))
921		(explain* [_ path via in x]
922		(let [dv (dval x)
923		path (conj path dv)]
924		(if-let [pred (predx x)]
925		(explain-1 form pred path via in x)
926		[{:path path :pred (abbrev form) :val x :reason "no method" :via via :in in}])))
927		(gen* [_ overrides path rmap]
928		(if gfn
929		(gfn)
930		(let [gen (fn [[k f]]
931		(let [p (f nil)]
932		(let [rmap (inck rmap id)]
933		(when-not (recur-limit? rmap id path k)
934		(gen/delay
935		(gen/fmap
936		#(tag % k)
937		(gensub p overrides (conj path k) rmap (list 'method form k))))))))
938		gs (->> (methods @mmvar)
939		(remove (fn [[k]] (invalid? k)))
940		(map gen)
941		(remove nil?))]
942		(when (every? identity gs)
943		(gen/one-of gs)))))
944		(with-gen* [_ gfn] (multi-spec-impl form mmvar retag gfn))
945		(describe* [_] `(multi-spec ~form ~retag))))))
946
947		(defn ^:skip-wiki tuple-impl
948		"Do not call this directly, use 'tuple'"
949		([forms preds] (tuple-impl forms preds nil))
950		([forms preds gfn]
951		(let [specs (delay (mapv specize preds forms))
952		cnt (count preds)]
953		(reify
954		Specize
955		(specize* [s] s)
956		(specize* [s _] s)
957
958		Spec
959		(conform* [_ x]
960		(let [specs @specs]
961		(if-not (c/and (vector? x)
962		(= (count x) cnt))
963		::invalid
964		(loop [ret x, i 0]
965		(if (= i cnt)
966		ret
967		(let [v (x i)
968		cv (conform* (specs i) v)]
969		(if (invalid? cv)
970		::invalid
971		(recur (if (identical? cv v) ret (assoc ret i cv))
972		(inc i)))))))))
973		(unform* [_ x]
974		(c/assert (c/and (vector? x)
975		(= (count x) (count preds))))
976		(loop [ret x, i 0]
977		(if (= i (count x))
978		ret
979		(let [cv (x i)
980		v (unform (preds i) cv)]
981		(recur (if (identical? cv v) ret (assoc ret i v))
982		(inc i))))))
983		(explain* [_ path via in x]
984		(cond
985		(not (vector? x))
986		[{:path path :pred 'vector? :val x :via via :in in}]
987
988		(not= (count x) (count preds))
989		[{:path path :pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}]
990
991		:else
992		(apply concat
993		(map (fn [i form pred]
994		(let [v (x i)]
995		(when-not (pvalid? pred v)
996		(explain-1 form pred (conj path i) via (conj in i) v))))
997		(range (count preds)) forms preds))))
998		(gen* [_ overrides path rmap]
999		(if gfn
1000		(gfn)
1001		(let [gen (fn [i p f]
1002		(gensub p overrides (conj path i) rmap f))
1003		gs (map gen (range (count preds)) preds forms)]
1004		(when (every? identity gs)
1005		(apply gen/tuple gs)))))
1006		(with-gen* [_ gfn] (tuple-impl forms preds gfn))
1007		(describe* [_] `(tuple ~@forms))))))
1008
1009		(defn- tagged-ret [tag ret]
1010		(clojure.lang.MapEntry. tag ret))
1011
1012		(defn ^:skip-wiki or-spec-impl
1013		"Do not call this directly, use 'or'"
1014		[keys forms preds gfn]
1015		(let [id (java.util.UUID/randomUUID)
1016		kps (zipmap keys preds)
1017		specs (delay (mapv specize preds forms))
1018		cform (case (count preds)
1019		2 (fn [x]
1020		(let [specs @specs
1021		ret (conform* (specs 0) x)]
1022		(if (invalid? ret)
1023		(let [ret (conform* (specs 1) x)]
1024		(if (invalid? ret)
1025		::invalid
1026		(tagged-ret (keys 1) ret)))
1027		(tagged-ret (keys 0) ret))))
1028		3 (fn [x]
1029		(let [specs @specs
1030		ret (conform* (specs 0) x)]
1031		(if (invalid? ret)
1032		(let [ret (conform* (specs 1) x)]
1033		(if (invalid? ret)
1034		(let [ret (conform* (specs 2) x)]
1035		(if (invalid? ret)
1036		::invalid
1037		(tagged-ret (keys 2) ret)))
1038		(tagged-ret (keys 1) ret)))
1039		(tagged-ret (keys 0) ret))))
1040		(fn [x]
1041		(let [specs @specs]
1042		(loop [i 0]
1043		(if (< i (count specs))
1044		(let [spec (specs i)]
1045		(let [ret (conform* spec x)]
1046		(if (invalid? ret)
1047		(recur (inc i))
1048		(tagged-ret (keys i) ret))))
1049		::invalid)))))]
1050		(reify
1051		Specize
1052		(specize* [s] s)
1053		(specize* [s _] s)
1054
1055		Spec
1056		(conform* [_ x] (cform x))
1057		(unform* [_ [k x]] (unform (kps k) x))
1058		(explain* [this path via in x]
1059		(when-not (pvalid? this x)
1060		(apply concat
1061		(map (fn [k form pred]
1062		(when-not (pvalid? pred x)
1063		(explain-1 form pred (conj path k) via in x)))
1064		keys forms preds))))
1065		(gen* [_ overrides path rmap]
1066		(if gfn
1067		(gfn)
1068		(let [gen (fn [k p f]
1069		(let [rmap (inck rmap id)]
1070		(when-not (recur-limit? rmap id path k)
1071		(gen/delay
1072		(gensub p overrides (conj path k) rmap f)))))
1073		gs (remove nil? (map gen keys preds forms))]
1074		(when-not (empty? gs)
1075		(gen/one-of gs)))))
1076		(with-gen* [_ gfn] (or-spec-impl keys forms preds gfn))
1077		(describe* [_] `(or ~@(mapcat vector keys forms))))))
1078
1079		(defn- and-preds [x preds forms]
1080		(loop [ret x
1081		[pred & preds] preds
1082		[form & forms] forms]
1083		(if pred
1084		(let [nret (dt pred ret form)]
1085		(if (invalid? nret)
1086		::invalid
1087		;;propagate conformed values
1088		(recur nret preds forms)))
1089		ret)))
1090
1091		(defn- explain-pred-list
1092		[forms preds path via in x]
1093		(loop [ret x
1094		[form & forms] forms
1095		[pred & preds] preds]
1096		(when pred
1097		(let [nret (dt pred ret form)]
1098		(if (invalid? nret)
1099		(explain-1 form pred path via in ret)
1100		(recur nret forms preds))))))
1101
1102		(defn ^:skip-wiki and-spec-impl
1103		"Do not call this directly, use 'and'"
1104		[forms preds gfn]
1105		(let [specs (delay (mapv specize preds forms))
1106		cform
1107		(case (count preds)
1108		2 (fn [x]
1109		(let [specs @specs
1110		ret (conform* (specs 0) x)]
1111		(if (invalid? ret)
1112		::invalid
1113		(conform* (specs 1) ret))))
1114		3 (fn [x]
1115		(let [specs @specs
1116		ret (conform* (specs 0) x)]
1117		(if (invalid? ret)
1118		::invalid
1119		(let [ret (conform* (specs 1) ret)]
1120		(if (invalid? ret)
1121		::invalid
1122		(conform* (specs 2) ret))))))
1123		(fn [x]
1124		(let [specs @specs]
1125		(loop [ret x i 0]
1126		(if (< i (count specs))
1127		(let [nret (conform* (specs i) ret)]
1128		(if (invalid? nret)
1129		::invalid
1130		;;propagate conformed values
1131		(recur nret (inc i))))
1132		ret)))))]
1133		(reify
1134		Specize
1135		(specize* [s] s)
1136		(specize* [s _] s)
1137
1138		Spec
1139		(conform* [_ x] (cform x))
1140		(unform* [_ x] (reduce #(unform %2 %1) x (reverse preds)))
1141		(explain* [_ path via in x] (explain-pred-list forms preds path via in x))
1142		(gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms))))
1143		(with-gen* [_ gfn] (and-spec-impl forms preds gfn))
1144		(describe* [_] `(and ~@forms)))))
1145
1146		(defn ^:skip-wiki merge-spec-impl
1147		"Do not call this directly, use 'merge'"
1148		[forms preds gfn]
1149		(reify
1150		Specize
1151		(specize* [s] s)
1152		(specize* [s _] s)
1153
1154		Spec
1155		(conform* [_ x] (let [ms (map #(dt %1 x %2) preds forms)]
1156		(if (some invalid? ms)
1157		::invalid
1158		(apply c/merge ms))))
1159		(unform* [_ x] (apply c/merge (map #(unform % x) (reverse preds))))
1160		(explain* [_ path via in x]
1161		(apply concat
1162		(map #(explain-1 %1 %2 path via in x)
1163		forms preds)))
1164		(gen* [_ overrides path rmap]
1165		(if gfn
1166		(gfn)
1167		(gen/fmap
1168		#(apply c/merge %)
1169		(apply gen/tuple (map #(gensub %1 overrides path rmap %2)
1170		preds forms)))))
1171		(with-gen* [_ gfn] (merge-spec-impl forms preds gfn))
1172		(describe* [_] `(merge ~@forms))))
1173
1174		(defn- coll-prob [x kfn kform distinct count min-count max-count
1175		path via in]
1176		(let [pred (c/or kfn coll?)
1177		kform (c/or kform `coll?)]
1178		(cond
1179		(not (pvalid? pred x))
1180		(explain-1 kform pred path via in x)
1181
1182		(c/and count (not= count (bounded-count count x)))
1183		[{:path path :pred `(= ~count (c/count ~'%)) :val x :via via :in in}]
1184
1185		(c/and (c/or min-count max-count)
1186		(not (<= (c/or min-count 0)
1187		(bounded-count (if max-count (inc max-count) min-count) x)
1188		(c/or max-count Integer/MAX_VALUE))))
1189		[{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}]
1190
1191		(c/and distinct (not (empty? x)) (not (apply distinct? x)))
1192		[{:path path :pred 'distinct? :val x :via via :in in}])))
1193
1194		(defn ^:skip-wiki every-impl
1195		"Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'"
1196		([form pred opts] (every-impl form pred opts nil))
1197		([form pred {gen-into :into
1198		describe-form ::describe
1199		:keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn ::cpred
1200		conform-keys ::conform-all]
1201		:or {gen-max 20}
1202		:as opts}
1203		gfn]
1204		(let [conform-into gen-into
1205		spec (delay (specize pred))
1206		check? #(valid? @spec %)
1207		kfn (c/or kfn (fn [i v] i))
1208		addcv (fn [ret i v cv] (conj ret cv))
1209		cfns (fn [x]
1210		;;returns a tuple of [init add complete] fns
1211		(cond
1212		(c/and (vector? x) (c/or (not conform-into) (vector? conform-into)))
1213		[identity
1214		(fn [ret i v cv]
1215		(if (identical? v cv)
1216		ret
1217		(assoc ret i cv)))
1218		identity]
1219
1220		(c/and (map? x) (c/or (c/and kind (not conform-into)) (map? conform-into)))
1221		[(if conform-keys empty identity)
1222		(fn [ret i v cv]
1223		(if (c/and (identical? v cv) (not conform-keys))
1224		ret
1225		(assoc ret (nth (if conform-keys cv v) 0) (nth cv 1))))
1226		identity]
1227
1228		(c/or (list? conform-into) (seq? conform-into) (c/and (not conform-into) (c/or (list? x) (seq? x))))
1229		[(constantly ()) addcv reverse]
1230
1231		:else [#(empty (c/or conform-into %)) addcv identity]))]
1232		(reify
1233		Specize
1234		(specize* [s] s)
1235		(specize* [s _] s)
1236
1237		Spec
1238		(conform* [_ x]
1239		(let [spec @spec]
1240		(cond
1241		(not (cpred x)) ::invalid
1242
1243		conform-all
1244		(let [[init add complete] (cfns x)]
1245		(loop [ret (init x), i 0, [v & vs :as vseq] (seq x)]
1246		(if vseq
1247		(let [cv (conform* spec v)]
1248		(if (invalid? cv)
1249		::invalid
1250		(recur (add ret i v cv) (inc i) vs)))
1251		(complete ret))))
1252
1253
1254		:else
1255		(if (indexed? x)
1256		(let [step (max 1 (long (/ (c/count x) coll-check-limit)))]
1257		(loop [i 0]
1258		(if (>= i (c/count x))
1259		x
1260		(if (valid? spec (nth x i))
1261		(recur (c/+ i step))
1262		::invalid))))
1263		(let [limit coll-check-limit]
1264		(loop [i 0 [v & vs :as vseq] (seq x)]
1265		(cond
1266		(c/or (nil? vseq) (= i limit)) x
1267		(valid? spec v) (recur (inc i) vs)
1268		:else ::invalid)))))))
1269		(unform* [_ x] x)
1270		(explain* [_ path via in x]
1271		(c/or (coll-prob x kind kind-form distinct count min-count max-count
1272		path via in)
1273		(apply concat
1274		((if conform-all identity (partial take coll-error-limit))
1275		(keep identity
1276		(map (fn [i v]
1277		(let [k (kfn i v)]
1278		(when-not (check? v)
1279		(let [prob (explain-1 form pred path via (conj in k) v)]
1280		prob))))
1281		(range) x))))))
1282		(gen* [_ overrides path rmap]
1283		(if gfn
1284		(gfn)
1285		(let [pgen (gensub pred overrides path rmap form)]
1286		(gen/bind
1287		(cond
1288		gen-into (gen/return (empty gen-into))
1289		kind (gen/fmap #(if (empty? %) % (empty %))
1290		(gensub kind overrides path rmap form))
1291		:else (gen/return []))
1292		(fn [init]
1293		(gen/fmap
1294		#(if (vector? init) % (into init %))
1295		(cond
1296		distinct
1297		(if count
1298		(gen/vector-distinct pgen {:num-elements count :max-tries 100})
1299		(gen/vector-distinct pgen {:min-elements (c/or min-count 0)
1300		:max-elements (c/or max-count (max gen-max (c/* 2 (c/or min-count 0))))
1301		:max-tries 100}))
1302
1303		count
1304		(gen/vector pgen count)
1305
1306		(c/or min-count max-count)
1307		(gen/vector pgen (c/or min-count 0) (c/or max-count (max gen-max (c/* 2 (c/or min-count 0)))))
1308
1309		:else
1310		(gen/vector pgen 0 gen-max))))))))
1311
1312		(with-gen* [_ gfn] (every-impl form pred opts gfn))
1313		(describe* [_] (c/or describe-form `(every ~(res form) ~@(mapcat identity opts))))))))
1314
1315		;;;;;;;;;;;;;;;;;;;;;;; regex ;;;;;;;;;;;;;;;;;;;
1316		;;See:
1317		;; http://matt.might.net/articles/implementation-of-regular-expression-matching-in-scheme-with-derivatives/
1318		;; http://www.ccs.neu.edu/home/turon/re-deriv.pdf
1319
1320		;;ctors
1321		(defn- accept [x] {::op ::accept :ret x})
1322
1323		(defn- accept? [{:keys [::op]}]
1324		(= ::accept op))
1325
1326		(defn- pcat* [{[p1 & pr :as ps] :ps, [k1 & kr :as ks] :ks, [f1 & fr :as forms] :forms, ret :ret, rep+ :rep+}]
1327		(when (every? identity ps)
1328		(if (accept? p1)
1329		(let [rp (:ret p1)
1330		ret (conj ret (if ks {k1 rp} rp))]
1331		(if pr
1332		(pcat* {:ps pr :ks kr :forms fr :ret ret})
1333		(accept ret)))
1334		{::op ::pcat, :ps ps, :ret ret, :ks ks, :forms forms :rep+ rep+})))
1335
1336		(defn- pcat [& ps] (pcat* {:ps ps :ret []}))
1337
1338		(defn ^:skip-wiki cat-impl
1339		"Do not call this directly, use 'cat'"
1340		[ks ps forms]
1341		(pcat* {:ks ks, :ps ps, :forms forms, :ret {}}))
1342
1343		(defn- rep* [p1 p2 ret splice form]
1344		(when p1
1345		(let [r {::op ::rep, :p2 p2, :splice splice, :forms form :id (java.util.UUID/randomUUID)}]
1346		(if (accept? p1)
1347		(assoc r :p1 p2 :ret (conj ret (:ret p1)))
1348		(assoc r :p1 p1, :ret ret)))))
1349
1350		(defn ^:skip-wiki rep-impl
1351		"Do not call this directly, use '*'"
1352		[form p] (rep* p p [] false form))
1353
1354		(defn ^:skip-wiki rep+impl
1355		"Do not call this directly, use '+'"
1356		[form p]
1357		(pcat* {:ps [p (rep* p p [] true form)] :forms `[~form (* ~form)] :ret [] :rep+ form}))
1358
1359		(defn ^:skip-wiki amp-impl
1360		"Do not call this directly, use '&'"
1361		[re preds pred-forms]
1362		{::op ::amp :p1 re :ps preds :forms pred-forms})
1363
1364		(defn- filter-alt [ps ks forms f]
1365		(if (c/or ks forms)
1366		(let [pks (->> (map vector ps
1367		(c/or (seq ks) (repeat nil))
1368		(c/or (seq forms) (repeat nil)))
1369		(filter #(-> % first f)))]
1370		[(seq (map first pks)) (when ks (seq (map second pks))) (when forms (seq (map #(nth % 2) pks)))])
1371		[(seq (filter f ps)) ks forms]))
1372
1373		(defn- alt* [ps ks forms]
1374		(let [[[p1 & pr :as ps] [k1 :as ks] forms] (filter-alt ps ks forms identity)]
1375		(when ps
1376		(let [ret {::op ::alt, :ps ps, :ks ks :forms forms}]
1377		(if (nil? pr)
1378		(if k1
1379		(if (accept? p1)
1380		(accept (tagged-ret k1 (:ret p1)))
1381		ret)
1382		p1)
1383		ret)))))
1384
1385		(defn- alts [& ps] (alt* ps nil nil))
1386		(defn- alt2 [p1 p2] (if (c/and p1 p2) (alts p1 p2) (c/or p1 p2)))
1387
1388		(defn ^:skip-wiki alt-impl
1389		"Do not call this directly, use 'alt'"
1390		[ks ps forms] (assoc (alt* ps ks forms) :id (java.util.UUID/randomUUID)))
1391
1392		(defn ^:skip-wiki maybe-impl
1393		"Do not call this directly, use '?'"
1394		[p form] (assoc (alt* [p (accept ::nil)] nil [form ::nil]) :maybe form))
1395
1396		(defn- noret? [p1 pret]
1397		(c/or (= pret ::nil)
1398		(c/and (#{::rep ::pcat} (::op (reg-resolve! p1))) ;;hrm, shouldn't know these
1399		(empty? pret))
1400		nil))
1401
1402		(declare preturn)
1403
1404		(defn- accept-nil? [p]
1405		(let [{:keys [::op ps p1 p2 forms] :as p} (reg-resolve! p)]
1406		(case op
1407		::accept true
1408		nil nil
1409		::amp (c/and (accept-nil? p1)
1410		(c/or (noret? p1 (preturn p1))
1411		(let [ret (-> (preturn p1) (and-preds ps (next forms)))]
1412		(not (invalid? ret)))))
1413		::rep (c/or (identical? p1 p2) (accept-nil? p1))
1414		::pcat (every? accept-nil? ps)
1415		::alt (c/some accept-nil? ps))))
1416
1417		(declare add-ret)
1418
1419		(defn- preturn [p]
1420		(let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms] :as p} (reg-resolve! p)]
1421		(case op
1422		::accept ret
1423		nil nil
1424		::amp (let [pret (preturn p1)]
1425		(if (noret? p1 pret)
1426		::nil
1427		(and-preds pret ps forms)))
1428		::rep (add-ret p1 ret k)
1429		::pcat (add-ret p0 ret k)
1430		::alt (let [[[p0] [k0]] (filter-alt ps ks forms accept-nil?)
1431		r (if (nil? p0) ::nil (preturn p0))]
1432		(if k0 (tagged-ret k0 r) r)))))
1433
1434		(defn- op-unform [p x]
1435		;;(prn {:p p :x x})
1436		(let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms rep+ maybe] :as p} (reg-resolve! p)
1437		kps (zipmap ks ps)]
1438		(case op
1439		::accept [ret]
1440		nil [(unform p x)]
1441		::amp (let [px (reduce #(unform %2 %1) x (reverse ps))]
1442		(op-unform p1 px))
1443		::rep (mapcat #(op-unform p1 %) x)
1444		::pcat (if rep+
1445		(mapcat #(op-unform p0 %) x)
1446		(mapcat (fn [k]
1447		(when (contains? x k)
1448		(op-unform (kps k) (get x k))))
1449		ks))
1450		::alt (if maybe
1451		[(unform p0 x)]
1452		(let [[k v] x]
1453		(op-unform (kps k) v))))))
1454
1455		(defn- add-ret [p r k]
1456		(let [{:keys [::op ps splice] :as p} (reg-resolve! p)
1457		prop #(let [ret (preturn p)]
1458		(if (empty? ret) r ((if splice into conj) r (if k {k ret} ret))))]
1459		(case op
1460		nil r
1461		(::alt ::accept ::amp)
1462		(let [ret (preturn p)]
1463		;;(prn {:ret ret})
1464		(if (= ret ::nil) r (conj r (if k {k ret} ret))))
1465
1466		(::rep ::pcat) (prop))))
1467
1468		(defn- deriv
1469		[p x]
1470		(let [{[p0 & pr :as ps] :ps, [k0 & kr :as ks] :ks, :keys [::op p1 p2 ret splice forms] :as p} (reg-resolve! p)]
1471		(when p
1472		(case op
1473		::accept nil
1474		nil (let [ret (dt p x p)]
1475		(when-not (invalid? ret) (accept ret)))
1476		::amp (when-let [p1 (deriv p1 x)]
1477		(if (= ::accept (::op p1))
1478		(let [ret (-> (preturn p1) (and-preds ps (next forms)))]
1479		(when-not (invalid? ret)
1480		(accept ret)))
1481		(amp-impl p1 ps forms)))
1482		::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret})
1483		(when (accept-nil? p0) (deriv (pcat* {:ps pr, :ks kr, :forms (next forms), :ret (add-ret p0 ret k0)}) x)))
1484		::alt (alt* (map #(deriv % x) ps) ks forms)
1485		::rep (alt2 (rep* (deriv p1 x) p2 ret splice forms)
1486		(when (accept-nil? p1) (deriv (rep* p2 p2 (add-ret p1 ret nil) splice forms) x)))))))
1487
1488		(defn- op-describe [p]
1489		(let [{:keys [::op ps ks forms splice p1 rep+ maybe] :as p} (reg-resolve! p)]
1490		;;(prn {:op op :ks ks :forms forms :p p})
1491		(when p
1492		(case op
1493		::accept nil
1494		nil p
1495		::amp (list* 'clojure.spec/& (op-describe p1) forms)
1496		::pcat (if rep+
1497		(list `+ rep+)
1498		(cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) forms)))
1499		::alt (if maybe
1500		(list `? (res maybe))
1501		(cons `alt (mapcat vector ks forms)))
1502		::rep (list (if splice `+ `*) forms)))))
1503
1504		(defn- op-explain [form p path via in input]
1505		;;(prn {:form form :p p :path path :input input})
1506		(let [[x :as input] input
1507		{:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve! p)
1508		via (if-let [name (spec-name p)] (conj via name) via)
1509		insufficient (fn [path form]
1510		[{:path path
1511		:reason "Insufficient input"
1512		:pred (abbrev form)
1513		:val ()
1514		:via via
1515		:in in}])]
1516		(when p
1517		(case op
1518		::accept nil
1519		nil (if (empty? input)
1520		(insufficient path form)
1521		(explain-1 form p path via in x))
1522		::amp (if (empty? input)
1523		(if (accept-nil? p1)
1524		(explain-pred-list forms ps path via in (preturn p1))
1525		(insufficient path (op-describe p1)))
1526		(if-let [p1 (deriv p1 x)]
1527		(explain-pred-list forms ps path via in (preturn p1))
1528		(op-explain (op-describe p1) p1 path via in input)))
1529		::pcat (let [pkfs (map vector
1530		ps
1531		(c/or (seq ks) (repeat nil))
1532		(c/or (seq forms) (repeat nil)))
1533		[pred k form] (if (= 1 (count pkfs))
1534		(first pkfs)
1535		(first (remove (fn [[p]] (accept-nil? p)) pkfs)))
1536		path (if k (conj path k) path)
1537		form (c/or form (op-describe pred))]
1538		(if (c/and (empty? input) (not pred))
1539		(insufficient path form)
1540		(op-explain form pred path via in input)))
1541		::alt (if (empty? input)
1542		(insufficient path (op-describe p))
1543		(apply concat
1544		(map (fn [k form pred]
1545		(op-explain (c/or form (op-describe pred))
1546		pred
1547		(if k (conj path k) path)
1548		via
1549		in
1550		input))
1551		(c/or (seq ks) (repeat nil))
1552		(c/or (seq forms) (repeat nil))
1553		ps)))
1554		::rep (op-explain (if (identical? p1 p2)
1555		forms
1556		(op-describe p1))
1557		p1 path via in input)))))
1558
1559		(defn- re-gen [p overrides path rmap f]
1560		;;(prn {:op op :ks ks :forms forms})
1561		(let [origp p
1562		{:keys [::op ps ks p1 p2 forms splice ret id ::gfn] :as p} (reg-resolve! p)
1563		rmap (if id (inck rmap id) rmap)
1564		ggens (fn [ps ks forms]
1565		(let [gen (fn [p k f]
1566		;;(prn {:k k :path path :rmap rmap :op op :id id})
1567		(when-not (c/and rmap id k (recur-limit? rmap id path k))
1568		(if id
1569		(gen/delay (re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))
1570		(re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))))]
1571		(map gen ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)))))]
1572		(c/or (when-let [gfn (c/or (get overrides (spec-name origp))
1573		(get overrides (spec-name p) )
1574		(get overrides path))]
1575		(case op
1576		(:accept nil) (gen/fmap vector (gfn))
1577		(gfn)))
1578		(when gfn
1579		(gfn))
1580		(when p
1581		(case op
1582		::accept (if (= ret ::nil)
1583		(gen/return [])
1584		(gen/return [ret]))
1585		nil (when-let [g (gensub p overrides path rmap f)]
1586		(gen/fmap vector g))
1587		::amp (re-gen p1 overrides path rmap (op-describe p1))
1588		::pcat (let [gens (ggens ps ks forms)]
1589		(when (every? identity gens)
1590		(apply gen/cat gens)))
1591		::alt (let [gens (remove nil? (ggens ps ks forms))]
1592		(when-not (empty? gens)
1593		(gen/one-of gens)))
1594		::rep (if (recur-limit? rmap id [id] id)
1595		(gen/return [])
1596		(when-let [g (re-gen p2 overrides path rmap forms)]
1597		(gen/fmap #(apply concat %)
1598		(gen/vector g)))))))))
1599
1600		(defn- re-conform [p [x & xs :as data]]
1601		;;(prn {:p p :x x :xs xs})
1602		(if (empty? data)
1603		(if (accept-nil? p)
1604		(let [ret (preturn p)]
1605		(if (= ret ::nil)
1606		nil
1607		ret))
1608		::invalid)
1609		(if-let [dp (deriv p x)]
1610		(recur dp xs)
1611		::invalid)))
1612
1613		(defn- re-explain [path via in re input]
1614		(loop [p re [x & xs :as data] input i 0]
1615		;;(prn {:p p :x x :xs xs :re re}) (prn)
1616		(if (empty? data)
1617		(if (accept-nil? p)
1618		nil ;;success
1619		(op-explain (op-describe p) p path via in nil))
1620		(if-let [dp (deriv p x)]
1621		(recur dp xs (inc i))
1622		(if (accept? p)
1623		(if (= (::op p) ::pcat)
1624		(op-explain (op-describe p) p path via (conj in i) (seq data))
1625		[{:path path
1626		:reason "Extra input"
1627		:pred (abbrev (op-describe re))
1628		:val data
1629		:via via
1630		:in (conj in i)}])
1631		(c/or (op-explain (op-describe p) p path via (conj in i) (seq data))
1632		[{:path path
1633		:reason "Extra input"
1634		:pred (abbrev (op-describe p))
1635		:val data
1636		:via via
1637		:in (conj in i)}]))))))
1638
1639		(defn ^:skip-wiki regex-spec-impl
1640		"Do not call this directly, use 'spec' with a regex op argument"
1641		[re gfn]
1642		(reify
1643		Specize
1644		(specize* [s] s)
1645		(specize* [s _] s)
1646
1647		Spec
1648		(conform* [_ x]
1649		(if (c/or (nil? x) (coll? x))
1650		(re-conform re (seq x))
1651		::invalid))
1652		(unform* [_ x] (op-unform re x))
1653		(explain* [_ path via in x]
1654		(if (c/or (nil? x) (coll? x))
1655		(re-explain path via in re (seq x))
1656		[{:path path :pred (abbrev (op-describe re)) :val x :via via :in in}]))
1657		(gen* [_ overrides path rmap]
1658		(if gfn
1659		(gfn)
1660		(re-gen re overrides path rmap (op-describe re))))
1661		(with-gen* [_ gfn] (regex-spec-impl re gfn))
1662		(describe* [_] (op-describe re))))
1663
1664		;;;;;;;;;;;;;;;;; HOFs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1665
1666		(defn- call-valid?
1667		[f specs args]
1668		(let [cargs (conform (:args specs) args)]
1669		(when-not (invalid? cargs)
1670		(let [ret (apply f args)
1671		cret (conform (:ret specs) ret)]
1672		(c/and (not (invalid? cret))
1673		(if (:fn specs)
1674		(pvalid? (:fn specs) {:args cargs :ret cret})
1675		true))))))
1676
1677		(defn- validate-fn
1678		"returns f if valid, else smallest"
1679		[f specs iters]
1680		(let [g (gen (:args specs))
1681		prop (gen/for-all* [g] #(call-valid? f specs %))]
1682		(let [ret (gen/quick-check iters prop)]
1683		(if-let [[smallest] (-> ret :shrunk :smallest)]
1684		smallest
1685		f))))
1686
1687		(defn ^:skip-wiki fspec-impl
1688		"Do not call this directly, use 'fspec'"
1689		[argspec aform retspec rform fnspec fform gfn]
1690		(let [specs {:args argspec :ret retspec :fn fnspec}]
1691		(reify
1692		clojure.lang.ILookup
1693		(valAt [this k] (get specs k))
1694		(valAt [_ k not-found] (get specs k not-found))
1695
1696		Specize
1697		(specize* [s] s)
1698		(specize* [s _] s)
1699
1700		Spec
1701		(conform* [this f] (if argspec
1702		(if (ifn? f)
1703		(if (identical? f (validate-fn f specs fspec-iterations)) f ::invalid)
1704		::invalid)
1705		(throw (Exception. (str "Can't conform fspec without args spec: " (pr-str (describe this)))))))
1706		(unform* [_ f] f)
1707		(explain* [_ path via in f]
1708		(if (ifn? f)
1709		(let [args (validate-fn f specs 100)]
1710		(if (identical? f args) ;;hrm, we might not be able to reproduce
1711		nil
1712		(let [ret (try (apply f args) (catch Throwable t t))]
1713		(if (instance? Throwable ret)
1714		;;TODO add exception data
1715		[{:path path :pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via :in in}]
1716
1717		(let [cret (dt retspec ret rform)]
1718		(if (invalid? cret)
1719		(explain-1 rform retspec (conj path :ret) via in ret)
1720		(when fnspec
1721		(let [cargs (conform argspec args)]
1722		(explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret})))))))))
1723		[{:path path :pred 'ifn? :val f :via via :in in}]))
1724		(gen* [_ overrides _ _] (if gfn
1725		(gfn)
1726		(gen/return
1727		(fn [& args]
1728		(c/assert (pvalid? argspec args) (with-out-str (explain argspec args)))
1729		(gen/generate (gen retspec overrides))))))
1730		(with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn))
1731		(describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform)))))
1732
1733		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1734		(clojure.spec/def ::kvs->map (conformer #(zipmap (map ::k %) (map ::v %)) #(map (fn [[k v]] {::k k ::v v}) %)))
1735
1736		(defmacro keys*
1737		"takes the same arguments as spec/keys and returns a regex op that matches sequences of key/values,
1738		converts them into a map, and conforms that map with a corresponding
1739		spec/keys call:
1740
1741		user=> (s/conform (s/keys :req-un [::a ::c]) {:a 1 :c 2})
1742		{:a 1, :c 2}
1743		user=> (s/conform (s/keys* :req-un [::a ::c]) [:a 1 :c 2])
1744		{:a 1, :c 2}
1745
1746		the resulting regex op can be composed into a larger regex:
1747
1748		user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99])
1749		{:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}"
1750		[& kspecs]
1751		`(let [mspec# (keys ~@kspecs)]
1752		(with-gen (clojure.spec/& (* (cat ::k keyword? ::v any?)) ::kvs->map mspec#)
1753		(fn [] (gen/fmap (fn [m#] (apply concat m#)) (gen mspec#))))))
1754
1755		(defn ^:skip-wiki nonconforming
1756		"takes a spec and returns a spec that has the same properties except
1757		'conform' returns the original (not the conformed) value. Note, will specize regex ops."
1758		[spec]
1759		(let [spec (delay (specize spec))]
1760		(reify
1761		Specize
1762		(specize* [s] s)
1763		(specize* [s _] s)
1764
1765		Spec
1766		(conform* [_ x] (let [ret (conform* @spec x)]
1767		(if (invalid? ret)
1768		::invalid
1769		x)))
1770		(unform* [_ x] x)
1771		(explain* [_ path via in x] (explain* @spec path via in x))
1772		(gen* [_ overrides path rmap] (gen* @spec overrides path rmap))
1773		(with-gen* [_ gfn] (nonconforming (with-gen* @spec gfn)))
1774		(describe* [_] `(nonconforming ~(describe* @spec))))))
1775
1776		(defn ^:skip-wiki nilable-impl
1777		"Do not call this directly, use 'nilable'"
1778		[form pred gfn]
1779		(let [spec (delay (specize pred form))]
1780		(reify
1781		Specize
1782		(specize* [s] s)
1783		(specize* [s _] s)
1784
1785		Spec
1786		(conform* [_ x] (if (nil? x) nil (conform* @spec x)))
1787		(unform* [_ x] (if (nil? x) nil (unform* @spec x)))
1788		(explain* [_ path via in x]
1789		(when-not (c/or (pvalid? @spec x) (nil? x))
1790		(conj
1791		(explain-1 form pred (conj path ::pred) via in x)
1792		{:path (conj path ::nil) :pred 'nil? :val x :via via :in in})))
1793		(gen* [_ overrides path rmap]
1794		(if gfn
1795		(gfn)
1796		(gen/frequency
1797		[[1 (gen/delay (gen/return nil))]
1798		[9 (gen/delay (gensub pred overrides (conj path ::pred) rmap form))]])))
1799		(with-gen* [_ gfn] (nilable-impl form pred gfn))
1800		(describe* [_] `(nilable ~(res form))))))
1801
1802		(defmacro nilable
1803		"returns a spec that accepts nil and values satisfying pred"
1804		[pred]
1805		(let [pf (res pred)]
1806		`(nilable-impl '~pf ~pred nil)))
1807
1808		(defn exercise
1809		"generates a number (default 10) of values compatible with spec and maps conform over them,
1810		returning a sequence of [val conformed-val] tuples. Optionally takes
1811		a generator overrides map as per gen"
1812		([spec] (exercise spec 10))
1813		([spec n] (exercise spec n nil))
1814		([spec n overrides]
1815		(map #(vector % (conform spec %)) (gen/sample (gen spec overrides) n))))
1816
1817		(defn exercise-fn
1818		"exercises the fn named by sym (a symbol) by applying it to
1819		n (default 10) generated samples of its args spec. When fspec is
1820		supplied its arg spec is used, and sym-or-f can be a fn. Returns a
1821		sequence of tuples of [args ret]. "
1822		([sym] (exercise-fn sym 10))
1823		([sym n] (exercise-fn sym n (get-spec sym)))
1824		([sym-or-f n fspec]
1825		(let [f (if (symbol? sym-or-f) (resolve sym-or-f) sym-or-f)]
1826		(for [args (gen/sample (gen (:args fspec)) n)]
1827		[args (apply f args)]))))
1828
1829		(defn inst-in-range?
1830		"Return true if inst at or after start and before end"
1831		[start end inst]
1832		(c/and (inst? inst)
1833		(let [t (inst-ms inst)]
1834		(c/and (<= (inst-ms start) t) (< t (inst-ms end))))))
1835
1836		(defmacro inst-in
1837		"Returns a spec that validates insts in the range from start
1838		(inclusive) to end (exclusive)."
1839		[start end]
1840		`(let [st# (inst-ms ~start)
1841		et# (inst-ms ~end)
1842		mkdate# (fn [d#] (java.util.Date. ^{:tag ~'long} d#))]
1843		(spec (and inst? #(inst-in-range? ~start ~end %))
1844		:gen (fn []
1845		(gen/fmap mkdate#
1846		(gen/large-integer* {:min st# :max et#}))))))
1847
1848		(defn int-in-range?
1849		"Return true if start <= val and val < end"
1850		[start end val]
1851		(c/and int? (<= start val) (< val end)))
1852
1853		(defmacro int-in
1854		"Returns a spec that validates ints in the range from start
1855		(inclusive) to end (exclusive)."
1856		[start end]
1857		`(spec (and int? #(int-in-range? ~start ~end %))
1858		:gen #(gen/large-integer* {:min ~start :max (dec ~end)})))
1859
1860		(defmacro double-in
1861		"Specs a 64-bit floating point number. Options:
1862
1863		:infinite? - whether +/- infinity allowed (default true)
1864		:NaN? - whether NaN allowed (default true)
1865		:min - minimum value (inclusive, default none)
1866		:max - maximum value (inclusive, default none)"
1867		[& {:keys [infinite? NaN? min max]
1868		:or {infinite? true NaN? true}
1869		:as m}]
1870		`(spec (and c/double?
1871		~@(when-not infinite? '[#(not (Double/isInfinite %))])
1872		~@(when-not NaN? '[#(not (Double/isNaN %))])
1873		~@(when max `[#(<= % ~max)])
1874		~@(when min `[#(<= ~min %)]))
1875		:gen #(gen/double* ~m)))
1876
1877		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; assert ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1878		(defonce
1879		^{:dynamic true
1880		:doc "If true, compiler will enable spec asserts, which are then
1881		subject to runtime control via check-asserts? If false, compiler
1882		will eliminate all spec assert overhead. See 'assert'.
1883
1884		Initially set to boolean value of clojure.spec.compile-asserts
1885		system property. Defaults to true."}
1886		compile-asserts
1887		(not= "false" (System/getProperty "clojure.spec.compile-asserts")))
1888
1889		(defn check-asserts?
1890		"Returns the value set by check-asserts."
1891		[]
1892		clojure.lang.RT/checkSpecAsserts)
1893
1894		(defn check-asserts
1895		"Enable or disable spec asserts that have been compiled
1896		with 'compile-asserts' true. See 'assert'.
1897
1898		Initially set to boolean value of clojure.spec.check-asserts
1899		system property. Defaults to false."
1900		[flag]
1901		(set! (. clojure.lang.RT checkSpecAsserts) flag))
1902
1903		(defn assert*
1904		"Do not call this directly, use 'assert'."
1905		[spec x]
1906		(if (valid? spec x)
1907		x
1908		(let [ed (c/merge (assoc (explain-data* spec [] [] [] x)
1909		::failure :assertion-failed))]
1910		(throw (ex-info
1911		(str "Spec assertion failed\n" (with-out-str (explain-out ed)))
1912		ed)))))
1913
1914		(defmacro assert
1915		"spec-checking assert expression. Returns x if x is valid? according
1916		to spec, else throws an ex-info with explain-data plus ::failure of
1917		:assertion-failed.
1918
1919		Can be disabled at either compile time or runtime:
1920
1921		If compile-asserts is false at compile time, compiles to x. Defaults
1922		to value of 'clojure.spec.compile-asserts' system property, or true if
1923		not set.
1924
1925		If (check-asserts?) is false at runtime, always returns x. Defaults to
1926		value of 'clojure.spec.check-asserts' system property, or false if not
1927		set. You can toggle check-asserts? with (check-asserts bool)."
1928		[spec x]
1929		(if compile-asserts
1930		`(if clojure.lang.RT/checkSpecAsserts
1931		(assert* ~spec ~x)
1932		~x)
1933		x))
1934
1935

-2

src/clj/clojure/string.clj less more

316	316
317	317	(defn index-of
318	318	"Return index of value (string or char) in s, optionally searching
319		forward from from-index or nil if not found."
	319	forward from from-index. Return nil if value not found."
320	320	{:added "1.8"}
321	321	([^CharSequence s value]
322	322	(let [result ^long

337	337
338	338	(defn last-index-of
339	339	"Return last index of value (string or char) in s, optionally
340		searching backward from from-index or nil if not found."
	340	searching backward from from-index. Return nil if value not found."
341	341	{:added "1.8"}
342	342	([^CharSequence s value]
343	343	(let [result ^long

+13

-11

src/jvm/clojure/lang/APersistentMap.java less more

13	13	import java.util.*;
14	14
15	15	public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable, MapEquivalence, IHashEq {
16		int _hash = -1;
17		int _hasheq = -1;
	16	int _hash;
	17	int _hasheq;
18	18
19	19	public String toString(){
20	20	return RT.printString(this);

92	92	return true;
93	93	}
94	94	public int hashCode(){
95		if(_hash == -1)
96		{
97		this._hash = mapHash(this);
98		}
99		return _hash;
	95	int cached = this._hash;
	96	if(cached == 0)
	97	{
	98	this._hash = cached = mapHash(this);
	99	}
	100	return cached;
100	101	}
101	102
102	103	static public int mapHash(IPersistentMap m){

111	112	}
112	113
113	114	public int hasheq(){
114		if(_hasheq == -1)
	115	int cached = this._hasheq;
	116	if(cached == 0)
115	117	{
116	118	//this._hasheq = mapHasheq(this);
117		_hasheq = Murmur3.hashUnordered(this);
118		}
119		return _hasheq;
	119	this._hasheq = cached = Murmur3.hashUnordered(this);
	120	}
	121	return cached;
120	122	}
121	123
122	124	static public int mapHasheq(IPersistentMap m) {

-8

src/jvm/clojure/lang/APersistentSet.java less more

17	17	import java.util.Set;
18	18
19	19	public abstract class APersistentSet extends AFn implements IPersistentSet, Collection, Set, Serializable, IHashEq {
20		int _hash = -1;
21		int _hasheq = -1;
	20	int _hash;
	21	int _hasheq;
22	22	final IPersistentMap impl;
23	23
24	24	protected APersistentSet(IPersistentMap impl){

90	90	}
91	91
92	92	public int hashCode(){
93		if(_hash == -1)
	93	int hash = this._hash;
	94	if(hash == 0)
94	95	{
95	96	//int hash = count();
96		int hash = 0;
97	97	for(ISeq s = seq(); s != null; s = s.next())
98	98	{
99	99	Object e = s.first();

102	102	}
103	103	this._hash = hash;
104	104	}
105		return _hash;
	105	return hash;
106	106	}
107	107
108	108	public int hasheq(){
109		if(_hasheq == -1){
	109	int cached = this._hasheq;
	110	if(cached == 0){
110	111	// int hash = 0;
111	112	// for(ISeq s = seq(); s != null; s = s.next())
112	113	// {

114	115	// hash += Util.hasheq(e);
115	116	// }
116	117	// this._hasheq = hash;
117		_hasheq = Murmur3.hashUnordered(this);
	118	this._hasheq = cached = Murmur3.hashUnordered(this);
118	119	}
119		return _hasheq;
	120	return cached;
120	121	}
121	122
122	123	public Object[] toArray(){

+13

-11

src/jvm/clojure/lang/APersistentVector.java less more

18	18	List,
19	19	RandomAccess, Comparable,
20	20	Serializable, IHashEq {
21		int _hash = -1;
22		int _hasheq = -1;
	21	int _hash;
	22	int _hasheq;
23	23
24	24	public String toString(){
25	25	return RT.printString(this);

138	138	}
139	139
140	140	public int hashCode(){
141		if(_hash == -1)
142		{
143		int hash = 1;
	141	int hash = this._hash;
	142	if(hash == 0)
	143	{
	144	hash = 1;
144	145	for(int i = 0;i<count();i++)
145	146	{
146	147	Object obj = nth(i);

148	149	}
149	150	this._hash = hash;
150	151	}
151		return _hash;
	152	return hash;
152	153	}
153	154
154	155	public int hasheq(){
155		if(_hasheq == -1) {
	156	int hash = this._hasheq;
	157	if(hash == 0) {
156	158	int n;
157		int hash = 1;
	159	hash = 1;
158	160
159	161	for(n=0;n<count();++n)
160	162	{
161	163	hash = 31 * hash + Util.hasheq(nth(n));
162	164	}
163	165
164		_hasheq = Murmur3.mixCollHash(hash, n);
165		}
166		return _hasheq;
	166	this._hasheq = hash = Murmur3.mixCollHash(hash, n);
	167	}
	168	return hash;
167	169	}
168	170
169	171	public Object get(int index){

+12

-1

src/jvm/clojure/lang/ATransientMap.java less more

13	13
14	14	import clojure.lang.PersistentHashMap.INode;
15	15
16		public abstract class ATransientMap extends AFn implements ITransientMap {
	16	public abstract class ATransientMap extends AFn implements ITransientMap, ITransientAssociative2 {
17	17	abstract void ensureEditable();
18	18	abstract ITransientMap doAssoc(Object key, Object val);
19	19	abstract ITransientMap doWithout(Object key);

78	78	return doValAt(key, notFound);
79	79	}
80	80
	81	private static final Object NOT_FOUND = new Object();
	82	public final boolean containsKey(Object key){
	83	return valAt(key, NOT_FOUND) != NOT_FOUND;
	84	}
	85	public final IMapEntry entryAt(Object key){
	86	Object v = valAt(key, NOT_FOUND);
	87	if(v != NOT_FOUND)
	88	return MapEntry.create(key, v);
	89	return null;
	90	}
	91
81	92	public final int count() {
82	93	ensureEditable();
83	94	return doCount();

+71

-1

src/jvm/clojure/lang/Atom.java less more

13	13
14	14	import java.util.concurrent.atomic.AtomicReference;
15	15
16		final public class Atom extends ARef implements IAtom{
	16	final public class Atom extends ARef implements IAtom2{
17	17	final AtomicReference state;
18	18
19	19	public Atom(Object state){

85	85	}
86	86	}
87	87
	88	public IPersistentVector swapVals(IFn f) {
	89	for(; ;)
	90	{
	91	Object oldv = deref();
	92	Object newv = f.invoke(oldv);
	93	validate(newv);
	94	if(state.compareAndSet(oldv, newv))
	95	{
	96	notifyWatches(oldv, newv);
	97	return LazilyPersistentVector.createOwning(oldv, newv);
	98	}
	99	}
	100	}
	101
	102	public IPersistentVector swapVals(IFn f, Object arg) {
	103	for(; ;)
	104	{
	105	Object oldv = deref();
	106	Object newv = f.invoke(oldv, arg);
	107	validate(newv);
	108	if(state.compareAndSet(oldv, newv))
	109	{
	110	notifyWatches(oldv, newv);
	111	return LazilyPersistentVector.createOwning(oldv, newv);
	112	}
	113	}
	114	}
	115
	116	public IPersistentVector swapVals(IFn f, Object arg1, Object arg2) {
	117	for(; ;)
	118	{
	119	Object oldv = deref();
	120	Object newv = f.invoke(oldv, arg1, arg2);
	121	validate(newv);
	122	if(state.compareAndSet(oldv, newv))
	123	{
	124	notifyWatches(oldv, newv);
	125	return LazilyPersistentVector.createOwning(oldv, newv);
	126	}
	127	}
	128	}
	129
	130	public IPersistentVector swapVals(IFn f, Object x, Object y, ISeq args) {
	131	for(; ;)
	132	{
	133	Object oldv = deref();
	134	Object newv = f.applyTo(RT.listStar(oldv, x, y, args));
	135	validate(newv);
	136	if(state.compareAndSet(oldv, newv))
	137	{
	138	notifyWatches(oldv, newv);
	139	return LazilyPersistentVector.createOwning(oldv, newv);
	140	}
	141	}
	142	}
	143
88	144	public boolean compareAndSet(Object oldv, Object newv){
89	145	validate(newv);
90	146	boolean ret = state.compareAndSet(oldv, newv);

100	156	notifyWatches(oldval, newval);
101	157	return newval;
102	158	}
	159
	160	public IPersistentVector resetVals(Object newv){
	161	validate(newv);
	162	for(; ;)
	163	{
	164	Object oldv = deref();
	165	if(state.compareAndSet(oldv, newv))
	166	{
	167	notifyWatches(oldv, newv);
	168	return LazilyPersistentVector.createOwning(oldv, newv);
	169	}
	170	}
103	171	}
	172
	173	}

-1

src/jvm/clojure/lang/Compile.java less more

30	30	private static final Var warn_on_reflection = RT.var("clojure.core", "warn-on-reflection");
31	31	private static final Var unchecked_math = RT.var("clojure.core", "unchecked-math");
32	32
33		public static void main(String[] args) throws IOException{
	33	public static void main(String[] args) throws IOException, ClassNotFoundException{
34	34
35	35	OutputStreamWriter out = (OutputStreamWriter) RT.OUT.deref();
36	36	PrintWriter err = RT.errPrintWriter();

52	52	uncheckedMath = Boolean.TRUE;
53	53	else if("warn-on-boxed".equals(uncheckedMathProp))
54	54	uncheckedMath = Keyword.intern("warn-on-boxed");
	55
	56	// force load to avoid transitive compilation during lazy load
	57	RT.load("clojure/core/specs/alpha");
55	58
56	59	try
57	60	{

+180

-95

src/jvm/clojure/lang/Compiler.java less more

225	225	//null or not
226	226	static final public Var IN_CATCH_FINALLY = Var.create(null).setDynamic();
227	227
	228	static final public Var METHOD_RETURN_CONTEXT = Var.create(null).setDynamic();
	229
228	230	static final public Var NO_RECUR = Var.create(null).setDynamic();
229	231
230	232	//DynamicClassLoader

370	372
371	373	static boolean isSpecial(Object sym){
372	374	return specials.containsKey(sym);
	375	}
	376
	377	static boolean inTailCall(C context) {
	378	return (context == C.RETURN) && (METHOD_RETURN_CONTEXT.deref() != null) && (IN_CATCH_FINALLY.deref() == null);
373	379	}
374	380
375	381	static Symbol resolveSymbol(Symbol sym){

636	642	final static Method getMethod = Method.getMethod("Object get()");
637	643	final static Method setMethod = Method.getMethod("Object set(Object)");
638	644
	645	Class jc;
	646
639	647	public VarExpr(Var var, Symbol tag){
640	648	this.var = var;
641	649	this.tag = tag != null ? tag : var.getTag();

658	666	}
659	667
660	668	public Class getJavaClass() {
661		return HostExpr.tagToClass(tag);
	669	if (jc == null)
	670	jc = HostExpr.tagToClass(tag);
	671	return jc;
662	672	}
663	673
664	674	public Object evalAssign(Expr val) {

1004	1014	Symbol sym = (Symbol) RT.first(call);
1005	1015	Symbol tag = tagOf(form);
1006	1016	PersistentVector args = PersistentVector.EMPTY;
	1017	boolean tailPosition = inTailCall(context);
1007	1018	for(ISeq s = RT.next(call); s != null; s = s.next())
1008	1019	args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first()));
1009	1020	if(c != null)
1010		return new StaticMethodExpr(source, line, column, tag, c, munge(sym.name), args);
	1021	return new StaticMethodExpr(source, line, column, tag, c, munge(sym.name), args, tailPosition);
1011	1022	else
1012		return new InstanceMethodExpr(source, line, column, tag, instance, munge(sym.name), args);
	1023	return new InstanceMethodExpr(source, line, column, tag, instance, munge(sym.name), args, tailPosition);
1013	1024	}
1014	1025	}
1015	1026	}

1026	1037	if(Util.equals(sym,COMPILE_STUB_SYM.get()))
1027	1038	return (Class) COMPILE_STUB_CLASS.get();
1028	1039	if(sym.name.indexOf('.') > 0 \|\| sym.name.charAt(0) == '[')
1029		c = RT.classForName(sym.name);
	1040	c = RT.classForNameNonLoading(sym.name);
1030	1041	else
1031	1042	{
1032	1043	Object o = currentNS().getMapping(sym);

1037	1048	else
1038	1049	{
1039	1050	try{
1040		c = RT.classForName(sym.name);
	1051	c = RT.classForNameNonLoading(sym.name);
1041	1052	}
1042	1053	catch(Exception e){
1043	1054	// aargh

1048	1059	}
1049	1060	}
1050	1061	else if(stringOk && form instanceof String)
1051		c = RT.classForName((String) form);
	1062	c = RT.classForNameNonLoading((String) form);
1052	1063	return c;
1053	1064	}
1054	1065

1133	1144	final static Method invokeNoArgInstanceMember = Method.getMethod("Object invokeNoArgInstanceMember(Object,String,boolean)");
1134	1145	final static Method setInstanceFieldMethod = Method.getMethod("Object setInstanceField(Object,String,Object)");
1135	1146
	1147	Class jc;
1136	1148
1137	1149	public InstanceFieldExpr(int line, int column, Expr target, String fieldName, Symbol tag, boolean requireField) {
1138	1150	this.target = target;

1212	1224	}
1213	1225
1214	1226	public Class getJavaClass() {
1215		return tag != null ? HostExpr.tagToClass(tag) : field.getType();
	1227	if (jc == null)
	1228	jc = tag != null ? HostExpr.tagToClass(tag) : field.getType();
	1229	return jc;
1216	1230	}
1217	1231
1218	1232	public Object evalAssign(Expr val) {

1255	1269	final int line;
1256	1270	final int column;
1257	1271
	1272	Class jc;
	1273
1258	1274	public StaticFieldExpr(int line, int column, Class c, String fieldName, Symbol tag) {
1259	1275	//this.className = className;
1260	1276	this.fieldName = fieldName;

1308	1324	public Class getJavaClass() {
1309	1325	//Class c = Class.forName(className);
1310	1326	//java.lang.reflect.Field field = c.getField(fieldName);
1311		return tag != null ? HostExpr.tagToClass(tag) : field.getType();
	1327	if (jc == null)
	1328	jc =tag != null ? HostExpr.tagToClass(tag) : field.getType();
	1329	return jc;
1312	1330	}
1313	1331
1314	1332	public Object evalAssign(Expr val) {

1439	1457	public final int line;
1440	1458	public final int column;
1441	1459	public final Symbol tag;
	1460	public final boolean tailPosition;
1442	1461	public final java.lang.reflect.Method method;
	1462	Class jc;
1443	1463
1444	1464	final static Method invokeInstanceMethodMethod =
1445	1465	Method.getMethod("Object invokeInstanceMethod(Object,String,Object[])");
1446	1466
1447	1467
1448		public InstanceMethodExpr(String source, int line, int column, Symbol tag, Expr target, String methodName, IPersistentVector args)
	1468	public InstanceMethodExpr(String source, int line, int column, Symbol tag, Expr target,
	1469	String methodName, IPersistentVector args, boolean tailPosition)
1449	1470	{
1450	1471	this.source = source;
1451	1472	this.line = line;

1454	1475	this.methodName = methodName;
1455	1476	this.target = target;
1456	1477	this.tag = tag;
	1478	this.tailPosition = tailPosition;
1457	1479	if(target.hasJavaClass() && target.getJavaClass() != null)
1458	1480	{
1459	1481	List methods = Reflector.getMethods(target.getJavaClass(), args.count(), methodName, false);

1547	1569	gen.checkCast(type);
1548	1570	MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args);
1549	1571	gen.visitLineNumber(line, gen.mark());
1550		if(context == C.RETURN)
	1572	if(tailPosition && !objx.canBeDirect)
1551	1573	{
1552	1574	ObjMethod method = (ObjMethod) METHOD.deref();
1553		method.emitClearLocals(gen);
	1575	method.emitClearThis(gen);
1554	1576	}
1555	1577	Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method));
1556	1578	if(method.getDeclaringClass().isInterface())

1606	1628	}
1607	1629
1608	1630	public Class getJavaClass() {
1609		return retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null);
	1631	if (jc == null)
	1632	jc = retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null);
	1633	return jc;
1610	1634	}
1611	1635	}
1612	1636

1621	1645	public final int column;
1622	1646	public final java.lang.reflect.Method method;
1623	1647	public final Symbol tag;
	1648	public final boolean tailPosition;
1624	1649	final static Method forNameMethod = Method.getMethod("Class classForName(String)");
1625	1650	final static Method invokeStaticMethodMethod =
1626	1651	Method.getMethod("Object invokeStaticMethod(Class,String,Object[])");
1627	1652	final static Keyword warnOnBoxedKeyword = Keyword.intern("warn-on-boxed");
1628
1629		public StaticMethodExpr(String source, int line, int column, Symbol tag, Class c, String methodName, IPersistentVector args)
	1653	Class jc;
	1654
	1655	public StaticMethodExpr(String source, int line, int column, Symbol tag, Class c,
	1656	String methodName, IPersistentVector args, boolean tailPosition)
1630	1657	{
1631	1658	this.c = c;
1632	1659	this.methodName = methodName;

1635	1662	this.line = line;
1636	1663	this.column = column;
1637	1664	this.tag = tag;
	1665	this.tailPosition = tailPosition;
1638	1666
1639	1667	List methods = Reflector.getMethods(c, args.count(), methodName, true);
1640	1668	if(methods.isEmpty())

1773	1801	MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args);
1774	1802	gen.visitLineNumber(line, gen.mark());
1775	1803	//Type type = Type.getObjectType(className.replace('.', '/'));
1776		if(context == C.RETURN)
	1804	if(tailPosition && !objx.canBeDirect)
1777	1805	{
1778	1806	ObjMethod method = (ObjMethod) METHOD.deref();
1779		method.emitClearLocals(gen);
	1807	method.emitClearThis(gen);
1780	1808	}
1781	1809	Type type = Type.getType(c);
1782	1810	Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method));

1819	1847	}
1820	1848
1821	1849	public Class getJavaClass() {
1822		return retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null);
	1850	if (jc == null)
	1851	jc = retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null);
	1852	return jc;
1823	1853	}
1824	1854	}
1825	1855

2270	2300	}
2271	2301	else
2272	2302	{
2273		if(bodyExpr == null)
2274		try {
2275		Var.pushThreadBindings(RT.map(NO_RECUR, true));
2276		bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body));
2277		} finally {
2278		Var.popThreadBindings();
2279		}
	2303	if(bodyExpr == null)
	2304	try {
	2305	Var.pushThreadBindings(RT.map(NO_RECUR, true, METHOD_RETURN_CONTEXT, null));
	2306	bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body));
	2307	} finally {
	2308	Var.popThreadBindings();
	2309	}
	2310
2280	2311	if(Util.equals(op, CATCH))
2281	2312	{
2282	2313	Class c = HostExpr.maybeClass(RT.second(f), false);

2324	2355	}
2325	2356	}
2326	2357	}
2327		if(bodyExpr == null) {
2328		try
2329		{
2330		Var.pushThreadBindings(RT.map(NO_RECUR, true));
2331		bodyExpr = (new BodyExpr.Parser()).parse(C.EXPRESSION, RT.seq(body));
2332		}
2333		finally
2334		{
2335		Var.popThreadBindings();
2336		}
2337		}
	2358	if(bodyExpr == null)
	2359	{
	2360	// this codepath is hit when there is neither catch or finally, e.g. (try (expr))
	2361	// return a body expr directly
	2362	try
	2363	{
	2364	Var.pushThreadBindings(RT.map(NO_RECUR, true));
	2365	bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body));
	2366	}
	2367	finally
	2368	{
	2369	Var.popThreadBindings();
	2370	}
	2371	return bodyExpr;
	2372	}
2338	2373
2339	2374	return new TryExpr(bodyExpr, catches, finallyExpr, retLocal,
2340	2375	finallyLocal);

2586	2621	gen.newInstance(type);
2587	2622	gen.dup();
2588	2623	MethodExpr.emitTypedArgs(objx, gen, ctor.getParameterTypes(), args);
2589		if(context == C.RETURN)
2590		{
2591		ObjMethod method = (ObjMethod) METHOD.deref();
2592		method.emitClearLocals(gen);
2593		}
2594	2624	gen.invokeConstructor(type, new Method("<init>", Type.getConstructorDescriptor(ctor)));
2595	2625	}
2596	2626	else

2598	2628	gen.push(destubClassName(c.getName()));
2599	2629	gen.invokeStatic(RT_TYPE, forNameMethod);
2600	2630	MethodExpr.emitArgsAsArray(args, objx, gen);
2601		if(context == C.RETURN)
2602		{
2603		ObjMethod method = (ObjMethod) METHOD.deref();
2604		method.emitClearLocals(gen);
2605		}
2606	2631	gen.invokeStatic(REFLECTOR_TYPE, invokeConstructorMethod);
2607	2632	}
2608	2633	if(context == C.STATEMENT)

3259	3284	public final int siteIndex;
3260	3285	public final String source;
3261	3286	static Type ILOOKUP_TYPE = Type.getType(ILookup.class);
	3287	Class jc;
3262	3288
3263	3289	public KeywordInvokeExpr(String source, int line, int column, Symbol tag, KeywordExpr kw, Expr target){
3264	3290	this.source = source;

3323	3349	}
3324	3350
3325	3351	public Class getJavaClass() {
3326		return HostExpr.tagToClass(tag);
	3352	if(jc == null)
	3353	jc = HostExpr.tagToClass(tag);
	3354	return jc;
3327	3355	}
3328	3356
3329	3357	}

3430	3458	public final Type[] paramtypes;
3431	3459	public final IPersistentVector args;
3432	3460	public final boolean variadic;
	3461	public final boolean tailPosition;
3433	3462	public final Object tag;
	3463	Class jc;
3434	3464
3435	3465	StaticInvokeExpr(Type target, Class retClass, Class[] paramclasses, Type[] paramtypes, boolean variadic,
3436		IPersistentVector args,Object tag){
	3466	IPersistentVector args,Object tag, boolean tailPosition){
3437	3467	this.target = target;
3438	3468	this.retClass = retClass;
3439	3469	this.paramclasses = paramclasses;
3440	3470	this.paramtypes = paramtypes;
3441	3471	this.args = args;
3442	3472	this.variadic = variadic;
	3473	this.tailPosition = tailPosition;
3443	3474	this.tag = tag;
3444	3475	}
3445	3476

3465	3496	}
3466	3497
3467	3498	public Class getJavaClass() {
3468		return retType((tag!=null)?HostExpr.tagToClass(tag):null, retClass);
	3499	if(jc == null)
	3500	jc =retType((tag!=null)?HostExpr.tagToClass(tag):null, retClass);
	3501	return jc;
3469	3502	}
3470	3503
3471	3504	public boolean canEmitPrimitive(){

3496	3529	else
3497	3530	MethodExpr.emitTypedArgs(objx, gen, paramclasses, args);
3498	3531
	3532	if(tailPosition && !objx.canBeDirect)
	3533	{
	3534	ObjMethod method = (ObjMethod) METHOD.deref();
	3535	method.emitClearThis(gen);
	3536	}
	3537
3499	3538	gen.invokeStatic(target, ms);
3500	3539	}
3501	3540

3503	3542	return Type.getType(retClass);
3504	3543	}
3505	3544
3506		public static Expr parse(Var v, ISeq args, Object tag) {
	3545	public static Expr parse(Var v, ISeq args, Object tag, boolean tailPosition) {
3507	3546	if(!v.isBound() \|\| v.get() == null)
3508	3547	{
3509	3548	// System.out.println("Not bound: " + v);

3559	3598	for(ISeq s = RT.seq(args); s != null; s = s.next())
3560	3599	argv = argv.cons(analyze(C.EXPRESSION, s.first()));
3561	3600
3562		return new StaticInvokeExpr(target,retClass,paramClasses, paramTypes,variadic, argv, tag);
	3601	return new StaticInvokeExpr(target,retClass,paramClasses, paramTypes,variadic, argv, tag, tailPosition);
3563	3602	}
3564	3603
3565	3604	}

3570	3609	public final IPersistentVector args;
3571	3610	public final int line;
3572	3611	public final int column;
	3612	public final boolean tailPosition;
3573	3613	public final String source;
3574	3614	public boolean isProtocol = false;
3575	3615	public boolean isDirect = false;

3578	3618	public java.lang.reflect.Method onMethod;
3579	3619	static Keyword onKey = Keyword.intern("on");
3580	3620	static Keyword methodMapKey = Keyword.intern("method-map");
	3621	Class jc;
3581	3622
3582	3623	static Object sigTag(int argcount, Var v){
3583	3624	Object arglists = RT.get(RT.meta(v), arglistsKey);

3592	3633	return null;
3593	3634	}
3594	3635
3595		public InvokeExpr(String source, int line, int column, Symbol tag, Expr fexpr, IPersistentVector args) {
	3636	public InvokeExpr(String source, int line, int column, Symbol tag, Expr fexpr, IPersistentVector args, boolean tailPosition) {
3596	3637	this.source = source;
3597	3638	this.fexpr = fexpr;
3598	3639	this.args = args;
3599	3640	this.line = line;
3600	3641	this.column = column;
	3642	this.tailPosition = tailPosition;
	3643
3601	3644	if(fexpr instanceof VarExpr)
3602	3645	{
3603	3646	Var fvar = ((VarExpr)fexpr).var;

3742	3785	}
3743	3786	gen.visitLineNumber(line, gen.mark());
3744	3787
3745		if(context == C.RETURN)
	3788	if(tailPosition && !objx.canBeDirect)
3746	3789	{
3747	3790	ObjMethod method = (ObjMethod) METHOD.deref();
3748		method.emitClearLocals(gen);
	3791	method.emitClearThis(gen);
3749	3792	}
3750	3793
3751	3794	gen.invokeInterface(IFN_TYPE, new Method("invoke", OBJECT_TYPE, ARG_TYPES[Math.min(MAX_POSITIONAL_ARITY + 1,

3757	3800	}
3758	3801
3759	3802	public Class getJavaClass() {
3760		return HostExpr.tagToClass(tag);
	3803	if (jc == null)
	3804	jc = HostExpr.tagToClass(tag);
	3805	return jc;
3761	3806	}
3762	3807
3763	3808	static public Expr parse(C context, ISeq form) {
	3809	boolean tailPosition = inTailCall(context);
3764	3810	if(context != C.EVAL)
3765	3811	context = C.EXPRESSION;
3766	3812	Expr fexpr = analyze(context, form.first());

3790	3836	Object sigtag = sigTag(arity, v);
3791	3837	Object vtag = RT.get(RT.meta(v), RT.TAG_KEY);
3792	3838	Expr ret = StaticInvokeExpr
3793		.parse(v, RT.next(form), formtag != null ? formtag : sigtag != null ? sigtag : vtag);
	3839	.parse(v, RT.next(form), formtag != null ? formtag : sigtag != null ? sigtag : vtag, tailPosition);
3794	3840	if(ret != null)
3795	3841	{
3796	3842	// System.out.println("invoke direct: " + v);

3837	3883	// throw new IllegalArgumentException(
3838	3884	// String.format("No more than %d args supported", MAX_POSITIONAL_ARITY));
3839	3885
3840		return new InvokeExpr((String) SOURCE.deref(), lineDeref(), columnDeref(), tagOf(form), fexpr, args);
	3886	return new InvokeExpr((String) SOURCE.deref(), lineDeref(), columnDeref(), tagOf(form), fexpr, args, tailPosition);
3841	3887	}
3842	3888	}
3843	3889

3862	3908	private boolean hasMeta;
3863	3909	private boolean hasEnclosingMethod;
3864	3910	// String superName = null;
	3911	Class jc;
3865	3912
3866	3913	public FnExpr(Object tag){
3867	3914	super(tag);

3876	3923	}
3877	3924
3878	3925	public Class getJavaClass() {
3879		return tag != null ? HostExpr.tagToClass(tag) : AFunction.class;
	3926	if (jc == null)
	3927	jc = tag != null ? HostExpr.tagToClass(tag) : AFunction.class;
	3928	return jc;
3880	3929	}
3881	3930
3882	3931	protected void emitMethods(ClassVisitor cv){

5004	5053	return true;
5005	5054	}
5006	5055
	5056	Class jc;
5007	5057	public Class getJavaClass() {
5008		return (compiledClass != null) ? compiledClass
5009		: (tag != null) ? HostExpr.tagToClass(tag)
5010		: IFn.class;
	5058	if (jc == null)
	5059	jc = (compiledClass != null) ? compiledClass
	5060	: (tag != null) ? HostExpr.tagToClass(tag)
	5061	: IFn.class;
	5062	return jc;
5011	5063	}
5012	5064
5013	5065	public void emitAssignLocal(GeneratorAdapter gen, LocalBinding lb,Expr val){

5295	5347	,CLEAR_PATH, pnode
5296	5348	,CLEAR_ROOT, pnode
5297	5349	,CLEAR_SITES, PersistentHashMap.EMPTY
	5350	,METHOD_RETURN_CONTEXT, RT.T
5298	5351	));
5299	5352
5300	5353	method.prim = primInterface(parms);

5872	5925	}
5873	5926	}
5874	5927	}
	5928
	5929	void emitClearThis(GeneratorAdapter gen) {
	5930	gen.visitInsn(Opcodes.ACONST_NULL);
	5931	gen.visitVarInsn(Opcodes.ASTORE, 0);
	5932	}
5875	5933	}
5876	5934
5877	5935	public static class LocalBinding{

5899	5957	name = munge(sym.name);
5900	5958	}
5901	5959
	5960	Boolean hjc;
	5961
5902	5962	public boolean hasJavaClass() {
5903		if(init != null && init.hasJavaClass()
5904		&& Util.isPrimitive(init.getJavaClass())
5905		&& !(init instanceof MaybePrimitiveExpr))
5906		return false;
5907		return tag != null
5908		\|\| (init != null && init.hasJavaClass());
5909		}
	5963	if (hjc == null)
	5964	{
	5965	if(init != null && init.hasJavaClass() && Util.isPrimitive(init.getJavaClass()) && !(init instanceof MaybePrimitiveExpr))
	5966	hjc = false;
	5967	else
	5968	hjc = tag != null \|\| (init != null && init.hasJavaClass());
	5969	}
	5970	return hjc;
	5971	}
	5972
	5973	Class jc;
5910	5974
5911	5975	public Class getJavaClass() {
5912		return tag != null ? HostExpr.tagToClass(tag)
5913		: init.getJavaClass();
	5976	if (jc == null)
	5977	jc = tag != null ? HostExpr.tagToClass(tag) : init.getJavaClass();
	5978	return jc;
5914	5979	}
5915	5980
5916	5981	public Class getPrimitiveType(){

5998	6063	return tag != null \|\| b.hasJavaClass();
5999	6064	}
6000	6065
	6066	Class jc;
6001	6067	public Class getJavaClass() {
6002		if(tag != null)
6003		return HostExpr.tagToClass(tag);
6004		return b.getJavaClass();
	6068	if (jc == null) {
	6069	if(tag != null)
	6070	jc = HostExpr.tagToClass(tag);
	6071	else
	6072	jc = b.getJavaClass();
	6073	}
	6074	return jc;
6005	6075	}
6006	6076
6007	6077

6299	6369	{
6300	6370	if(recurMismatches != null && RT.booleanCast(recurMismatches.nth(i/2)))
6301	6371	{
6302		init = new StaticMethodExpr("", 0, 0, null, RT.class, "box", RT.vector(init));
	6372	init = new StaticMethodExpr("", 0, 0, null, RT.class, "box", RT.vector(init), false);
6303	6373	if(RT.booleanCast(RT.WARN_ON_REFLECTION.deref()))
6304	6374	RT.errPrintWriter().println("Auto-boxing loop arg: " + sym);
6305	6375	}
6306	6376	else if(maybePrimitiveType(init) == int.class)
6307		init = new StaticMethodExpr("", 0, 0, null, RT.class, "longCast", RT.vector(init));
	6377	init = new StaticMethodExpr("", 0, 0, null, RT.class, "longCast", RT.vector(init), false);
6308	6378	else if(maybePrimitiveType(init) == float.class)
6309		init = new StaticMethodExpr("", 0, 0, null, RT.class, "doubleCast", RT.vector(init));
	6379	init = new StaticMethodExpr("", 0, 0, null, RT.class, "doubleCast", RT.vector(init), false);
6310	6380	}
6311	6381	//sequential enhancement of env (like Lisp let*)
6312	6382	try

6338	6408	try {
6339	6409	if(isLoop)
6340	6410	{
	6411	Object methodReturnContext = context == C.RETURN ? METHOD_RETURN_CONTEXT.deref() : null;
6341	6412	Var.pushThreadBindings(
6342	6413	RT.map(CLEAR_PATH, clearpath,
6343	6414	CLEAR_ROOT, clearroot,
6344		NO_RECUR, null));
	6415	NO_RECUR, null,
	6416	METHOD_RETURN_CONTEXT, methodReturnContext));
6345	6417
6346	6418	}
6347	6419	bodyExpr = (new BodyExpr.Parser()).parse(isLoop ? C.RETURN : context, body);

6791	6863	return dst;
6792	6864	}
6793	6865
	6866	private static volatile Var MACRO_CHECK = null;
	6867	private static volatile boolean MACRO_CHECK_LOADING = false;
	6868	private static final Object MACRO_CHECK_LOCK = new Object();
	6869
	6870	private static Var ensureMacroCheck() throws ClassNotFoundException, IOException {
	6871	if(MACRO_CHECK == null) {
	6872	synchronized(MACRO_CHECK_LOCK) {
	6873	if(MACRO_CHECK == null) {
	6874	MACRO_CHECK_LOADING = true;
	6875	RT.load("clojure/spec/alpha");
	6876	RT.load("clojure/core/specs/alpha");
	6877	MACRO_CHECK = Var.find(Symbol.intern("clojure.spec.alpha", "macroexpand-check"));
	6878	MACRO_CHECK_LOADING = false;
	6879	}
	6880	}
	6881	}
	6882	return MACRO_CHECK;
	6883	}
	6884
	6885	public static void checkSpecs(Var v, ISeq form) {
	6886	if(RT.CHECK_SPECS && !MACRO_CHECK_LOADING) {
	6887	try {
	6888	ensureMacroCheck().applyTo(RT.cons(v, RT.list(form.next())));
	6889	} catch(Exception e) {
	6890	throw new CompilerException((String) SOURCE_PATH.deref(), lineDeref(), columnDeref(), e);
	6891	}
	6892	}
	6893	}
	6894
6794	6895	public static Object macroexpand1(Object x) {
6795	6896	if(x instanceof ISeq)
6796	6897	{

6802	6903	Var v = isMacro(op);
6803	6904	if(v != null)
6804	6905	{
6805		// Do not check specs while inside clojure.spec
6806		if(! "clojure/spec.clj".equals(SOURCE_PATH.deref()))
6807		{
6808		try
6809		{
6810		final Namespace checkns = Namespace.find(Symbol.intern("clojure.spec"));
6811		if (checkns != null)
6812		{
6813		final Var check = Var.find(Symbol.intern("clojure.spec/macroexpand-check"));
6814		if ((check != null) && (check.isBound()))
6815		check.applyTo(RT.cons(v, RT.list(form.next())));
6816		}
6817		Symbol.intern("clojure.spec");
6818		}
6819		catch(IllegalArgumentException e)
6820		{
6821		throw new CompilerException((String) SOURCE_PATH.deref(), lineDeref(), columnDeref(), e);
6822		}
6823		}
	6906	checkSpecs(v, form);
	6907
6824	6908	try
6825	6909	{
6826	6910	ISeq args = RT.cons(form, RT.cons(Compiler.LOCAL_ENV.get(), form.next()));

8247	8331	,CLEAR_PATH, pnode
8248	8332	,CLEAR_ROOT, pnode
8249	8333	,CLEAR_SITES, PersistentHashMap.EMPTY
	8334	,METHOD_RETURN_CONTEXT, RT.T
8250	8335	));
8251	8336
8252	8337	//register 'this' as local 0

+20

-13

src/jvm/clojure/lang/Delay.java less more

12	12	package clojure.lang;
13	13
14	14	public class Delay implements IDeref, IPending{
15		Object val;
16		Throwable exception;
17		IFn fn;
	15	volatile Object val;
	16	volatile Throwable exception;
	17	volatile IFn fn;
18	18
19	19	public Delay(IFn fn){
20	20	this.fn = fn;

28	28	: x;
29	29	}
30	30
31		synchronized public Object deref() {
	31	public Object deref() {
32	32	if(fn != null)
33	33	{
34		try
35		{
36		val = fn.invoke();
37		}
38		catch(Throwable t)
39		{
40		exception = t;
41		}
42		fn = null;
	34	synchronized(this)
	35	{
	36	//double check
	37	if(fn!=null)
	38	{
	39	try
	40	{
	41	val = fn.invoke();
	42	}
	43	catch(Throwable t)
	44	{
	45	exception = t;
	46	}
	47	fn = null;
	48	}
	49	}
43	50	}
44	51	if(exception != null)
45	52	throw Util.sneakyThrow(exception);

+33

-17

src/jvm/clojure/lang/EdnReader.java less more

48	48	macros['#'] = new DispatchReader();
49	49
50	50
	51	dispatchMacros['#'] = new SymbolicValueReader();
51	52	dispatchMacros['^'] = new MetaReader();
52	53	//dispatchMacros['"'] = new RegexReader();
53	54	dispatchMacros['{'] = new SetReader();

504	505	throw Util.runtimeException("Namespaced map literal must contain an even number of forms");
505	506
506	507	// Construct output map
507		IPersistentMap m = RT.map();
	508	Object[] a = new Object[kvs.size()];
508	509	Iterator iter = kvs.iterator();
509		while(iter.hasNext()) {
	510	for(int i = 0; iter.hasNext(); i += 2) {
510	511	Object key = iter.next();
511	512	Object val = iter.next();
512	513
513	514	if(key instanceof Keyword) {
514	515	Keyword kw = (Keyword) key;
515	516	if (kw.getNamespace() == null) {
516		m = m.assoc(Keyword.intern(ns, kw.getName()), val);
	517	key = Keyword.intern(ns, kw.getName());
517	518	} else if (kw.getNamespace().equals("_")) {
518		m = m.assoc(Keyword.intern(null, kw.getName()), val);
519		} else {
520		m = m.assoc(kw, val);
	519	key = Keyword.intern(null, kw.getName());
521	520	}
522	521	} else if(key instanceof Symbol) {
523	522	Symbol s = (Symbol) key;
524	523	if (s.getNamespace() == null) {
525		m = m.assoc(Symbol.intern(ns, s.getName()), val);
	524	key = Symbol.intern(ns, s.getName());
526	525	} else if (s.getNamespace().equals("_")) {
527		m = m.assoc(Symbol.intern(null, s.getName()), val);
528		} else {
529		m = m.assoc(s, val);
530		}
531		} else {
532		m = m.assoc(key, val);
533		}
534		}
535		return m;
	526	key = Symbol.intern(null, s.getName());
	527	}
	528	}
	529	a[i] = key;
	530	a[i+1] = val;
	531	}
	532	return RT.map(a);
536	533	}
537	534	}
538	535

708	705	}
709	706	}
710	707
	708
	709	public static class SymbolicValueReader extends AFn{
	710
	711	static IPersistentMap specials = PersistentHashMap.create(Symbol.intern("Inf"), Double.POSITIVE_INFINITY,
	712	Symbol.intern("-Inf"), Double.NEGATIVE_INFINITY,
	713	Symbol.intern("NaN"), Double.NaN);
	714
	715	public Object invoke(Object reader, Object quote, Object opts) {
	716	PushbackReader r = (PushbackReader) reader;
	717	Object o = read(r, true, null, true, opts);
	718
	719	if (!(o instanceof Symbol))
	720	throw Util.runtimeException("Invalid token: ##" + o);
	721	if (!(specials.containsKey(o)))
	722	throw Util.runtimeException("Unknown symbolic value: ##" + o);
	723
	724	return specials.valAt(o);
	725	}
	726	}
	727
711	728	public static List readDelimitedList(char delim, PushbackReader r, boolean isRecursive, Object opts) {
712	729	final int firstline =
713	730	(r instanceof LineNumberingPushbackReader) ?

788	805
789	806	}
790	807	}
791

+23

-0

src/jvm/clojure/lang/IAtom2.java less more

	0	/**
	1	* Copyright (c) Rich Hickey. All rights reserved.
	2	* The use and distribution terms for this software are covered by the
	3	* Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
	4	* which can be found in the file epl-v10.html at the root of this distribution.
	5	* By using this software in any fashion, you are agreeing to be bound by
	6	* the terms of this license.
	7	* You must not remove this notice, or any other, from this software.
	8	**/
	9
	10	package clojure.lang;
	11
	12	public interface IAtom2 extends IAtom {
	13	IPersistentVector swapVals(IFn f);
	14
	15	IPersistentVector swapVals(IFn f, Object arg);
	16
	17	IPersistentVector swapVals(IFn f, Object arg1, Object arg2);
	18
	19	IPersistentVector swapVals(IFn f, Object x, Object y, ISeq args);
	20
	21	IPersistentVector resetVals(Object newv);
	22	}

+16

-0

src/jvm/clojure/lang/ITransientAssociative2.java less more

	0	/**
	1	* Copyright (c) Rich Hickey. All rights reserved.
	2	* The use and distribution terms for this software are covered by the
	3	* Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
	4	* which can be found in the file epl-v10.html at the root of this distribution.
	5	* By using this software in any fashion, you are agreeing to be bound by
	6	* the terms of this license.
	7	* You must not remove this notice, or any other, from this software.
	8	**/
	9
	10	package clojure.lang;
	11
	12	public interface ITransientAssociative2 extends ITransientAssociative {
	13	boolean containsKey(Object key);
	14	IMapEntry entryAt(Object key);
	15	}

+128

-45

src/jvm/clojure/lang/LispReader.java less more

106	106
107	107
108	108	dispatchMacros['^'] = new MetaReader();
	109	dispatchMacros['#'] = new SymbolicValueReader();
109	110	dispatchMacros['\''] = new VarReader();
110	111	dispatchMacros['"'] = new RegexReader();
111	112	dispatchMacros['('] = new FnReader();

117	118	dispatchMacros['?'] = new ConditionalReader();
118	119	dispatchMacros[':'] = new NamespaceMapReader();
119	120	}
	121
	122	public static interface Resolver{
	123	Symbol currentNS();
	124	Symbol resolveClass(Symbol sym);
	125	Symbol resolveAlias(Symbol sym);
	126	Symbol resolveVar(Symbol sym);
	127	}
120	128
121	129	static boolean isWhitespace(int ch){
122	130	return Character.isWhitespace(ch) \|\| ch == ',';

194	202	static public Object read(PushbackReader r, boolean eofIsError, Object eofValue, boolean isRecursive, Object opts)
195	203	{
196	204	// start with pendingForms null as reader conditional splicing is not allowed at top level
197		return read(r, eofIsError, eofValue, null, null, isRecursive, opts, null);
	205	return read(r, eofIsError, eofValue, null, null, isRecursive, opts, null, (Resolver) RT.READER_RESOLVER.deref());
198	206	}
199	207
200	208	static private Object read(PushbackReader r, boolean eofIsError, Object eofValue, boolean isRecursive, Object opts, Object pendingForms) {
201		return read(r, eofIsError, eofValue, null, null, isRecursive, opts, ensurePending(pendingForms));
	209	return read(r, eofIsError, eofValue, null, null, isRecursive, opts, ensurePending(pendingForms), (Resolver) RT.READER_RESOLVER.deref());
202	210	}
203	211
204	212	static private Object ensurePending(Object pendingForms) {

221	229	}
222	230	}
223	231
224		static private Object read(PushbackReader r, boolean eofIsError, Object eofValue, Character returnOn, Object returnOnValue, boolean isRecursive, Object opts, Object pendingForms)
	232	static private Object read(PushbackReader r, boolean eofIsError, Object eofValue, Character returnOn,
	233	Object returnOnValue, boolean isRecursive, Object opts, Object pendingForms,
	234	Resolver resolver)
225	235	{
226	236	if(RT.READEVAL.deref() == UNKNOWN)
227	237	throw Util.runtimeException("Reading disallowed - read-eval bound to :unknown");

281	291	}
282	292
283	293	String token = readToken(r, (char) ch);
284		return interpretToken(token);
	294	return interpretToken(token, resolver);
285	295	}
286	296	}
287	297	catch(Exception e)

369	379	return uc;
370	380	}
371	381
372		static private Object interpretToken(String s) {
	382	static private Object interpretToken(String s, Resolver resolver) {
373	383	if(s.equals("nil"))
374	384	{
375	385	return null;

384	394	}
385	395	Object ret = null;
386	396
387		ret = matchSymbol(s);
	397	ret = matchSymbol(s, resolver);
388	398	if(ret != null)
389	399	return ret;
390	400

392	402	}
393	403
394	404
395		private static Object matchSymbol(String s){
	405	private static Object matchSymbol(String s, Resolver resolver){
396	406	Matcher m = symbolPat.matcher(s);
397	407	if(m.matches())
398	408	{

406	416	if(s.startsWith("::"))
407	417	{
408	418	Symbol ks = Symbol.intern(s.substring(2));
409		Namespace kns;
410		if(ks.ns != null)
411		kns = Compiler.namespaceFor(ks);
412		else
413		kns = Compiler.currentNS();
414		//auto-resolving keyword
415		if (kns != null)
416		return Keyword.intern(kns.name.name,ks.name);
417		else
418		return null;
419		}
	419	if(resolver != null)
	420	{
	421	Symbol nsym;
	422	if(ks.ns != null)
	423	nsym = resolver.resolveAlias(Symbol.intern(ks.ns));
	424	else
	425	nsym = resolver.currentNS();
	426	//auto-resolving keyword
	427	if(nsym != null)
	428	return Keyword.intern(nsym.name, ks.name);
	429	else
	430	return null;
	431	}
	432	else
	433	{
	434	Namespace kns;
	435	if(ks.ns != null)
	436	kns = Compiler.currentNS().lookupAlias(Symbol.intern(ks.ns));
	437	else
	438	kns = Compiler.currentNS();
	439	//auto-resolving keyword
	440	if(kns != null)
	441	return Keyword.intern(kns.name.name, ks.name);
	442	else
	443	return null;
	444	}
	445	}
420	446	boolean isKeyword = s.charAt(0) == ':';
421	447	Symbol sym = Symbol.intern(s.substring(isKeyword ? 1 : 0));
422	448	if(isKeyword)

639	665	// Resolve autoresolved ns
640	666	String ns;
641	667	if (auto) {
	668	Resolver resolver = (Resolver) RT.READER_RESOLVER.deref();
642	669	if (sym == null) {
643		ns = Compiler.currentNS().getName().getName();
	670	if(resolver != null)
	671	ns = resolver.currentNS().name;
	672	else
	673	ns = Compiler.currentNS().getName().getName();
644	674	} else if (!(sym instanceof Symbol) \|\| ((Symbol)sym).getNamespace() != null) {
645	675	throw Util.runtimeException("Namespaced map must specify a valid namespace: " + sym);
646	676	} else {
647		Namespace resolvedNS = Compiler.currentNS().lookupAlias((Symbol)sym);
648		if(resolvedNS == null)
649		resolvedNS = Namespace.find((Symbol)sym);
	677	Symbol resolvedNS;
	678	if (resolver != null)
	679	resolvedNS = resolver.resolveAlias((Symbol) sym);
	680	else{
	681	Namespace rns = Compiler.currentNS().lookupAlias((Symbol)sym);
	682	resolvedNS = rns != null?rns.getName():null;
	683	}
650	684
651	685	if(resolvedNS == null) {
652	686	throw Util.runtimeException("Unknown auto-resolved namespace alias: " + sym);
653	687	} else {
654		ns = resolvedNS.getName().getName();
	688	ns = resolvedNS.getName();
655	689	}
656	690	}
657	691	} else if (!(sym instanceof Symbol) \|\| ((Symbol)sym).getNamespace() != null) {

666	700	throw Util.runtimeException("Namespaced map literal must contain an even number of forms");
667	701
668	702	// Construct output map
669		IPersistentMap m = RT.map();
	703	Object[] a = new Object[kvs.size()];
670	704	Iterator iter = kvs.iterator();
671		while(iter.hasNext()) {
	705	for(int i = 0; iter.hasNext(); i += 2) {
672	706	Object key = iter.next();
673	707	Object val = iter.next();
674	708
675	709	if(key instanceof Keyword) {
676	710	Keyword kw = (Keyword) key;
677	711	if (kw.getNamespace() == null) {
678		m = m.assoc(Keyword.intern(ns, kw.getName()), val);
	712	key = Keyword.intern(ns, kw.getName());
679	713	} else if (kw.getNamespace().equals("_")) {
680		m = m.assoc(Keyword.intern(null, kw.getName()), val);
681		} else {
682		m = m.assoc(kw, val);
	714	key = Keyword.intern(null, kw.getName());
683	715	}
684	716	} else if(key instanceof Symbol) {
685	717	Symbol s = (Symbol) key;
686	718	if (s.getNamespace() == null) {
687		m = m.assoc(Symbol.intern(ns, s.getName()), val);
	719	key = Symbol.intern(ns, s.getName());
688	720	} else if (s.getNamespace().equals("_")) {
689		m = m.assoc(Symbol.intern(null, s.getName()), val);
690		} else {
691		m = m.assoc(s, val);
692		}
693		} else {
694		m = m.assoc(key, val);
695		}
696		}
697		return m;
	721	key = Symbol.intern(null, s.getName());
	722	}
	723	}
	724	a[i] = key;
	725	a[i+1] = val;
	726	}
	727	return RT.map(a);
	728	}
	729	}
	730
	731
	732	public static class SymbolicValueReader extends AFn{
	733
	734	static IPersistentMap specials = PersistentHashMap.create(Symbol.intern("Inf"), Double.POSITIVE_INFINITY,
	735	Symbol.intern("-Inf"), Double.NEGATIVE_INFINITY,
	736	Symbol.intern("NaN"), Double.NaN);
	737
	738	public Object invoke(Object reader, Object quote, Object opts, Object pendingForms) {
	739	PushbackReader r = (PushbackReader) reader;
	740	Object o = read(r, true, null, true, opts, ensurePending(pendingForms));
	741
	742	if (!(o instanceof Symbol))
	743	throw Util.runtimeException("Invalid token: ##" + o);
	744	if (!(specials.containsKey(o)))
	745	throw Util.runtimeException("Unknown symbolic value: ##" + o);
	746
	747	return specials.valAt(o);
698	748	}
699	749	}
700	750

861	911	PushbackReader r = (PushbackReader) reader;
862	912	if(ARG_ENV.deref() == null)
863	913	{
864		return interpretToken(readToken(r, '%'));
	914	return interpretToken(readToken(r, '%'), null);
865	915	}
866	916	int ch = read1(r);
867	917	unread(r, ch);

946	996	ret = RT.list(Compiler.QUOTE, form);
947	997	else if(form instanceof Symbol)
948	998	{
	999	Resolver resolver = (Resolver) RT.READER_RESOLVER.deref();
949	1000	Symbol sym = (Symbol) form;
950	1001	if(sym.ns == null && sym.name.endsWith("#"))
951	1002	{

962	1013	else if(sym.ns == null && sym.name.endsWith("."))
963	1014	{
964	1015	Symbol csym = Symbol.intern(null, sym.name.substring(0, sym.name.length() - 1));
965		csym = Compiler.resolveSymbol(csym);
	1016	if(resolver != null){
	1017	Symbol rc = resolver.resolveClass(csym);
	1018	if(rc != null)
	1019	csym = rc;
	1020	}
	1021	else
	1022	csym = Compiler.resolveSymbol(csym);
966	1023	sym = Symbol.intern(null, csym.name.concat("."));
967	1024	}
968	1025	else if(sym.ns == null && sym.name.startsWith("."))
969	1026	{
970	1027	// Simply quote method names.
971	1028	}
	1029	else if(resolver != null)
	1030	{
	1031	Symbol nsym = null;
	1032	if(sym.ns != null){
	1033	Symbol alias = Symbol.intern(null, sym.ns);
	1034	nsym = resolver.resolveClass(alias);
	1035	if(nsym == null)
	1036	nsym = resolver.resolveAlias(alias);
	1037	}
	1038	if(nsym != null){
	1039	// Classname/foo -> package.qualified.Classname/foo
	1040	sym = Symbol.intern(nsym.name, sym.name);
	1041	}
	1042	else if(sym.ns == null){
	1043	Symbol rsym = resolver.resolveClass(sym);
	1044	if(rsym == null)
	1045	rsym = resolver.resolveVar(sym);
	1046	if(rsym != null)
	1047	sym = rsym;
	1048	else
	1049	sym = Symbol.intern(resolver.currentNS().name,sym.name);
	1050	}
	1051	//leave alone if qualified
	1052	}
972	1053	else
973	1054	{
974	1055	Object maybeClass = null;

1295	1376	((LineNumberingPushbackReader) r).getLineNumber() : -1;
1296	1377
1297	1378	ArrayList a = new ArrayList();
	1379	Resolver resolver = (Resolver) RT.READER_RESOLVER.deref();
1298	1380
1299	1381	for(; ;) {
1300	1382
1301		Object form = read(r, false, READ_EOF, delim, READ_FINISHED, isRecursive, opts, pendingForms);
	1383	Object form = read(r, false, READ_EOF, delim, READ_FINISHED, isRecursive, opts, pendingForms,
	1384	resolver);
1302	1385
1303	1386	if (form == READ_EOF) {
1304	1387	if (firstline < 0)

1444	1527	for(; ;) {
1445	1528	if(result == READ_STARTED) {
1446	1529	// Read the next feature
1447		form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms);
	1530	form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms, null);
1448	1531
1449	1532	if (form == READ_EOF) {
1450	1533	if (firstline < 0)

1462	1545
1463	1546	//Read the form corresponding to the feature, and assign it to result if everything is kosher
1464	1547
1465		form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms);
	1548	form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms, (Resolver) RT.READER_RESOLVER.deref());
1466	1549
1467	1550	if (form == READ_EOF) {
1468	1551	if (firstline < 0)

1483	1566	// When we already have a result, or when the feature didn't match, discard the next form in the reader
1484	1567	try {
1485	1568	Var.pushThreadBindings(RT.map(RT.SUPPRESS_READ, RT.T));
1486		form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms);
	1569	form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms, (Resolver) RT.READER_RESOLVER.deref());
1487	1570
1488	1571	if (form == READ_EOF) {
1489	1572	if (firstline < 0)

+38

-13

src/jvm/clojure/lang/Numbers.java less more

152	152	}
153	153
154	154	static public Number divide(Object x, Object y){
	155	if (isNaN(x)){
	156	return (Number)x;
	157	} else if(isNaN(y)){
	158	return (Number)y;
	159	}
155	160	Ops yops = ops(y);
156	161	if(yops.isZero((Number)y))
157	162	throw new ArithmeticException("Divide by zero");

1032	1037	}
1033	1038
1034	1039	@WarnBoxedMath(false)
1035		static int hasheq(Number x){
1036		Class xc = x.getClass();
1037
1038		if(xc == Long.class
1039		\|\| xc == Integer.class
1040		\|\| xc == Short.class
1041		\|\| xc == Byte.class
1042		\|\| (xc == BigInteger.class && lte(x, Long.MAX_VALUE) && gte(x,Long.MIN_VALUE)))
1043		{
	1040	static int hasheqFrom(Number x, Class xc){
	1041	if(xc == Integer.class
	1042	\|\| xc == Short.class
	1043	\|\| xc == Byte.class
	1044	\|\| (xc == BigInteger.class && lte(x, Long.MAX_VALUE) && gte(x,Long.MIN_VALUE)))
	1045	{
1044	1046	long lpart = x.longValue();
1045	1047	return Murmur3.hashLong(lpart);
1046	1048	//return (int) (lpart ^ (lpart >>> 32));
1047		}
	1049	}
1048	1050	if(xc == BigDecimal.class)
1049		{
	1051	{
1050	1052	// stripTrailingZeros() to make all numerically equal
1051	1053	// BigDecimal values come out the same before calling
1052	1054	// hashCode. Special check for 0 because

1055	1057	if (isZero(x))
1056	1058	return BigDecimal.ZERO.hashCode();
1057	1059	else
1058		{
	1060	{
1059	1061	BigDecimal tmp = ((BigDecimal) x).stripTrailingZeros();
1060	1062	return tmp.hashCode();
1061		}
1062	1063	}
	1064	}
	1065	if(xc == Float.class && x.equals(-0.0f))
	1066	{
	1067	return 0; // match 0.0f
	1068	}
1063	1069	return x.hashCode();
	1070	}
	1071
	1072	@WarnBoxedMath(false)
	1073	static int hasheq(Number x){
	1074	Class xc = x.getClass();
	1075
	1076	if(xc == Long.class)
	1077	{
	1078	long lpart = x.longValue();
	1079	return Murmur3.hashLong(lpart);
	1080	//return (int) (lpart ^ (lpart >>> 32));
	1081	}
	1082	if(xc == Double.class)
	1083	{
	1084	if(x.equals(-0.0))
	1085	return 0; // match 0.0
	1086	return x.hashCode();
	1087	}
	1088	return hasheqFrom(x, xc);
1064	1089	}
1065	1090
1066	1091	static Category category(Object x){

+13

-11

src/jvm/clojure/lang/PersistentQueue.java less more

30	30	final ISeq f;
31	31	final PersistentVector r;
32	32	//static final int INITIAL_REAR_SIZE = 4;
33		int _hash = -1;
34		int _hasheq = -1;
	33	int _hash;
	34	int _hasheq;
35	35
36	36	PersistentQueue(IPersistentMap meta, int cnt, ISeq f, PersistentVector r){
37	37	super(meta);

69	69	}
70	70
71	71	public int hashCode(){
72		if(_hash == -1)
73		{
74		int hash = 1;
	72	int hash = this._hash;
	73	if(hash == 0)
	74	{
	75	hash = 1;
75	76	for(ISeq s = seq(); s != null; s = s.next())
76	77	{
77	78	hash = 31 * hash + (s.first() == null ? 0 : s.first().hashCode());
78	79	}
79	80	this._hash = hash;
80	81	}
81		return _hash;
	82	return hash;
82	83	}
83	84
84	85	public int hasheq() {
85		if(_hasheq == -1)
86		{
	86	int cached = this._hasheq;
	87	if(cached == 0)
	88	{
87	89	// int hash = 1;
88	90	// for(ISeq s = seq(); s != null; s = s.next())
89	91	// {
90	92	// hash = 31 * hash + Util.hasheq(s.first());
91	93	// }
92	94	// this._hasheq = hash;
93		_hasheq = Murmur3.hashOrdered(this);
94		}
95		return _hasheq;
	95	this._hasheq = cached = Murmur3.hashOrdered(this);
	96	}
	97	return cached;
96	98	}
97	99
98	100	public Object peek(){

+13

-1

src/jvm/clojure/lang/PersistentVector.java less more

514	514	}
515	515	}
516	516
517		static final class TransientVector extends AFn implements ITransientVector, Counted{
	517	static final class TransientVector extends AFn implements ITransientVector, ITransientAssociative2, Counted{
518	518	volatile int cnt;
519	519	volatile int shift;
520	520	volatile Node root;

677	677	return notFound;
678	678	}
679	679
	680	private static final Object NOT_FOUND = new Object();
	681	public final boolean containsKey(Object key){
	682	return valAt(key, NOT_FOUND) != NOT_FOUND;
	683	}
	684
	685	public final IMapEntry entryAt(Object key){
	686	Object v = valAt(key, NOT_FOUND);
	687	if(v != NOT_FOUND)
	688	return MapEntry.create(key, v);
	689	return null;
	690	}
	691
680	692	public Object invoke(Object arg1) {
681	693	//note - relies on ensureEditable in nth
682	694	if(Util.isInteger(arg1))

+25

-4

src/jvm/clojure/lang/RT.java less more

35	35	static final public String LOADER_SUFFIX = "__init";
36	36
37	37	//simple-symbol->class
38		final static IPersistentMap DEFAULT_IMPORTS = map(
	38	final static public IPersistentMap DEFAULT_IMPORTS = map(
39	39	// Symbol.intern("RT"), "clojure.lang.RT",
40	40	// Symbol.intern("Num"), "clojure.lang.Num",
41	41	// Symbol.intern("Symbol"), "clojure.lang.Symbol",

226	226	final static Var PRINT_DUP = Var.intern(CLOJURE_NS, Symbol.intern("print-dup"), F).setDynamic();
227	227	final static Var WARN_ON_REFLECTION = Var.intern(CLOJURE_NS, Symbol.intern("warn-on-reflection"), F).setDynamic();
228	228	final static Var ALLOW_UNRESOLVED_VARS = Var.intern(CLOJURE_NS, Symbol.intern("allow-unresolved-vars"), F).setDynamic();
	229	final static Var READER_RESOLVER = Var.intern(CLOJURE_NS, Symbol.intern("reader-resolver"), null).setDynamic();
229	230
230	231	final static Var IN_NS_VAR = Var.intern(CLOJURE_NS, Symbol.intern("in-ns"), F);
231	232	final static Var NS_VAR = Var.intern(CLOJURE_NS, Symbol.intern("ns"), F);

298	299	}
299	300
300	301	public static boolean checkSpecAsserts = Boolean.getBoolean("clojure.spec.check-asserts");
	302	public static boolean instrumentMacros = ! Boolean.getBoolean("clojure.spec.skip-macros");
	303	static volatile boolean CHECK_SPECS = false;
301	304
302	305	static{
303	306	Keyword arglistskw = Keyword.intern(null, "arglists");

334	337	catch(Exception e) {
335	338	throw Util.sneakyThrow(e);
336	339	}
	340
	341	CHECK_SPECS = RT.instrumentMacros;
337	342	}
338	343
339	344	static public Keyword keyword(String ns, String name){

460	465
461	466	static void doInit() throws ClassNotFoundException, IOException{
462	467	load("clojure/core");
463		load("clojure/spec");
464		load("clojure/core/specs");
465	468
466	469	Var.pushThreadBindings(
467	470	RT.mapUniqueKeys(CURRENT_NS, CURRENT_NS.deref(),

767	770	return nth(coll, n);
768	771	return null;
769	772	}
	773	else if(coll instanceof ITransientSet) {
	774	ITransientSet set = (ITransientSet) coll;
	775	return set.get(key);
	776	}
770	777
771	778	return null;
772	779	}

795	802	else if(key instanceof Number && (coll instanceof String \|\| coll.getClass().isArray())) {
796	803	int n = ((Number) key).intValue();
797	804	return n >= 0 && n < count(coll) ? nth(coll, n) : notFound;
	805	}
	806	else if(coll instanceof ITransientSet) {
	807	ITransientSet set = (ITransientSet) coll;
	808	if(set.contains(key))
	809	return set.get(key);
	810	return notFound;
798	811	}
799	812	return notFound;
800	813

825	838	int n = ((Number) key).intValue();
826	839	return n >= 0 && n < count(coll);
827	840	}
	841	else if(coll instanceof ITransientSet)
	842	return ((ITransientSet)coll).contains(key) ? T : F;
	843	else if(coll instanceof ITransientAssociative2)
	844	return (((ITransientAssociative2)coll).containsKey(key)) ? T : F;
828	845	throw new IllegalArgumentException("contains? not supported on type: " + coll.getClass().getName());
829	846	}
830	847

833	850	return null;
834	851	else if(coll instanceof Associative)
835	852	return ((Associative) coll).entryAt(key);
836		else {
	853	else if(coll instanceof Map) {
837	854	Map m = (Map) coll;
838	855	if(m.containsKey(key))
839	856	return MapEntry.create(key, m.get(key));
840	857	return null;
841	858	}
	859	else if(coll instanceof ITransientAssociative2) {
	860	return ((ITransientAssociative2) coll).entryAt(key);
	861	}
	862	throw new IllegalArgumentException("find not supported on type: " + coll.getClass().getName());
842	863	}
843	864
844	865	//takes a seq of key,val,key,val

+28

-2

src/jvm/clojure/lang/Var.java less more

11	11
12	12	package clojure.lang;
13	13
	14	import java.io.ObjectStreamException;
	15	import java.io.Serializable;
14	16	import java.util.concurrent.atomic.AtomicBoolean;
15	17
16	18
17		public final class Var extends ARef implements IFn, IRef, Settable{
	19	public final class Var extends ARef implements IFn, IRef, Settable, Serializable{
18	20
19	21	static class TBox{
20	22

711	713	return RT.dissoc(c, k);
712	714	}
713	715	};
714		}
	716
	717
	718	/***
	719	Note - serialization only supports reconnecting the Var identity on the deserializing end
	720	Neither the value in the var nor any of its properties are serialized
	721	***/
	722
	723	private static class Serialized implements Serializable{
	724	public Serialized(Symbol nsName, Symbol sym){
	725	this.nsName = nsName;
	726	this.sym = sym;
	727	}
	728
	729	private Symbol nsName;
	730	private Symbol sym;
	731
	732	private Object readResolve() throws ObjectStreamException{
	733	return intern(nsName, sym);
	734	}
	735	}
	736
	737	private Object writeReplace() throws ObjectStreamException{
	738	return new Serialized(ns.getName(), sym);
	739	}
	740	}

+24

-0

test/clojure/test_clojure/atoms.clj less more

17	17	; swap! reset!
18	18	; compare-and-set!
19	19
	20	(deftest swap-vals-returns-old-value
	21	(let [a (atom 0)]
	22	(is (= [0 1] (swap-vals! a inc)))
	23	(is (= [1 2] (swap-vals! a inc)))
	24	(is (= 2 @a))))
	25
	26	(deftest deref-swap-arities
	27	(binding [warn-on-reflection true]
	28	(let [a (atom 0)]
	29	(is (= [0 1] (swap-vals! a + 1)))
	30	(is (= [1 3] (swap-vals! a + 1 1)))
	31	(is (= [3 6] (swap-vals! a + 1 1 1)))
	32	(is (= [6 10] (swap-vals! a + 1 1 1 1)))
	33	(is (= 10 @a)))))
	34
	35	(deftest deref-reset-returns-old-value
	36	(let [a (atom 0)]
	37	(is (= [0 :b] (reset-vals! a :b)))
	38	(is (= [:b 45M] (reset-vals! a 45M)))
	39	(is (= 45M @a))))
	40
	41	(deftest reset-on-deref-reset-equality
	42	(let [a (atom :usual-value)]
	43	(is (= :usual-value (reset! a (first (reset-vals! a :almost-never-seen-value)))))))

+33

-0

test/clojure/test_clojure/compilation.clj less more

353	353	;; throws an exception on failure
354	354	(is (eval `(fn [] ~(CLJ1399. 1)))))
355	355
	356	(deftest CLJ-1250-this-clearing
	357	(testing "clearing during try/catch/finally"
	358	(let [closed-over-in-catch (let [x :foo]
	359	(fn []
	360	(try
	361	(throw (Exception. "boom"))
	362	(catch Exception e
	363	x)))) ;; x should remain accessible to the fn
	364
	365	a (atom nil)
	366	closed-over-in-finally (fn []
	367	(try
	368	:ret
	369	(finally
	370	(reset! a :run))))]
	371	(is (= :foo (closed-over-in-catch)))
	372	(is (= :ret (closed-over-in-finally)))
	373	(is (= :run @a))))
	374	(testing "no clearing when loop not in return context"
	375	(let [x (atom 5)
	376	bad (fn []
	377	(loop [] (System/getProperties))
	378	(swap! x dec)
	379	(when (pos? @x)
	380	(recur)))]
	381	(is (nil? (bad))))))
	382
356	383	(deftest CLJ-1586-lazyseq-literals-preserve-metadata
357	384	(should-not-reflect (eval (list '.substring (with-meta (concat '(identity) '("foo")) {:tag 'String}) 0))))
358	385

394	421	;; eventually call `load` and reset called?.
395	422	(require 'clojure.repl :reload))
396	423	(is @called?)))
	424
	425	(deftest clj-1714
	426	(testing "CLJ-1714 Classes shouldn't have their static initialisers called simply by type hinting or importing"
	427	;; ClassWithFailingStaticInitialiser will throw if its static initialiser is called
	428	(is (eval '(fn [^compilation.ClassWithFailingStaticInitialiser c])))
	429	(is (eval '(import (compilation ClassWithFailingStaticInitialiser))))))

+48

-1

test/clojure/test_clojure/delays.clj less more

0	0	(ns clojure.test-clojure.delays
1		(:use clojure.test))
	1	(:use clojure.test)
	2	(:import [java.util.concurrent CyclicBarrier]))
2	3
3	4	(deftest calls-once
4	5	(let [a (atom 0)
5	6	d (delay (swap! a inc))]
6	7	(is (= 0 @a))
	8	(is (= 1 @d))
	9	(is (= 1 @d))
	10	(is (= 1 @a))))
	11
	12	(deftest calls-once-in-parallel
	13	(let [a (atom 0)
	14	d (delay (swap! a inc))
	15	threads 100
	16	^CyclicBarrier barrier (CyclicBarrier. (+ threads 1))]
	17	(is (= 0 @a))
	18	(dotimes [_ threads]
	19	(->
	20	(Thread.
	21	(fn []
	22	(.await barrier)
	23	(dotimes [_ 10000]
	24	(is (= 1 @d)))
	25	(.await barrier)))
	26	(.start)))
	27	(.await barrier)
	28	(.await barrier)
7	29	(is (= 1 @d))
8	30	(is (= 1 @d))
9	31	(is (= 1 @a))))

18	40	first-result (try-call)]
19	41	(is (instance? Exception first-result))
20	42	(is (identical? first-result (try-call)))))
	43
	44	(deftest saves-exceptions-in-parallel
	45	(let [f #(do (throw (Exception. "broken"))
	46	1)
	47	d (delay (f))
	48	try-call #(try
	49	@d
	50	(catch Exception e e))
	51	threads 100
	52	^CyclicBarrier barrier (CyclicBarrier. (+ threads 1))]
	53	(dotimes [_ threads]
	54	(->
	55	(Thread.
	56	(fn []
	57	(.await barrier)
	58	(let [first-result (try-call)]
	59	(dotimes [_ 10000]
	60	(is (instance? Exception (try-call)))
	61	(is (identical? first-result (try-call)))))
	62	(.await barrier)))
	63	(.start)))
	64	(.await barrier)
	65	(.await barrier)
	66	(is (instance? Exception (try-call)))
	67	(is (identical? (try-call) (try-call)))))

+34

-3

test/clojure/test_clojure/java_interop.clj less more

9	9
10	10
11	11	(ns clojure.test-clojure.java-interop
12		(:use clojure.test))
	12	(:use clojure.test)
	13	(:require [clojure.inspector]))
13	14
14	15	; http://clojure.org/java_interop
15	16	; http://clojure.org/compilation

149	150	(:class b) java.awt.Color )))
150	151
151	152	(deftest test-iterable-bean
152		(is (.iterator ^Iterable (bean (java.util.Date.))))
153		(is (hash (bean (java.util.Date.)))))
	153	(let [b (bean (java.util.Date.))]
	154	(is (.iterator ^Iterable b))
	155	(is (= (into [] b) (into [] (seq b))))
	156	(is (hash b))))
154	157
155	158	; proxy, proxy-super
156	159

169	172	str)
170	173	"chain chain chain")))
171	174
	175
	176	;; serialized-proxy can be regenerated using a modified version of
	177	;; Clojure with the proxy serialization prohibition disabled and the
	178	;; following code:
	179	#_(let [baos (java.io.ByteArrayOutputStream.) ]
	180	(with-open [baos baos]
	181	(.writeObject (java.io.ObjectOutputStream. baos) (clojure.inspector/list-model nil)))
	182	(println (apply str (for [c (String. (.toByteArray baos) "ISO-8859-1")]
	183	(if (<= 32 (int c) (int \z)) c (format "\\%03o" (int c)))))))
	184	(def serialized-proxy "\254\355\000\005sr\000Eclojure.inspector.proxy$javax.swing.table.AbstractTableModel$ff19274art\330\266_\010ME\002\000\001L\000\016__clojureFnMapt\000\035Lclojure/lang/IPersistentMap;xr\000$javax.swing.table.AbstractTableModelr\313\3538\256\001\377\276\002\000\001L\000\014listenerListt\000%Ljavax/swing/event/EventListenerList;xpsr\000#javax.swing.event.EventListenerList\2616\306\175\204\352\326D\003\000\000xppxsr\000\037clojure.lang.PersistentArrayMap\3437p\017\230\305\364\337\002\000\002L\000\005_metaq\000\176\000\001[\000\005arrayt\000\023[Ljava/lang/Object;xr\000\033clojure.lang.APersistentMap]\174/\003t r\173\002\000\002I\000\005_hashI\000\007_hasheqxp\000\000\000\000\000\000\000\000pur\000\023[Ljava.lang.Object;\220\316X\237\020s)l\002\000\000xp\000\000\000\006t\000\016getColumnCountsr\000%clojure.inspector$list_model$fn__8816H\252\320\325b\371!+\002\000\000xr\000\026clojure.lang.AFunction>\006p\234\236F\375\313\002\000\001L\000\021__methodImplCachet\000\036Lclojure/lang/MethodImplCache;xppt\000\013getRowCountsr\000%clojure.inspector$list_model$fn__8818-\037I\247\234/U\226\002\000\001L\000\005nrowst\000\022Ljava/lang/Object;xq\000\176\000\017ppt\000\012getValueAtsr\000%clojure.inspector$list_model$fn__8820\323\331\174ke\233\370\034\002\000\002L\000\011get_labelq\000\176\000\024L\000\011get_valueq\000\176\000\024xq\000\176\000\017ppp")
	185
	186	(deftest test-proxy-non-serializable
	187	(testing "That proxy classes refuse serialization and deserialization"
	188	;; Serializable listed directly in interface list:
	189	(is (thrown? java.io.NotSerializableException
	190	(-> (java.io.ByteArrayOutputStream.)
	191	(java.io.ObjectOutputStream.)
	192	(.writeObject (proxy [Object java.io.Serializable] [])))))
	193	;; Serializable included via inheritence:
	194	(is (thrown? java.io.NotSerializableException
	195	(-> (java.io.ByteArrayOutputStream.)
	196	(java.io.ObjectOutputStream.)
	197	(.writeObject (clojure.inspector/list-model nil)))))
	198	;; Deserialization also prohibited:
	199	(is (thrown? java.io.NotSerializableException
	200	(-> serialized-proxy (.getBytes "ISO-8859-1")
	201	java.io.ByteArrayInputStream. java.io.ObjectInputStream.
	202	.readObject)))))
172	203
173	204	(deftest test-bases
174	205	(are [x y] (= x y)

+73

-1

test/clojure/test_clojure/numbers.clj less more

71	71	(all-pairs-equal #'= [(byte 2) (short 2) (int 2) (long 2)
72	72	(bigint 2) (biginteger 2)])
73	73	(all-pairs-equal #'= [(float 2.0) (double 2.0)])
	74	(all-pairs-equal #'= [(float 0.0) (double 0.0) (float -0.0) (double -0.0)])
74	75	(all-pairs-equal #'= [2.0M 2.00M])
75	76	(all-pairs-equal #'= [(float 1.5) (double 1.5)])
76	77	(all-pairs-equal #'= [1.50M 1.500M])

84	85	(bigint 2)
85	86	(double 2.0) 2.0M 2.00M])
86	87	(all-pairs-hash-consistent-with-= [(/ 3 2) (double 1.5) 1.50M 1.500M])
87		(all-pairs-hash-consistent-with-= [(double 0.0) 0.0M 0.00M])
	88	(all-pairs-hash-consistent-with-= [(double -0.0) (double 0.0) -0.0M -0.00M 0.0M 0.00M (float -0.0) (float 0.0)])
88	89
89	90	;; == tests for numerical equality, returning true even for numbers
90	91	;; in different categories.
91	92	(all-pairs-equal #'== [(byte 0) (short 0) (int 0) (long 0)
92	93	(bigint 0) (biginteger 0)
	94	(float -0.0) (double -0.0) -0.0M -0.00M
93	95	(float 0.0) (double 0.0) 0.0M 0.00M])
94	96	(all-pairs-equal #'== [(byte 2) (short 2) (int 2) (long 2)
95	97	(bigint 2) (biginteger 2)

806	808	(<= 1000 Double/NaN) (<= 1000 (Double. Double/NaN))
807	809	(> 1000 Double/NaN) (> 1000 (Double. Double/NaN))
808	810	(>= 1000 Double/NaN) (>= 1000 (Double. Double/NaN))))
	811
	812	(deftest test-nan-as-operand
	813	(testing "All numeric operations with NaN as an operand produce NaN as a result"
	814	(let [nan Double/NaN
	815	onan (cast Object Double/NaN)]
	816	(are [x] (Double/isNaN x)
	817	(+ nan 1)
	818	(+ nan 0)
	819	(+ nan 0.0)
	820	(+ 1 nan)
	821	(+ 0 nan)
	822	(+ 0.0 nan)
	823	(+ nan nan)
	824	(- nan 1)
	825	(- nan 0)
	826	(- nan 0.0)
	827	(- 1 nan)
	828	(- 0 nan)
	829	(- 0.0 nan)
	830	(- nan nan)
	831	(* nan 1)
	832	(* nan 0)
	833	(* nan 0.0)
	834	(* 1 nan)
	835	(* 0 nan)
	836	(* 0.0 nan)
	837	(* nan nan)
	838	(/ nan 1)
	839	(/ nan 0)
	840	(/ nan 0.0)
	841	(/ 1 nan)
	842	(/ 0 nan)
	843	(/ 0.0 nan)
	844	(/ nan nan)
	845	(+ onan 1)
	846	(+ onan 0)
	847	(+ onan 0.0)
	848	(+ 1 onan)
	849	(+ 0 onan)
	850	(+ 0.0 onan)
	851	(+ onan onan)
	852	(- onan 1)
	853	(- onan 0)
	854	(- onan 0.0)
	855	(- 1 onan)
	856	(- 0 onan)
	857	(- 0.0 onan)
	858	(- onan onan)
	859	(* onan 1)
	860	(* onan 0)
	861	(* onan 0.0)
	862	(* 1 onan)
	863	(* 0 onan)
	864	(* 0.0 onan)
	865	(* onan onan)
	866	(/ onan 1)
	867	(/ onan 0)
	868	(/ onan 0.0)
	869	(/ 1 onan)
	870	(/ 0 onan)
	871	(/ 0.0 onan)
	872	(/ onan onan)
	873	(+ nan onan)
	874	(+ onan nan)
	875	(- nan onan)
	876	(- onan nan)
	877	(* nan onan)
	878	(* onan nan)
	879	(/ nan onan)
	880	(/ onan nan) ))))

+13

-0

test/clojure/test_clojure/other_functions.clj less more

327	327	(apply (apply some-fn (repeat i (comp not boolean))) (range i))))
328	328	true))))
329	329
	330
	331	(deftest test-max-min-key
	332	(are [k coll min-item max-item] (and (= min-item (apply min-key k coll))
	333	(= max-item (apply max-key k coll)))
	334	count ["longest" "a" "xy" "foo" "bar"] "a" "longest"
	335	- [5 10 15 20 25] 25 5
	336	#(if (neg? %) (- %) %) [-2 -1 0 1 2 3 4] 0 4
	337	{nil 1 false -1 true 0} [true true false nil] false nil)
	338	(are [f k coll expected] (= expected (apply f k coll))
	339	min-key :x [{:x 1000} {:x 1001} {:x 1002} {:x 1000 :second true}] {:x 1000 :second true}
	340	max-key :x [{:x 1000} {:x 999} {:x 998} {:x 1000 :second true}] {:x 1000 :second true}))
	341
	342
330	343	; Printing
331	344	; pr prn print println newline
332	345	; pr-str prn-str print-str println-str [with-out-str (vars.clj)]

+17

-17

test/clojure/test_clojure/predicates.clj less more

146	146	barray (byte-array 0)
147	147	uri (java.net.URI. "http://clojure.org")]
148	148	['
149		[identity int? pos-int? neg-int? nat-int? double? boolean? indexed? seqable? ident? uuid? bigdec? inst? uri? bytes?]
150		[0 true false false true false false false false false false false false false false]
151		[1 true true false true false false false false false false false false false false]
152		[-1 true false true false false false false false false false false false false false]
153		[1.0 false false false false true false false false false false false false false false]
154		[true false false false false false true false false false false false false false false]
155		[[] false false false false false false true true false false false false false false]
156		[nil false false false false false false false true false false false false false false]
157		[{} false false false false false false false true false false false false false false]
158		[:foo false false false false false false false false true false false false false false]
159		['foo false false false false false false false false true false false false false false]
160		[0.0M false false false false false false false false false false true false false false]
161		[0N false false false false false false false false false false false false false false]
162		[uuid false false false false false false false false false true false false false false]
163		[uri false false false false false false false false false false false false true false]
164		[now false false false false false false false false false false false true false false]
165		[barray false false false false false false false true false false false false false true]]))
	149	[identity int? pos-int? neg-int? nat-int? double? boolean? indexed? seqable? ident? uuid? decimal? inst? uri? bytes?]
	150	[0 true false false true false false false false false false false false false false]
	151	[1 true true false true false false false false false false false false false false]
	152	[-1 true false true false false false false false false false false false false false]
	153	[1.0 false false false false true false false false false false false false false false]
	154	[true false false false false false true false false false false false false false false]
	155	[[] false false false false false false true true false false false false false false]
	156	[nil false false false false false false false true false false false false false false]
	157	[{} false false false false false false false true false false false false false false]
	158	[:foo false false false false false false false false true false false false false false]
	159	['foo false false false false false false false false true false false false false false]
	160	[0.0M false false false false false false false false false false true false false false]
	161	[0N false false false false false false false false false false false false false false]
	162	[uuid false false false false false false false false false true false false false false]
	163	[uri false false false false false false false false false false false false true false]
	164	[now false false false false false false false false false false false true false false]
	165	[barray false false false false false false false true false false false false false true]]))
166	166
167	167	(deftest test-preds
168	168	(let [[preds & rows] pred-val-table]

-0

test/clojure/test_clojure/printer.clj less more

139	139	(let [date-map (bean (java.util.Date. 0))]
140	140	(is (= (binding [print-namespace-maps true] (pr-str date-map))
141	141	(binding [print-namespace-maps false] (pr-str date-map))))))
	142
	143	(deftest print-symbol-values
	144	(are [s v] (= s (pr-str v))
	145	"##Inf" Double/POSITIVE_INFINITY
	146	"##-Inf" Double/NEGATIVE_INFINITY
	147	"##NaN" Double/NaN
	148	"##Inf" Float/POSITIVE_INFINITY
	149	"##-Inf" Float/NEGATIVE_INFINITY
	150	"##NaN" Float/NaN))

+15

-8

test/clojure/test_clojure/reader.cljc less more

211	211
212	212	(is (instance? Double -1.0))
213	213	(is (instance? Double -1.))
	214
	215	(is (= Double/POSITIVE_INFINITY ##Inf))
	216	(is (= Double/NEGATIVE_INFINITY ##-Inf))
	217	(is (and (instance? Double ##NaN) (.isNaN ##NaN)))
214	218
215	219	; Read BigDecimal
216	220	(is (instance? BigDecimal 9223372036854775808M))

726	730	(is (= #::s{1 nil, :a nil, :a/b nil, :_/d nil}
727	731	#::s {1 nil, :a nil, :a/b nil, :_/d nil}
728	732	{1 nil, :clojure.string/a nil, :a/b nil, :d nil}))
729		(is (= #::clojure.core{1 nil, :a nil, :a/b nil, :_/d nil} {1 nil, :clojure.core/a nil, :a/b nil, :d nil}))
730	733	(is (= (read-string "#:a{b 1 b/c 2}") {'a/b 1, 'b/c 2}))
731	734	(is (= (binding [ns (the-ns 'clojure.test-clojure.reader)] (read-string "#::{b 1, b/c 2, _/d 3}")) {'clojure.test-clojure.reader/b 1, 'b/c 2, 'd 3}))
732		(is (= (binding [ns (the-ns 'clojure.test-clojure.reader)] (read-string "#::s{b 1, b/c 2, _/d 3}")) {'clojure.string/b 1, 'b/c 2, 'd 3}))
733		(is (= (read-string "#::clojure.core{b 1, b/c 2, _/d 3}") {'clojure.core/b 1, 'b/c 2, 'd 3})))
	735	(is (= (binding [ns (the-ns 'clojure.test-clojure.reader)] (read-string "#::s{b 1, b/c 2, _/d 3}")) {'clojure.string/b 1, 'b/c 2, 'd 3})))
734	736
735	737	(deftest namespaced-map-errors
736	738	(are [err msg form] (thrown-with-msg? err msg (read-string form))
737	739	Exception #"Invalid token" "#:::"
738	740	Exception #"Namespaced map literal must contain an even number of forms" "#:s{1}"
739	741	Exception #"Namespaced map must specify a valid namespace" "#:s/t{1 2}"
740		Exception #"Namespaced map literal must contain an even number of forms" "#::clojure.core{1}"
741		Exception #"Namespaced map must specify a valid namespace" "#::clojure.core/t{1 2}"
742	742	Exception #"Unknown auto-resolved namespace alias" "#::BOGUS{1 2}"
743		Exception #"Namespaced map must specify a namespace" "#:: clojure.core{:a 1}"
744		Exception #"Namespaced map must specify a namespace" "#: clojure.core{:a 1}"))
	743	Exception #"Namespaced map must specify a namespace" "#: s{:a 1}"
	744	Exception #"Duplicate key: :user/a" "#::{:a 1 :a 2}"
	745	Exception #"Duplicate key: user/a" "#::{a 1 a 2}"))
745	746
746	747	(deftest namespaced-map-edn
747	748	(is (= {1 1, :a/b 2, :b/c 3, :d 4}
748	749	(edn/read-string "#:a{1 1, :b 2, :b/c 3, :_/d 4}")
749		(edn/read-string "#:a {1 1, :b 2, :b/c 3, :_/d 4}"))))⏎
	750	(edn/read-string "#:a {1 1, :b 2, :b/c 3, :_/d 4}"))))
	751
	752	(deftest invalid-symbol-value
	753	(is (thrown-with-msg? Exception #"Invalid token" (read-string "##5")))
	754	(is (thrown-with-msg? Exception #"Invalid token" (edn/read-string "##5")))
	755	(is (thrown-with-msg? Exception #"Unknown symbolic value" (read-string "##Foo")))
	756	(is (thrown-with-msg? Exception #"Unknown symbolic value" (edn/read-string "##Foo"))))

-0

test/clojure/test_clojure/reducers.clj less more

88	88	([ret k v] (when (= k k-fail)
89	89	(throw (IndexOutOfBoundsException.)))))
90	90	(zipmap (range test-map-count) (repeat :dummy)))))))
	91
	92	(deftest test-closed-over-clearing
	93	;; this will throw OutOfMemory without proper reference clearing
	94	(is (number? (reduce + 0 (r/map identity (range 1e8))))))

-1

test/clojure/test_clojure/repl.clj less more

7	7	(deftest test-doc
8	8	(testing "with namespaces"
9	9	(is (= "clojure.pprint"
10		(second (str/split-lines (with-out-str (doc clojure.pprint))))))))
	10	(second (str/split-lines (with-out-str (doc clojure.pprint)))))))
	11	(testing "with special cases"
	12	(is (= (with-out-str (doc catch)) (with-out-str (doc try))))))
11	13
12	14	(deftest test-source
13	15	(is (= "(defn foo [])" (source-fn 'clojure.test-clojure.repl.example/foo)))

-1

test/clojure/test_clojure/serialization.clj less more

168	168	(atom nil)
169	169	(ref nil)
170	170	(agent nil)
171		#'+
	171	;;#'+
172	172
173	173	;; stateful seqs
174	174	(enumeration-seq (java.util.Collections/enumeration (range 50)))

-201

~~test/clojure/test_clojure/spec.clj~~ less more

0		(ns clojure.test-clojure.spec
1		(:require [clojure.spec :as s]
2		[clojure.spec.gen :as gen]
3		[clojure.spec.test :as stest]
4		[clojure.test :refer :all]))
5
6		(set! warn-on-reflection true)
7
8		(defmacro result-or-ex [x]
9		`(try
10		~x
11		(catch Throwable t#
12		(.getName (class t#)))))
13
14		(def even-count? #(even? (count %)))
15
16		(defn submap?
17		"Is m1 a subset of m2?"
18		[m1 m2]
19		(if (and (map? m1) (map? m2))
20		(every? (fn [[k v]] (and (contains? m2 k)
21		(submap? v (get m2 k))))
22		m1)
23		(= m1 m2)))
24
25		(deftest conform-explain
26		(let [a (s/and #(> % 5) #(< % 10))
27		o (s/or :s string? :k keyword?)
28		c (s/cat :a string? :b keyword?)
29		either (s/alt :a string? :b keyword?)
30		star (s/* keyword?)
31		plus (s/+ keyword?)
32		opt (s/? keyword?)
33		andre (s/& (s/* keyword?) even-count?)
34		m (s/map-of keyword? string?)
35		mkeys (s/map-of (s/and keyword? (s/conformer name)) any?)
36		mkeys2 (s/map-of (s/and keyword? (s/conformer name)) any? :conform-keys true)
37		s (s/coll-of (s/spec (s/cat :tag keyword? :val any?)) :kind list?)
38		v (s/coll-of keyword? :kind vector?)
39		coll (s/coll-of keyword?)
40		lrange (s/int-in 7 42)
41		drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2)
42		irange (s/inst-in #inst "1939" #inst "1946")
43		]
44		(are [spec x conformed ed]
45		(let [co (result-or-ex (s/conform spec x))
46		e (result-or-ex (::s/problems (s/explain-data spec x)))]
47		(when (not= conformed co) (println "conform fail\n\texpect=" conformed "\n\tactual=" co))
48		(when (not (every? true? (map submap? ed e)))
49		(println "explain failures\n\texpect=" ed "\n\tactual failures=" e "\n\tsubmap?=" (map submap? ed e)))
50		(and (= conformed co) (every? true? (map submap? ed e))))
51
52		lrange 7 7 nil
53		lrange 8 8 nil
54		lrange 42 ::s/invalid [{:pred '(int-in-range? 7 42 %), :val 42}]
55
56		irange #inst "1938" ::s/invalid [{:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1938"}]
57		irange #inst "1942" #inst "1942" nil
58		irange #inst "1946" ::s/invalid [{:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1946"}]
59
60		drange 3.0 ::s/invalid [{:pred '(<= 3.1 %), :val 3.0}]
61		drange 3.1 3.1 nil
62		drange 3.2 3.2 nil
63		drange Double/POSITIVE_INFINITY ::s/invalid [{:pred '(not (isInfinite %)), :val Double/POSITIVE_INFINITY}]
64		;; can't use equality-based test for Double/NaN
65		;; drange Double/NaN ::s/invalid {[] {:pred '(not (isNaN %)), :val Double/NaN}}
66
67		keyword? :k :k nil
68		keyword? nil ::s/invalid [{:pred ::s/unknown :val nil}]
69		keyword? "abc" ::s/invalid [{:pred ::s/unknown :val "abc"}]
70
71		a 6 6 nil
72		a 3 ::s/invalid '[{:pred (> % 5), :val 3}]
73		a 20 ::s/invalid '[{:pred (< % 10), :val 20}]
74		a nil "java.lang.NullPointerException" "java.lang.NullPointerException"
75		a :k "java.lang.ClassCastException" "java.lang.ClassCastException"
76
77		o "a" [:s "a"] nil
78		o :a [:k :a] nil
79		o 'a ::s/invalid '[{:pred string?, :val a, :path [:s]} {:pred keyword?, :val a :path [:k]}]
80
81		c nil ::s/invalid '[{:reason "Insufficient input", :pred string?, :val (), :path [:a]}]
82		c [] ::s/invalid '[{:reason "Insufficient input", :pred string?, :val (), :path [:a]}]
83		c [:a] ::s/invalid '[{:pred string?, :val :a, :path [:a], :in [0]}]
84		c ["a"] ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val (), :path [:b]}]
85		c ["s" :k] '{:a "s" :b :k} nil
86		c ["s" :k 5] ::s/invalid '[{:reason "Extra input", :pred (cat :a string? :b keyword?), :val (5)}]
87		(s/cat) nil {} nil
88		(s/cat) [5] ::s/invalid '[{:reason "Extra input", :pred (cat), :val (5), :in [0]}]
89
90		either nil ::s/invalid '[{:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}]
91		either [] ::s/invalid '[{:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}]
92		either [:k] [:b :k] nil
93		either ["s"] [:a "s"] nil
94		either [:b "s"] ::s/invalid '[{:reason "Extra input", :pred (alt :a string? :b keyword?), :val ("s") :via []}]
95
96		star nil [] nil
97		star [] [] nil
98		star [:k] [:k] nil
99		star [:k1 :k2] [:k1 :k2] nil
100		star [:k1 :k2 "x"] ::s/invalid '[{:pred keyword?, :val "x" :via []}]
101		star ["a"] ::s/invalid '[{:pred keyword?, :val "a" :via []}]
102
103		plus nil ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val () :via []}]
104		plus [] ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val () :via []}]
105		plus [:k] [:k] nil
106		plus [:k1 :k2] [:k1 :k2] nil
107		plus [:k1 :k2 "x"] ::s/invalid '[{:pred keyword?, :val "x", :in [2]}]
108		plus ["a"] ::s/invalid '[{:pred keyword?, :val "a" :via []}]
109
110		opt nil nil nil
111		opt [] nil nil
112		opt :k ::s/invalid '[{:pred (? keyword?), :val :k}]
113		opt [:k] :k nil
114		opt [:k1 :k2] ::s/invalid '[{:reason "Extra input", :pred (? keyword?), :val (:k2)}]
115		opt [:k1 :k2 "x"] ::s/invalid '[{:reason "Extra input", :pred (? keyword?), :val (:k2 "x")}]
116		opt ["a"] ::s/invalid '[{:pred keyword?, :val "a"}]
117
118		andre nil nil nil
119		andre [] nil nil
120		andre :k :clojure.spec/invalid '[{:pred (& (* keyword?) even-count?), :val :k}]
121		andre [:k] ::s/invalid '[{:pred even-count?, :val [:k]}]
122		andre [:j :k] [:j :k] nil
123
124		m nil ::s/invalid '[{:pred map?, :val nil}]
125		m {} {} nil
126		m {:a "b"} {:a "b"} nil
127
128		mkeys nil ::s/invalid '[{:pred map?, :val nil}]
129		mkeys {} {} nil
130		mkeys {:a 1 :b 2} {:a 1 :b 2} nil
131
132		mkeys2 nil ::s/invalid '[{:pred map?, :val nil}]
133		mkeys2 {} {} nil
134		mkeys2 {:a 1 :b 2} {"a" 1 "b" 2} nil
135
136		s '([:a 1] [:b "2"]) '({:tag :a :val 1} {:tag :b :val "2"}) nil
137
138		v [:a :b] [:a :b] nil
139		v '(:a :b) ::s/invalid '[{:pred vector? :val (:a :b)}]
140
141		coll nil ::s/invalid '[{:path [], :pred coll?, :val nil, :via [], :in []}]
142		coll [] [] nil
143		coll [:a] [:a] nil
144		coll [:a :b] [:a :b] nil
145		coll (map identity [:a :b]) '(:a :b) nil
146		;;coll [:a "b"] ::s/invalid '[{:pred (coll-checker keyword?), :val [:a b]}]
147		)))
148
149		(defn check-conform-unform [spec vals expected-conforms]
150		(let [actual-conforms (map #(s/conform spec %) vals)
151		unforms (map #(s/unform spec %) actual-conforms)]
152		(is (= actual-conforms expected-conforms))
153		(is (= vals unforms))))
154
155		(deftest nilable-conform-unform
156		(check-conform-unform
157		(s/nilable int?)
158		[5 nil]
159		[5 nil])
160		(check-conform-unform
161		(s/nilable (s/or :i int? :s string?))
162		[5 "x" nil]
163		[[:i 5] [:s "x"] nil]))
164
165		(deftest nonconforming-conform-unform
166		(check-conform-unform
167		(s/nonconforming (s/or :i int? :s string?))
168		[5 "x"]
169		[5 "x"]))
170
171		(deftest coll-form
172		(are [spec form]
173		(= (s/form spec) form)
174		(s/map-of int? any?)
175		'(clojure.spec/map-of clojure.core/int? clojure.core/any?)
176
177		(s/coll-of int?)
178		'(clojure.spec/coll-of clojure.core/int?)
179
180		(s/every-kv int? int?)
181		'(clojure.spec/every-kv clojure.core/int? clojure.core/int?)
182
183		(s/every int?)
184		'(clojure.spec/every clojure.core/int?)
185
186		(s/coll-of (s/tuple (s/tuple int?)))
187		'(clojure.spec/coll-of (clojure.spec/tuple (clojure.spec/tuple clojure.core/int?)))
188
189		(s/coll-of int? :kind vector?)
190		'(clojure.spec/coll-of clojure.core/int? :kind clojure.core/vector?)
191
192		(s/coll-of int? :gen #(gen/return [1 2]))
193		'(clojure.spec/coll-of clojure.core/int? :gen (fn* [] (gen/return [1 2])))))
194
195		(comment
196		(require '[clojure.test :refer (run-tests)])
197		(in-ns 'clojure.test-clojure.spec)
198		(run-tests)
199
200		)

+27

-0

test/clojure/test_clojure/transients.clj less more

52	52	t2 @(future (conj! t 4))
53	53	p (persistent! t2)]
54	54	(is (= [1 2 3 4] p))))
	55
	56	(deftest transient-lookups
	57	(let [tv (transient [1 2 3])]
	58	(is (= 1 (get tv 0)))
	59	(is (= :foo (get tv 4 :foo)))
	60	(is (= true (contains? tv 0)))
	61	(is (= [0 1] (find tv 0)))
	62	(is (= nil (find tv -1))))
	63	(let [ts (transient #{1 2})]
	64	(is (= true (contains? ts 1)))
	65	(is (= false (contains? ts 99)))
	66	(is (= 1 (get ts 1)))
	67	(is (= nil (get ts 99))))
	68	(let [tam (transient (array-map :a 1 :b 2))]
	69	(is (= true (contains? tam :a)))
	70	(is (= false (contains? tam :x)))
	71	(is (= 1 (get tam :a)))
	72	(is (= nil (get tam :x)))
	73	(is (= [:a 1] (find tam :a)))
	74	(is (= nil (find tam :x))))
	75	(let [thm (transient (hash-map :a 1 :b 2))]
	76	(is (= true (contains? thm :a)))
	77	(is (= false (contains? thm :x)))
	78	(is (= 1 (get thm :a)))
	79	(is (= nil (get thm :x)))
	80	(is (= [:a 1] (find thm :a)))
	81	(is (= nil (find thm :x)))))

+11

-2

test/clojure/test_clojure/vectors.clj less more

321	321	(vector-of :double)
322	322	(vector-of :char))
323	323	(testing "with invalid type argument"
324		(are [x] (thrown? NullPointerException x)
	324	(are [x] (thrown? IllegalArgumentException x)
325	325	(vector-of nil)
326	326	(vector-of Float/TYPE)
327	327	(vector-of 'int)
	328	(vector-of :integer)
328	329	(vector-of ""))))
329	330	(testing "vector-like (vector-of :type x1 x2 x3 … xn)"
330	331	(are [vec gvec] (and (instance? clojure.core.Vec gvec)

359	360	(vector-of :int #{1 2 3 4})
360	361	(vector-of :int (sorted-set 1 2 3 4))
361	362	(vector-of :int 1 2 "3")
362		(vector-of :int "1" "2" "3")))))
	363	(vector-of :int "1" "2" "3")))
	364	(testing "instances of IPersistentVector"
	365	(are [gvec] (instance? clojure.lang.IPersistentVector gvec)
	366	(vector-of :int 1 2 3)
	367	(vector-of :double 1 2 3)))
	368	(testing "fully implements IPersistentVector"
	369	(are [gvec] (= 3 (.length gvec))
	370	(vector-of :int 1 2 3)
	371	(vector-of :double 1 2 3)))))
363	372
364	373	(deftest empty-vector-equality
365	374	(let [colls [[] (vector-of :long) '()]]

+13

-0

test/java/compilation/ClassWithFailingStaticInitialiser.java less more

	0	package compilation;
	1
	2	public class ClassWithFailingStaticInitialiser {
	3	static {
	4	// Static analysis refuses to compile a static initialiser
	5	// which will always throw, so we pretend to branch. This may
	6	// need updating if the static analysis gets cleverer in the
	7	// future
	8	if(true) {
	9	throw new AssertionError("Static Initialiser was run when it shouldn't have been");
	10	}
	11	}
	12	}