nandi/clonim · d177210

modified README.md +17 -17 Viewed

@@ -111,7 +111,7 @@ Clojure's small array-maps are, without giving up hashed lookup.
111	111	The set column is the honest shape of the old representation: `conj` rebuilt the
112	112	whole set and re-scanned it for duplicates, so building one was O(n³).
113	113
114		-Seqs are lazy. `map`, `filter`, `remove`, `range`, `take`, `drop`,
	114	+Seqs are lazy and chunked. `map`, `filter`, `remove`, `range`, `take`, `drop`,
115	115	`take-while`, `drop-while`, `concat`, `map-indexed`, `iterate`, `repeat`,
116	116	`repeatedly` and `cycle` return a chain of thunks: each element is computed on
117	117	first demand and memoized, so infinite seqs are ordinary values and a consumer
@@ -129,12 +129,10 @@ builtin never materializes more of a seq than it was asked for. `nth`, `first`,
129	129	need; `count`, `reduce` and printing realize the whole seq, which is what those
130	130	mean.
131	131
132		-The cost is the usual one: a fully realized lazy seq allocates a cons cell and
133		-a thunk per element, where the eager version filled one flat `seq`. Realizing
134		-all of `(map inc (range 1000000))` went from 290 ms to 570 ms. Clojure buys most
135		-of that back by realizing in 32-element chunks; clonim does not chunk yet, which
136		-is why its laziness is exact — `take 3` computes exactly three elements, not
137		-thirty-two.
	132	+Like Clojure, the main lazy producers realize 32 elements at a time. This
	133	+amortizes thunk and allocation overhead; it also means that demanding three
	134	+mapped elements may execute the mapping function for the first 32. Chunks and
	135	+ordinary cons sequences interoperate through the same cursor API.
138	136
139	137	Long chains need one piece of care. ARC frees a linked structure by recursing
140	138	into it, so dropping a million-element seq means a million destructor frames and
@@ -160,21 +158,23 @@ serialize queued state transitions; this initial implementation is cooperative,
160	158	so queued actions run when an agent is dereferenced, awaited, or inspected for
161	159	an error rather than on a background thread.
162	160
	161	+Refs: `ref`, `dosync`, `alter`, `commute`, `ref-set`, and `ensure`. Because the
	162	+runtime is single-threaded, transactions are serialized rather than retried.
	163	+
	164	+Transducers: the map/filter/remove composition path works with `transduce`,
	165	+`sequence`, `eduction`, and three-argument `into`.
	166	+
	167	+Protocols: `defprotocol`, `extend-type`, `extend-protocol`, and `satisfies?`
	168	+dispatch over clonim's runtime value kinds, with `Object` as the fallback type.
	169	+
163	170	Lazy seqs: `iterate` `repeat` `repeatedly` `cycle` `doall` `dorun`, and the seq
164	171	library above returns them where Clojure does.
165	172
166	173	## What doesn't (yet)
167	174
168		-- Syntax-quote. User macros can construct forms with `quote` and ordinary
169		- core functions such as `list`, `vector`, and `apply`, but automatic
170		- namespace qualification through syntax-quote/unquote is not implemented yet.
171		-- Chunked seqs. Lazy seqs are unchunked, so full realization allocates two
172		- cells per element and runs ~2× slower than the old eager path. 32-element
173		- chunking is the fix, at the cost of exact demand.
174		-- Destructuring in parameter lists. `(let [[a b] xs] …)` works; `(defn f
175		- [[a b]] …)` does not.
176		-- Protocols/records, dynamic namespace operations, refs/agents,
177		- `#()` literals, syntax-quote, transducers, Nim interop.
	175	+- Records, dynamic namespace operations, and general Nim interop.
	176	+- The full transducer surface (including reduced values and lazy `sequence`).
	177	+- Reader conditionals and the full JVM reader/type surface.
178	178
179	179	## Tests
180	180

  The set column is the honest shape of the old representation: `conj` rebuilt the
  whole set and re-scanned it for duplicates, so building one was O(n³).
--**Seqs are lazy.** `map`, `filter`, `remove`, `range`, `take`, `drop`,
++**Seqs are lazy and chunked.** `map`, `filter`, `remove`, `range`, `take`, `drop`,
  `take-while`, `drop-while`, `concat`, `map-indexed`, `iterate`, `repeat`,
  `repeatedly` and `cycle` return a chain of thunks: each element is computed on
  first demand and memoized, so infinite seqs are ordinary values and a consumer
  need; `count`, `reduce` and printing realize the whole seq, which is what those
  mean.
--The cost is the usual one: a fully realized lazy seq allocates a cons cell and
++Like Clojure, the main lazy producers realize 32 elements at a time. This
--a thunk per element, where the eager version filled one flat `seq`. Realizing
++amortizes thunk and allocation overhead; it also means that demanding three
--all of `(map inc (range 1000000))` went from 290 ms to 570 ms. Clojure buys most
++mapped elements may execute the mapping function for the first 32. Chunks and
--of that back by realizing in 32-element chunks; clonim does not chunk yet, which
++ordinary cons sequences interoperate through the same cursor API.
--is why its laziness is exact — `take 3` computes exactly three elements, not
--thirty-two.
  Long chains need one piece of care. ARC frees a linked structure by recursing
  into it, so dropping a million-element seq means a million destructor frames and
  so queued actions run when an agent is dereferenced, awaited, or inspected for
  an error rather than on a background thread.
++Refs: `ref`, `dosync`, `alter`, `commute`, `ref-set`, and `ensure`. Because the
++runtime is single-threaded, transactions are serialized rather than retried.
++
++Transducers: the map/filter/remove composition path works with `transduce`,
++`sequence`, `eduction`, and three-argument `into`.
++
++Protocols: `defprotocol`, `extend-type`, `extend-protocol`, and `satisfies?`
++dispatch over clonim's runtime value kinds, with `Object` as the fallback type.
++
  Lazy seqs: `iterate` `repeat` `repeatedly` `cycle` `doall` `dorun`, and the seq
  library above returns them where Clojure does.
  ## What doesn't (yet)
--- **Syntax-quote.** User macros can construct forms with `quote` and ordinary
++- Records, dynamic namespace operations, and general Nim interop.
--  core functions such as `list`, `vector`, and `apply`, but automatic
++- The full transducer surface (including reduced values and lazy `sequence`).
--  namespace qualification through syntax-quote/unquote is not implemented yet.
++- Reader conditionals and the full JVM reader/type surface.
--- **Chunked seqs.** Lazy seqs are unchunked, so full realization allocates two
--  cells per element and runs ~2× slower than the old eager path. 32-element
--  chunking is the fix, at the cost of exact demand.
--- **Destructuring in parameter lists.** `(let [[a b] xs] …)` works; `(defn f
--  [[a b]] …)` does not.
--- Protocols/records, dynamic namespace operations, refs/agents,
--  `#()` literals, syntax-quote, transducers, Nim interop.
  ## Tests

added examples/core_gaps.clj +22 -0 Viewed

new file mode 100644
@@ -0,0 +1,22 @@
	1	+(ns core-gaps)
	2	+
	3	+;; syntax quote qualifies symbols, honors unquote/splicing, and keeps one
	4	+;; auto-gensym binding stable throughout an expansion.
	5	+(defmacro unless [test then else] `(if ~test ~else ~then))
	6	+(defmacro twice [x] `(let [value# ~x] (+ value# value#)))
	7	+(defmacro packed [x & xs] `[~x ~@xs])
	8	+(println (unless false :yes :no))
	9	+(println (twice 9))
	10	+(println (packed 1 2 3))
	11	+(println `not-yet-defined)
	12	+
	13	+;; The initial transducer surface composes without intermediate collections.
	14	+(def xf (comp (filter odd?) (map inc)))
	15	+(println (transduce xf + 0 (range 10)))
	16	+(println (sequence xf (range 6)))
	17	+(println (into [] xf (range 6)))
	18	+
	19	+;; Refs are serialized cells in clonim's single-threaded runtime.
	20	+(def total (ref 1))
	21	+(println (dosync (alter total + 4) (commute total * 2) (ensure total)))
	22	+(println (dosync (ref-set total 7)) (deref total))

++(ns core-gaps)
++
++;; syntax quote qualifies symbols, honors unquote/splicing, and keeps one
++;; auto-gensym binding stable throughout an expansion.
++(defmacro unless [test then else] `(if ~test ~else ~then))
++(defmacro twice [x] `(let [value# ~x] (+ value# value#)))
++(defmacro packed [x & xs] `[~x ~@xs])
++(println (unless false :yes :no))
++(println (twice 9))
++(println (packed 1 2 3))
++(println `not-yet-defined)
++
++;; The initial transducer surface composes without intermediate collections.
++(def xf (comp (filter odd?) (map inc)))
++(println (transduce xf + 0 (range 10)))
++(println (sequence xf (range 6)))
++(println (into [] xf (range 6)))
++
++;; Refs are serialized cells in clonim's single-threaded runtime.
++(def total (ref 1))
++(println (dosync (alter total + 4) (commute total * 2) (ensure total)))
++(println (dosync (ref-set total 7)) (deref total))

added examples/protocols.clj +30 -0 Viewed

new file mode 100644
@@ -0,0 +1,30 @@
	1	+(ns protocols)
	2	+
	3	+(defprotocol Describable
	4	+ (describe [this])
	5	+ (combine [this other]))
	6	+
	7	+(extend-protocol Describable
	8	+ Long
	9	+ (describe [this] (str "integer:" this))
	10	+ (combine [this other] (+ this other))
	11	+
	12	+ String
	13	+ (describe [this] (str "string:" this))
	14	+ (combine [this other] (str this other))
	15	+
	16	+ Object
	17	+ (describe [this] (str "other:" this))
	18	+ (combine [this other] [this other]))
	19	+
	20	+(println (describe 4) (combine 4 5))
	21	+(println (describe "a") (combine "a" "b"))
	22	+(println (describe :x) (combine :x :y))
	23	+(println (satisfies? Describable 1)
	24	+ (satisfies? Describable "x")
	25	+ (satisfies? Describable []))
	26	+
	27	+(defprotocol Sized (size-of [this]))
	28	+(extend-type clojure.lang.IPersistentVector Sized
	29	+ (size-of [this] (count this)))
	30	+(println (size-of [1 2 3]) (satisfies? Sized {}) (satisfies? Sized []))

++(ns protocols)
++
++(defprotocol Describable
++  (describe [this])
++  (combine [this other]))
++
++(extend-protocol Describable
++  Long
++  (describe [this] (str "integer:" this))
++  (combine [this other] (+ this other))
++
++  String
++  (describe [this] (str "string:" this))
++  (combine [this other] (str this other))
++
++  Object
++  (describe [this] (str "other:" this))
++  (combine [this other] [this other]))
++
++(println (describe 4) (combine 4 5))
++(println (describe "a") (combine "a" "b"))
++(println (describe :x) (combine :x :y))
++(println (satisfies? Describable 1)
++         (satisfies? Describable "x")
++         (satisfies? Describable []))
++
++(defprotocol Sized (size-of [this]))
++(extend-type clojure.lang.IPersistentVector Sized
++  (size-of [this] (count this)))
++(println (size-of [1 2 3]) (satisfies? Sized {}) (satisfies? Sized []))

modified examples/user_macros.clj +13 -0 Viewed

@@ -9,7 +9,20 @@
9	9
10	10	(defmacro nothing [] nil)
11	11
	12	+(defmacro unless-sq [test then else]
	13	+ `(if ~test ~else ~then))
	14	+
	15	+(defmacro collect [x & xs]
	16	+ `[~x ~@xs])
	17	+
	18	+(defmacro twice [expr]
	19	+ `(let [value# ~expr] (+ value# value#)))
	20	+
12	21	(println (unless false :yes :no))
13	22	(call-list println "variadic" 3)
14	23	(println (form-and-env))
15	24	(println (nil? (nothing)))
	25	+(println (unless-sq false :syntax :quote))
	26	+(println (collect 1 2 3 4))
	27	+(println (twice 6))
	28	+(println `quoted-symbol)

  (defmacro nothing [] nil)
++(defmacro unless-sq [test then else]
++  `(if ~test ~else ~then))
++
++(defmacro collect [x & xs]
++  `[~x ~@xs])
++
++(defmacro twice [expr]
++  `(let [value# ~expr] (+ value# value#)))
++
  (println (unless false :yes :no))
  (call-list println "variadic" 3)
  (println (form-and-env))
  (println (nil? (nothing)))
++(println (unless-sq false :syntax :quote))
++(println (collect 1 2 3 4))
++(println (twice 6))
++(println `quoted-symbol)

modified src/app_runtime_source.nim +16 -0 Viewed

@@ -5,3 +5,19 @@ import runtime, core, namespaces
5	5	export runtime, core, namespaces
6	6
7	7	proc initClonimRuntime*() = discard
	8	+
	9	+# Keep the source-runtime surface identical to app_runtime.nim. The release
	10	+# compiler embeds this module, while development builds link app_runtime.nim's
	11	+# C wrappers; generated programs should not need to distinguish the two.
	12	+proc registerCoreArithmetic*(names: openArray[string]) =
	13	+ registerCoreArithmeticSelected(names)
	14	+proc registerCorePredicates*(names: openArray[string]) =
	15	+ registerCorePredicatesSelected(names)
	16	+proc registerCoreStringsIo*(names: openArray[string]) =
	17	+ registerCoreStringsIoSelected(names)
	18	+proc registerCoreCollections*(names: openArray[string]) =
	19	+ registerCoreCollectionsSelected(names)
	20	+proc registerCoreHigherOrder*(names: openArray[string]) =
	21	+ registerCoreHigherOrderSelected(names)
	22	+proc registerCoreStateHost*(names: openArray[string]) =
	23	+ registerCoreStateHostSelected(names)

  export runtime, core, namespaces
  proc initClonimRuntime*() = discard
++
++# Keep the source-runtime surface identical to app_runtime.nim. The release
++# compiler embeds this module, while development builds link app_runtime.nim's
++# C wrappers; generated programs should not need to distinguish the two.
++proc registerCoreArithmetic*(names: openArray[string]) =
++  registerCoreArithmeticSelected(names)
++proc registerCorePredicates*(names: openArray[string]) =
++  registerCorePredicatesSelected(names)
++proc registerCoreStringsIo*(names: openArray[string]) =
++  registerCoreStringsIoSelected(names)
++proc registerCoreCollections*(names: openArray[string]) =
++  registerCoreCollectionsSelected(names)
++proc registerCoreHigherOrder*(names: openArray[string]) =
++  registerCoreHigherOrderSelected(names)
++proc registerCoreStateHost*(names: openArray[string]) =
++  registerCoreStateHostSelected(names)

modified src/compiler.nim +4 -1 Viewed

@@ -143,7 +143,7 @@ const specialHeads = ["quote", "if", "do", "let", "let", "loop", "loop",
143	143	"recur", "fn", "fn*", "def", "defn", "defn-", "defmacro", "and", "or",
144	144	"when", "when-not", "if-not", "cond", "when-let", "if-let", "->", "->>",
145	145	"doseq", "dotimes", "try", "comment", "ns", "require", "in-ns", "use",
146		- "import", "set!", "declare", "binding"].toHashSet
	146	+ "import", "set!", "declare", "binding", "dosync"].toHashSet
147	147
148	148	const intOps = {"+": "+", "-": "-", "": ""}.toTable
149	149	const intCalls = {"quot": "idiv", "rem": "irem"}.toTable
@@ -1014,6 +1014,9 @@ proc genInto(f: Value, dst: string, env: Env, c: Ctx) =
1014	1014	of "do":
1015	1015	genBody(args, dst, env, c)
1016	1016	return
	1017	+ of "dosync":
	1018	+ genBody(args, dst, env, c)
	1019	+ return
1017	1020	of "let", "let*":
1018	1021	if args.len == 0: err("let requires bindings")
1019	1022	genLet(args[0], args[1 .. ^1], dst, env, c)

    "recur", "fn", "fn*", "def", "defn", "defn-", "defmacro", "and", "or",
    "when", "when-not", "if-not", "cond", "when-let", "if-let", "->", "->>",
    "doseq", "dotimes", "try", "comment", "ns", "require", "in-ns", "use",
--  "import", "set!", "declare", "binding"].toHashSet
++  "import", "set!", "declare", "binding", "dosync"].toHashSet
  const intOps = {"+": "+", "-": "-", "*": "*"}.toTable
  const intCalls = {"quot": "idiv", "rem": "irem"}.toTable
        of "do":
          genBody(args, dst, env, c)
          return
++      of "dosync":
++        genBody(args, dst, env, c)
++        return
        of "let", "let*":
          if args.len == 0: err("let requires bindings")
          genLet(args[0], args[1 .. ^1], dst, env, c)

modified src/core.nim +148 -1 Viewed

@@ -5,6 +5,50 @@ import runtime
5	5
6	6	var selectedCore: HashSet[string]
7	7	var selectingCore = false
	8	+var protocolImpls = initTable[string, Value]()
	9	+var protocolMethods = initTable[string, HashSet[string]]()
	10	+
	11	+proc protocolTypeName(v: Value): string =
	12	+ case v.kind
	13	+ of kNil: "nil"
	14	+ of kBool: "boolean"
	15	+ of kInt: "integer"
	16	+ of kFloat: "float"
	17	+ of kChar: "character"
	18	+ of kStr: "string"
	19	+ of kKeyword: "keyword"
	20	+ of kSymbol: "symbol"
	21	+ of kList: "list"
	22	+ of kVector: "vector"
	23	+ of kMap: "map"
	24	+ of kSet: "set"
	25	+ of kCons, kChunk, kLazy: "seq"
	26	+ of kFn: "function"
	27	+ of kAgent: "agent"
	28	+
	29	+proc normalizedProtocolType(v: Value): string =
	30	+ let raw = str(v).split('/')[^1].split('.')[^1]
	31	+ case raw.toLowerAscii
	32	+ of "nil": "nil"
	33	+ of "boolean", "bool": "boolean"
	34	+ of "long", "integer", "int": "integer"
	35	+ of "double", "float": "float"
	36	+ of "character", "char": "character"
	37	+ of "string": "string"
	38	+ of "keyword": "keyword"
	39	+ of "symbol": "symbol"
	40	+ of "list", "ipersistentlist": "list"
	41	+ of "vector", "ipersistentvector": "vector"
	42	+ of "map", "ipersistentmap": "map"
	43	+ of "set", "ipersistentset": "set"
	44	+ of "iseq", "seq", "lazyseq": "seq"
	45	+ of "ifn", "function", "fn": "function"
	46	+ of "agent": "agent"
	47	+ of "object", "default": "default"
	48	+ else: raw.toLowerAscii
	49	+
	50	+proc protocolKey(protocol, methodName, typ: string): string =
	51	+ protocol & "\x1f" & methodName & "\x1f" & typ
8	52
9	53	proc num(v: Value): float64 =
10	54	case v.kind
@@ -992,8 +1036,13 @@ proc registerCoreCollections*() =
992	1036	mkList(r)
993	1037	def "into", proc (a: openArray[Value]): Value =
994	1038	result = a[0]
995		- if a.len > 1:
	1039	+ if a.len == 2:
996	1040	for x in elems(a[1]): result = conjOne(result, x)
	1041	+ elif a.len == 3:
	1042	+ let step = mkFn("conj-step", proc (xs: openArray[Value]): Value =
	1043	+ conjOne(xs[0], xs[1]))
	1044	+ let rf = call(a[1], [step])
	1045	+ for x in elems(a[2]): result = call(rf, [result, x])
997	1046	def "mapcat", proc (a: openArray[Value]): Value =
998	1047	## Like map, then concat: the fn takes one element from each collection.
999	1048	var colls: seq[seq[Value]] = @[]
@@ -1015,6 +1064,13 @@ proc registerCoreHigherOrder*() =
1015	1064	callArgs.add toSeq(a[^1])
1016	1065	call(a[0], callArgs)
1017	1066	def "map", proc (a: openArray[Value]): Value =
	1067	+ if a.len == 1:
	1068	+ let f = a[0]
	1069	+ return mkFn("map-transducer", proc (xfArgs: openArray[Value]): Value =
	1070	+ let rf = argAt(xfArgs, 0)
	1071	+ mkFn("map-step", proc (step: openArray[Value]): Value =
	1072	+ if step.len < 2: return call(rf, step)
	1073	+ call(rf, [step[0], call(f, [step[1]])])))
1018	1074	if a.len == 2: return lazyMap(a[0], cursor(a[1]))
1019	1075	var cs: seq[Cursor] = @[]
1020	1076	for i in 1 ..< a.len: cs.add cursor(a[i])
@@ -1026,8 +1082,22 @@ proc registerCoreHigherOrder*() =
1026	1082	def "map-indexed", proc (a: openArray[Value]): Value =
1027	1083	lazyMapIndexed(a[0], 0, cursor(a[1]))
1028	1084	def "filter", proc (a: openArray[Value]): Value =
	1085	+ if a.len == 1:
	1086	+ let pred = a[0]
	1087	+ return mkFn("filter-transducer", proc (xfArgs: openArray[Value]): Value =
	1088	+ let rf = argAt(xfArgs, 0)
	1089	+ mkFn("filter-step", proc (step: openArray[Value]): Value =
	1090	+ if step.len < 2: return call(rf, step)
	1091	+ if truthy(call(pred, [step[1]])): call(rf, step) else: step[0]))
1029	1092	lazyFilter(a[0], cursor(a[1]), keep = true)
1030	1093	def "remove", proc (a: openArray[Value]): Value =
	1094	+ if a.len == 1:
	1095	+ let pred = a[0]
	1096	+ return mkFn("remove-transducer", proc (xfArgs: openArray[Value]): Value =
	1097	+ let rf = argAt(xfArgs, 0)
	1098	+ mkFn("remove-step", proc (step: openArray[Value]): Value =
	1099	+ if step.len < 2: return call(rf, step)
	1100	+ if not truthy(call(pred, [step[1]])): call(rf, step) else: step[0]))
1031	1101	lazyFilter(a[0], cursor(a[1]), keep = false)
1032	1102	def "reduce", proc (a: openArray[Value]): Value =
1033	1103	## Streams the source rather than materializing it, so folding a lazy seq
@@ -1045,6 +1115,33 @@ proc registerCoreHigherOrder*() =
1045	1115	var acc = a[1]
1046	1116	for x in elems(a[2]): acc = call(f, [acc, x])
1047	1117	acc
	1118	+ def "transduce", proc (a: openArray[Value]): Value =
	1119	+ let rf = call(a[0], [a[1]])
	1120	+ let coll = a[^1]
	1121	+ var acc: Value
	1122	+ if a.len == 3:
	1123	+ var c = cursor(coll)
	1124	+ if not hasNext(c): return call(a[1], [])
	1125	+ acc = next(c)
	1126	+ while hasNext(c): acc = call(rf, [acc, next(c)])
	1127	+ else:
	1128	+ acc = a[2]
	1129	+ for x in elems(coll): acc = call(rf, [acc, x])
	1130	+ acc
	1131	+ def "sequence", proc (a: openArray[Value]): Value =
	1132	+ let step = mkFn("sequence-step", proc (xs: openArray[Value]): Value =
	1133	+ conjOne(xs[0], xs[1]))
	1134	+ let rf = call(a[0], [step])
	1135	+ var result = mkVector(@[])
	1136	+ for x in elems(a[1]): result = call(rf, [result, x])
	1137	+ mkList(toSeq(result))
	1138	+ def "eduction", proc (a: openArray[Value]): Value =
	1139	+ let step = mkFn("eduction-step", proc (xs: openArray[Value]): Value =
	1140	+ conjOne(xs[0], xs[1]))
	1141	+ let rf = call(a[0], [step])
	1142	+ var result = mkVector(@[])
	1143	+ for x in elems(a[1]): result = call(rf, [result, x])
	1144	+ mkList(toSeq(result))
1048	1145	def "some", proc (a: openArray[Value]): Value =
1049	1146	for x in elems(a[1]):
1050	1147	let r = call(a[0], [x])
@@ -1117,6 +1214,56 @@ proc registerCoreStateHost*() =
1117	1214	let nv = call(a[1], @[cur] & @(a[2 .. ^1]))
1118	1215	call(a[0], [mkKeyword("set"), nv])
1119	1216
	1217	+ # Refs use the same mutable cell representation as atoms. clonim programs
	1218	+ # execute on one thread, so a dosync body is already an atomic transaction;
	1219	+ # alter and commute consequently have identical serialized semantics.
	1220	+ def "ref", proc (a: openArray[Value]): Value =
	1221	+ var cell = a[0]
	1222	+ mkFn("ref", proc (args: openArray[Value]): Value =
	1223	+ if args.len == 0: return cell
	1224	+ cell = args[1]
	1225	+ cell)
	1226	+ def "ref-set", proc (a: openArray[Value]): Value =
	1227	+ call(a[0], [mkKeyword("set"), a[1]])
	1228	+ def "alter", proc (a: openArray[Value]): Value =
	1229	+ let current = call(a[0], [])
	1230	+ let value = call(a[1], @[current] & @(a[2 .. ^1]))
	1231	+ call(a[0], [mkKeyword("set"), value])
	1232	+ def "commute", proc (a: openArray[Value]): Value =
	1233	+ let current = call(a[0], [])
	1234	+ let value = call(a[1], @[current] & @(a[2 .. ^1]))
	1235	+ call(a[0], [mkKeyword("set"), value])
	1236	+ def "ensure", proc (a: openArray[Value]): Value = call(a[0], [])
	1237	+
	1238	+ # ---- protocols over clonim runtime value kinds
	1239	+ def "make-protocol-fn", proc (a: openArray[Value]): Value =
	1240	+ let protocol = str(a[0])
	1241	+ let methodName = str(a[1])
	1242	+ protocolMethods.mgetOrPut(protocol, initHashSet[string]()).incl methodName
	1243	+ mkFn(methodName, proc (args: openArray[Value]): Value =
	1244	+ if args.len == 0: err("Protocol method " & methodName & " requires a target")
	1245	+ let exact = protocolKey(protocol, methodName, protocolTypeName(args[0]))
	1246	+ let fallback = protocolKey(protocol, methodName, "default")
	1247	+ if protocolImpls.hasKey(exact): return call(protocolImpls[exact], args)
	1248	+ if protocolImpls.hasKey(fallback): return call(protocolImpls[fallback], args)
	1249	+ err("No implementation of " & protocol & "/" & methodName &
	1250	+ " for " & protocolTypeName(args[0])))
	1251	+ def "extend-protocol!", proc (a: openArray[Value]): Value =
	1252	+ let protocol = str(a[0])
	1253	+ let methodName = str(a[1])
	1254	+ let typ = normalizedProtocolType(a[2])
	1255	+ protocolImpls[protocolKey(protocol, methodName, typ)] = a[3]
	1256	+ a[3]
	1257	+ def "satisfies?", proc (a: openArray[Value]): Value =
	1258	+ let protocol = str(a[0])
	1259	+ if not protocolMethods.hasKey(protocol): return FalseV
	1260	+ let typ = protocolTypeName(a[1])
	1261	+ for methodName in protocolMethods[protocol]:
	1262	+ if not protocolImpls.hasKey(protocolKey(protocol, methodName, typ)) and
	1263	+ not protocolImpls.hasKey(protocolKey(protocol, methodName, "default")):
	1264	+ return FalseV
	1265	+ TrueV
	1266	+
1120	1267	def "ex-message", proc (a: openArray[Value]): Value =
1121	1268	## Thrown values reach a catch clause as their message string.
1122	1269	(if a[0].kind == kStr: a[0] else: NilV)

  var selectedCore: HashSet[string]
  var selectingCore = false
++var protocolImpls = initTable[string, Value]()
++var protocolMethods = initTable[string, HashSet[string]]()
++
++proc protocolTypeName(v: Value): string =
++  case v.kind
++  of kNil: "nil"
++  of kBool: "boolean"
++  of kInt: "integer"
++  of kFloat: "float"
++  of kChar: "character"
++  of kStr: "string"
++  of kKeyword: "keyword"
++  of kSymbol: "symbol"
++  of kList: "list"
++  of kVector: "vector"
++  of kMap: "map"
++  of kSet: "set"
++  of kCons, kChunk, kLazy: "seq"
++  of kFn: "function"
++  of kAgent: "agent"
++
++proc normalizedProtocolType(v: Value): string =
++  let raw = str(v).split('/')[^1].split('.')[^1]
++  case raw.toLowerAscii
++  of "nil": "nil"
++  of "boolean", "bool": "boolean"
++  of "long", "integer", "int": "integer"
++  of "double", "float": "float"
++  of "character", "char": "character"
++  of "string": "string"
++  of "keyword": "keyword"
++  of "symbol": "symbol"
++  of "list", "ipersistentlist": "list"
++  of "vector", "ipersistentvector": "vector"
++  of "map", "ipersistentmap": "map"
++  of "set", "ipersistentset": "set"
++  of "iseq", "seq", "lazyseq": "seq"
++  of "ifn", "function", "fn": "function"
++  of "agent": "agent"
++  of "object", "default": "default"
++  else: raw.toLowerAscii
++
++proc protocolKey(protocol, methodName, typ: string): string =
++  protocol & "\x1f" & methodName & "\x1f" & typ
  proc num(v: Value): float64 =
    case v.kind
      mkList(r)
    def "into", proc (a: openArray[Value]): Value =
      result = a[0]
--    if a.len > 1:
++    if a.len == 2:
        for x in elems(a[1]): result = conjOne(result, x)
++    elif a.len == 3:
++      let step = mkFn("conj-step", proc (xs: openArray[Value]): Value =
++        conjOne(xs[0], xs[1]))
++      let rf = call(a[1], [step])
++      for x in elems(a[2]): result = call(rf, [result, x])
    def "mapcat", proc (a: openArray[Value]): Value =
      ## Like map, then concat: the fn takes one element from each collection.
      var colls: seq[seq[Value]] = @[]
      callArgs.add toSeq(a[^1])
      call(a[0], callArgs)
    def "map", proc (a: openArray[Value]): Value =
++    if a.len == 1:
++      let f = a[0]
++      return mkFn("map-transducer", proc (xfArgs: openArray[Value]): Value =
++        let rf = argAt(xfArgs, 0)
++        mkFn("map-step", proc (step: openArray[Value]): Value =
++          if step.len < 2: return call(rf, step)
++          call(rf, [step[0], call(f, [step[1]])])))
      if a.len == 2: return lazyMap(a[0], cursor(a[1]))
      var cs: seq[Cursor] = @[]
      for i in 1 ..< a.len: cs.add cursor(a[i])
    def "map-indexed", proc (a: openArray[Value]): Value =
      lazyMapIndexed(a[0], 0, cursor(a[1]))
    def "filter", proc (a: openArray[Value]): Value =
++    if a.len == 1:
++      let pred = a[0]
++      return mkFn("filter-transducer", proc (xfArgs: openArray[Value]): Value =
++        let rf = argAt(xfArgs, 0)
++        mkFn("filter-step", proc (step: openArray[Value]): Value =
++          if step.len < 2: return call(rf, step)
++          if truthy(call(pred, [step[1]])): call(rf, step) else: step[0]))
      lazyFilter(a[0], cursor(a[1]), keep = true)
    def "remove", proc (a: openArray[Value]): Value =
++    if a.len == 1:
++      let pred = a[0]
++      return mkFn("remove-transducer", proc (xfArgs: openArray[Value]): Value =
++        let rf = argAt(xfArgs, 0)
++        mkFn("remove-step", proc (step: openArray[Value]): Value =
++          if step.len < 2: return call(rf, step)
++          if not truthy(call(pred, [step[1]])): call(rf, step) else: step[0]))
      lazyFilter(a[0], cursor(a[1]), keep = false)
    def "reduce", proc (a: openArray[Value]): Value =
      ## Streams the source rather than materializing it, so folding a lazy seq
      var acc = a[1]
      for x in elems(a[2]): acc = call(f, [acc, x])
      acc
++  def "transduce", proc (a: openArray[Value]): Value =
++    let rf = call(a[0], [a[1]])
++    let coll = a[^1]
++    var acc: Value
++    if a.len == 3:
++      var c = cursor(coll)
++      if not hasNext(c): return call(a[1], [])
++      acc = next(c)
++      while hasNext(c): acc = call(rf, [acc, next(c)])
++    else:
++      acc = a[2]
++      for x in elems(coll): acc = call(rf, [acc, x])
++    acc
++  def "sequence", proc (a: openArray[Value]): Value =
++    let step = mkFn("sequence-step", proc (xs: openArray[Value]): Value =
++      conjOne(xs[0], xs[1]))
++    let rf = call(a[0], [step])
++    var result = mkVector(@[])
++    for x in elems(a[1]): result = call(rf, [result, x])
++    mkList(toSeq(result))
++  def "eduction", proc (a: openArray[Value]): Value =
++    let step = mkFn("eduction-step", proc (xs: openArray[Value]): Value =
++      conjOne(xs[0], xs[1]))
++    let rf = call(a[0], [step])
++    var result = mkVector(@[])
++    for x in elems(a[1]): result = call(rf, [result, x])
++    mkList(toSeq(result))
    def "some", proc (a: openArray[Value]): Value =
      for x in elems(a[1]):
        let r = call(a[0], [x])
      let nv = call(a[1], @[cur] & @(a[2 .. ^1]))
      call(a[0], [mkKeyword("set"), nv])
++  # Refs use the same mutable cell representation as atoms. clonim programs
++  # execute on one thread, so a dosync body is already an atomic transaction;
++  # alter and commute consequently have identical serialized semantics.
++  def "ref", proc (a: openArray[Value]): Value =
++    var cell = a[0]
++    mkFn("ref", proc (args: openArray[Value]): Value =
++      if args.len == 0: return cell
++      cell = args[1]
++      cell)
++  def "ref-set", proc (a: openArray[Value]): Value =
++    call(a[0], [mkKeyword("set"), a[1]])
++  def "alter", proc (a: openArray[Value]): Value =
++    let current = call(a[0], [])
++    let value = call(a[1], @[current] & @(a[2 .. ^1]))
++    call(a[0], [mkKeyword("set"), value])
++  def "commute", proc (a: openArray[Value]): Value =
++    let current = call(a[0], [])
++    let value = call(a[1], @[current] & @(a[2 .. ^1]))
++    call(a[0], [mkKeyword("set"), value])
++  def "ensure", proc (a: openArray[Value]): Value = call(a[0], [])
++
++  # ---- protocols over clonim runtime value kinds
++  def "make-protocol-fn", proc (a: openArray[Value]): Value =
++    let protocol = str(a[0])
++    let methodName = str(a[1])
++    protocolMethods.mgetOrPut(protocol, initHashSet[string]()).incl methodName
++    mkFn(methodName, proc (args: openArray[Value]): Value =
++      if args.len == 0: err("Protocol method " & methodName & " requires a target")
++      let exact = protocolKey(protocol, methodName, protocolTypeName(args[0]))
++      let fallback = protocolKey(protocol, methodName, "default")
++      if protocolImpls.hasKey(exact): return call(protocolImpls[exact], args)
++      if protocolImpls.hasKey(fallback): return call(protocolImpls[fallback], args)
++      err("No implementation of " & protocol & "/" & methodName &
++          " for " & protocolTypeName(args[0])))
++  def "extend-protocol!", proc (a: openArray[Value]): Value =
++    let protocol = str(a[0])
++    let methodName = str(a[1])
++    let typ = normalizedProtocolType(a[2])
++    protocolImpls[protocolKey(protocol, methodName, typ)] = a[3]
++    a[3]
++  def "satisfies?", proc (a: openArray[Value]): Value =
++    let protocol = str(a[0])
++    if not protocolMethods.hasKey(protocol): return FalseV
++    let typ = protocolTypeName(a[1])
++    for methodName in protocolMethods[protocol]:
++      if not protocolImpls.hasKey(protocolKey(protocol, methodName, typ)) and
++         not protocolImpls.hasKey(protocolKey(protocol, methodName, "default")):
++        return FalseV
++    TrueV
++
    def "ex-message", proc (a: openArray[Value]): Value =
      ## Thrown values reach a catch clause as their message string.
      (if a[0].kind == kStr: a[0] else: NilV)

modified src/namespaces.nim +133 -4 Viewed

@@ -1,7 +1,7 @@
1	1	## Static namespaces and dependency loading, before compiler.compileForms.
2		-## This pass understands the compiler's fixed macro/binding forms, not arbitrary
3		-## user macro expansion. Reader limitations (including syntax-quote and reader
4		-## conditionals) still apply. Core discovery temporarily swaps runtime globals;
	2	+## This pass understands the compiler's fixed macro/binding forms and expands
	3	+## user macros. Reader conditionals are still outside the supported subset.
	4	+## Core discovery temporarily swaps runtime globals;
5	5	## like that runtime, this module is intended for single-threaded use.
6	6	## Core var references are canonical clojure.core/name symbols. Generated code
7	7	## must call registerNamespaceCore() after registerCore() (or register the same
@@ -31,7 +31,9 @@ const syntaxHeads = ["quote", "if", "do", "let", "let", "loop", "loop",
31	31	"recur", "fn", "fn*", "def", "defn", "defn-", "defmacro", "and", "or",
32	32	"when", "when-not", "if-not", "cond", "when-let", "if-let", "->", "->>",
33	33	"doseq", "dotimes", "try", "catch", "finally", "comment", "set!", "declare",
34		- "case", "for", "with-open", "assert", "binding"]
	34	+ "case", "for", "with-open", "assert", "binding", "syntax-quote",
	35	+ "unquote", "unquote-splicing", "dosync", "defprotocol", "extend-type",
	36	+ "extend-protocol"]
35	37
36	38	# Unlike macros, these heads cannot be shadowed in operator position.
37	39	const specialForms = ["quote", "if", "do", "let", "loop", "recur", "fn*",
@@ -160,6 +162,68 @@ proc define(ns: Namespace, v: Value, private = false): Value =
160	162
161	163	proc walk(r: Resolver, ns: Namespace, v: Value, locals: HashSet[string]): Value
162	164
	165	+proc syntaxQuoted(r: Resolver, ns: Namespace, v: Value,
	166	+ locals: HashSet[string], gensyms: var Table[string, string]): Value =
	167	+ ## Turn syntax-quoted data into ordinary list/vector/map/set construction.
	168	+ ## The result is evaluated by the macro interpreter, so unquotes remain
	169	+ ## normal expressions while all other symbols become quoted, qualified data.
	170	+ if v.kind == kList and v.items.len > 0 and v.items[0].kind == kSymbol:
	171	+ if v.items[0].s == "unquote":
	172	+ if v.items.len != 2: fail("unquote expects one form")
	173	+ return r.walk(ns, v.items[1], locals)
	174	+ if v.items[0].s == "unquote-splicing":
	175	+ fail("unquote-splicing is only valid inside a collection")
	176	+ if v.kind == kSymbol:
	177	+ var name = v.s
	178	+ if name.endsWith("#"):
	179	+ if not gensyms.hasKey(name):
	180	+ inc r.gensym
	181	+ gensyms[name] = name[0 ..< name.len - 1] &
	182	+ "__" & $r.gensym & "__auto__"
	183	+ name = gensyms[name]
	184	+ elif name notin syntaxHeads:
	185	+ let slash = name.find('/')
	186	+ if slash > 0:
	187	+ let prefix = name[0 ..< slash]
	188	+ name = ns.aliases.getOrDefault(prefix, prefix) & name[slash .. ^1]
	189	+ elif name in r.cores:
	190	+ name = "clojure.core/" & name
	191	+ else:
	192	+ name = ns.name & "/" & name
	193	+ return mkList(@[mkSymbol("quote"), mkSymbol(name)])
	194	+ if v.kind notin {kList, kVector, kMap, kSet}:
	195	+ return v
	196	+
	197	+ var items: seq[Value]
	198	+ if v.kind == kMap:
	199	+ for (k, value) in v.pairs:
	200	+ items.add k
	201	+ items.add value
	202	+ else:
	203	+ items = v.items
	204	+ var pieces: seq[Value]
	205	+ var spliced = false
	206	+ for item in items:
	207	+ if item.kind == kList and item.items.len > 0 and
	208	+ isSym(item.items[0], "unquote-splicing"):
	209	+ if item.items.len != 2: fail("unquote-splicing expects one form")
	210	+ pieces.add r.walk(ns, item.items[1], locals)
	211	+ spliced = true
	212	+ else:
	213	+ pieces.add mkList(@[mkSymbol("clojure.core/list"),
	214	+ r.syntaxQuoted(ns, item, locals, gensyms)])
	215	+ let joined =
	216	+ if pieces.len == 0: mkList(@[mkSymbol("quote"), NilV])
	217	+ elif pieces.len == 1 and spliced: pieces[0]
	218	+ else: mkList(@[mkSymbol("clojure.core/concat")] & pieces)
	219	+ let ctor = case v.kind
	220	+ of kList: "clojure.core/list"
	221	+ of kVector: "clojure.core/vector"
	222	+ of kMap: "clojure.core/hash-map"
	223	+ of kSet: "clojure.core/hash-set"
	224	+ else: ""
	225	+ mkList(@[mkSymbol("clojure.core/apply"), mkSymbol(ctor), joined])
	226	+
163	227	proc macroKey(r: Resolver, ns: Namespace, raw: string): string =
164	228	let slash = raw.find('/')
165	229	if slash > 0:
@@ -346,6 +410,12 @@ proc walk(r: Resolver, ns: Namespace, v: Value, locals: HashSet[string]): Value
346	410	let (isMacro, expanded) = r.expandMacro(ns, v, locals)
347	411	if isMacro: return r.walk(ns, expanded, locals)
348	412	let h = ns.syntaxHead(v, locals)
	413	+ if h == "syntax-quote":
	414	+ if xs.len != 2: fail("syntax-quote expects one form")
	415	+ var gensyms = initTable[string, string]()
	416	+ return r.syntaxQuoted(ns, xs[1], locals, gensyms)
	417	+ if h in ["unquote", "unquote-splicing"]:
	418	+ fail(h & " is only valid inside syntax-quote")
349	419	if h in ["quote", "comment"]:
350	420	xs[0] = mkSymbol(h)
351	421	return mkList(xs)
@@ -353,6 +423,63 @@ proc walk(r: Resolver, ns: Namespace, v: Value, locals: HashSet[string]): Value
353	423	fail(h & " is only supported as a static top-level ns/require declaration")
354	424	if h in syntaxHeads: xs[0] = mkSymbol(h)
355	425	case h
	426	+ of "defprotocol":
	427	+ if xs.len < 3: fail("defprotocol requires a name and method signatures")
	428	+ let protocolName = simple(xs[1], "protocol name")
	429	+ let protocolSym = ns.define(xs[1])
	430	+ var forms = @[mkSymbol("do"),
	431	+ mkList(@[mkSymbol("def"), protocolSym,
	432	+ mkList(@[mkSymbol("quote"), protocolSym])])]
	433	+ for signature in xs[2 .. ^1]:
	434	+ if signature.kind != kList or signature.items.len < 2:
	435	+ fail("protocol method requires a name and parameter vector")
	436	+ let methodName = simple(signature.items[0], "protocol method")
	437	+ let methodSym = ns.define(signature.items[0])
	438	+ let params = signature.items[1]
	439	+ if params.kind != kVector and
	440	+ not (params.kind == kList and params.items.len > 0 and
	441	+ params.items[0].kind == kVector):
	442	+ fail("protocol method " & methodName & " requires parameter vectors")
	443	+ forms.add mkList(@[mkSymbol("def"), methodSym,
	444	+ mkList(@[mkSymbol("clojure.core/make-protocol-fn"),
	445	+ mkStr(protocolSym.s), mkStr(methodName)])])
	446	+ return mkList(forms)
	447	+ of "extend-type", "extend-protocol":
	448	+ if xs.len < 4: fail(h & " requires a type, protocol, and methods")
	449	+ var forms = @[mkSymbol("do")]
	450	+ proc addMethods(protocolForm, typeForm: Value, methods: seq[Value]) =
	451	+ if protocolForm.kind != kSymbol: fail("protocol name must be a symbol")
	452	+ let protocol = r.qualify(ns, protocolForm.s, locals)
	453	+ for implForm in methods:
	454	+ if implForm.kind != kList or implForm.items.len < 3 or
	455	+ implForm.items[0].kind != kSymbol or implForm.items[1].kind != kVector:
	456	+ fail("protocol implementation requires (method [args] body...)")
	457	+ let methodName = implForm.items[0].s.split('/')[^1]
	458	+ let fnForm = mkList(@[mkSymbol("fn"), implForm.items[1]] & implForm.items[2 .. ^1])
	459	+ forms.add mkList(@[mkSymbol("clojure.core/extend-protocol!"),
	460	+ mkStr(protocol), mkStr(methodName),
	461	+ mkList(@[mkSymbol("quote"), typeForm]), fnForm])
	462	+ if h == "extend-type":
	463	+ let typ = xs[1]
	464	+ var i = 2
	465	+ while i < xs.len:
	466	+ let protocol = xs[i]
	467	+ inc i
	468	+ let start = i
	469	+ while i < xs.len and xs[i].kind == kList: inc i
	470	+ if start == i: fail("extend-type protocol requires method implementations")
	471	+ addMethods(protocol, typ, xs[start ..< i])
	472	+ else:
	473	+ let protocol = xs[1]
	474	+ var i = 2
	475	+ while i < xs.len:
	476	+ let typ = xs[i]
	477	+ inc i
	478	+ let start = i
	479	+ while i < xs.len and xs[i].kind == kList: inc i
	480	+ if start == i: fail("extend-protocol type requires method implementations")
	481	+ addMethods(protocol, typ, xs[start ..< i])
	482	+ return r.walk(ns, mkList(forms), locals)
356	483	of "fn", "fn*":
357	484	var scope = locals
358	485	var start = 1
@@ -475,6 +602,8 @@ proc walk(r: Resolver, ns: Namespace, v: Value, locals: HashSet[string]): Value
475	602	msg = mkList(@[mkSymbol("str"), mkStr("Assert failed: "), xs[2]])
476	603	return r.walk(ns, mkList(@[mkSymbol("when-not"), xs[1],
477	604	mkList(@[mkSymbol("throw"), msg])]), locals)
	605	+ of "dosync":
	606	+ return r.walk(ns, mkList(@[mkSymbol("do")] & xs[1 .. ^1]), locals)
478	607	of "->", "->>":
479	608	# Expand before resolving: a bare step can be a syntax head (e.g. do).
480	609	if xs.len < 2: fail(h & " requires an expression")

  ## Static namespaces and dependency loading, before compiler.compileForms.
--## This pass understands the compiler's fixed macro/binding forms, not arbitrary
++## This pass understands the compiler's fixed macro/binding forms and expands
--## user macro expansion. Reader limitations (including syntax-quote and reader
++## user macros. Reader conditionals are still outside the supported subset.
--## conditionals) still apply. Core discovery temporarily swaps runtime globals;
++## Core discovery temporarily swaps runtime globals;
  ## like that runtime, this module is intended for single-threaded use.
  ## Core var references are canonical clojure.core/name symbols. Generated code
  ## must call registerNamespaceCore() after registerCore() (or register the same
    "recur", "fn", "fn*", "def", "defn", "defn-", "defmacro", "and", "or",
    "when", "when-not", "if-not", "cond", "when-let", "if-let", "->", "->>",
    "doseq", "dotimes", "try", "catch", "finally", "comment", "set!", "declare",
--  "case", "for", "with-open", "assert", "binding"]
++  "case", "for", "with-open", "assert", "binding", "syntax-quote",
++  "unquote", "unquote-splicing", "dosync", "defprotocol", "extend-type",
++  "extend-protocol"]
  # Unlike macros, these heads cannot be shadowed in operator position.
  const specialForms = ["quote", "if", "do", "let*", "loop*", "recur", "fn*",
  proc walk(r: Resolver, ns: Namespace, v: Value, locals: HashSet[string]): Value
++proc syntaxQuoted(r: Resolver, ns: Namespace, v: Value,
++                  locals: HashSet[string], gensyms: var Table[string, string]): Value =
++  ## Turn syntax-quoted data into ordinary list/vector/map/set construction.
++  ## The result is evaluated by the macro interpreter, so unquotes remain
++  ## normal expressions while all other symbols become quoted, qualified data.
++  if v.kind == kList and v.items.len > 0 and v.items[0].kind == kSymbol:
++    if v.items[0].s == "unquote":
++      if v.items.len != 2: fail("unquote expects one form")
++      return r.walk(ns, v.items[1], locals)
++    if v.items[0].s == "unquote-splicing":
++      fail("unquote-splicing is only valid inside a collection")
++  if v.kind == kSymbol:
++    var name = v.s
++    if name.endsWith("#"):
++      if not gensyms.hasKey(name):
++        inc r.gensym
++        gensyms[name] = name[0 ..< name.len - 1] &
++                        "__" & $r.gensym & "__auto__"
++      name = gensyms[name]
++    elif name notin syntaxHeads:
++      let slash = name.find('/')
++      if slash > 0:
++        let prefix = name[0 ..< slash]
++        name = ns.aliases.getOrDefault(prefix, prefix) & name[slash .. ^1]
++      elif name in r.cores:
++        name = "clojure.core/" & name
++      else:
++        name = ns.name & "/" & name
++    return mkList(@[mkSymbol("quote"), mkSymbol(name)])
++  if v.kind notin {kList, kVector, kMap, kSet}:
++    return v
++
++  var items: seq[Value]
++  if v.kind == kMap:
++    for (k, value) in v.pairs:
++      items.add k
++      items.add value
++  else:
++    items = v.items
++  var pieces: seq[Value]
++  var spliced = false
++  for item in items:
++    if item.kind == kList and item.items.len > 0 and
++       isSym(item.items[0], "unquote-splicing"):
++      if item.items.len != 2: fail("unquote-splicing expects one form")
++      pieces.add r.walk(ns, item.items[1], locals)
++      spliced = true
++    else:
++      pieces.add mkList(@[mkSymbol("clojure.core/list"),
++                          r.syntaxQuoted(ns, item, locals, gensyms)])
++  let joined =
++    if pieces.len == 0: mkList(@[mkSymbol("quote"), NilV])
++    elif pieces.len == 1 and spliced: pieces[0]
++    else: mkList(@[mkSymbol("clojure.core/concat")] & pieces)
++  let ctor = case v.kind
++    of kList: "clojure.core/list"
++    of kVector: "clojure.core/vector"
++    of kMap: "clojure.core/hash-map"
++    of kSet: "clojure.core/hash-set"
++    else: ""
++  mkList(@[mkSymbol("clojure.core/apply"), mkSymbol(ctor), joined])
++
  proc macroKey(r: Resolver, ns: Namespace, raw: string): string =
    let slash = raw.find('/')
    if slash > 0:
      let (isMacro, expanded) = r.expandMacro(ns, v, locals)
      if isMacro: return r.walk(ns, expanded, locals)
    let h = ns.syntaxHead(v, locals)
++  if h == "syntax-quote":
++    if xs.len != 2: fail("syntax-quote expects one form")
++    var gensyms = initTable[string, string]()
++    return r.syntaxQuoted(ns, xs[1], locals, gensyms)
++  if h in ["unquote", "unquote-splicing"]:
++    fail(h & " is only valid inside syntax-quote")
    if h in ["quote", "comment"]:
      xs[0] = mkSymbol(h)
      return mkList(xs)
      fail(h & " is only supported as a static top-level ns/require declaration")
    if h in syntaxHeads: xs[0] = mkSymbol(h)
    case h
++  of "defprotocol":
++    if xs.len < 3: fail("defprotocol requires a name and method signatures")
++    let protocolName = simple(xs[1], "protocol name")
++    let protocolSym = ns.define(xs[1])
++    var forms = @[mkSymbol("do"),
++      mkList(@[mkSymbol("def"), protocolSym,
++               mkList(@[mkSymbol("quote"), protocolSym])])]
++    for signature in xs[2 .. ^1]:
++      if signature.kind != kList or signature.items.len < 2:
++        fail("protocol method requires a name and parameter vector")
++      let methodName = simple(signature.items[0], "protocol method")
++      let methodSym = ns.define(signature.items[0])
++      let params = signature.items[1]
++      if params.kind != kVector and
++         not (params.kind == kList and params.items.len > 0 and
++              params.items[0].kind == kVector):
++        fail("protocol method " & methodName & " requires parameter vectors")
++      forms.add mkList(@[mkSymbol("def"), methodSym,
++        mkList(@[mkSymbol("clojure.core/make-protocol-fn"),
++                 mkStr(protocolSym.s), mkStr(methodName)])])
++    return mkList(forms)
++  of "extend-type", "extend-protocol":
++    if xs.len < 4: fail(h & " requires a type, protocol, and methods")
++    var forms = @[mkSymbol("do")]
++    proc addMethods(protocolForm, typeForm: Value, methods: seq[Value]) =
++      if protocolForm.kind != kSymbol: fail("protocol name must be a symbol")
++      let protocol = r.qualify(ns, protocolForm.s, locals)
++      for implForm in methods:
++        if implForm.kind != kList or implForm.items.len < 3 or
++           implForm.items[0].kind != kSymbol or implForm.items[1].kind != kVector:
++          fail("protocol implementation requires (method [args] body...)")
++        let methodName = implForm.items[0].s.split('/')[^1]
++        let fnForm = mkList(@[mkSymbol("fn"), implForm.items[1]] & implForm.items[2 .. ^1])
++        forms.add mkList(@[mkSymbol("clojure.core/extend-protocol!"),
++          mkStr(protocol), mkStr(methodName),
++          mkList(@[mkSymbol("quote"), typeForm]), fnForm])
++    if h == "extend-type":
++      let typ = xs[1]
++      var i = 2
++      while i < xs.len:
++        let protocol = xs[i]
++        inc i
++        let start = i
++        while i < xs.len and xs[i].kind == kList: inc i
++        if start == i: fail("extend-type protocol requires method implementations")
++        addMethods(protocol, typ, xs[start ..< i])
++    else:
++      let protocol = xs[1]
++      var i = 2
++      while i < xs.len:
++        let typ = xs[i]
++        inc i
++        let start = i
++        while i < xs.len and xs[i].kind == kList: inc i
++        if start == i: fail("extend-protocol type requires method implementations")
++        addMethods(protocol, typ, xs[start ..< i])
++    return r.walk(ns, mkList(forms), locals)
    of "fn", "fn*":
      var scope = locals
      var start = 1
        msg = mkList(@[mkSymbol("str"), mkStr("Assert failed: "), xs[2]])
      return r.walk(ns, mkList(@[mkSymbol("when-not"), xs[1],
                                 mkList(@[mkSymbol("throw"), msg])]), locals)
++  of "dosync":
++    return r.walk(ns, mkList(@[mkSymbol("do")] & xs[1 .. ^1]), locals)
    of "->", "->>":
      # Expand before resolving: a bare step can be a syntax head (e.g. do).
      if xs.len < 2: fail(h & " requires an expression")

modified src/reader.nim +9 -0 Viewed

@@ -191,6 +191,15 @@ proc readForm(r: var Reader): Value =
191	191	of '\'':
192	192	discard r.advance
193	193	return mkList(@[mkSymbol("quote"), r.readForm])
	194	+ of '`':
	195	+ discard r.advance
	196	+ return mkList(@[mkSymbol("syntax-quote"), r.readForm])
	197	+ of '~':
	198	+ discard r.advance
	199	+ if r.peek == '@':
	200	+ discard r.advance
	201	+ return mkList(@[mkSymbol("unquote-splicing"), r.readForm])
	202	+ return mkList(@[mkSymbol("unquote"), r.readForm])
194	203	of '@':
195	204	discard r.advance
196	205	return mkList(@[mkSymbol("deref"), r.readForm])

    of '\'':
      discard r.advance
      return mkList(@[mkSymbol("quote"), r.readForm])
++  of '`':
++    discard r.advance
++    return mkList(@[mkSymbol("syntax-quote"), r.readForm])
++  of '~':
++    discard r.advance
++    if r.peek == '@':
++      discard r.advance
++      return mkList(@[mkSymbol("unquote-splicing"), r.readForm])
++    return mkList(@[mkSymbol("unquote"), r.readForm])
    of '@':
      discard r.advance
      return mkList(@[mkSymbol("deref"), r.readForm])

added tests/core_gaps.expected +9 -0 Viewed

new file mode 100644
@@ -0,0 +1,9 @@
	1	+:yes
	2	+18
	3	+[1 2 3]
	4	+core-gaps/not-yet-defined
	5	+30
	6	+(2 4 6)
	7	+[2 4 6]
	8	+10
	9	+7 7

++:yes
++18
++[1 2 3]
++core-gaps/not-yet-defined
++30
++(2 4 6)
++[2 4 6]
++10
++7 7

added tests/protocols.expected +5 -0 Viewed

new file mode 100644
@@ -0,0 +1,5 @@
	1	+integer:4 9
	2	+string:a ab
	3	+other::x [:x :y]
	4	+true true true
	5	+3 false true

++integer:4 9
++string:a ab
++other::x [:x :y]
++true true true
++3 false true

modified tests/user_macros.expected +4 -0 Viewed

@@ -2,3 +2,7 @@
2	2	variadic 3
3	3	[(form-and-env) {}]
4	4	true
	5	+:syntax
	6	+[1 2 3 4]
	7	+12
	8	+user/quoted-symbol

  variadic 3
  [(form-and-env) {}]
  true
++:syntax
++[1 2 3 4]
++12
++user/quoted-symbol

feat: add protocols and core language features