nandi/clonim · a485529

added examples/binding_forms.clj +30 -0 Viewed

new file mode 100644
@@ -0,0 +1,30 @@
	1	+(ns binding-forms)
	2	+
	3	+;; destructuring in fn parameters, including multiple arities
	4	+(println ((fn [[a b] c] [a b c]) [1 2] 3)) ; [1 2 3]
	5	+(println (map (fn [[k v]] (str k v)) [[:a 1] [:b 2]])) ; (:a1 :b2)
	6	+(defn g ([[a b]] (+ a b)) ([x y] (* x y)))
	7	+(println (g [3 4]) (g 3 4)) ; 7 12
	8	+(println ((fn [{:keys [x y]}] [x y]) {:x 1 :y 2})) ; [1 2]
	9	+
	10	+;; :as, :or, nesting, and a rest that is nil once exhausted
	11	+(let [[a b & more :as all] [1 2 3 4]] (println a b more all))
	12	+(let [[a & r] [1]] (println r (nil? r))) ; nil true
	13	+(let [{:keys [x y] :or {y 9} :as m} {:x 1}] (println x y m))
	14	+(let [[[a b] [c]] [[1 2] [3]]] (println a b c)) ; 1 2 3
	15	+(println ((fn [& xs] xs)) ((fn [& xs] xs) 1)) ; nil (1)
	16	+
	17	+;; loop variables destructure too, and recur assigns the whole form
	18	+(println (loop [[t & more] [1 2 3] acc []]
	19	+ (if (nil? t) acc (recur more (conj acc t))))) ; [1 2 3]
	20	+
	21	+;; #() is one call, and takes numbered arguments
	22	+(println (map #(format "%02x" %) [227 176])) ; (e3 b0)
	23	+(println (map #(* 2 %) [1 2 3])) ; (2 4 6)
	24	+(println (map #(+ %1 %2) [1 2] [10 20])) ; (11 22)
	25	+(println (#(vector % %) 7)) ; [7 7]
	26	+
	27	+;; a rebound loop variable is still a Value, not a raw int
	28	+(println (loop [i 0 acc 0]
	29	+ (if (= i 3) acc
	30	+ (let [[acc] [(+ acc i)]] (recur (inc i) acc))))) ; 3

++(ns binding-forms)
++
++;; destructuring in fn parameters, including multiple arities
++(println ((fn [[a b] c] [a b c]) [1 2] 3))              ; [1 2 3]
++(println (map (fn [[k v]] (str k v)) [[:a 1] [:b 2]]))  ; (:a1 :b2)
++(defn g ([[a b]] (+ a b)) ([x y] (* x y)))
++(println (g [3 4]) (g 3 4))                             ; 7 12
++(println ((fn [{:keys [x y]}] [x y]) {:x 1 :y 2}))      ; [1 2]
++
++;; :as, :or, nesting, and a rest that is nil once exhausted
++(let [[a b & more :as all] [1 2 3 4]] (println a b more all))
++(let [[a & r] [1]] (println r (nil? r)))                ; nil true
++(let [{:keys [x y] :or {y 9} :as m} {:x 1}] (println x y m))
++(let [[[a b] [c]] [[1 2] [3]]] (println a b c))         ; 1 2 3
++(println ((fn [& xs] xs)) ((fn [& xs] xs) 1))           ; nil (1)
++
++;; loop variables destructure too, and recur assigns the whole form
++(println (loop [[t & more] [1 2 3] acc []]
++           (if (nil? t) acc (recur more (conj acc t)))))  ; [1 2 3]
++
++;; #() is one call, and takes numbered arguments
++(println (map #(format "%02x" %) [227 176]))            ; (e3 b0)
++(println (map #(* 2 %) [1 2 3]))                        ; (2 4 6)
++(println (map #(+ %1 %2) [1 2] [10 20]))                ; (11 22)
++(println (#(vector % %) 7))                             ; [7 7]
++
++;; a rebound loop variable is still a Value, not a raw int
++(println (loop [i 0 acc 0]
++           (if (= i 3) acc
++             (let [[acc] [(+ acc i)]] (recur (inc i) acc)))))  ; 3

added examples/bitops.clj +10 -0 Viewed

new file mode 100644
@@ -0,0 +1,10 @@
	1	+(ns bitops)
	2	+
	3	+(println (bit-and 12 10) (bit-or 12 10) (bit-xor 12 10)) ; 8 14 6
	4	+(println (bit-and-not 12 10) (bit-not 0) (bit-not 5)) ; 4 -1 -6
	5	+(println (bit-and 255 170 15) (bit-or 1 2 4) (bit-xor 1 2 4)) ; variadic: 10 7 7
	6	+(println (bit-shift-left 1 10) (bit-shift-right 1024 3)) ; 1024 128
	7	+(println (bit-shift-right -8 1) (unsigned-bit-shift-right -1 60)) ; -4 15
	8	+(println (bit-test 5 0) (bit-test 5 1)) ; true false
	9	+(println (bit-set 0 4) (bit-clear 31 0) (bit-flip 5 1)) ; 16 30 7
	10	+(println (reduce bit-xor [1 2 4 8])) ; as a value: 15

++(ns bitops)
++
++(println (bit-and 12 10) (bit-or 12 10) (bit-xor 12 10))   ; 8 14 6
++(println (bit-and-not 12 10) (bit-not 0) (bit-not 5))      ; 4 -1 -6
++(println (bit-and 255 170 15) (bit-or 1 2 4) (bit-xor 1 2 4)) ; variadic: 10 7 7
++(println (bit-shift-left 1 10) (bit-shift-right 1024 3))   ; 1024 128
++(println (bit-shift-right -8 1) (unsigned-bit-shift-right -1 60)) ; -4 15
++(println (bit-test 5 0) (bit-test 5 1))                    ; true false
++(println (bit-set 0 4) (bit-clear 31 0) (bit-flip 5 1))    ; 16 30 7
++(println (reduce bit-xor [1 2 4 8]))                       ; as a value: 15

added examples/cli_args.clj +7 -0 Viewed

new file mode 100644
@@ -0,0 +1,7 @@
	1	+(ns cli-args)
	2	+
	3	+;; A program with -main gets it called with the command line, which is also
	4	+;; command-line-args.
	5	+(defn -main [& argv]
	6	+ (println "args:" (count argv) (vec argv))
	7	+ (println "same:" (= (seq argv) (seq command-line-args))))

++(ns cli-args)
++
++;; A program with -main gets it called with the command line, which is also
++;; *command-line-args*.
++(defn -main [& argv]
++  (println "args:" (count argv) (vec argv))
++  (println "same:" (= (seq argv) (seq *command-line-args*))))

added examples/hostfns.clj +34 -0 Viewed

new file mode 100644
@@ -0,0 +1,34 @@
	1	+(ns hostfns (:require [clojure.string :as str]))
	2	+
	3	+;; characters
	4	+(println \a \space (int \A) (char 66) (str \x \y) (char? \a)) ; a 65 B xy true
	5	+(println (.charAt "abc" 1) (= \a \a) (= \a 97) (#{\- \+} \+)) ; b true false +
	6	+(prn \a \newline \tab) ; \a \newline \tab
	7	+(println (Character/isDigit \7) (Character/isLetter \7)) ; true false
	8	+
	9	+;; numbers
	10	+(println (long 3.7) (unchecked-int 4294967295) (unchecked-byte 200)) ; 3 -1 -56
	11	+(println (Integer/parseInt "ff" 16) (Long/parseLong "-12")) ; 255 -12
	12	+(println (Double/parseDouble "2.5") (Math/floor 2.7) (Math/ceil 2.1)); 2.5 2.0 3.0
	13	+
	14	+;; format
	15	+(println (format "%02x\|%s\|%5d\|%-4s\|%.2f\|%X\|%%" 10 :kw 42 "ab" 3.14159 255))
	16	+
	17	+;; sequences
	18	+(println (into [] (mapcat (fn [a b] [a b]) [1 2] [:a :b]))) ; [1 :a 2 :b]
	19	+(println (partition-all 2 [1 2 3 4 5])) ; ((1 2) (3 4) (5))
	20	+(println (partition-by even? [1 3 2 4 5])) ; ((1 3) (2 4) (5))
	21	+(println (into #{} [1 1 2]) (into {} [[:a 1]])) ; #{1 2} {:a 1}
	22	+
	23	+;; strings
	24	+(println (str/blank? " ") (str/starts-with? "abc" "ab")
	25	+ (str/ends-with? "abc" "bc") (str/includes? "abc" "b")
	26	+ (str/index-of "abc" "c")) ; true true true true 2
	27	+
	28	+;; volatiles, classes, exceptions
	29	+(let [v (volatile! 1)] (vreset! v 9) (println @v (vswap! v + 1))) ; 9 10
	30	+(println (boolean nil) (instance? (class (int-array 0)) (int-array 2)))
	31	+(println (try (throw (ex-info "boom" {})) (catch Exception e (ex-message e))))
	32	+
	33	+;; a string is a sequence of characters
	34	+(println (map int "IHDR") (first "xy") (apply str (reverse "abc")))

++(ns hostfns (:require [clojure.string :as str]))
++
++;; characters
++(println \a \space (int \A) (char 66) (str \x \y) (char? \a))       ; a   65 B xy true
++(println (.charAt "abc" 1) (= \a \a) (= \a 97) (#{\- \+} \+))       ; b true false +
++(prn \a \newline \tab)                                              ; \a \newline \tab
++(println (Character/isDigit \7) (Character/isLetter \7))            ; true false
++
++;; numbers
++(println (long 3.7) (unchecked-int 4294967295) (unchecked-byte 200)) ; 3 -1 -56
++(println (Integer/parseInt "ff" 16) (Long/parseLong "-12"))          ; 255 -12
++(println (Double/parseDouble "2.5") (Math/floor 2.7) (Math/ceil 2.1)); 2.5 2.0 3.0
++
++;; format
++(println (format "%02x|%s|%5d|%-4s|%.2f|%X|%%" 10 :kw 42 "ab" 3.14159 255))
++
++;; sequences
++(println (into [] (mapcat (fn [a b] [a b]) [1 2] [:a :b])))          ; [1 :a 2 :b]
++(println (partition-all 2 [1 2 3 4 5]))                              ; ((1 2) (3 4) (5))
++(println (partition-by even? [1 3 2 4 5]))                           ; ((1 3) (2 4) (5))
++(println (into #{} [1 1 2]) (into {} [[:a 1]]))                      ; #{1 2} {:a 1}
++
++;; strings
++(println (str/blank? "  ") (str/starts-with? "abc" "ab")
++         (str/ends-with? "abc" "bc") (str/includes? "abc" "b")
++         (str/index-of "abc" "c"))                                   ; true true true true 2
++
++;; volatiles, classes, exceptions
++(let [v (volatile! 1)] (vreset! v 9) (println @v (vswap! v + 1)))     ; 9 10
++(println (boolean nil) (instance? (class (int-array 0)) (int-array 2)))
++(println (try (throw (ex-info "boom" {})) (catch Exception e (ex-message e))))
++
++;; a string is a sequence of characters
++(println (map int "IHDR") (first "xy") (apply str (reverse "abc")))

added examples/macros.clj +35 -0 Viewed

new file mode 100644
@@ -0,0 +1,35 @@
	1	+(ns macros (:require [clojure.java.io :as io]))
	2	+
	3	+;; case: literal constants, grouped clauses, optional default
	4	+(defn kind [x] (case x 0 :zero 1 :one (2 3) :few :other))
	5	+(println (kind 0) (kind 1) (kind 3) (kind 9)) ; :zero :one :few :other
	6	+(println (case \n \n :nl \t :tab :none)) ; :nl
	7	+(println (case :east :east 1 :west 2 3)) ; 1
	8	+(println (try (case 5 0 :z) (catch Exception e (ex-message e)))) ; No matching clause: 5
	9	+
	10	+;; for: one or more bindings, eager
	11	+(println (for [n (range 4)] (* n n))) ; (0 1 4 9)
	12	+(println (for [a [1 2] b [:x :y]] [a b])) ; ([1 :x] [1 :y] [2 :x] [2 :y])
	13	+(println (apply str (for [c "abc"] c))) ; abc
	14	+
	15	+;; assert
	16	+(println (try (assert (= 1 2) "nope") (catch Exception e (ex-message e))))
	17	+(println (try (assert (= 1 2)) (catch Exception e (ex-message e))))
	18	+
	19	+;; binding: dynamic scope, unwound on every exit
	20	+(def ^:dynamic depth 0)
	21	+(defn show [] (println "depth" depth))
	22	+(show)
	23	+(binding [depth 3] (show))
	24	+(show)
	25	+(println (try (binding [depth 9] (throw (ex-info "x" {})))
	26	+ (catch Exception e depth))) ; 0
	27	+
	28	+;; StringBuilder, with-open and a write handle
	29	+(let [b (StringBuilder.)]
	30	+ (.append b \h) (.append b "ello")
	31	+ (println (str b) (.length b))) ; hello 5
	32	+(with-open [o (io/output-stream "macros.tmp")]
	33	+ (.write o (byte-array (map unchecked-byte [104 105]))))
	34	+(println (slurp "macros.tmp")) ; hi
	35	+(io/delete-file "macros.tmp")

++(ns macros (:require [clojure.java.io :as io]))
++
++;; case: literal constants, grouped clauses, optional default
++(defn kind [x] (case x 0 :zero 1 :one (2 3) :few :other))
++(println (kind 0) (kind 1) (kind 3) (kind 9))        ; :zero :one :few :other
++(println (case \n \n :nl \t :tab :none))             ; :nl
++(println (case :east :east 1 :west 2 3))             ; 1
++(println (try (case 5 0 :z) (catch Exception e (ex-message e)))) ; No matching clause: 5
++
++;; for: one or more bindings, eager
++(println (for [n (range 4)] (* n n)))                ; (0 1 4 9)
++(println (for [a [1 2] b [:x :y]] [a b]))            ; ([1 :x] [1 :y] [2 :x] [2 :y])
++(println (apply str (for [c "abc"] c)))              ; abc
++
++;; assert
++(println (try (assert (= 1 2) "nope") (catch Exception e (ex-message e))))
++(println (try (assert (= 1 2)) (catch Exception e (ex-message e))))
++
++;; binding: dynamic scope, unwound on every exit
++(def ^:dynamic *depth* 0)
++(defn show [] (println "depth" *depth*))
++(show)
++(binding [*depth* 3] (show))
++(show)
++(println (try (binding [*depth* 9] (throw (ex-info "x" {})))
++              (catch Exception e *depth*)))         ; 0
++
++;; StringBuilder, with-open and a write handle
++(let [b (StringBuilder.)]
++  (.append b \h) (.append b "ello")
++  (println (str b) (.length b)))                     ; hello 5
++(with-open [o (io/output-stream "macros.tmp")]
++  (.write o (byte-array (map unchecked-byte [104 105]))))
++(println (slurp "macros.tmp"))                       ; hi
++(io/delete-file "macros.tmp")

modified src/app_runtime.nim +3 -0 Viewed

@@ -18,10 +18,12 @@ proc setVar*(name: string, v: Value): Value {.discardable, importc: "clonim_set_
18	18	proc cellGet*(c: VarCell): Value {.importc: "clonim_cell_get".}
19	19	proc cellIs*(c: VarCell, v: Value): bool {.importc: "clonim_cell_is".}
20	20	proc getVar*(name: string): Value {.importc: "clonim_get_var".}
	21	+proc hasVar*(name: string): bool {.importc: "clonim_has_var".}
21	22	proc call*(f: Value, args: openArray[Value]): Value {.importc: "clonim_call".}
22	23	proc argAt*(args: openArray[Value], i: int): Value {.importc: "clonim_arg_at".}
23	24	proc restArgs*(args: openArray[Value], i: int): Value {.importc: "clonim_rest_args".}
24	25	proc seqDrop*(v: Value, n: int): Value {.importc: "clonim_seq_drop".}
	26	+proc seqDropOrNil*(v: Value, n: int): Value {.importc: "clonim_seq_drop_or_nil".}
25	27	proc toSeq*(v: Value): seq[Value] {.importc: "clonim_to_seq".}
26	28	proc truthy*(v: Value): bool {.importc: "clonim_truthy".}
27	29
@@ -30,6 +32,7 @@ iterator elems*(v: Value): Value =
30	32
31	33	proc mkInt*(x: int64): Value {.importc: "clonim_mk_int".}
32	34	proc mkFloat*(x: float64): Value {.importc: "clonim_mk_float".}
	35	+proc mkChar*(code: int64): Value {.importc: "clonim_mk_char".}
33	36	proc mkStr*(x: string): Value {.importc: "clonim_mk_str".}
34	37	proc mkKeyword*(x: string): Value {.importc: "clonim_mk_keyword".}
35	38	proc mkSymbol*(x: string): Value {.importc: "clonim_mk_symbol".}

  proc cellGet*(c: VarCell): Value {.importc: "clonim_cell_get".}
  proc cellIs*(c: VarCell, v: Value): bool {.importc: "clonim_cell_is".}
  proc getVar*(name: string): Value {.importc: "clonim_get_var".}
++proc hasVar*(name: string): bool {.importc: "clonim_has_var".}
  proc call*(f: Value, args: openArray[Value]): Value {.importc: "clonim_call".}
  proc argAt*(args: openArray[Value], i: int): Value {.importc: "clonim_arg_at".}
  proc restArgs*(args: openArray[Value], i: int): Value {.importc: "clonim_rest_args".}
  proc seqDrop*(v: Value, n: int): Value {.importc: "clonim_seq_drop".}
++proc seqDropOrNil*(v: Value, n: int): Value {.importc: "clonim_seq_drop_or_nil".}
  proc toSeq*(v: Value): seq[Value] {.importc: "clonim_to_seq".}
  proc truthy*(v: Value): bool {.importc: "clonim_truthy".}
  proc mkInt*(x: int64): Value {.importc: "clonim_mk_int".}
  proc mkFloat*(x: float64): Value {.importc: "clonim_mk_float".}
++proc mkChar*(code: int64): Value {.importc: "clonim_mk_char".}
  proc mkStr*(x: string): Value {.importc: "clonim_mk_str".}
  proc mkKeyword*(x: string): Value {.importc: "clonim_mk_keyword".}
  proc mkSymbol*(x: string): Value {.importc: "clonim_mk_symbol".}

modified src/clonim.nim +3 -0 Viewed

@@ -87,6 +87,8 @@ proc runtimeLib(release: bool): string =
87	87	"--nimcache:" & installed.parentDir /
88	88	(if release: "nimcache-release" else: "nimcache-debug"),
89	89	"-o:" & installed]
	90	+ # The HTTP primitive speaks TLS; without this it can only reach http://.
	91	+ args.add "-d:ssl"
90	92	if release: args.add "-d:release"
91	93	args.add source
92	94	let (output, code) = execCmdEx(args.mapIt(quoteShell(it)).join(" "))
@@ -203,6 +205,7 @@ proc main() =
203	205	nimCmd.add "--passL:-Wl,--allow-multiple-definition"
204	206	nimCmd.add "--passL:" & rtLib
205	207	nimCmd.add "--passL:-lm"
	208	+ nimCmd.add "-d:ssl"
206	209	if release:
207	210	# `-d:release` disables Nim runtime checks but keeps DWARF and symbol
208	211	# tables by default. Native deliverables should not carry that metadata.

                 "--nimcache:" & installed.parentDir /
                   (if release: "nimcache-release" else: "nimcache-debug"),
                 "-o:" & installed]
++  # The HTTP primitive speaks TLS; without this it can only reach http://.
++  args.add "-d:ssl"
    if release: args.add "-d:release"
    args.add source
    let (output, code) = execCmdEx(args.mapIt(quoteShell(it)).join(" "))
      nimCmd.add "--passL:-Wl,--allow-multiple-definition"
      nimCmd.add "--passL:" & rtLib
    nimCmd.add "--passL:-lm"
++  nimCmd.add "-d:ssl"
    if release:
      # `-d:release` disables Nim runtime checks but keeps DWARF and symbol
      # tables by default. Native deliverables should not carry that metadata.

modified src/compiler.nim +204 -51 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"].toHashSet
	146	+ "import", "set!", "declare", "binding"].toHashSet
147	147
148	148	const intOps = {"+": "+", "-": "-", "": ""}.toTable
149	149	const intCalls = {"quot": "idiv", "rem": "irem"}.toTable
@@ -175,6 +175,7 @@ proc quoteLit(v: Value): string =
175	175	of kBool: (if v.b: "TrueV" else: "FalseV")
176	176	of kInt: "mkInt(" & $v.i & ")"
177	177	of kFloat: "mkFloat(" & $v.f & ")"
	178	+ of kChar: "mkChar(" & $v.i & ")"
178	179	of kStr: "mkStr(" & nimStr(v.s) & ")"
179	180	of kKeyword: "mkKeyword(" & nimStr(v.s) & ")"
180	181	of kSymbol: "mkSymbol(" & nimStr(v.s) & ")"
@@ -254,6 +255,7 @@ type
254	255	params: seq[string]
255	256	restParam: string
256	257	body: seq[Value]
	258	+ destructures: seq[(Value, string)]
257	259
258	260	proc parseParams(v: Value): FnClause =
259	261	if v.isNil or v.kind != kVector: err("Parameter list must be a vector, got: " & prStr(v))
@@ -263,9 +265,20 @@ proc parseParams(v: Value): FnClause =
263	265	let p = v.items[i]
264	266	if isSym(p, "&"):
265	267	if i + 1 >= v.items.len: err("Missing symbol after &")
266		- result.restParam = symName(v.items[i + 1])
	268	+ let rest = v.items[i + 1]
	269	+ if rest.kind == kSymbol: result.restParam = symName(rest)
	270	+ else:
	271	+ result.restParam = "destr__rest"
	272	+ result.destructures.add (rest, result.restParam)
267	273	break
268		- result.params.add symName(p)
	274	+ if p.kind == kSymbol:
	275	+ result.params.add symName(p)
	276	+ else:
	277	+ # A destructuring parameter binds a plain one, then lets the existing
	278	+ # let machinery take it apart at the top of the body.
	279	+ let nm = "destr__" & $i
	280	+ result.params.add nm
	281	+ result.destructures.add (p, nm)
269	282	inc i
270	283
271	284	proc genClauseBody(cl: FnClause, name, selfIdent: string, env: Env, c: Ctx,
@@ -319,6 +332,51 @@ proc collectRecurs(forms: seq[Value], into: var seq[seq[Value]]) =
319	332	if coreName(head.s) in ["loop", "loop", "fn", "fn", "defn", "defn-"]: continue
320	333	collectRecurs(f.items, into)
321	334
	335	+proc patternNames(v: Value, into: var HashSet[string]) =
	336	+ ## Names a binding pattern introduces. Lenient: the resolver has already
	337	+ ## rejected malformed patterns, and a name too many only costs an
	338	+ ## optimisation.
	339	+ if v.isNil: return
	340	+ case v.kind
	341	+ of kSymbol: (if v.s != "&": into.incl v.s)
	342	+ of kVector:
	343	+ for x in v.items: patternNames(x, into)
	344	+ of kMap:
	345	+ for (k, value) in v.pairs:
	346	+ if k.kind == kKeyword:
	347	+ case k.s
	348	+ of "keys", "syms", "strs":
	349	+ for x in value.items: (if x.kind == kSymbol: into.incl x.s)
	350	+ of "as": patternNames(value, into)
	351	+ else: discard
	352	+ else: patternNames(k, into)
	353	+ else: discard
	354	+
	355	+proc collectBoundSymbols(v: Value, into: var HashSet[string]) =
	356	+ ## Every name a binding form inside these forms introduces. A loop variable
	357	+ ## or parameter that some inner form rebinds cannot be held as a raw int64:
	358	+ ## the int analysis probes recur values in the outer scope, where the name
	359	+ ## still looks integral even though the recur sees the inner Value binding.
	360	+ if v.isNil or v.kind != kList or v.items.len == 0: return
	361	+ let head = v.items[0]
	362	+ if head.kind == kSymbol:
	363	+ let h = coreName(head.s)
	364	+ if h in ["let", "let", "loop", "loop", "when-let", "if-let", "doseq",
	365	+ "dotimes", "binding"] and v.items.len > 1 and v.items[1].kind == kVector:
	366	+ var i = 0
	367	+ while i < v.items[1].items.len:
	368	+ patternNames(v.items[1].items[i], into)
	369	+ i += 2
	370	+ elif h in ["fn", "fn*", "defn", "defn-"]:
	371	+ for x in v.items:
	372	+ if x.kind == kVector: patternNames(x, into)
	373	+ elif x.kind == kList and x.items.len > 0 and x.items[0].kind == kVector:
	374	+ patternNames(x.items[0], into)
	375	+ for x in v.items: collectBoundSymbols(x, into)
	376	+
	377	+proc shadowedNames(forms: seq[Value]): HashSet[string] =
	378	+ for f in forms: collectBoundSymbols(f, result)
	379	+
322	380	proc usesIntPrim(c: Ctx, forms: seq[Value]): bool =
323	381	## Whether an int-specialised twin could differ from the generic proc at all.
324	382	## Emitting one for a fn that never does arithmetic just doubles the work Nim
@@ -376,6 +434,9 @@ proc genFn(name: string, clauses: seq[FnClause], selfIdent: string, env: Env,
376	434	probe.ints.incl p
377	435	probe.intFns[key] = iprc
378	436	var recurSafe = true
	437	+ let shadowed = shadowedNames(cl.body)
	438	+ for p in cl.params:
	439	+ if p in shadowed: recurSafe = false
379	440	var myRecurs: seq[seq[Value]] = @[]
380	441	collectRecurs(cl.body, myRecurs)
381	442	for r in myRecurs:
@@ -441,6 +502,15 @@ proc genFn(name: string, clauses: seq[FnClause], selfIdent: string, env: Env,
441	502	c.pop
442	503	c.line(")")
443	504
	505	+proc withDestructuring(cl: FnClause): FnClause =
	506	+ result = cl
	507	+ if cl.destructures.len == 0: return
	508	+ var bs: seq[Value] = @[]
	509	+ for (pattern, nm) in cl.destructures:
	510	+ bs.add pattern
	511	+ bs.add mkSymbol(nm)
	512	+ result.body = @[mkList(@[mkSymbol("let"), mkVector(bs)] & cl.body)]
	513	+
444	514	proc genFnForm(args: seq[Value], env: Env, c: Ctx, dst: string, defName: string,
445	515	directEnv: Env = nil, cell = "") =
446	516	## (fn name? [params] body...) or (fn name? ([params] body...) ...)
@@ -453,14 +523,14 @@ proc genFnForm(args: seq[Value], env: Env, c: Ctx, dst: string, defName: string,
453	523	if i < args.len and args[i].kind == kVector:
454	524	var cl = parseParams(args[i])
455	525	cl.body = args[i + 1 .. ^1]
456		- clauses.add cl
	526	+ clauses.add withDestructuring(cl)
457	527	else:
458	528	while i < args.len:
459	529	let cf = args[i]
460	530	if cf.kind != kList or cf.items.len == 0: err("Bad fn arity form: " & prStr(cf))
461	531	var cl = parseParams(cf.items[0])
462	532	cl.body = cf.items[1 .. ^1]
463		- clauses.add cl
	533	+ clauses.add withDestructuring(cl)
464	534	inc i
465	535	if clauses.len == 0: err("fn requires at least one arity")
466	536	if name.len > 0:
@@ -472,6 +542,70 @@ proc genFnForm(args: seq[Value], env: Env, c: Ctx, dst: string, defName: string,
472	542	else:
473	543	genFn("fn", clauses, "", env, c, dst)
474	544
	545	+proc bindPattern(target: Value, v: string, lenv: Env, c: Ctx) =
	546	+ ## Bind one binding form -- a symbol or a destructuring pattern -- to the
	547	+ ## value already computed into `v`.
	548	+ if target.kind == kSymbol:
	549	+ let id = c.gensym("l" & mangle(target.s))
	550	+ c.line("var " & id & ": Value = " & v)
	551	+ lenv.locals[target.s] = id
	552	+ elif target.kind == kVector:
	553	+ # sequential destructuring: [a b & rest :as whole]
	554	+ var idx = 0
	555	+ var j = 0
	556	+ while j < target.items.len:
	557	+ let p = target.items[j]
	558	+ if p.kind == kKeyword and p.s == "as":
	559	+ if j + 1 >= target.items.len: err("Missing symbol after :as")
	560	+ bindPattern(target.items[j + 1], v, lenv, c)
	561	+ j += 2
	562	+ continue
	563	+ if isSym(p, "&"):
	564	+ if j + 1 >= target.items.len: err("Missing binding form after &")
	565	+ let id = c.gensym("lrest")
	566	+ c.line("var " & id & ": Value = seqDropOrNil(" & v & ", " & $idx & ")")
	567	+ bindPattern(target.items[j + 1], id, lenv, c)
	568	+ j += 2
	569	+ continue
	570	+ let id = c.gensym("lnth")
	571	+ c.line("var " & id & ": Value = call(getVar(\"clojure.core/nth\"), [" & v & ", mkInt(" &
	572	+ $idx & "), NilV])")
	573	+ bindPattern(p, id, lenv, c)
	574	+ inc idx; inc j
	575	+ elif target.kind == kMap:
	576	+ # associative destructuring: {a :a, :keys [b c], :or {b 1}, :as m}
	577	+ var defaults = NilV
	578	+ for (k, valForm) in target.pairs:
	579	+ if k.kind == kKeyword and k.s == "or": defaults = valForm
	580	+ proc bindKey(nm: string, key: string) =
	581	+ let id = c.gensym("l" & mangle(nm))
	582	+ var default = "NilV"
	583	+ if defaults.kind == kMap:
	584	+ for (dk, dv) in defaults.pairs:
	585	+ if dk.kind == kSymbol and dk.s == nm: default = genExpr(dv, lenv, c)
	586	+ c.line("var " & id & ": Value = call(getVar(\"clojure.core/get\"), [" & v &
	587	+ ", mkKeyword(" & nimStr(key) & "), " & default & "])")
	588	+ lenv.locals[nm] = id
	589	+ for (k, valForm) in target.pairs:
	590	+ if k.kind == kKeyword:
	591	+ case k.s
	592	+ of "or": discard
	593	+ of "as": bindPattern(valForm, v, lenv, c)
	594	+ of "keys":
	595	+ for ks in valForm.items: bindKey(symName(ks), symName(ks))
	596	+ of "strs":
	597	+ for ks in valForm.items: bindKey(symName(ks), symName(ks))
	598	+ else: err("Unsupported destructuring directive: :" & k.s)
	599	+ elif valForm.kind == kKeyword and k.kind == kSymbol:
	600	+ bindKey(symName(k), valForm.s)
	601	+ else:
	602	+ let id = c.gensym("l" & mangle(symName(k)))
	603	+ let kv = genExpr(valForm, lenv, c)
	604	+ c.line("var " & id & ": Value = call(getVar(\"clojure.core/get\"), [" & v & ", " & kv & "])")
	605	+ lenv.locals[symName(k)] = id
	606	+ else:
	607	+ err("Unsupported binding form: " & prStr(target))
	608	+
475	609	proc genLet(bindings: Value, body: seq[Value], dst: string, env: Env, c: Ctx) =
476	610	if bindings.isNil or bindings.kind != kVector:
477	611	err("let requires a vector for its bindings")
@@ -480,57 +614,35 @@ proc genLet(bindings: Value, body: seq[Value], dst: string, env: Env, c: Ctx) =
480	614	let lenv = newEnv(env)
481	615	var i = 0
482	616	while i < bindings.items.len:
483		- let target = bindings.items[i]
484		- let initForm = bindings.items[i + 1]
485		- let v = genExpr(initForm, lenv, c)
486		- if target.kind == kSymbol:
487		- let id = c.gensym("l" & mangle(target.s))
488		- c.line("var " & id & ": Value = " & v)
489		- lenv.locals[target.s] = id
490		- elif target.kind == kVector:
491		- # sequential destructuring: [a b & rest]
492		- var idx = 0
493		- var j = 0
494		- while j < target.items.len:
495		- let p = target.items[j]
496		- if isSym(p, "&"):
497		- let restSym = symName(target.items[j + 1])
498		- let id = c.gensym("l" & mangle(restSym))
499		- c.line("var " & id & ": Value = seqDrop(" & v & ", " & $idx & ")")
500		- lenv.locals[restSym] = id
501		- break
502		- let id = c.gensym("l" & mangle(symName(p)))
503		- c.line("var " & id & ": Value = call(getVar(\"clojure.core/nth\"), [" & v & ", mkInt(" &
504		- $idx & "), NilV])")
505		- lenv.locals[symName(p)] = id
506		- inc idx; inc j
507		- elif target.kind == kMap:
508		- # associative destructuring: {a :a, :keys [b c]}
509		- for (k, valForm) in target.pairs:
510		- if k.kind == kKeyword and k.s == "keys":
511		- for ks in valForm.items:
512		- let nm = symName(ks)
513		- let id = c.gensym("l" & mangle(nm))
514		- c.line("var " & id & ": Value = call(getVar(\"clojure.core/get\"), [" & v &
515		- ", mkKeyword(" & nimStr(nm) & ")])")
516		- lenv.locals[nm] = id
517		- else:
518		- let nm = symName(k)
519		- let id = c.gensym("l" & mangle(nm))
520		- let kv = genExpr(valForm, lenv, c)
521		- c.line("var " & id & ": Value = call(getVar(\"clojure.core/get\"), [" & v & ", " & kv & "])")
522		- lenv.locals[nm] = id
523		- else:
524		- err("Unsupported binding form: " & prStr(target))
	617	+ let v = genExpr(bindings.items[i + 1], lenv, c)
	618	+ bindPattern(bindings.items[i], v, lenv, c)
525	619	i += 2
526	620	genBody(body, dst, lenv, c)
527	621
528	622	proc genLoop(bindings: Value, body: seq[Value], dst: string, env: Env, c: Ctx) =
529	623	if bindings.isNil or bindings.kind != kVector or bindings.items.len mod 2 != 0:
530	624	err("loop requires an even-sized binding vector")
	625	+ # A destructuring loop variable becomes a plain one that recur can assign,
	626	+ # taken apart again by a let at the top of the body.
	627	+ var bindings = bindings
	628	+ var body = body
	629	+ var patterns: seq[Value] = @[]
	630	+ var i = 0
	631	+ while i < bindings.items.len:
	632	+ if bindings.items[i].kind != kSymbol:
	633	+ let nm = mkSymbol("loop__" & $i)
	634	+ patterns.add bindings.items[i]
	635	+ patterns.add nm
	636	+ var xs = bindings.items
	637	+ xs[i] = nm
	638	+ bindings = mkVector(xs)
	639	+ i += 2
	640	+ if patterns.len > 0:
	641	+ body = @[mkList(@[mkSymbol("let"), mkVector(patterns)] & body)]
	642	+
531	643	var names: seq[string] = @[]
532	644	var inits: seq[Value] = @[]
533		- var i = 0
	645	+ i = 0
534	646	while i < bindings.items.len:
535	647	names.add symName(bindings.items[i])
536	648	inits.add bindings.items[i + 1]
@@ -544,8 +656,9 @@ proc genLoop(bindings: Value, body: seq[Value], dst: string, env: Env, c: Ctx) =
544	656	collectRecurs(body, recurs)
545	657	for r in recurs:
546	658	if r.len != names.len: recurs = @[]; break # arity error, reported later
	659	+ let shadowed = shadowedNames(body)
547	660	var isInt: seq[bool] = @[]
548		- for n in names: isInt.add true
	661	+ for n in names: isInt.add n notin shadowed
549	662	var probeIdents: seq[string] = @[]
550	663	for n in names: probeIdents.add "probe"
551	664	while true:
@@ -778,7 +891,7 @@ proc tryExpr(f: Value, env: Env, c: Ctx): string =
778	891	## Keeping a subexpression as an expression is what lets the C compiler hold
779	892	## it in a register instead of round-tripping it through a Value slot.
780	893	case f.kind
781		- of kNil, kBool, kInt, kFloat, kStr, kKeyword:
	894	+ of kNil, kBool, kInt, kFloat, kChar, kStr, kKeyword:
782	895	quoteLit(f)
783	896	of kSymbol:
784	897	let local = env.lookup(f.s)
@@ -846,7 +959,7 @@ proc genInto(f: Value, dst: string, env: Env, c: Ctx) =
846	959	if e.len > 0:
847	960	c.line(dst & " = " & e); return
848	961	case f.kind
849		- of kNil, kBool, kInt, kFloat, kStr, kKeyword:
	962	+ of kNil, kBool, kInt, kFloat, kChar, kStr, kKeyword:
850	963	c.line(dst & " = " & quoteLit(f))
851	964	of kSymbol:
852	965	let local = env.lookup(f.s)
@@ -1090,6 +1203,31 @@ proc genInto(f: Value, dst: string, env: Env, c: Ctx) =
1090	1203	c.pop
1091	1204	c.line(dst & " = NilV")
1092	1205	return
	1206	+ of "binding":
	1207	+ # Dynamic scope: the vars keep their new values for the duration of
	1208	+ # the body, on every path out of it.
	1209	+ let b = args[0]
	1210	+ if b.kind != kVector or b.items.len mod 2 != 0:
	1211	+ err("binding requires paired bindings")
	1212	+ var saved: seq[(string, string)] = @[]
	1213	+ var i = 0
	1214	+ while i < b.items.len:
	1215	+ let nm = symName(b.items[i])
	1216	+ let v = genExpr(b.items[i + 1], env, c)
	1217	+ let cell = c.cellFor(nm)
	1218	+ let keep = c.gensym("bind")
	1219	+ c.line("var " & keep & ": Value = cellGet(" & cell & ")")
	1220	+ c.line("setVar(" & nimStr(nm) & ", " & v & ")")
	1221	+ saved.add (nm, keep)
	1222	+ i += 2
	1223	+ c.line("try:")
	1224	+ c.push; genBody(args[1 .. ^1], dst, env, c); c.pop
	1225	+ c.line("finally:")
	1226	+ c.push
	1227	+ for (nm, keep) in saved:
	1228	+ c.line("setVar(" & nimStr(nm) & ", " & keep & ")")
	1229	+ c.pop
	1230	+ return
1093	1231	of "try":
1094	1232	var bodyForms: seq[Value] = @[]
1095	1233	var catchSym = ""
@@ -1134,6 +1272,7 @@ proc genInto(f: Value, dst: string, env: Env, c: Ctx) =
1134	1272	# ------------------------------------------------------------- entry point
1135	1273	const preamble = """
1136	1274	## Generated by clonim. Do not edit.
	1275	+import std/os
1137	1276	import app_runtime
1138	1277
1139	1278	proc cljMain() =
@@ -1165,6 +1304,20 @@ proc compileForms*(forms: seq[Value]): string =
1165	1304	c.line("var " & t & ": Value = NilV")
1166	1305	genInto(f, t, env, c)
1167	1306	c.line("discard " & t)
	1307	+ # A program that defines -main gets it called with the command-line
	1308	+ # arguments once the top-level forms have run, as on the JVM.
	1309	+ var mainVar = ""
	1310	+ for name, _ in c.defCounts:
	1311	+ if name == "-main" or name.endsWith("/-main"): mainVar = name
	1312	+ c.line("var clonimArgv: seq[Value] = @[]")
	1313	+ c.line("for a in commandLineParams(): clonimArgv.add mkStr(a)")
	1314	+ c.line("setVar(\"clojure.core/command-line-args\", " &
	1315	+ "(if clonimArgv.len == 0: NilV else: mkList(clonimArgv)))")
	1316	+ if mainVar.len > 0:
	1317	+ c.line("if hasVar(" & nimStr(mainVar) & "):")
	1318	+ c.push
	1319	+ c.line("discard call(getVar(" & nimStr(mainVar) & "), clonimArgv)")
	1320	+ c.pop
1168	1321	var src = preamble & " initClonimRuntime()\n registerCore()\n registerNamespaceCore()\n" & c.prelude.join("\n") & "\n" &
1169	1322	c.body.join("\n") & "\n\n"
1170	1323	src &= """

    "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"].toHashSet
++  "import", "set!", "declare", "binding"].toHashSet
  const intOps = {"+": "+", "-": "-", "*": "*"}.toTable
  const intCalls = {"quot": "idiv", "rem": "irem"}.toTable
    of kBool: (if v.b: "TrueV" else: "FalseV")
    of kInt: "mkInt(" & $v.i & ")"
    of kFloat: "mkFloat(" & $v.f & ")"
++  of kChar: "mkChar(" & $v.i & ")"
    of kStr: "mkStr(" & nimStr(v.s) & ")"
    of kKeyword: "mkKeyword(" & nimStr(v.s) & ")"
    of kSymbol: "mkSymbol(" & nimStr(v.s) & ")"
      params: seq[string]
      restParam: string
      body: seq[Value]
++    destructures: seq[(Value, string)]
  proc parseParams(v: Value): FnClause =
    if v.isNil or v.kind != kVector: err("Parameter list must be a vector, got: " & prStr(v))
      let p = v.items[i]
      if isSym(p, "&"):
        if i + 1 >= v.items.len: err("Missing symbol after &")
--      result.restParam = symName(v.items[i + 1])
++      let rest = v.items[i + 1]
++      if rest.kind == kSymbol: result.restParam = symName(rest)
++      else:
++        result.restParam = "destr__rest"
++        result.destructures.add (rest, result.restParam)
        break
--    result.params.add symName(p)
++    if p.kind == kSymbol:
++      result.params.add symName(p)
++    else:
++      # A destructuring parameter binds a plain one, then lets the existing
++      # let machinery take it apart at the top of the body.
++      let nm = "destr__" & $i
++      result.params.add nm
++      result.destructures.add (p, nm)
      inc i
  proc genClauseBody(cl: FnClause, name, selfIdent: string, env: Env, c: Ctx,
        if coreName(head.s) in ["loop", "loop*", "fn", "fn*", "defn", "defn-"]: continue
      collectRecurs(f.items, into)
++proc patternNames(v: Value, into: var HashSet[string]) =
++  ## Names a binding pattern introduces. Lenient: the resolver has already
++  ## rejected malformed patterns, and a name too many only costs an
++  ## optimisation.
++  if v.isNil: return
++  case v.kind
++  of kSymbol: (if v.s != "&": into.incl v.s)
++  of kVector:
++    for x in v.items: patternNames(x, into)
++  of kMap:
++    for (k, value) in v.pairs:
++      if k.kind == kKeyword:
++        case k.s
++        of "keys", "syms", "strs":
++          for x in value.items: (if x.kind == kSymbol: into.incl x.s)
++        of "as": patternNames(value, into)
++        else: discard
++      else: patternNames(k, into)
++  else: discard
++
++proc collectBoundSymbols(v: Value, into: var HashSet[string]) =
++  ## Every name a binding form inside these forms introduces. A loop variable
++  ## or parameter that some inner form rebinds cannot be held as a raw int64:
++  ## the int analysis probes recur values in the outer scope, where the name
++  ## still looks integral even though the recur sees the inner Value binding.
++  if v.isNil or v.kind != kList or v.items.len == 0: return
++  let head = v.items[0]
++  if head.kind == kSymbol:
++    let h = coreName(head.s)
++    if h in ["let", "let*", "loop", "loop*", "when-let", "if-let", "doseq",
++             "dotimes", "binding"] and v.items.len > 1 and v.items[1].kind == kVector:
++      var i = 0
++      while i < v.items[1].items.len:
++        patternNames(v.items[1].items[i], into)
++        i += 2
++    elif h in ["fn", "fn*", "defn", "defn-"]:
++      for x in v.items:
++        if x.kind == kVector: patternNames(x, into)
++        elif x.kind == kList and x.items.len > 0 and x.items[0].kind == kVector:
++          patternNames(x.items[0], into)
++  for x in v.items: collectBoundSymbols(x, into)
++
++proc shadowedNames(forms: seq[Value]): HashSet[string] =
++  for f in forms: collectBoundSymbols(f, result)
++
  proc usesIntPrim(c: Ctx, forms: seq[Value]): bool =
    ## Whether an int-specialised twin could differ from the generic proc at all.
    ## Emitting one for a fn that never does arithmetic just doubles the work Nim
          probe.ints.incl p
        probe.intFns[key] = iprc
        var recurSafe = true
++      let shadowed = shadowedNames(cl.body)
++      for p in cl.params:
++        if p in shadowed: recurSafe = false
        var myRecurs: seq[seq[Value]] = @[]
        collectRecurs(cl.body, myRecurs)
        for r in myRecurs:
    c.pop
    c.line(")")
++proc withDestructuring(cl: FnClause): FnClause =
++  result = cl
++  if cl.destructures.len == 0: return
++  var bs: seq[Value] = @[]
++  for (pattern, nm) in cl.destructures:
++    bs.add pattern
++    bs.add mkSymbol(nm)
++  result.body = @[mkList(@[mkSymbol("let"), mkVector(bs)] & cl.body)]
++
  proc genFnForm(args: seq[Value], env: Env, c: Ctx, dst: string, defName: string,
                 directEnv: Env = nil, cell = "") =
    ## (fn name? [params] body...) or (fn name? ([params] body...) ...)
    if i < args.len and args[i].kind == kVector:
      var cl = parseParams(args[i])
      cl.body = args[i + 1 .. ^1]
--    clauses.add cl
++    clauses.add withDestructuring(cl)
    else:
      while i < args.len:
        let cf = args[i]
        if cf.kind != kList or cf.items.len == 0: err("Bad fn arity form: " & prStr(cf))
        var cl = parseParams(cf.items[0])
        cl.body = cf.items[1 .. ^1]
--      clauses.add cl
++      clauses.add withDestructuring(cl)
        inc i
    if clauses.len == 0: err("fn requires at least one arity")
    if name.len > 0:
    else:
      genFn("fn", clauses, "", env, c, dst)
++proc bindPattern(target: Value, v: string, lenv: Env, c: Ctx) =
++  ## Bind one binding form -- a symbol or a destructuring pattern -- to the
++  ## value already computed into `v`.
++  if target.kind == kSymbol:
++    let id = c.gensym("l" & mangle(target.s))
++    c.line("var " & id & ": Value = " & v)
++    lenv.locals[target.s] = id
++  elif target.kind == kVector:
++    # sequential destructuring: [a b & rest :as whole]
++    var idx = 0
++    var j = 0
++    while j < target.items.len:
++      let p = target.items[j]
++      if p.kind == kKeyword and p.s == "as":
++        if j + 1 >= target.items.len: err("Missing symbol after :as")
++        bindPattern(target.items[j + 1], v, lenv, c)
++        j += 2
++        continue
++      if isSym(p, "&"):
++        if j + 1 >= target.items.len: err("Missing binding form after &")
++        let id = c.gensym("lrest")
++        c.line("var " & id & ": Value = seqDropOrNil(" & v & ", " & $idx & ")")
++        bindPattern(target.items[j + 1], id, lenv, c)
++        j += 2
++        continue
++      let id = c.gensym("lnth")
++      c.line("var " & id & ": Value = call(getVar(\"clojure.core/nth\"), [" & v & ", mkInt(" &
++             $idx & "), NilV])")
++      bindPattern(p, id, lenv, c)
++      inc idx; inc j
++  elif target.kind == kMap:
++    # associative destructuring: {a :a, :keys [b c], :or {b 1}, :as m}
++    var defaults = NilV
++    for (k, valForm) in target.pairs:
++      if k.kind == kKeyword and k.s == "or": defaults = valForm
++    proc bindKey(nm: string, key: string) =
++      let id = c.gensym("l" & mangle(nm))
++      var default = "NilV"
++      if defaults.kind == kMap:
++        for (dk, dv) in defaults.pairs:
++          if dk.kind == kSymbol and dk.s == nm: default = genExpr(dv, lenv, c)
++      c.line("var " & id & ": Value = call(getVar(\"clojure.core/get\"), [" & v &
++             ", mkKeyword(" & nimStr(key) & "), " & default & "])")
++      lenv.locals[nm] = id
++    for (k, valForm) in target.pairs:
++      if k.kind == kKeyword:
++        case k.s
++        of "or": discard
++        of "as": bindPattern(valForm, v, lenv, c)
++        of "keys":
++          for ks in valForm.items: bindKey(symName(ks), symName(ks))
++        of "strs":
++          for ks in valForm.items: bindKey(symName(ks), symName(ks))
++        else: err("Unsupported destructuring directive: :" & k.s)
++      elif valForm.kind == kKeyword and k.kind == kSymbol:
++        bindKey(symName(k), valForm.s)
++      else:
++        let id = c.gensym("l" & mangle(symName(k)))
++        let kv = genExpr(valForm, lenv, c)
++        c.line("var " & id & ": Value = call(getVar(\"clojure.core/get\"), [" & v & ", " & kv & "])")
++        lenv.locals[symName(k)] = id
++  else:
++    err("Unsupported binding form: " & prStr(target))
++
  proc genLet(bindings: Value, body: seq[Value], dst: string, env: Env, c: Ctx) =
    if bindings.isNil or bindings.kind != kVector:
      err("let requires a vector for its bindings")
    let lenv = newEnv(env)
    var i = 0
    while i < bindings.items.len:
--    let target = bindings.items[i]
++    let v = genExpr(bindings.items[i + 1], lenv, c)
--    let initForm = bindings.items[i + 1]
++    bindPattern(bindings.items[i], v, lenv, c)
--    let v = genExpr(initForm, lenv, c)
--    if target.kind == kSymbol:
--      let id = c.gensym("l" & mangle(target.s))
--      c.line("var " & id & ": Value = " & v)
--      lenv.locals[target.s] = id
--    elif target.kind == kVector:
--      # sequential destructuring: [a b & rest]
--      var idx = 0
--      var j = 0
--      while j < target.items.len:
--        let p = target.items[j]
--        if isSym(p, "&"):
--          let restSym = symName(target.items[j + 1])
--          let id = c.gensym("l" & mangle(restSym))
--          c.line("var " & id & ": Value = seqDrop(" & v & ", " & $idx & ")")
--          lenv.locals[restSym] = id
--          break
--        let id = c.gensym("l" & mangle(symName(p)))
--        c.line("var " & id & ": Value = call(getVar(\"clojure.core/nth\"), [" & v & ", mkInt(" &
--               $idx & "), NilV])")
--        lenv.locals[symName(p)] = id
--        inc idx; inc j
--    elif target.kind == kMap:
--      # associative destructuring: {a :a, :keys [b c]}
--      for (k, valForm) in target.pairs:
--        if k.kind == kKeyword and k.s == "keys":
--          for ks in valForm.items:
--            let nm = symName(ks)
--            let id = c.gensym("l" & mangle(nm))
--            c.line("var " & id & ": Value = call(getVar(\"clojure.core/get\"), [" & v &
--                   ", mkKeyword(" & nimStr(nm) & ")])")
--            lenv.locals[nm] = id
--        else:
--          let nm = symName(k)
--          let id = c.gensym("l" & mangle(nm))
--          let kv = genExpr(valForm, lenv, c)
--          c.line("var " & id & ": Value = call(getVar(\"clojure.core/get\"), [" & v & ", " & kv & "])")
--          lenv.locals[nm] = id
--    else:
--      err("Unsupported binding form: " & prStr(target))
      i += 2
    genBody(body, dst, lenv, c)
  proc genLoop(bindings: Value, body: seq[Value], dst: string, env: Env, c: Ctx) =
    if bindings.isNil or bindings.kind != kVector or bindings.items.len mod 2 != 0:
      err("loop requires an even-sized binding vector")
++  # A destructuring loop variable becomes a plain one that recur can assign,
++  # taken apart again by a let at the top of the body.
++  var bindings = bindings
++  var body = body
++  var patterns: seq[Value] = @[]
++  var i = 0
++  while i < bindings.items.len:
++    if bindings.items[i].kind != kSymbol:
++      let nm = mkSymbol("loop__" & $i)
++      patterns.add bindings.items[i]
++      patterns.add nm
++      var xs = bindings.items
++      xs[i] = nm
++      bindings = mkVector(xs)
++    i += 2
++  if patterns.len > 0:
++    body = @[mkList(@[mkSymbol("let"), mkVector(patterns)] & body)]
++
    var names: seq[string] = @[]
    var inits: seq[Value] = @[]
--  var i = 0
++  i = 0
    while i < bindings.items.len:
      names.add symName(bindings.items[i])
      inits.add bindings.items[i + 1]
    collectRecurs(body, recurs)
    for r in recurs:
      if r.len != names.len: recurs = @[]; break   # arity error, reported later
++  let shadowed = shadowedNames(body)
    var isInt: seq[bool] = @[]
--  for n in names: isInt.add true
++  for n in names: isInt.add n notin shadowed
    var probeIdents: seq[string] = @[]
    for n in names: probeIdents.add "probe"
    while true:
    ## Keeping a subexpression as an expression is what lets the C compiler hold
    ## it in a register instead of round-tripping it through a Value slot.
    case f.kind
--  of kNil, kBool, kInt, kFloat, kStr, kKeyword:
++  of kNil, kBool, kInt, kFloat, kChar, kStr, kKeyword:
      quoteLit(f)
    of kSymbol:
      let local = env.lookup(f.s)
    if e.len > 0:
      c.line(dst & " = " & e); return
    case f.kind
--  of kNil, kBool, kInt, kFloat, kStr, kKeyword:
++  of kNil, kBool, kInt, kFloat, kChar, kStr, kKeyword:
      c.line(dst & " = " & quoteLit(f))
    of kSymbol:
      let local = env.lookup(f.s)
          c.pop
          c.line(dst & " = NilV")
          return
++      of "binding":
++        # Dynamic scope: the vars keep their new values for the duration of
++        # the body, on every path out of it.
++        let b = args[0]
++        if b.kind != kVector or b.items.len mod 2 != 0:
++          err("binding requires paired bindings")
++        var saved: seq[(string, string)] = @[]
++        var i = 0
++        while i < b.items.len:
++          let nm = symName(b.items[i])
++          let v = genExpr(b.items[i + 1], env, c)
++          let cell = c.cellFor(nm)
++          let keep = c.gensym("bind")
++          c.line("var " & keep & ": Value = cellGet(" & cell & ")")
++          c.line("setVar(" & nimStr(nm) & ", " & v & ")")
++          saved.add (nm, keep)
++          i += 2
++        c.line("try:")
++        c.push; genBody(args[1 .. ^1], dst, env, c); c.pop
++        c.line("finally:")
++        c.push
++        for (nm, keep) in saved:
++          c.line("setVar(" & nimStr(nm) & ", " & keep & ")")
++        c.pop
++        return
        of "try":
          var bodyForms: seq[Value] = @[]
          var catchSym = ""
  # ------------------------------------------------------------- entry point
  const preamble = """
  ## Generated by clonim. Do not edit.
++import std/os
  import app_runtime
  proc cljMain() =
      c.line("var " & t & ": Value = NilV")
      genInto(f, t, env, c)
      c.line("discard " & t)
++  # A program that defines -main gets it called with the command-line
++  # arguments once the top-level forms have run, as on the JVM.
++  var mainVar = ""
++  for name, _ in c.defCounts:
++    if name == "-main" or name.endsWith("/-main"): mainVar = name
++  c.line("var clonimArgv: seq[Value] = @[]")
++  c.line("for a in commandLineParams(): clonimArgv.add mkStr(a)")
++  c.line("setVar(\"clojure.core/*command-line-args*\", " &
++         "(if clonimArgv.len == 0: NilV else: mkList(clonimArgv)))")
++  if mainVar.len > 0:
++    c.line("if hasVar(" & nimStr(mainVar) & "):")
++    c.push
++    c.line("discard call(getVar(" & nimStr(mainVar) & "), clonimArgv)")
++    c.pop
    var src = preamble & "  initClonimRuntime()\n  registerCore()\n  registerNamespaceCore()\n" & c.prelude.join("\n") & "\n" &
              c.body.join("\n") & "\n\n"
    src &= """

modified src/core.nim +352 -12 Viewed

@@ -1,5 +1,5 @@
1	1	## clonim core — clojure.core builtins, registered into the global var table.
2		-import std/[strutils, math, times, random]
	2	+import std/[strutils, math, times, random, re, os, httpclient, sequtils]
3	3	import runtime
4	4
5	5	proc num(v: Value): float64 =
@@ -15,7 +15,7 @@ proc isFloaty(vs: openArray[Value]): bool =
15	15
16	16	proc intOf(v: Value): int64 =
17	17	case v.kind
18		- of kInt: v.i
	18	+ of kInt, kChar: v.i
19	19	of kFloat: int64(v.f)
20	20	else: err("Not a number: " & prStr(v))
21	21
@@ -338,6 +338,10 @@ proc lazyConcat(colls: seq[Value], i: int, c: Cursor): Value =
338	338	proc def(name: string, f: proc (args: openArray[Value]): Value {.closure.}) =
339	339	setVar(name, mkFn(name, f))
340	340
	341	+proc def(name: string, v: Value) =
	342	+ ## A var whose value is data rather than a function, such as out.
	343	+ setVar(name, v)
	344	+
341	345	# ----------------------------------------------------------------- fusion
342	346	## A pipeline whose intermediate sequences are syntactic temporaries -- nobody
343	347	## named them, so nobody can hold them -- does not need those sequences to
@@ -397,6 +401,102 @@ proc fusedCount*(base: Value, ops: openArray[FusedOp]): Value =
397	401	inc n
398	402	mkInt(n)
399	403
	404	+proc sOf(v: Value): string =
	405	+ ## A string argument, checked: reaching into a nil or a number here would
	406	+ ## read through a nil object pointer.
	407	+ if v.isNil or v.kind != kStr: err("Expected a string, got: " & prStr(v))
	408	+ v.s
	409	+
	410	+proc parseIntRadix(s: string, radix: int): int64 =
	411	+ ## Java's Integer/Long.parseInt: an optional sign, then digits in `radix`.
	412	+ var i = 0
	413	+ var neg = false
	414	+ if i < s.len and (s[i] == '-' or s[i] == '+'):
	415	+ neg = s[i] == '-'; inc i
	416	+ if i >= s.len: err("Not a number: " & s)
	417	+ while i < s.len:
	418	+ let c = toLowerAscii(s[i])
	419	+ let d = (if c in '0'..'9': ord(c) - ord('0')
	420	+ elif c in 'a'..'z': ord(c) - ord('a') + 10
	421	+ else: 99)
	422	+ if d >= radix: err("Not a number: " & s)
	423	+ result = result * int64(radix) + int64(d)
	424	+ inc i
	425	+ if neg: result = -result
	426	+
	427	+proc javaFormat(fmt: string, args: openArray[Value]): string =
	428	+ ## The subset of java.util.Formatter that shows up in Clojure source:
	429	+ ## %s %d %x %X %o %c %f %e %b, with flags "-0+ " and width.precision.
	430	+ var ai = 0
	431	+ var i = 0
	432	+ while i < fmt.len:
	433	+ if fmt[i] != '%': result.add fmt[i]; inc i; continue
	434	+ inc i
	435	+ if i < fmt.len and fmt[i] == '%': result.add '%'; inc i; continue
	436	+ var flags = ""
	437	+ while i < fmt.len and fmt[i] in {'-', '0', '+', ' ', ',', '#'}:
	438	+ flags.add fmt[i]; inc i
	439	+ var width = ""
	440	+ while i < fmt.len and fmt[i].isDigit: width.add fmt[i]; inc i
	441	+ var prec = -1
	442	+ if i < fmt.len and fmt[i] == '.':
	443	+ inc i
	444	+ var p = ""
	445	+ while i < fmt.len and fmt[i].isDigit: p.add fmt[i]; inc i
	446	+ prec = parseInt(p)
	447	+ if i >= fmt.len: err("Bad format string: " & fmt)
	448	+ let conv = fmt[i]; inc i
	449	+ if ai >= args.len: err("Too few arguments for format string: " & fmt)
	450	+ let v = args[ai]; inc ai
	451	+ var body: string
	452	+ case conv
	453	+ of 's', 'S':
	454	+ body = str(v)
	455	+ if prec >= 0 and body.len > prec: body = body[0 ..< prec]
	456	+ if conv == 'S': body = body.toUpperAscii
	457	+ of 'd': body = $intOf(v)
	458	+ of 'x', 'X':
	459	+ body = toHex(intOf(v)).strip(trailing = false, chars = {'0'})
	460	+ if body.len == 0: body = "0"
	461	+ body = (if conv == 'x': body.toLowerAscii else: body.toUpperAscii)
	462	+ of 'o':
	463	+ body = toOct(intOf(v), 22).strip(trailing = false, chars = {'0'})
	464	+ if body.len == 0: body = "0"
	465	+ of 'f': body = formatFloat(num(v), ffDecimal, (if prec < 0: 6 else: prec))
	466	+ of 'e', 'E':
	467	+ body = formatFloat(num(v), ffScientific, (if prec < 0: 6 else: prec))
	468	+ if conv == 'E': body = body.toUpperAscii
	469	+ of 'b': body = (if truthy(v): "true" else: "false")
	470	+ of 'c': body = str(v)
	471	+ of 'n': body = "\n"; dec ai
	472	+ else: err("Unsupported format conversion: %" & conv
	473	+ )
	474	+ let w = (if width.len == 0: 0 else: parseInt(width))
	475	+ if body.len < w:
	476	+ let pad = w - body.len
	477	+ if '-' in flags: body = body & " ".repeat(pad)
	478	+ elif '0' in flags and conv in {'d', 'x', 'X', 'o', 'f', 'e', 'E'}:
	479	+ if body.len > 0 and body[0] == '-': body = "-" & "0".repeat(pad) & body[1 .. ^1]
	480	+ else: body = "0".repeat(pad) & body
	481	+ else: body = " ".repeat(pad) & body
	482	+ result.add body
	483	+
	484	+proc writeOut(f: File, s: string) =
	485	+ ## A closed pipe ends the program quietly, the way a tool killed by SIGPIPE
	486	+ ## does, rather than surfacing as an unhandled IOError.
	487	+ try:
	488	+ f.write(s)
	489	+ f.flushFile
	490	+ except IOError:
	491	+ quit(0)
	492	+
	493	+proc currentOut(): File =
	494	+ ## Where print and friends write. `binding` can move it to err.
	495	+ if hasVar("clojure.core/out") and equals(getVar("clojure.core/out"), mkKeyword("stderr")):
	496	+ stderr
	497	+ else:
	498	+ stdout
	499	+
400	500	proc registerCore*() =
401	501	# ---- arithmetic
402	502	def "+", proc (a: openArray[Value]): Value =
@@ -419,6 +519,35 @@ proc registerCore*() =
419	519	var r = irem(x, y)
420	520	if r != 0 and ((r < 0) != (y < 0)): r += y
421	521	mkInt(r)
	522	+ # ---- bitwise (int64, JVM semantics: shift counts mask to 0..63)
	523	+ def "bit-and", proc (a: openArray[Value]): Value =
	524	+ result = mkInt(intOf(a[0]))
	525	+ for i in 1 ..< a.len: result = mkInt(result.i and intOf(a[i]))
	526	+ def "bit-or", proc (a: openArray[Value]): Value =
	527	+ result = mkInt(intOf(a[0]))
	528	+ for i in 1 ..< a.len: result = mkInt(result.i or intOf(a[i]))
	529	+ def "bit-xor", proc (a: openArray[Value]): Value =
	530	+ result = mkInt(intOf(a[0]))
	531	+ for i in 1 ..< a.len: result = mkInt(result.i xor intOf(a[i]))
	532	+ def "bit-and-not", proc (a: openArray[Value]): Value =
	533	+ result = mkInt(intOf(a[0]))
	534	+ for i in 1 ..< a.len: result = mkInt(result.i and not intOf(a[i]))
	535	+ def "bit-not", proc (a: openArray[Value]): Value = mkInt(not intOf(a[0]))
	536	+ def "bit-shift-left", proc (a: openArray[Value]): Value =
	537	+ mkInt(intOf(a[0]) shl (intOf(a[1]) and 63))
	538	+ def "bit-shift-right", proc (a: openArray[Value]): Value =
	539	+ # arithmetic: the sign bit is replicated, as on the JVM
	540	+ mkInt(ashr(intOf(a[0]), intOf(a[1]) and 63))
	541	+ def "unsigned-bit-shift-right", proc (a: openArray[Value]): Value =
	542	+ mkInt(cast[int64](cast[uint64](intOf(a[0])) shr uint64(intOf(a[1]) and 63)))
	543	+ def "bit-test", proc (a: openArray[Value]): Value =
	544	+ mkBool((ashr(intOf(a[0]), intOf(a[1]) and 63) and 1) != 0)
	545	+ def "bit-set", proc (a: openArray[Value]): Value =
	546	+ mkInt(intOf(a[0]) or (1'i64 shl (intOf(a[1]) and 63)))
	547	+ def "bit-clear", proc (a: openArray[Value]): Value =
	548	+ mkInt(intOf(a[0]) and not (1'i64 shl (intOf(a[1]) and 63)))
	549	+ def "bit-flip", proc (a: openArray[Value]): Value =
	550	+ mkInt(intOf(a[0]) xor (1'i64 shl (intOf(a[1]) and 63)))
422	551	def "inc", proc (a: openArray[Value]): Value =
423	552	(if a[0].kind == kFloat: mkFloat(a[0].f + 1.0) else: mkInt(a[0].i + 1))
424	553	def "dec", proc (a: openArray[Value]): Value =
@@ -436,6 +565,37 @@ proc registerCore*() =
436	565	def "rand-int", proc (a: openArray[Value]): Value = mkInt(rand(int(intOf(a[0])) - 1))
437	566	def "double", proc (a: openArray[Value]): Value = mkFloat(num(a[0]))
438	567	def "int", proc (a: openArray[Value]): Value = mkInt(intOf(a[0]))
	568	+ def "char", proc (a: openArray[Value]): Value =
	569	+ (if a[0].kind == kChar: a[0] else: mkChar(intOf(a[0])))
	570	+ def "char?", proc (a: openArray[Value]): Value = mkBool(a[0].kind == kChar)
	571	+ def ".charAt", proc (a: openArray[Value]): Value =
	572	+ let i = int(intOf(a[1]))
	573	+ if i < 0 or i >= a[0].s.len: err("String index out of range: " & $i)
	574	+ mkChar(int64(ord(a[0].s[i])))
	575	+ def "Character/isDigit", proc (a: openArray[Value]): Value =
	576	+ mkBool(a[0].kind == kChar and a[0].i >= int64(ord('0')) and a[0].i <= int64(ord('9')))
	577	+ def "Character/isLetter", proc (a: openArray[Value]): Value =
	578	+ mkBool(a[0].kind == kChar and char(a[0].i) in Letters)
	579	+ def "Character/isWhitespace", proc (a: openArray[Value]): Value =
	580	+ mkBool(a[0].kind == kChar and char(a[0].i) in {' ', '\t', '\n', '\r', '\f', '\v'})
	581	+ def "long", proc (a: openArray[Value]): Value = mkInt(intOf(a[0]))
	582	+ def "unchecked-int", proc (a: openArray[Value]): Value =
	583	+ mkInt(int64(cast[int32](uint32(intOf(a[0]) and 0xffffffff'i64))))
	584	+ def "unchecked-byte", proc (a: openArray[Value]): Value =
	585	+ mkInt(int64(cast[int8](uint8(intOf(a[0]) and 0xff))))
	586	+ def "Math/floor", proc (a: openArray[Value]): Value = mkFloat(floor(num(a[0])))
	587	+ def "Math/ceil", proc (a: openArray[Value]): Value = mkFloat(ceil(num(a[0])))
	588	+ def "Math/abs", proc (a: openArray[Value]): Value =
	589	+ (if a[0].kind == kFloat: mkFloat(abs(a[0].f)) else: mkInt(abs(a[0].i)))
	590	+ def "Integer/parseInt", proc (a: openArray[Value]): Value =
	591	+ let radix = (if a.len > 1: int(intOf(a[1])) else: 10)
	592	+ mkInt(parseIntRadix(a[0].s.strip, radix))
	593	+ def "Long/parseLong", proc (a: openArray[Value]): Value =
	594	+ let radix = (if a.len > 1: int(intOf(a[1])) else: 10)
	595	+ mkInt(parseIntRadix(a[0].s.strip, radix))
	596	+ def "Double/parseDouble", proc (a: openArray[Value]): Value =
	597	+ try: mkFloat(parseFloat(a[0].s.strip))
	598	+ except ValueError: err("Not a number: " & a[0].s)
439	599
440	600	# ---- comparison / predicates
441	601	def "=", proc (a: openArray[Value]): Value =
@@ -491,21 +651,34 @@ proc registerCore*() =
491	651	var parts: seq[string] = @[]
492	652	for x in a: parts.add prStr(x)
493	653	mkStr(parts.join(" "))
	654	+ def "out", mkKeyword("stdout")
	655	+ def "err", mkKeyword("stderr")
	656	+ def "in", mkKeyword("stdin")
	657	+ def "command-line-args", NilV
494	658	def "println", proc (a: openArray[Value]): Value =
495	659	var parts: seq[string] = @[]
496	660	for x in a: parts.add str(x)
497		- echo parts.join(" ")
	661	+ writeOut(currentOut(), parts.join(" ") & "\n")
498	662	NilV
499	663	def "prn", proc (a: openArray[Value]): Value =
500	664	var parts: seq[string] = @[]
501	665	for x in a: parts.add prStr(x)
502		- echo parts.join(" ")
	666	+ writeOut(currentOut(), parts.join(" ") & "\n")
503	667	NilV
504	668	def "print", proc (a: openArray[Value]): Value =
505	669	var parts: seq[string] = @[]
506	670	for x in a: parts.add str(x)
507		- stdout.write parts.join(" ")
	671	+ writeOut(currentOut(), parts.join(" "))
	672	+ NilV
	673	+ def "pr", proc (a: openArray[Value]): Value =
	674	+ var parts: seq[string] = @[]
	675	+ for x in a: parts.add prStr(x)
	676	+ writeOut(currentOut(), parts.join(" "))
508	677	NilV
	678	+ def "flush", proc (a: openArray[Value]): Value =
	679	+ writeOut(currentOut(), ""); NilV
	680	+ def "newline", proc (a: openArray[Value]): Value =
	681	+ writeOut(currentOut(), "\n"); NilV
509	682	def "name", proc (a: openArray[Value]): Value =
510	683	case a[0].kind
511	684	of kKeyword, kSymbol, kStr: mkStr(a[0].s)
@@ -513,16 +686,25 @@ proc registerCore*() =
513	686	def "keyword", proc (a: openArray[Value]): Value = mkKeyword(str(a[0]))
514	687	def "symbol", proc (a: openArray[Value]): Value = mkSymbol(str(a[0]))
515	688	def "subs", proc (a: openArray[Value]): Value =
516		- let s = a[0].s
	689	+ let s = sOf(a[0])
517	690	let st = int(intOf(a[1]))
518	691	let en = (if a.len > 2: int(intOf(a[2])) else: s.len)
519	692	mkStr(s[st ..< en])
520		- def "clojure.string/upper-case", proc (a: openArray[Value]): Value = mkStr(a[0].s.toUpperAscii)
521		- def "clojure.string/lower-case", proc (a: openArray[Value]): Value = mkStr(a[0].s.toLowerAscii)
522		- def "clojure.string/trim", proc (a: openArray[Value]): Value = mkStr(a[0].s.strip)
	693	+ def "clojure.string/upper-case", proc (a: openArray[Value]): Value = mkStr(sOf(a[0]).toUpperAscii)
	694	+ def "clojure.string/lower-case", proc (a: openArray[Value]): Value = mkStr(sOf(a[0]).toLowerAscii)
	695	+ def "clojure.string/trim", proc (a: openArray[Value]): Value = mkStr(sOf(a[0]).strip)
	696	+ def "re-find", proc (a: openArray[Value]): Value =
	697	+ let pattern = re(sOf(a[0]))
	698	+ let start = find(sOf(a[1]), pattern)
	699	+ if start < 0: NilV
	700	+ else:
	701	+ let n = matchLen(sOf(a[1]), pattern, start)
	702	+ mkStr(sOf(a[1])[start ..< start + n])
	703	+ def "clojure.string/replace", proc (a: openArray[Value]): Value =
	704	+ mkStr(sOf(a[0]).replace(re(sOf(a[1])), sOf(a[2])))
523	705	def "clojure.string/split", proc (a: openArray[Value]): Value =
524	706	var r: seq[Value] = @[]
525		- for piece in a[0].s.split(a[1].s): r.add mkStr(piece)
	707	+ for piece in sOf(a[0]).split(sOf(a[1])): r.add mkStr(piece)
526	708	mkVector(r)
527	709	def "clojure.string/join", proc (a: openArray[Value]): Value =
528	710	let sep = (if a.len > 1: str(a[0]) else: "")
@@ -532,9 +714,86 @@ proc registerCore*() =
532	714	mkStr(parts.join(sep))
533	715	def "read-line", proc (a: openArray[Value]): Value =
534	716	try: mkStr(stdin.readLine()) except CatchableError: NilV
535		- def "slurp", proc (a: openArray[Value]): Value = mkStr(readFile(a[0].s))
	717	+ def "slurp", proc (a: openArray[Value]): Value =
	718	+ (if a[0].kind == kKeyword and a[0].s == "stdin": mkStr(stdin.readAll)
	719	+ else: mkStr(readFile(sOf(a[0]))))
536	720	def "spit", proc (a: openArray[Value]): Value =
537		- writeFile(a[0].s, str(a[1])); NilV
	721	+ writeFile(sOf(a[0]), str(a[1])); NilV
	722	+ def "int-array", proc (a: openArray[Value]): Value =
	723	+ if a.len == 1 and a[0].kind == kInt: mkList(newSeqWith(int(a[0].i), mkInt(0)))
	724	+ elif a.len == 1: mkList(toSeq(a[0])) else: mkList(a)
	725	+ def "long-array", proc (a: openArray[Value]): Value =
	726	+ if a.len == 1 and a[0].kind == kInt: mkList(newSeqWith(int(a[0].i), mkInt(0)))
	727	+ elif a.len == 1: mkList(toSeq(a[0])) else: mkList(a)
	728	+ def "byte-array", proc (a: openArray[Value]): Value =
	729	+ if a.len == 1: mkList(toSeq(a[0])) else: mkList(a)
	730	+ def "alength", proc (a: openArray[Value]): Value = mkInt(count(a[0]))
	731	+ def "aget", proc (a: openArray[Value]): Value =
	732	+ let i = int(intOf(a[1]))
	733	+ if a[0].kind == kList: a[0].obj.xs[i] else: toSeq(a[0])[i]
	734	+ def "aset", proc (a: openArray[Value]): Value =
	735	+ if a[0].kind != kList: err("aset expects an array")
	736	+ a[0].obj.xs[int(intOf(a[1]))] = a[2]; a[2]
	737	+ def "System/arraycopy", proc (a: openArray[Value]): Value =
	738	+ for i in 0 ..< int(intOf(a[4])):
	739	+ a[2].obj.xs[int(intOf(a[3])) + i] = a[0].obj.xs[int(intOf(a[1])) + i]
	740	+ NilV
	741	+ def ".getBytes", proc (a: openArray[Value]): Value =
	742	+ var xs: seq[Value] = @[]
	743	+ for ch in sOf(a[0]): xs.add mkInt(ord(ch))
	744	+ mkList(xs)
	745	+ def "StringBuilder.", proc (a: openArray[Value]): Value =
	746	+ ## A mutable string: the one place a string value is written in place.
	747	+ mkStr(if a.len > 0: str(a[0]) else: "")
	748	+ def ".append", proc (a: openArray[Value]): Value =
	749	+ if a[0].kind != kStr: err(".append expects a StringBuilder")
	750	+ a[0].obj.s.add(str(a[1]))
	751	+ a[0]
	752	+ def ".toString", proc (a: openArray[Value]): Value = mkStr(str(a[0]))
	753	+ def ".length", proc (a: openArray[Value]): Value = mkInt(int64(sOf(a[0]).len))
	754	+ def "output-stream", proc (a: openArray[Value]): Value =
	755	+ ## A write handle, driven by keyword messages so that it stays an
	756	+ ## ordinary value: (o :write bytes) and (o :close).
	757	+ let path = sOf(a[0])
	758	+ var f: File
	759	+ if not f.open(path, fmWrite): err("Cannot open for writing: " & path)
	760	+ var closed = false
	761	+ mkFn("output-stream", proc (args: openArray[Value]): Value =
	762	+ if args.len == 0 or args[0].kind != kKeyword:
	763	+ err("output-stream expects a keyword message")
	764	+ case args[0].s
	765	+ of "write":
	766	+ if closed: err("Stream is closed: " & path)
	767	+ var bytes = ""
	768	+ for x in elems(args[1]): bytes.add char(uint8(intOf(x) and 0xff))
	769	+ f.write(bytes)
	770	+ of "close":
	771	+ if not closed: f.close(); closed = true
	772	+ else: err("Unknown stream message: " & prStr(args[0]))
	773	+ NilV)
	774	+ def ".write", proc (a: openArray[Value]): Value =
	775	+ call(a[0], [mkKeyword("write"), a[1]])
	776	+ def ".close", proc (a: openArray[Value]): Value =
	777	+ (if a[0].kind == kFn: call(a[0], [mkKeyword("close")]) else: NilV)
	778	+ def "delete-file", proc (a: openArray[Value]): Value =
	779	+ try:
	780	+ removeFile(sOf(a[0]))
	781	+ TrueV
	782	+ except OSError:
	783	+ if a.len > 1 and truthy(a[1]): FalseV
	784	+ else: raise
	785	+ def "http-fetch", proc (a: openArray[Value]): Value =
	786	+ ## Native replacement for the narrow Jolt HTTP API used by Freeqsay.
	787	+ try:
	788	+ let response = newHttpClient().get(sOf(a[0]))
	789	+ writeFile(sOf(a[1]), response.body)
	790	+ mkMap(@[(mkKeyword("outcome"), mkKeyword("ok")),
	791	+ (mkKeyword("status"), mkInt(response.code.int)),
	792	+ (mkKeyword("error"), NilV)])
	793	+ except CatchableError as e:
	794	+ mkMap(@[(mkKeyword("outcome"), mkKeyword("error")),
	795	+ (mkKeyword("status"), mkInt(0)),
	796	+ (mkKeyword("error"), mkStr(e.msg))])
538	797	# Host primitive used by the source-level stdlib's now-ms wrapper.
539	798	def "epoch-time-ms", proc (a: openArray[Value]): Value = mkInt(int64(epochTime() * 1000))
540	799
@@ -700,6 +959,45 @@ proc registerCore*() =
700	959	r.add mkList(s[i ..< i + n]); i += n
701	960	mkList(r)
702	961
	962	+ def "partition-all", proc (a: openArray[Value]): Value =
	963	+ let n = int(intOf(a[0]))
	964	+ let step = (if a.len > 2: int(intOf(a[1])) else: n)
	965	+ let s = toSeq(a[^1])
	966	+ var r: seq[Value] = @[]
	967	+ var i = 0
	968	+ while i < s.len:
	969	+ r.add mkList(s[i ..< min(i + n, s.len)]); i += step
	970	+ mkList(r)
	971	+ def "partition-by", proc (a: openArray[Value]): Value =
	972	+ let s = toSeq(a[1])
	973	+ var r: seq[Value] = @[]
	974	+ var run: seq[Value] = @[]
	975	+ var key = NilV
	976	+ for x in s:
	977	+ let k = call(a[0], [x])
	978	+ if run.len == 0 or equals(k, key): run.add x
	979	+ else:
	980	+ r.add mkList(run); run = @[x]
	981	+ key = k
	982	+ if run.len > 0: r.add mkList(run)
	983	+ mkList(r)
	984	+ def "into", proc (a: openArray[Value]): Value =
	985	+ result = a[0]
	986	+ if a.len > 1:
	987	+ for x in elems(a[1]): result = conjOne(result, x)
	988	+ def "mapcat", proc (a: openArray[Value]): Value =
	989	+ ## Like map, then concat: the fn takes one element from each collection.
	990	+ var colls: seq[seq[Value]] = @[]
	991	+ for i in 1 ..< a.len: colls.add toSeq(a[i])
	992	+ var n = -1
	993	+ for c in colls: (if n < 0 or c.len < n: n = c.len)
	994	+ var r: seq[Value] = @[]
	995	+ for i in 0 ..< max(n, 0):
	996	+ var args: seq[Value] = @[]
	997	+ for c in colls: args.add c[i]
	998	+ for x in elems(call(a[0], args)): r.add x
	999	+ mkList(r)
	1000	+
703	1001	# ---- higher order
704	1002	def "apply", proc (a: openArray[Value]): Value =
705	1003	var callArgs: seq[Value] = @[]
@@ -799,6 +1097,48 @@ proc registerCore*() =
799	1097	let nv = call(a[1], @[cur] & @(a[2 .. ^1]))
800	1098	call(a[0], [mkKeyword("set"), nv])
801	1099
	1100	+ def "ex-message", proc (a: openArray[Value]): Value =
	1101	+ ## Thrown values reach a catch clause as their message string.
	1102	+ (if a[0].kind == kStr: a[0] else: NilV)
	1103	+ def "volatile!", proc (a: openArray[Value]): Value =
	1104	+ var cell = a[0]
	1105	+ mkFn("volatile", proc (args: openArray[Value]): Value =
	1106	+ if args.len == 0: return cell
	1107	+ cell = args[1]
	1108	+ cell)
	1109	+ def "vreset!", proc (a: openArray[Value]): Value =
	1110	+ call(a[0], [mkKeyword("set"), a[1]])
	1111	+ def "vswap!", proc (a: openArray[Value]): Value =
	1112	+ let cur = call(a[0], [])
	1113	+ call(a[0], [mkKeyword("set"), call(a[1], @[cur] & @(a[2 .. ^1]))])
	1114	+ def "boolean", proc (a: openArray[Value]): Value = mkBool(truthy(a[0]))
	1115	+ def "class", proc (a: openArray[Value]): Value = mkKeyword($a[0].kind)
	1116	+ def "instance?", proc (a: openArray[Value]): Value =
	1117	+ mkBool(a[0].kind == kKeyword and a[0].s == $a[1].kind)
	1118	+ def "format", proc (a: openArray[Value]): Value = mkStr(javaFormat(sOf(a[0]), a[1 .. ^1]))
	1119	+ def "System/exit", proc (a: openArray[Value]): Value =
	1120	+ quit(if a.len > 0: int(intOf(a[0])) else: 0)
	1121	+ def "System/currentTimeMillis", proc (a: openArray[Value]): Value =
	1122	+ mkInt(int64(epochTime() * 1000))
	1123	+ def "System/getProperty", proc (a: openArray[Value]): Value =
	1124	+ ## Only the properties a hosted program can reasonably expect here.
	1125	+ case sOf(a[0])
	1126	+ of "java.io.tmpdir": mkStr(getTempDir().strip(leading = false, chars = {'/'}))
	1127	+ of "user.dir": mkStr(getCurrentDir())
	1128	+ of "user.name": mkStr(getEnv("USER"))
	1129	+ of "line.separator": mkStr("\n")
	1130	+ else: (if a.len > 1: a[1] else: NilV)
	1131	+ def "clojure.string/blank?", proc (a: openArray[Value]): Value =
	1132	+ mkBool(a[0].kind == kNil or sOf(a[0]).strip.len == 0)
	1133	+ def "clojure.string/starts-with?", proc (a: openArray[Value]): Value =
	1134	+ mkBool(sOf(a[0]).startsWith(sOf(a[1])))
	1135	+ def "clojure.string/ends-with?", proc (a: openArray[Value]): Value =
	1136	+ mkBool(sOf(a[0]).endsWith(sOf(a[1])))
	1137	+ def "clojure.string/includes?", proc (a: openArray[Value]): Value =
	1138	+ mkBool(sOf(a[1]) in sOf(a[0]))
	1139	+ def "clojure.string/index-of", proc (a: openArray[Value]): Value =
	1140	+ let i = sOf(a[0]).find(sOf(a[1]))
	1141	+ (if i < 0: NilV else: mkInt(int64(i)))
802	1142	def "throw", proc (a: openArray[Value]): Value = err(str(a[0]))
803	1143	def "ex-info", proc (a: openArray[Value]): Value = mkStr(str(a[0]))
804	1144	def "time-ms", proc (a: openArray[Value]): Value = mkInt(int64(epochTime() * 1000))

  ## clonim core — clojure.core builtins, registered into the global var table.
--import std/[strutils, math, times, random]
++import std/[strutils, math, times, random, re, os, httpclient, sequtils]
  import runtime
  proc num(v: Value): float64 =
  proc intOf(v: Value): int64 =
    case v.kind
--  of kInt: v.i
++  of kInt, kChar: v.i
    of kFloat: int64(v.f)
    else: err("Not a number: " & prStr(v))
  proc def(name: string, f: proc (args: openArray[Value]): Value {.closure.}) =
    setVar(name, mkFn(name, f))
++proc def(name: string, v: Value) =
++  ## A var whose value is data rather than a function, such as *out*.
++  setVar(name, v)
++
  # ----------------------------------------------------------------- fusion
  ## A pipeline whose intermediate sequences are syntactic temporaries -- nobody
  ## named them, so nobody can hold them -- does not need those sequences to
      inc n
    mkInt(n)
++proc sOf(v: Value): string =
++  ## A string argument, checked: reaching into a nil or a number here would
++  ## read through a nil object pointer.
++  if v.isNil or v.kind != kStr: err("Expected a string, got: " & prStr(v))
++  v.s
++
++proc parseIntRadix(s: string, radix: int): int64 =
++  ## Java's Integer/Long.parseInt: an optional sign, then digits in `radix`.
++  var i = 0
++  var neg = false
++  if i < s.len and (s[i] == '-' or s[i] == '+'):
++    neg = s[i] == '-'; inc i
++  if i >= s.len: err("Not a number: " & s)
++  while i < s.len:
++    let c = toLowerAscii(s[i])
++    let d = (if c in '0'..'9': ord(c) - ord('0')
++             elif c in 'a'..'z': ord(c) - ord('a') + 10
++             else: 99)
++    if d >= radix: err("Not a number: " & s)
++    result = result * int64(radix) + int64(d)
++    inc i
++  if neg: result = -result
++
++proc javaFormat(fmt: string, args: openArray[Value]): string =
++  ## The subset of java.util.Formatter that shows up in Clojure source:
++  ## %s %d %x %X %o %c %f %e %b, with flags "-0+ " and width.precision.
++  var ai = 0
++  var i = 0
++  while i < fmt.len:
++    if fmt[i] != '%': result.add fmt[i]; inc i; continue
++    inc i
++    if i < fmt.len and fmt[i] == '%': result.add '%'; inc i; continue
++    var flags = ""
++    while i < fmt.len and fmt[i] in {'-', '0', '+', ' ', ',', '#'}:
++      flags.add fmt[i]; inc i
++    var width = ""
++    while i < fmt.len and fmt[i].isDigit: width.add fmt[i]; inc i
++    var prec = -1
++    if i < fmt.len and fmt[i] == '.':
++      inc i
++      var p = ""
++      while i < fmt.len and fmt[i].isDigit: p.add fmt[i]; inc i
++      prec = parseInt(p)
++    if i >= fmt.len: err("Bad format string: " & fmt)
++    let conv = fmt[i]; inc i
++    if ai >= args.len: err("Too few arguments for format string: " & fmt)
++    let v = args[ai]; inc ai
++    var body: string
++    case conv
++    of 's', 'S':
++      body = str(v)
++      if prec >= 0 and body.len > prec: body = body[0 ..< prec]
++      if conv == 'S': body = body.toUpperAscii
++    of 'd': body = $intOf(v)
++    of 'x', 'X':
++      body = toHex(intOf(v)).strip(trailing = false, chars = {'0'})
++      if body.len == 0: body = "0"
++      body = (if conv == 'x': body.toLowerAscii else: body.toUpperAscii)
++    of 'o':
++      body = toOct(intOf(v), 22).strip(trailing = false, chars = {'0'})
++      if body.len == 0: body = "0"
++    of 'f': body = formatFloat(num(v), ffDecimal, (if prec < 0: 6 else: prec))
++    of 'e', 'E':
++      body = formatFloat(num(v), ffScientific, (if prec < 0: 6 else: prec))
++      if conv == 'E': body = body.toUpperAscii
++    of 'b': body = (if truthy(v): "true" else: "false")
++    of 'c': body = str(v)
++    of 'n': body = "\n"; dec ai
++    else: err("Unsupported format conversion: %" & conv
++    )
++    let w = (if width.len == 0: 0 else: parseInt(width))
++    if body.len < w:
++      let pad = w - body.len
++      if '-' in flags: body = body & " ".repeat(pad)
++      elif '0' in flags and conv in {'d', 'x', 'X', 'o', 'f', 'e', 'E'}:
++        if body.len > 0 and body[0] == '-': body = "-" & "0".repeat(pad) & body[1 .. ^1]
++        else: body = "0".repeat(pad) & body
++      else: body = " ".repeat(pad) & body
++    result.add body
++
++proc writeOut(f: File, s: string) =
++  ## A closed pipe ends the program quietly, the way a tool killed by SIGPIPE
++  ## does, rather than surfacing as an unhandled IOError.
++  try:
++    f.write(s)
++    f.flushFile
++  except IOError:
++    quit(0)
++
++proc currentOut(): File =
++  ## Where print and friends write. `binding` can move it to *err*.
++  if hasVar("clojure.core/*out*") and equals(getVar("clojure.core/*out*"), mkKeyword("stderr")):
++    stderr
++  else:
++    stdout
++
  proc registerCore*() =
    # ---- arithmetic
    def "+", proc (a: openArray[Value]): Value =
      var r = irem(x, y)
      if r != 0 and ((r < 0) != (y < 0)): r += y
      mkInt(r)
++  # ---- bitwise (int64, JVM semantics: shift counts mask to 0..63)
++  def "bit-and", proc (a: openArray[Value]): Value =
++    result = mkInt(intOf(a[0]))
++    for i in 1 ..< a.len: result = mkInt(result.i and intOf(a[i]))
++  def "bit-or", proc (a: openArray[Value]): Value =
++    result = mkInt(intOf(a[0]))
++    for i in 1 ..< a.len: result = mkInt(result.i or intOf(a[i]))
++  def "bit-xor", proc (a: openArray[Value]): Value =
++    result = mkInt(intOf(a[0]))
++    for i in 1 ..< a.len: result = mkInt(result.i xor intOf(a[i]))
++  def "bit-and-not", proc (a: openArray[Value]): Value =
++    result = mkInt(intOf(a[0]))
++    for i in 1 ..< a.len: result = mkInt(result.i and not intOf(a[i]))
++  def "bit-not", proc (a: openArray[Value]): Value = mkInt(not intOf(a[0]))
++  def "bit-shift-left", proc (a: openArray[Value]): Value =
++    mkInt(intOf(a[0]) shl (intOf(a[1]) and 63))
++  def "bit-shift-right", proc (a: openArray[Value]): Value =
++    # arithmetic: the sign bit is replicated, as on the JVM
++    mkInt(ashr(intOf(a[0]), intOf(a[1]) and 63))
++  def "unsigned-bit-shift-right", proc (a: openArray[Value]): Value =
++    mkInt(cast[int64](cast[uint64](intOf(a[0])) shr uint64(intOf(a[1]) and 63)))
++  def "bit-test", proc (a: openArray[Value]): Value =
++    mkBool((ashr(intOf(a[0]), intOf(a[1]) and 63) and 1) != 0)
++  def "bit-set", proc (a: openArray[Value]): Value =
++    mkInt(intOf(a[0]) or (1'i64 shl (intOf(a[1]) and 63)))
++  def "bit-clear", proc (a: openArray[Value]): Value =
++    mkInt(intOf(a[0]) and not (1'i64 shl (intOf(a[1]) and 63)))
++  def "bit-flip", proc (a: openArray[Value]): Value =
++    mkInt(intOf(a[0]) xor (1'i64 shl (intOf(a[1]) and 63)))
    def "inc", proc (a: openArray[Value]): Value =
      (if a[0].kind == kFloat: mkFloat(a[0].f + 1.0) else: mkInt(a[0].i + 1))
    def "dec", proc (a: openArray[Value]): Value =
    def "rand-int", proc (a: openArray[Value]): Value = mkInt(rand(int(intOf(a[0])) - 1))
    def "double", proc (a: openArray[Value]): Value = mkFloat(num(a[0]))
    def "int", proc (a: openArray[Value]): Value = mkInt(intOf(a[0]))
++  def "char", proc (a: openArray[Value]): Value =
++    (if a[0].kind == kChar: a[0] else: mkChar(intOf(a[0])))
++  def "char?", proc (a: openArray[Value]): Value = mkBool(a[0].kind == kChar)
++  def ".charAt", proc (a: openArray[Value]): Value =
++    let i = int(intOf(a[1]))
++    if i < 0 or i >= a[0].s.len: err("String index out of range: " & $i)
++    mkChar(int64(ord(a[0].s[i])))
++  def "Character/isDigit", proc (a: openArray[Value]): Value =
++    mkBool(a[0].kind == kChar and a[0].i >= int64(ord('0')) and a[0].i <= int64(ord('9')))
++  def "Character/isLetter", proc (a: openArray[Value]): Value =
++    mkBool(a[0].kind == kChar and char(a[0].i) in Letters)
++  def "Character/isWhitespace", proc (a: openArray[Value]): Value =
++    mkBool(a[0].kind == kChar and char(a[0].i) in {' ', '\t', '\n', '\r', '\f', '\v'})
++  def "long", proc (a: openArray[Value]): Value = mkInt(intOf(a[0]))
++  def "unchecked-int", proc (a: openArray[Value]): Value =
++    mkInt(int64(cast[int32](uint32(intOf(a[0]) and 0xffffffff'i64))))
++  def "unchecked-byte", proc (a: openArray[Value]): Value =
++    mkInt(int64(cast[int8](uint8(intOf(a[0]) and 0xff))))
++  def "Math/floor", proc (a: openArray[Value]): Value = mkFloat(floor(num(a[0])))
++  def "Math/ceil", proc (a: openArray[Value]): Value = mkFloat(ceil(num(a[0])))
++  def "Math/abs", proc (a: openArray[Value]): Value =
++    (if a[0].kind == kFloat: mkFloat(abs(a[0].f)) else: mkInt(abs(a[0].i)))
++  def "Integer/parseInt", proc (a: openArray[Value]): Value =
++    let radix = (if a.len > 1: int(intOf(a[1])) else: 10)
++    mkInt(parseIntRadix(a[0].s.strip, radix))
++  def "Long/parseLong", proc (a: openArray[Value]): Value =
++    let radix = (if a.len > 1: int(intOf(a[1])) else: 10)
++    mkInt(parseIntRadix(a[0].s.strip, radix))
++  def "Double/parseDouble", proc (a: openArray[Value]): Value =
++    try: mkFloat(parseFloat(a[0].s.strip))
++    except ValueError: err("Not a number: " & a[0].s)
    # ---- comparison / predicates
    def "=", proc (a: openArray[Value]): Value =
      var parts: seq[string] = @[]
      for x in a: parts.add prStr(x)
      mkStr(parts.join(" "))
++  def "*out*", mkKeyword("stdout")
++  def "*err*", mkKeyword("stderr")
++  def "*in*", mkKeyword("stdin")
++  def "*command-line-args*", NilV
    def "println", proc (a: openArray[Value]): Value =
      var parts: seq[string] = @[]
      for x in a: parts.add str(x)
--    echo parts.join(" ")
++    writeOut(currentOut(), parts.join(" ") & "\n")
      NilV
    def "prn", proc (a: openArray[Value]): Value =
      var parts: seq[string] = @[]
      for x in a: parts.add prStr(x)
--    echo parts.join(" ")
++    writeOut(currentOut(), parts.join(" ") & "\n")
      NilV
    def "print", proc (a: openArray[Value]): Value =
      var parts: seq[string] = @[]
      for x in a: parts.add str(x)
--    stdout.write parts.join(" ")
++    writeOut(currentOut(), parts.join(" "))
++    NilV
++  def "pr", proc (a: openArray[Value]): Value =
++    var parts: seq[string] = @[]
++    for x in a: parts.add prStr(x)
++    writeOut(currentOut(), parts.join(" "))
      NilV
++  def "flush", proc (a: openArray[Value]): Value =
++    writeOut(currentOut(), ""); NilV
++  def "newline", proc (a: openArray[Value]): Value =
++    writeOut(currentOut(), "\n"); NilV
    def "name", proc (a: openArray[Value]): Value =
      case a[0].kind
      of kKeyword, kSymbol, kStr: mkStr(a[0].s)
    def "keyword", proc (a: openArray[Value]): Value = mkKeyword(str(a[0]))
    def "symbol", proc (a: openArray[Value]): Value = mkSymbol(str(a[0]))
    def "subs", proc (a: openArray[Value]): Value =
--    let s = a[0].s
++    let s = sOf(a[0])
      let st = int(intOf(a[1]))
      let en = (if a.len > 2: int(intOf(a[2])) else: s.len)
      mkStr(s[st ..< en])
--  def "clojure.string/upper-case", proc (a: openArray[Value]): Value = mkStr(a[0].s.toUpperAscii)
++  def "clojure.string/upper-case", proc (a: openArray[Value]): Value = mkStr(sOf(a[0]).toUpperAscii)
--  def "clojure.string/lower-case", proc (a: openArray[Value]): Value = mkStr(a[0].s.toLowerAscii)
++  def "clojure.string/lower-case", proc (a: openArray[Value]): Value = mkStr(sOf(a[0]).toLowerAscii)
--  def "clojure.string/trim", proc (a: openArray[Value]): Value = mkStr(a[0].s.strip)
++  def "clojure.string/trim", proc (a: openArray[Value]): Value = mkStr(sOf(a[0]).strip)
++  def "re-find", proc (a: openArray[Value]): Value =
++    let pattern = re(sOf(a[0]))
++    let start = find(sOf(a[1]), pattern)
++    if start < 0: NilV
++    else:
++      let n = matchLen(sOf(a[1]), pattern, start)
++      mkStr(sOf(a[1])[start ..< start + n])
++  def "clojure.string/replace", proc (a: openArray[Value]): Value =
++    mkStr(sOf(a[0]).replace(re(sOf(a[1])), sOf(a[2])))
    def "clojure.string/split", proc (a: openArray[Value]): Value =
      var r: seq[Value] = @[]
--    for piece in a[0].s.split(a[1].s): r.add mkStr(piece)
++    for piece in sOf(a[0]).split(sOf(a[1])): r.add mkStr(piece)
      mkVector(r)
    def "clojure.string/join", proc (a: openArray[Value]): Value =
      let sep = (if a.len > 1: str(a[0]) else: "")
      mkStr(parts.join(sep))
    def "read-line", proc (a: openArray[Value]): Value =
      try: mkStr(stdin.readLine()) except CatchableError: NilV
--  def "slurp", proc (a: openArray[Value]): Value = mkStr(readFile(a[0].s))
++  def "slurp", proc (a: openArray[Value]): Value =
++    (if a[0].kind == kKeyword and a[0].s == "stdin": mkStr(stdin.readAll)
++     else: mkStr(readFile(sOf(a[0]))))
    def "spit", proc (a: openArray[Value]): Value =
--    writeFile(a[0].s, str(a[1])); NilV
++    writeFile(sOf(a[0]), str(a[1])); NilV
++  def "int-array", proc (a: openArray[Value]): Value =
++    if a.len == 1 and a[0].kind == kInt: mkList(newSeqWith(int(a[0].i), mkInt(0)))
++    elif a.len == 1: mkList(toSeq(a[0])) else: mkList(a)
++  def "long-array", proc (a: openArray[Value]): Value =
++    if a.len == 1 and a[0].kind == kInt: mkList(newSeqWith(int(a[0].i), mkInt(0)))
++    elif a.len == 1: mkList(toSeq(a[0])) else: mkList(a)
++  def "byte-array", proc (a: openArray[Value]): Value =
++    if a.len == 1: mkList(toSeq(a[0])) else: mkList(a)
++  def "alength", proc (a: openArray[Value]): Value = mkInt(count(a[0]))
++  def "aget", proc (a: openArray[Value]): Value =
++    let i = int(intOf(a[1]))
++    if a[0].kind == kList: a[0].obj.xs[i] else: toSeq(a[0])[i]
++  def "aset", proc (a: openArray[Value]): Value =
++    if a[0].kind != kList: err("aset expects an array")
++    a[0].obj.xs[int(intOf(a[1]))] = a[2]; a[2]
++  def "System/arraycopy", proc (a: openArray[Value]): Value =
++    for i in 0 ..< int(intOf(a[4])):
++      a[2].obj.xs[int(intOf(a[3])) + i] = a[0].obj.xs[int(intOf(a[1])) + i]
++    NilV
++  def ".getBytes", proc (a: openArray[Value]): Value =
++    var xs: seq[Value] = @[]
++    for ch in sOf(a[0]): xs.add mkInt(ord(ch))
++    mkList(xs)
++  def "StringBuilder.", proc (a: openArray[Value]): Value =
++    ## A mutable string: the one place a string value is written in place.
++    mkStr(if a.len > 0: str(a[0]) else: "")
++  def ".append", proc (a: openArray[Value]): Value =
++    if a[0].kind != kStr: err(".append expects a StringBuilder")
++    a[0].obj.s.add(str(a[1]))
++    a[0]
++  def ".toString", proc (a: openArray[Value]): Value = mkStr(str(a[0]))
++  def ".length", proc (a: openArray[Value]): Value = mkInt(int64(sOf(a[0]).len))
++  def "*output-stream*", proc (a: openArray[Value]): Value =
++    ## A write handle, driven by keyword messages so that it stays an
++    ## ordinary value: (o :write bytes) and (o :close).
++    let path = sOf(a[0])
++    var f: File
++    if not f.open(path, fmWrite): err("Cannot open for writing: " & path)
++    var closed = false
++    mkFn("output-stream", proc (args: openArray[Value]): Value =
++      if args.len == 0 or args[0].kind != kKeyword:
++        err("output-stream expects a keyword message")
++      case args[0].s
++      of "write":
++        if closed: err("Stream is closed: " & path)
++        var bytes = ""
++        for x in elems(args[1]): bytes.add char(uint8(intOf(x) and 0xff))
++        f.write(bytes)
++      of "close":
++        if not closed: f.close(); closed = true
++      else: err("Unknown stream message: " & prStr(args[0]))
++      NilV)
++  def ".write", proc (a: openArray[Value]): Value =
++    call(a[0], [mkKeyword("write"), a[1]])
++  def ".close", proc (a: openArray[Value]): Value =
++    (if a[0].kind == kFn: call(a[0], [mkKeyword("close")]) else: NilV)
++  def "*delete-file*", proc (a: openArray[Value]): Value =
++    try:
++      removeFile(sOf(a[0]))
++      TrueV
++    except OSError:
++      if a.len > 1 and truthy(a[1]): FalseV
++      else: raise
++  def "*http-fetch*", proc (a: openArray[Value]): Value =
++    ## Native replacement for the narrow Jolt HTTP API used by Freeqsay.
++    try:
++      let response = newHttpClient().get(sOf(a[0]))
++      writeFile(sOf(a[1]), response.body)
++      mkMap(@[(mkKeyword("outcome"), mkKeyword("ok")),
++              (mkKeyword("status"), mkInt(response.code.int)),
++              (mkKeyword("error"), NilV)])
++    except CatchableError as e:
++      mkMap(@[(mkKeyword("outcome"), mkKeyword("error")),
++              (mkKeyword("status"), mkInt(0)),
++              (mkKeyword("error"), mkStr(e.msg))])
    # Host primitive used by the source-level stdlib's now-ms wrapper.
    def "*epoch-time-ms*", proc (a: openArray[Value]): Value = mkInt(int64(epochTime() * 1000))
        r.add mkList(s[i ..< i + n]); i += n
      mkList(r)
++  def "partition-all", proc (a: openArray[Value]): Value =
++    let n = int(intOf(a[0]))
++    let step = (if a.len > 2: int(intOf(a[1])) else: n)
++    let s = toSeq(a[^1])
++    var r: seq[Value] = @[]
++    var i = 0
++    while i < s.len:
++      r.add mkList(s[i ..< min(i + n, s.len)]); i += step
++    mkList(r)
++  def "partition-by", proc (a: openArray[Value]): Value =
++    let s = toSeq(a[1])
++    var r: seq[Value] = @[]
++    var run: seq[Value] = @[]
++    var key = NilV
++    for x in s:
++      let k = call(a[0], [x])
++      if run.len == 0 or equals(k, key): run.add x
++      else:
++        r.add mkList(run); run = @[x]
++      key = k
++    if run.len > 0: r.add mkList(run)
++    mkList(r)
++  def "into", proc (a: openArray[Value]): Value =
++    result = a[0]
++    if a.len > 1:
++      for x in elems(a[1]): result = conjOne(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]] = @[]
++    for i in 1 ..< a.len: colls.add toSeq(a[i])
++    var n = -1
++    for c in colls: (if n < 0 or c.len < n: n = c.len)
++    var r: seq[Value] = @[]
++    for i in 0 ..< max(n, 0):
++      var args: seq[Value] = @[]
++      for c in colls: args.add c[i]
++      for x in elems(call(a[0], args)): r.add x
++    mkList(r)
++
    # ---- higher order
    def "apply", proc (a: openArray[Value]): Value =
      var callArgs: seq[Value] = @[]
      let nv = call(a[1], @[cur] & @(a[2 .. ^1]))
      call(a[0], [mkKeyword("set"), nv])
++  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)
++  def "volatile!", proc (a: openArray[Value]): Value =
++    var cell = a[0]
++    mkFn("volatile", proc (args: openArray[Value]): Value =
++      if args.len == 0: return cell
++      cell = args[1]
++      cell)
++  def "vreset!", proc (a: openArray[Value]): Value =
++    call(a[0], [mkKeyword("set"), a[1]])
++  def "vswap!", proc (a: openArray[Value]): Value =
++    let cur = call(a[0], [])
++    call(a[0], [mkKeyword("set"), call(a[1], @[cur] & @(a[2 .. ^1]))])
++  def "boolean", proc (a: openArray[Value]): Value = mkBool(truthy(a[0]))
++  def "class", proc (a: openArray[Value]): Value = mkKeyword($a[0].kind)
++  def "instance?", proc (a: openArray[Value]): Value =
++    mkBool(a[0].kind == kKeyword and a[0].s == $a[1].kind)
++  def "format", proc (a: openArray[Value]): Value = mkStr(javaFormat(sOf(a[0]), a[1 .. ^1]))
++  def "System/exit", proc (a: openArray[Value]): Value =
++    quit(if a.len > 0: int(intOf(a[0])) else: 0)
++  def "System/currentTimeMillis", proc (a: openArray[Value]): Value =
++    mkInt(int64(epochTime() * 1000))
++  def "System/getProperty", proc (a: openArray[Value]): Value =
++    ## Only the properties a hosted program can reasonably expect here.
++    case sOf(a[0])
++    of "java.io.tmpdir": mkStr(getTempDir().strip(leading = false, chars = {'/'}))
++    of "user.dir": mkStr(getCurrentDir())
++    of "user.name": mkStr(getEnv("USER"))
++    of "line.separator": mkStr("\n")
++    else: (if a.len > 1: a[1] else: NilV)
++  def "clojure.string/blank?", proc (a: openArray[Value]): Value =
++    mkBool(a[0].kind == kNil or sOf(a[0]).strip.len == 0)
++  def "clojure.string/starts-with?", proc (a: openArray[Value]): Value =
++    mkBool(sOf(a[0]).startsWith(sOf(a[1])))
++  def "clojure.string/ends-with?", proc (a: openArray[Value]): Value =
++    mkBool(sOf(a[0]).endsWith(sOf(a[1])))
++  def "clojure.string/includes?", proc (a: openArray[Value]): Value =
++    mkBool(sOf(a[1]) in sOf(a[0]))
++  def "clojure.string/index-of", proc (a: openArray[Value]): Value =
++    let i = sOf(a[0]).find(sOf(a[1]))
++    (if i < 0: NilV else: mkInt(int64(i)))
    def "throw", proc (a: openArray[Value]): Value = err(str(a[0]))
    def "ex-info", proc (a: openArray[Value]): Value = mkStr(str(a[0]))
    def "time-ms", proc (a: openArray[Value]): Value = mkInt(int64(epochTime() * 1000))

modified src/namespaces.nim +88 -3 Viewed

@@ -16,16 +16,18 @@ type
16	16	defs, privateDefs, required: HashSet[string]
17	17	Resolver = ref object
18	18	roots: seq[string]
19		- cores: HashSet[string]
	19	+ cores, hosts: HashSet[string]
20	20	spaces: Table[string, Namespace]
21	21	active: seq[string]
22	22	loaded: HashSet[string]
23	23	output: seq[Value]
	24	+ gensym: int
24	25
25	26	const syntaxHeads = ["quote", "if", "do", "let", "let", "loop", "loop",
26	27	"recur", "fn", "fn*", "def", "defn", "defn-", "defmacro", "and", "or",
27	28	"when", "when-not", "if-not", "cond", "when-let", "if-let", "->", "->>",
28		- "doseq", "dotimes", "try", "catch", "finally", "comment", "set!", "declare"]
	29	+ "doseq", "dotimes", "try", "catch", "finally", "comment", "set!", "declare",
	30	+ "case", "for", "with-open", "assert", "binding"]
29	31
30	32	# Unlike macros, these heads cannot be shadowed in operator position.
31	33	const specialForms = ["quote", "if", "do", "let", "loop", "recur", "fn*",
@@ -64,6 +66,22 @@ proc registeredCoreNames(): HashSet[string] =
64	66	finally:
65	67	globals = saved
66	68
	69	+proc registeredHostNames(): HashSet[string] =
	70	+ ## Runtime functions in named host namespaces (for example clojure.string)
	71	+ ## do not need a shadow source file merely to be required by user code.
	72	+ let saved = globals
	73	+ globals = initTable[string, VarCell]()
	74	+ try:
	75	+ registerCore()
	76	+ for name, cell in globals:
	77	+ if cell.bound: result.incl name
	78	+ finally:
	79	+ globals = saved
	80	+
	81	+proc hasHostNamespace(r: Resolver, name: string): bool =
	82	+ for candidate in r.hosts:
	83	+ if candidate.startsWith(name & "/"): return true
	84	+
67	85	proc registerNamespaceCore*() =
68	86	## Call after registerCore in the generated program, before resolving cells.
69	87	## Both spellings share a cell, so rebinding remains coherent.
@@ -83,6 +101,8 @@ proc checkVar(r: Resolver, ns: Namespace, target, name: string,
83	101	if target == "clojure.core":
84	102	if name in r.cores or (allowSyntax and name in syntaxHeads): return
85	103	fail("no definition " & canonical)
	104	+ # JVM-style host calls (for example System/arraycopy) are globally provided.
	105	+ if canonical in r.hosts: return
86	106	if target != ns.name and target notin ns.required:
87	107	fail("namespace " & target & " is not required by " & ns.name)
88	108	if not r.spaces.hasKey(target) or name notin r.spaces[target].defs:
@@ -271,6 +291,66 @@ proc walk(r: Resolver, ns: Namespace, v: Value, locals: HashSet[string]): Value
271	291	scope.incl simple(xs[2], "catch binding")
272	292	for i in 3 ..< xs.len: xs[i] = r.walk(ns, xs[i], scope)
273	293	return mkList(xs)
	294	+ of "case":
	295	+ # (case e test-constant result ... default?) — the constants are literal,
	296	+ # so they are quoted rather than resolved.
	297	+ if xs.len < 3: fail("case requires an expression and at least one clause")
	298	+ inc r.gensym
	299	+ let sym = mkSymbol("case__" & $r.gensym)
	300	+ var clauses: seq[Value] = @[]
	301	+ var i = 2
	302	+ while i + 1 < xs.len:
	303	+ let test = xs[i]
	304	+ var pred: Value
	305	+ if test.kind in {kList, kVector} and test.items.len > 0:
	306	+ # a group of constants shares one result
	307	+ var alts: seq[Value] = @[mkSymbol("or")]
	308	+ for t in test.items:
	309	+ alts.add mkList(@[mkSymbol("="), sym, mkList(@[mkSymbol("quote"), t])])
	310	+ pred = mkList(alts)
	311	+ else:
	312	+ pred = mkList(@[mkSymbol("="), sym, mkList(@[mkSymbol("quote"), test])])
	313	+ clauses.add pred
	314	+ clauses.add xs[i + 1]
	315	+ i += 2
	316	+ clauses.add mkSymbol("else")
	317	+ if i < xs.len: clauses.add xs[i]
	318	+ else:
	319	+ clauses.add mkList(@[mkSymbol("throw"),
	320	+ mkList(@[mkSymbol("str"), mkStr("No matching clause: "), sym])])
	321	+ return r.walk(ns, mkList(@[mkSymbol("let"), mkVector(@[sym, xs[1]]),
	322	+ mkList(@[mkSymbol("cond")] & clauses)]), locals)
	323	+ of "for":
	324	+ # A comprehension over one or more bindings, without the modifier clauses.
	325	+ if xs.len < 3 or xs[1].kind != kVector: fail("for requires [sym coll] bindings")
	326	+ var bs = xs[1].items
	327	+ if bs.len == 0 or bs.len mod 2 != 0: fail("for requires paired bindings")
	328	+ for j in countup(0, bs.len - 1, 2):
	329	+ if bs[j].kind == kKeyword: fail("for modifier clauses are not supported: " & prStr(bs[j]))
	330	+ var body = mkList(@[mkSymbol("do")] & xs[2 .. ^1])
	331	+ var j = bs.len - 2
	332	+ while j >= 0:
	333	+ let combine = (if j == bs.len - 2: "map" else: "mapcat")
	334	+ body = mkList(@[mkSymbol(combine),
	335	+ mkList(@[mkSymbol("fn"), mkVector(@[bs[j]]), body]),
	336	+ bs[j + 1]])
	337	+ j -= 2
	338	+ return r.walk(ns, body, locals)
	339	+ of "with-open":
	340	+ if xs.len < 2 or xs[1].kind != kVector or xs[1].items.len != 2:
	341	+ fail("with-open requires [sym resource]")
	342	+ let bs = xs[1].items
	343	+ let body = mkList(@[mkSymbol("do")] & xs[2 .. ^1])
	344	+ let cleanup = mkList(@[mkSymbol("finally"), mkList(@[mkSymbol(".close"), bs[0]])])
	345	+ return r.walk(ns, mkList(@[mkSymbol("let"), mkVector(bs),
	346	+ mkList(@[mkSymbol("try"), body, cleanup])]), locals)
	347	+ of "assert":
	348	+ if xs.len < 2: fail("assert requires a test")
	349	+ var msg = mkList(@[mkSymbol("str"), mkStr("Assert failed: " & prStr(xs[1]))])
	350	+ if xs.len > 2:
	351	+ msg = mkList(@[mkSymbol("str"), mkStr("Assert failed: "), xs[2]])
	352	+ return r.walk(ns, mkList(@[mkSymbol("when-not"), xs[1],
	353	+ mkList(@[mkSymbol("throw"), msg])]), locals)
274	354	of "->", "->>":
275	355	# Expand before resolving: a bare step can be a syntax head (e.g. do).
276	356	if xs.len < 2: fail(h & " requires an expression")
@@ -299,6 +379,10 @@ proc process(r: Resolver, forms: seq[Value], expected = "")
299	379	proc load(r: Resolver, name: string) =
300	380	validNamespace(name)
301	381	if name == "clojure.core": return
	382	+ if r.hasHostNamespace(name):
	383	+ discard r.space(name)
	384	+ r.loaded.incl name
	385	+ return
302	386	if name in r.active: fail("dependency cycle: " & (r.active & @[name]).join(" -> "))
303	387	if name in r.loaded: return
304	388	let relative = name.replace('.', '/').replace('-', '_')
@@ -410,6 +494,7 @@ proc resolveSource*(src: string, sourceRoots: seq[string]): seq[Value] =
410	494	## Forward references require declare. Qualified references require a direct
411	495	## require, except for the current namespace and implicit clojure.core.
412	496	## Unknown and externally private vars are rejected during analysis.
413		- let r = Resolver(roots: sourceRoots, cores: registeredCoreNames())
	497	+ let r = Resolver(roots: sourceRoots, cores: registeredCoreNames(),
	498	+ hosts: registeredHostNames())
414	499	r.process(readAll(src))
415	500	r.output

      defs, privateDefs, required: HashSet[string]
    Resolver = ref object
      roots: seq[string]
--    cores: HashSet[string]
++    cores, hosts: HashSet[string]
      spaces: Table[string, Namespace]
      active: seq[string]
      loaded: HashSet[string]
      output: seq[Value]
++    gensym: int
  const syntaxHeads = ["quote", "if", "do", "let", "let*", "loop", "loop*",
    "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"]
++  "doseq", "dotimes", "try", "catch", "finally", "comment", "set!", "declare",
++  "case", "for", "with-open", "assert", "binding"]
  # Unlike macros, these heads cannot be shadowed in operator position.
  const specialForms = ["quote", "if", "do", "let*", "loop*", "recur", "fn*",
    finally:
      globals = saved
++proc registeredHostNames(): HashSet[string] =
++  ## Runtime functions in named host namespaces (for example clojure.string)
++  ## do not need a shadow source file merely to be required by user code.
++  let saved = globals
++  globals = initTable[string, VarCell]()
++  try:
++    registerCore()
++    for name, cell in globals:
++      if cell.bound: result.incl name
++  finally:
++    globals = saved
++
++proc hasHostNamespace(r: Resolver, name: string): bool =
++  for candidate in r.hosts:
++    if candidate.startsWith(name & "/"): return true
++
  proc registerNamespaceCore*() =
    ## Call after registerCore in the generated program, before resolving cells.
    ## Both spellings share a cell, so rebinding remains coherent.
    if target == "clojure.core":
      if name in r.cores or (allowSyntax and name in syntaxHeads): return
      fail("no definition " & canonical)
++  # JVM-style host calls (for example System/arraycopy) are globally provided.
++  if canonical in r.hosts: return
    if target != ns.name and target notin ns.required:
      fail("namespace " & target & " is not required by " & ns.name)
    if not r.spaces.hasKey(target) or name notin r.spaces[target].defs:
      scope.incl simple(xs[2], "catch binding")
      for i in 3 ..< xs.len: xs[i] = r.walk(ns, xs[i], scope)
      return mkList(xs)
++  of "case":
++    # (case e test-constant result ... default?) — the constants are literal,
++    # so they are quoted rather than resolved.
++    if xs.len < 3: fail("case requires an expression and at least one clause")
++    inc r.gensym
++    let sym = mkSymbol("case__" & $r.gensym)
++    var clauses: seq[Value] = @[]
++    var i = 2
++    while i + 1 < xs.len:
++      let test = xs[i]
++      var pred: Value
++      if test.kind in {kList, kVector} and test.items.len > 0:
++        # a group of constants shares one result
++        var alts: seq[Value] = @[mkSymbol("or")]
++        for t in test.items:
++          alts.add mkList(@[mkSymbol("="), sym, mkList(@[mkSymbol("quote"), t])])
++        pred = mkList(alts)
++      else:
++        pred = mkList(@[mkSymbol("="), sym, mkList(@[mkSymbol("quote"), test])])
++      clauses.add pred
++      clauses.add xs[i + 1]
++      i += 2
++    clauses.add mkSymbol("else")
++    if i < xs.len: clauses.add xs[i]
++    else:
++      clauses.add mkList(@[mkSymbol("throw"),
++                           mkList(@[mkSymbol("str"), mkStr("No matching clause: "), sym])])
++    return r.walk(ns, mkList(@[mkSymbol("let"), mkVector(@[sym, xs[1]]),
++                               mkList(@[mkSymbol("cond")] & clauses)]), locals)
++  of "for":
++    # A comprehension over one or more bindings, without the modifier clauses.
++    if xs.len < 3 or xs[1].kind != kVector: fail("for requires [sym coll] bindings")
++    var bs = xs[1].items
++    if bs.len == 0 or bs.len mod 2 != 0: fail("for requires paired bindings")
++    for j in countup(0, bs.len - 1, 2):
++      if bs[j].kind == kKeyword: fail("for modifier clauses are not supported: " & prStr(bs[j]))
++    var body = mkList(@[mkSymbol("do")] & xs[2 .. ^1])
++    var j = bs.len - 2
++    while j >= 0:
++      let combine = (if j == bs.len - 2: "map" else: "mapcat")
++      body = mkList(@[mkSymbol(combine),
++                      mkList(@[mkSymbol("fn"), mkVector(@[bs[j]]), body]),
++                      bs[j + 1]])
++      j -= 2
++    return r.walk(ns, body, locals)
++  of "with-open":
++    if xs.len < 2 or xs[1].kind != kVector or xs[1].items.len != 2:
++      fail("with-open requires [sym resource]")
++    let bs = xs[1].items
++    let body = mkList(@[mkSymbol("do")] & xs[2 .. ^1])
++    let cleanup = mkList(@[mkSymbol("finally"), mkList(@[mkSymbol(".close"), bs[0]])])
++    return r.walk(ns, mkList(@[mkSymbol("let"), mkVector(bs),
++                               mkList(@[mkSymbol("try"), body, cleanup])]), locals)
++  of "assert":
++    if xs.len < 2: fail("assert requires a test")
++    var msg = mkList(@[mkSymbol("str"), mkStr("Assert failed: " & prStr(xs[1]))])
++    if xs.len > 2:
++      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 "->", "->>":
      # Expand before resolving: a bare step can be a syntax head (e.g. do).
      if xs.len < 2: fail(h & " requires an expression")
  proc load(r: Resolver, name: string) =
    validNamespace(name)
    if name == "clojure.core": return
++  if r.hasHostNamespace(name):
++    discard r.space(name)
++    r.loaded.incl name
++    return
    if name in r.active: fail("dependency cycle: " & (r.active & @[name]).join(" -> "))
    if name in r.loaded: return
    let relative = name.replace('.', '/').replace('-', '_')
    ## Forward references require declare. Qualified references require a direct
    ## require, except for the current namespace and implicit clojure.core.
    ## Unknown and externally private vars are rejected during analysis.
--  let r = Resolver(roots: sourceRoots, cores: registeredCoreNames())
++  let r = Resolver(roots: sourceRoots, cores: registeredCoreNames(),
++                   hosts: registeredHostNames())
    r.process(readAll(src))
    r.output

modified src/reader.nim +92 -2 Viewed

@@ -1,5 +1,5 @@
1	1	## clonim reader — text -> data (forms are ordinary runtime Values, as in Clojure).
2		-import std/[strutils]
	2	+import std/[strutils, sequtils]
3	3	import runtime
4	4
5	5	type
@@ -7,6 +7,7 @@ type
7	7	src: string
8	8	pos: int
9	9	line: int
	10	+ anonId: int
10	11
11	12	proc peek(r: Reader): char =
12	13	(if r.pos < r.src.len: r.src[r.pos] else: '\0')
@@ -36,6 +37,42 @@ proc skipWs(r: var Reader) =
36	37
37	38	proc readForm(r: var Reader): Value
38	39
	40	+proc anonArgIndex(name: string): int =
	41	+ ## % and %1 are the first argument, %2 the second, and so on. -1 for
	42	+ ## anything that is not an anonymous-argument symbol.
	43	+ if name.len == 0 or name[0] != '%': return -1
	44	+ if name.len == 1: return 1
	45	+ try: parseInt(name[1 .. ^1])
	46	+ except ValueError: -1
	47	+
	48	+proc replaceAnonArg(v: Value, arg: string): Value =
	49	+ if v.kind == kSymbol:
	50	+ let n = anonArgIndex(v.s)
	51	+ if n > 0: return mkSymbol(arg & "_" & $n)
	52	+ case v.kind
	53	+ of kList: mkList(v.items.mapIt(replaceAnonArg(it, arg)))
	54	+ of kVector: mkVector(v.items.mapIt(replaceAnonArg(it, arg)))
	55	+ of kSet: mkSet(v.items.mapIt(replaceAnonArg(it, arg)))
	56	+ of kMap:
	57	+ var pairs: seq[(Value, Value)]
	58	+ for (k, val) in v.pairs: pairs.add (replaceAnonArg(k, arg), replaceAnonArg(val, arg))
	59	+ mkMap(pairs)
	60	+ else: v
	61	+
	62	+proc countAnonArgs(v: Value, arity: var int) =
	63	+ if v.isNil: return
	64	+ if v.kind == kSymbol:
	65	+ let n = anonArgIndex(v.s)
	66	+ if n > arity: arity = n
	67	+ return
	68	+ case v.kind
	69	+ of kList, kVector, kSet:
	70	+ for x in v.items: countAnonArgs(x, arity)
	71	+ of kMap:
	72	+ for (k, val) in v.pairs:
	73	+ countAnonArgs(k, arity); countAnonArgs(val, arity)
	74	+ else: discard
	75	+
39	76	proc readDelimited(r: var Reader, closing: char): seq[Value] =
40	77	result = @[]
41	78	while true:
@@ -67,6 +104,33 @@ proc readString(r: var Reader): Value =
67	104	s.add c
68	105	mkStr(s)
69	106
	107	+proc readChar(r: var Reader): Value =
	108	+ ## A character literal: \a, \newline, \uXXXX, or any single character —
	109	+ ## including the delimiters, which never start a name here.
	110	+ discard r.advance # the backslash
	111	+ if r.pos >= r.src.len: r.readerErr("EOF while reading character")
	112	+ let first = r.advance
	113	+ var name = $first
	114	+ if first in Letters or first in Digits:
	115	+ while r.pos < r.src.len:
	116	+ let c = r.peek
	117	+ if c in {' ', '\t', '\n', '\r', ','} or (c in macroChars and c != '\''): break
	118	+ name.add r.advance
	119	+ if name.len == 1: return mkChar(int64(ord(name[0])))
	120	+ case name
	121	+ of "newline": mkChar(10)
	122	+ of "tab": mkChar(9)
	123	+ of "return": mkChar(13)
	124	+ of "space": mkChar(32)
	125	+ of "backspace": mkChar(8)
	126	+ of "formfeed": mkChar(12)
	127	+ else:
	128	+ if name[0] == 'u' and name.len == 5:
	129	+ try: return mkChar(int64(parseHexInt(name[1 .. ^1])))
	130	+ except ValueError: discard
	131	+ r.readerErr("Unsupported character literal: \\" & name)
	132	+ NilV
	133	+
70	134	proc readToken(r: var Reader): string =
71	135	result = ""
72	136	while r.pos < r.src.len:
@@ -80,6 +144,13 @@ proc parseAtom(r: Reader, tok: string): Value =
80	144	if tok == "true": return TrueV
81	145	if tok == "false": return FalseV
82	146	if tok.len > 1 and tok[0] == ':': return mkKeyword(tok[1 .. ^1])
	147	+ # Clojure accepts hexadecimal integer literals, commonly used for bit masks
	148	+ # and crypto constants.
	149	+ let sign = (if tok.len > 0 and tok[0] == '-': -1'i64 else: 1'i64)
	150	+ let digits = (if tok.len > 0 and tok[0] in {'-', '+'}: tok[1 .. ^1] else: tok)
	151	+ if digits.len > 2 and digits[0 .. 1].toLowerAscii == "0x":
	152	+ try: return mkInt(sign * int64(parseHexInt(digits[2 .. ^1])))
	153	+ except ValueError: discard
83	154	# number?
84	155	let body = (if tok[0] in {'-', '+'} and tok.len > 1: tok[1 .. ^1] else: tok)
85	156	if body.len > 0 and body[0] in Digits:
@@ -115,6 +186,8 @@ proc readForm(r: var Reader): Value =
115	186	r.readerErr("Unmatched delimiter: " & c)
116	187	of '"':
117	188	return r.readString
	189	+ of '\\':
	190	+ return r.readChar
118	191	of '\'':
119	192	discard r.advance
120	193	return mkList(@[mkSymbol("quote"), r.readForm])
@@ -130,13 +203,30 @@ proc readForm(r: var Reader): Value =
130	203	if r.peek2 == '{':
131	204	discard r.advance; discard r.advance
132	205	return mkSet(r.readDelimited('}'))
	206	+ if r.peek2 == '"':
	207	+ # A Clojure regex literal carries its pattern source at read time. The
	208	+ # runtime's regular-expression operations accept that source string, so
	209	+ # preserve the usual string escaping while avoiding a JVM-only Pattern
	210	+ # object in the portable value representation.
	211	+ discard r.advance
	212	+ return r.readString
133	213	if r.peek2 == '_':
134	214	discard r.advance; discard r.advance
135	215	discard r.readForm
136	216	r.skipWs
137	217	return r.readForm
138	218	if r.peek2 == '(':
139		- r.readerErr("#() anonymous fn literals are not supported; use (fn [x] ...)")
	219	+ discard r.advance; discard r.advance
	220	+ inc r.anonId
	221	+ let arg = "anon_arg_" & $r.anonId
	222	+ let body = r.readDelimited(')')
	223	+ # The contents are one call, not a body: #(f x) is (fn [a] (f x)).
	224	+ let form = replaceAnonArg(mkList(body), arg)
	225	+ var arity = 0
	226	+ countAnonArgs(mkList(body), arity)
	227	+ var params: seq[Value] = @[]
	228	+ for i in 1 .. arity: params.add mkSymbol(arg & "_" & $i)
	229	+ return mkList(@[mkSymbol("fn"), mkVector(params), form])
140	230	r.readerErr("Unsupported dispatch: #" & r.peek2
141	231	)
142	232	else:

  ## clonim reader — text -> data (forms are ordinary runtime Values, as in Clojure).
--import std/[strutils]
++import std/[strutils, sequtils]
  import runtime
  type
      src: string
      pos: int
      line: int
++    anonId: int
  proc peek(r: Reader): char =
    (if r.pos < r.src.len: r.src[r.pos] else: '\0')
  proc readForm(r: var Reader): Value
++proc anonArgIndex(name: string): int =
++  ## % and %1 are the first argument, %2 the second, and so on. -1 for
++  ## anything that is not an anonymous-argument symbol.
++  if name.len == 0 or name[0] != '%': return -1
++  if name.len == 1: return 1
++  try: parseInt(name[1 .. ^1])
++  except ValueError: -1
++
++proc replaceAnonArg(v: Value, arg: string): Value =
++  if v.kind == kSymbol:
++    let n = anonArgIndex(v.s)
++    if n > 0: return mkSymbol(arg & "_" & $n)
++  case v.kind
++  of kList: mkList(v.items.mapIt(replaceAnonArg(it, arg)))
++  of kVector: mkVector(v.items.mapIt(replaceAnonArg(it, arg)))
++  of kSet: mkSet(v.items.mapIt(replaceAnonArg(it, arg)))
++  of kMap:
++    var pairs: seq[(Value, Value)]
++    for (k, val) in v.pairs: pairs.add (replaceAnonArg(k, arg), replaceAnonArg(val, arg))
++    mkMap(pairs)
++  else: v
++
++proc countAnonArgs(v: Value, arity: var int) =
++  if v.isNil: return
++  if v.kind == kSymbol:
++    let n = anonArgIndex(v.s)
++    if n > arity: arity = n
++    return
++  case v.kind
++  of kList, kVector, kSet:
++    for x in v.items: countAnonArgs(x, arity)
++  of kMap:
++    for (k, val) in v.pairs:
++      countAnonArgs(k, arity); countAnonArgs(val, arity)
++  else: discard
++
  proc readDelimited(r: var Reader, closing: char): seq[Value] =
    result = @[]
    while true:
        s.add c
    mkStr(s)
++proc readChar(r: var Reader): Value =
++  ## A character literal: \a, \newline, \uXXXX, or any single character —
++  ## including the delimiters, which never start a name here.
++  discard r.advance # the backslash
++  if r.pos >= r.src.len: r.readerErr("EOF while reading character")
++  let first = r.advance
++  var name = $first
++  if first in Letters or first in Digits:
++    while r.pos < r.src.len:
++      let c = r.peek
++      if c in {' ', '\t', '\n', '\r', ','} or (c in macroChars and c != '\''): break
++      name.add r.advance
++  if name.len == 1: return mkChar(int64(ord(name[0])))
++  case name
++  of "newline": mkChar(10)
++  of "tab": mkChar(9)
++  of "return": mkChar(13)
++  of "space": mkChar(32)
++  of "backspace": mkChar(8)
++  of "formfeed": mkChar(12)
++  else:
++    if name[0] == 'u' and name.len == 5:
++      try: return mkChar(int64(parseHexInt(name[1 .. ^1])))
++      except ValueError: discard
++    r.readerErr("Unsupported character literal: \\" & name)
++    NilV
++
  proc readToken(r: var Reader): string =
    result = ""
    while r.pos < r.src.len:
    if tok == "true": return TrueV
    if tok == "false": return FalseV
    if tok.len > 1 and tok[0] == ':': return mkKeyword(tok[1 .. ^1])
++  # Clojure accepts hexadecimal integer literals, commonly used for bit masks
++  # and crypto constants.
++  let sign = (if tok.len > 0 and tok[0] == '-': -1'i64 else: 1'i64)
++  let digits = (if tok.len > 0 and tok[0] in {'-', '+'}: tok[1 .. ^1] else: tok)
++  if digits.len > 2 and digits[0 .. 1].toLowerAscii == "0x":
++    try: return mkInt(sign * int64(parseHexInt(digits[2 .. ^1])))
++    except ValueError: discard
    # number?
    let body = (if tok[0] in {'-', '+'} and tok.len > 1: tok[1 .. ^1] else: tok)
    if body.len > 0 and body[0] in Digits:
      r.readerErr("Unmatched delimiter: " & c)
    of '"':
      return r.readString
++  of '\\':
++    return r.readChar
    of '\'':
      discard r.advance
      return mkList(@[mkSymbol("quote"), r.readForm])
      if r.peek2 == '{':
        discard r.advance; discard r.advance
        return mkSet(r.readDelimited('}'))
++    if r.peek2 == '"':
++      # A Clojure regex literal carries its pattern source at read time.  The
++      # runtime's regular-expression operations accept that source string, so
++      # preserve the usual string escaping while avoiding a JVM-only Pattern
++      # object in the portable value representation.
++      discard r.advance
++      return r.readString
      if r.peek2 == '_':
        discard r.advance; discard r.advance
        discard r.readForm
        r.skipWs
        return r.readForm
      if r.peek2 == '(':
--      r.readerErr("#() anonymous fn literals are not supported; use (fn [x] ...)")
++      discard r.advance; discard r.advance
++      inc r.anonId
++      let arg = "anon_arg_" & $r.anonId
++      let body = r.readDelimited(')')
++      # The contents are one call, not a body: #(f x) is (fn [a] (f x)).
++      let form = replaceAnonArg(mkList(body), arg)
++      var arity = 0
++      countAnonArgs(mkList(body), arity)
++      var params: seq[Value] = @[]
++      for i in 1 .. arity: params.add mkSymbol(arg & "_" & $i)
++      return mkList(@[mkSymbol("fn"), mkVector(params), form])
      r.readerErr("Unsupported dispatch: #" & r.peek2
        )
    else:

modified src/runtime.nim +28 -3 Viewed

@@ -6,7 +6,7 @@
6	6	## collection. Maps and sets additionally remember insertion order — every
7	7	## entry carries an `ord` stamp and iteration sorts by it — so printing and
8	8	## `keys`/`vals` stay predictable the way Clojure's small array-maps are.
9		-import std/[tables, strutils, hashes, bitops, algorithm]
	9	+import std/[tables, strutils, hashes, bitops, algorithm, unicode]
10	10	import runtime_types
11	11	export runtime_types
12	12
@@ -267,6 +267,7 @@ proc mapEntries*(m: PMap): seq[MEntry] =
267	267	proc mkBool*(x: bool): Value = (if x: TrueV else: FalseV)
268	268	proc mkInt*(x: int64): Value {.inline.} = Value(kind: kInt, raw: x)
269	269	proc mkFloat*(x: float64): Value {.inline.} = Value(kind: kFloat, raw: cast[int64](x))
	270	+proc mkChar*(code: int64): Value {.inline.} = Value(kind: kChar, raw: code)
270	271	proc mkStr*(x: string): Value = Value(kind: kStr, obj: Obj(kind: kStr, s: x))
271	272	proc mkKeyword*(x: string): Value = Value(kind: kKeyword, obj: Obj(kind: kKeyword, s: x))
272	273	proc mkSymbol*(x: string): Value = Value(kind: kSymbol, obj: Obj(kind: kSymbol, s: x))
@@ -439,12 +440,19 @@ proc seqDrop*(v: Value, n: int): Value =
439	440	result = seqRest(result)
440	441	dec k
441	442
	443	+proc seqDropOrNil*(v: Value, n: int): Value =
	444	+ ## What `& rest` binds: the remainder, or nil once it is exhausted, as on
	445	+ ## the JVM, where an empty rest is nil rather than an empty seq.
	446	+ result = seqDrop(v, n)
	447	+ if seqIsEmpty(result): result = NilV
	448	+
442	449	proc hashValue*(v: Value): uint32 =
443	450	if v.isNil: return 0
444	451	case v.kind
445	452	of kNil: 0'u32
446	453	of kBool: (if v.b: 0x9e3779b9'u32 else: 0x85ebca6b'u32)
447	454	of kInt: uint32(hash(v.i))
	455	+ of kChar: mixHash(5'u32, uint32(hash(v.i)))
448	456	of kFloat:
449	457	# ints and floats compare equal across kinds, so they must hash alike
450	458	if v.f == float64(int64(v.f)): uint32(hash(int64(v.f)))
@@ -536,6 +544,7 @@ proc equals*(a, b: Value): bool =
536	544	of kNil: true
537	545	of kBool: a.b == b.b
538	546	of kInt: a.i == b.i
	547	+ of kChar: a.i == b.i
539	548	of kFloat: a.f == b.f
540	549	of kStr, kKeyword, kSymbol: a.s == b.s
541	550	of kSet:
@@ -574,6 +583,17 @@ proc toStr*(v: Value, readable: bool): string =
574	583	var s = $v.f
575	584	if '.' notin s and 'e' notin s and 'n' notin s and 'i' notin s: s &= ".0"
576	585	s
	586	+ of kChar:
	587	+ if not readable: $Rune(v.i)
	588	+ else:
	589	+ case v.i
	590	+ of 10: "\\newline"
	591	+ of 9: "\\tab"
	592	+ of 13: "\\return"
	593	+ of 8: "\\backspace"
	594	+ of 12: "\\formfeed"
	595	+ of 32: "\\space"
	596	+ else: "\\" & $Rune(v.i)
577	597	of kStr: (if readable: escapeStr(v.s) else: v.s)
578	598	of kKeyword: ":" & v.s
579	599	of kSymbol: v.s
@@ -635,11 +655,16 @@ proc call*(f: Value, args: openArray[Value]): Value =
635	655	# (:k m) => lookup
636	656	if args.len == 0: err("Wrong number of args to keyword")
637	657	let m = args[0]
638		- if m.isNil or m.kind != kMap: return NilV
	658	+ if m.isNil or m.kind notin {kMap, kSet}: return NilV
639	659	mapGet(m.m, f, (if args.len > 1: args[1] else: NilV))
640	660	of kMap:
641	661	if args.len == 0: err("Wrong number of args to map")
642	662	mapGet(f.m, args[0], (if args.len > 1: args[1] else: NilV))
	663	+ of kSet:
	664	+ # (#{...} x) => the element, or nil
	665	+ if args.len == 0: err("Wrong number of args to set")
	666	+ if mapContains(f.m, args[0]): args[0]
	667	+ else: (if args.len > 1: args[1] else: NilV)
643	668	of kVector:
644	669	if args.len != 1 or args[0].kind != kInt: err("Vector lookup needs one int")
645	670	vecNth(f.vec, int(args[0].i))
@@ -664,7 +689,7 @@ proc toSeq*(v: Value): seq[Value] =
664	689	of kList, kVector, kSet, kCons, kChunk, kLazy: v.items
665	690	of kStr:
666	691	var r: seq[Value] = @[]
667		- for c in v.s: r.add mkStr($c)
	692	+ for c in v.s: r.add mkChar(int64(ord(c)))
668	693	r
669	694	of kMap:
670	695	var r: seq[Value] = @[]

  ## collection. Maps and sets additionally remember insertion order — every
  ## entry carries an `ord` stamp and iteration sorts by it — so printing and
  ## `keys`/`vals` stay predictable the way Clojure's small array-maps are.
--import std/[tables, strutils, hashes, bitops, algorithm]
++import std/[tables, strutils, hashes, bitops, algorithm, unicode]
  import runtime_types
  export runtime_types
  proc mkBool*(x: bool): Value = (if x: TrueV else: FalseV)
  proc mkInt*(x: int64): Value {.inline.} = Value(kind: kInt, raw: x)
  proc mkFloat*(x: float64): Value {.inline.} = Value(kind: kFloat, raw: cast[int64](x))
++proc mkChar*(code: int64): Value {.inline.} = Value(kind: kChar, raw: code)
  proc mkStr*(x: string): Value = Value(kind: kStr, obj: Obj(kind: kStr, s: x))
  proc mkKeyword*(x: string): Value = Value(kind: kKeyword, obj: Obj(kind: kKeyword, s: x))
  proc mkSymbol*(x: string): Value = Value(kind: kSymbol, obj: Obj(kind: kSymbol, s: x))
      result = seqRest(result)
      dec k
++proc seqDropOrNil*(v: Value, n: int): Value =
++  ## What `& rest` binds: the remainder, or nil once it is exhausted, as on
++  ## the JVM, where an empty rest is nil rather than an empty seq.
++  result = seqDrop(v, n)
++  if seqIsEmpty(result): result = NilV
++
  proc hashValue*(v: Value): uint32 =
    if v.isNil: return 0
    case v.kind
    of kNil: 0'u32
    of kBool: (if v.b: 0x9e3779b9'u32 else: 0x85ebca6b'u32)
    of kInt: uint32(hash(v.i))
++  of kChar: mixHash(5'u32, uint32(hash(v.i)))
    of kFloat:
      # ints and floats compare equal across kinds, so they must hash alike
      if v.f == float64(int64(v.f)): uint32(hash(int64(v.f)))
    of kNil: true
    of kBool: a.b == b.b
    of kInt: a.i == b.i
++  of kChar: a.i == b.i
    of kFloat: a.f == b.f
    of kStr, kKeyword, kSymbol: a.s == b.s
    of kSet:
      var s = $v.f
      if '.' notin s and 'e' notin s and 'n' notin s and 'i' notin s: s &= ".0"
      s
++  of kChar:
++    if not readable: $Rune(v.i)
++    else:
++      case v.i
++      of 10: "\\newline"
++      of 9: "\\tab"
++      of 13: "\\return"
++      of 8: "\\backspace"
++      of 12: "\\formfeed"
++      of 32: "\\space"
++      else: "\\" & $Rune(v.i)
    of kStr: (if readable: escapeStr(v.s) else: v.s)
    of kKeyword: ":" & v.s
    of kSymbol: v.s
      # (:k m) => lookup
      if args.len == 0: err("Wrong number of args to keyword")
      let m = args[0]
--    if m.isNil or m.kind != kMap: return NilV
++    if m.isNil or m.kind notin {kMap, kSet}: return NilV
      mapGet(m.m, f, (if args.len > 1: args[1] else: NilV))
    of kMap:
      if args.len == 0: err("Wrong number of args to map")
      mapGet(f.m, args[0], (if args.len > 1: args[1] else: NilV))
++  of kSet:
++    # (#{...} x) => the element, or nil
++    if args.len == 0: err("Wrong number of args to set")
++    if mapContains(f.m, args[0]): args[0]
++    else: (if args.len > 1: args[1] else: NilV)
    of kVector:
      if args.len != 1 or args[0].kind != kInt: err("Vector lookup needs one int")
      vecNth(f.vec, int(args[0].i))
    of kList, kVector, kSet, kCons, kChunk, kLazy: v.items
    of kStr:
      var r: seq[Value] = @[]
--    for c in v.s: r.add mkStr($c)
++    for c in v.s: r.add mkChar(int64(ord(c)))
      r
    of kMap:
      var r: seq[Value] = @[]

modified src/runtime_lib.nim +3 -0 Viewed

@@ -15,15 +15,18 @@ proc clonim_set_var(name: string, v: Value): Value = setVar(name, v)
15	15	proc clonim_cell_get(c: VarCell): Value = cellGet(c)
16	16	proc clonim_cell_is(c: VarCell, v: Value): bool = cellIs(c, v)
17	17	proc clonim_get_var(name: string): Value = getVar(name)
	18	+proc clonim_has_var(name: string): bool = hasVar(name)
18	19	proc clonim_call(f: Value, args: openArray[Value]): Value = call(f, args)
19	20	proc clonim_arg_at(args: openArray[Value], i: int): Value = argAt(args, i)
20	21	proc clonim_rest_args(args: openArray[Value], i: int): Value = restArgs(args, i)
21	22	proc clonim_seq_drop(v: Value, n: int): Value = seqDrop(v, n)
	23	+proc clonim_seq_drop_or_nil(v: Value, n: int): Value = seqDropOrNil(v, n)
22	24	proc clonim_to_seq(v: Value): seq[Value] = toSeq(v)
23	25	proc clonim_truthy(v: Value): bool = truthy(v)
24	26
25	27	proc clonim_mk_int(x: int64): Value = mkInt(x)
26	28	proc clonim_mk_float(x: float64): Value = mkFloat(x)
	29	+proc clonim_mk_char(code: int64): Value = mkChar(code)
27	30	proc clonim_mk_str(x: string): Value = mkStr(x)
28	31	proc clonim_mk_keyword(x: string): Value = mkKeyword(x)
29	32	proc clonim_mk_symbol(x: string): Value = mkSymbol(x)

  proc clonim_cell_get(c: VarCell): Value = cellGet(c)
  proc clonim_cell_is(c: VarCell, v: Value): bool = cellIs(c, v)
  proc clonim_get_var(name: string): Value = getVar(name)
++proc clonim_has_var(name: string): bool = hasVar(name)
  proc clonim_call(f: Value, args: openArray[Value]): Value = call(f, args)
  proc clonim_arg_at(args: openArray[Value], i: int): Value = argAt(args, i)
  proc clonim_rest_args(args: openArray[Value], i: int): Value = restArgs(args, i)
  proc clonim_seq_drop(v: Value, n: int): Value = seqDrop(v, n)
++proc clonim_seq_drop_or_nil(v: Value, n: int): Value = seqDropOrNil(v, n)
  proc clonim_to_seq(v: Value): seq[Value] = toSeq(v)
  proc clonim_truthy(v: Value): bool = truthy(v)
  proc clonim_mk_int(x: int64): Value = mkInt(x)
  proc clonim_mk_float(x: float64): Value = mkFloat(x)
++proc clonim_mk_char(code: int64): Value = mkChar(code)
  proc clonim_mk_str(x: string): Value = mkStr(x)
  proc clonim_mk_keyword(x: string): Value = mkKeyword(x)
  proc clonim_mk_symbol(x: string): Value = mkSymbol(x)

modified src/runtime_types.nim +3 -3 Viewed

@@ -4,7 +4,7 @@
4	4
5	5	type
6	6	Kind* = enum
7		- kNil, kBool, kInt, kFloat, kStr, kKeyword, kSymbol,
	7	+ kNil, kBool, kInt, kFloat, kChar, kStr, kKeyword, kSymbol,
8	8	kList, kVector, kMap, kSet, kCons, kChunk, kLazy, kFn
9	9
10	10	VNode* = ref object
@@ -53,7 +53,7 @@ type
53	53	Obj* = ref ValueObj
54	54	ValueObj* = object
55	55	case kind*: Kind
56		- of kNil, kBool, kInt, kFloat: discard
	56	+ of kNil, kBool, kInt, kFloat, kChar: discard
57	57	of kStr, kKeyword, kSymbol: s*: string
58	58	of kList: xs*: seq[Value]
59	59	of kVector: vec*: PVec
@@ -133,7 +133,7 @@ proc `=destroy`*(x: var ValueObj) =
133	133	`=destroy`(x.thunk)
134	134	if not x.cached.isNil: pendingFree.add x.cached
135	135	`=destroy`(x.cached)
136		- of kNil, kBool, kInt, kFloat: discard
	136	+ of kNil, kBool, kInt, kFloat, kChar: discard
137	137	if draining: return
138	138	draining = true
139	139	while pendingFree.len > 0:

  type
    Kind* = enum
--    kNil, kBool, kInt, kFloat, kStr, kKeyword, kSymbol,
++    kNil, kBool, kInt, kFloat, kChar, kStr, kKeyword, kSymbol,
      kList, kVector, kMap, kSet, kCons, kChunk, kLazy, kFn
    VNode* = ref object
    Obj* = ref ValueObj
    ValueObj* = object
      case kind*: Kind
--    of kNil, kBool, kInt, kFloat: discard
++    of kNil, kBool, kInt, kFloat, kChar: discard
      of kStr, kKeyword, kSymbol: s*: string
      of kList: xs*: seq[Value]
      of kVector: vec*: PVec
      `=destroy`(x.thunk)
      if not x.cached.isNil: pendingFree.add x.cached
      `=destroy`(x.cached)
--  of kNil, kBool, kInt, kFloat: discard
++  of kNil, kBool, kInt, kFloat, kChar: discard
    if draining: return
    draining = true
    while pendingFree.len > 0:

added stdlib/clojure/java/io.clj +10 -0 Viewed

new file mode 100644
@@ -0,0 +1,10 @@
	1	+(ns clojure.java.io)
	2	+
	3	+;; Native file operations supplied by Clonim's runtime.
	4	+(defn delete-file
	5	+ ([path] (delete-file path false))
	6	+ ([path silently] (delete-file path silently)))
	7	+
	8	+;; A write handle for `with-open`: (.write o bytes) then (.close o).
	9	+(defn output-stream [path]
	10	+ (output-stream path))

++(ns clojure.java.io)
++
++;; Native file operations supplied by Clonim's runtime.
++(defn delete-file
++  ([path] (*delete-file* path false))
++  ([path silently] (*delete-file* path silently)))
++
++;; A write handle for `with-open`: (.write o bytes) then (.close o).
++(defn output-stream [path]
++  (*output-stream* path))

added stdlib/jolt/mvn_http.clj +5 -0 Viewed

new file mode 100644
@@ -0,0 +1,5 @@
	1	+(ns jolt.mvn-http)
	2	+
	3	+;; Compatibility surface for Jolt's small HTTP helper.
	4	+(defn fetch* [url path]
	5	+ (http-fetch url path))

++(ns jolt.mvn-http)
++
++;; Compatibility surface for Jolt's small HTTP helper.
++(defn fetch* [url path]
++  (*http-fetch* url path))

added tests/binding_forms.expected +15 -0 Viewed

new file mode 100644
@@ -0,0 +1,15 @@
	1	+[1 2 3]
	2	+(:a1 :b2)
	3	+7 12
	4	+[1 2]
	5	+1 2 (3 4) [1 2 3 4]
	6	+nil true
	7	+1 9 {:x 1}
	8	+1 2 3
	9	+nil (1)
	10	+[1 2 3]
	11	+(e3 b0)
	12	+(2 4 6)
	13	+(11 22)
	14	+[7 7]
	15	+3

++[1 2 3]
++(:a1 :b2)
++7 12
++[1 2]
++1 2 (3 4) [1 2 3 4]
++nil true
++1 9 {:x 1}
++1 2 3
++nil (1)
++[1 2 3]
++(e3 b0)
++(2 4 6)
++(11 22)
++[7 7]
++3

added tests/bitops.expected +8 -0 Viewed

new file mode 100644
@@ -0,0 +1,8 @@
	1	+8 14 6
	2	+4 -1 -6
	3	+10 7 7
	4	+1024 128
	5	+-4 15
	6	+true false
	7	+16 30 7
	8	+15

++8 14 6
++4 -1 -6
++10 7 7
++1024 128
++-4 15
++true false
++16 30 7
++15

added tests/cli_args.expected +2 -0 Viewed

new file mode 100644
@@ -0,0 +1,2 @@
	1	+args: 0 []
	2	+same: true

new file mode 100644
@@ -0,0 +1,2 @@
	1	+args: 0 []
	2	+same: true

added tests/hostfns.expected +17 -0 Viewed

new file mode 100644
@@ -0,0 +1,17 @@
	1	+a 65 B xy true
	2	+b true false +
	3	+\a \newline \tab
	4	+true false
	5	+3 -1 -56
	6	+255 -12
	7	+2.5 2.0 3.0
	8	+0a\|:kw\| 42\|ab \|3.14\|FF\|%
	9	+[1 :a 2 :b]
	10	+((1 2) (3 4) (5))
	11	+((1 3) (2 4) (5))
	12	+#{1 2} {:a 1}
	13	+true true true true 2
	14	+9 10
	15	+false true
	16	+boom
	17	+(73 72 68 82) x cba

++a   65 B xy true
++b true false +
++\a \newline \tab
++true false
++3 -1 -56
++255 -12
++2.5 2.0 3.0
++0a|:kw|   42|ab  |3.14|FF|%
++[1 :a 2 :b]
++((1 2) (3 4) (5))
++((1 3) (2 4) (5))
++#{1 2} {:a 1}
++true true true true 2
++9 10
++false true
++boom
++(73 72 68 82) x cba

added tests/macros.expected +15 -0 Viewed

new file mode 100644
@@ -0,0 +1,15 @@
	1	+:zero :one :few :other
	2	+:nl
	3	+1
	4	+No matching clause: 5
	5	+(0 1 4 9)
	6	+([1 :x] [1 :y] [2 :x] [2 :y])
	7	+abc
	8	+Assert failed: nope
	9	+Assert failed: (= 1 2)
	10	+depth 0
	11	+depth 3
	12	+depth 0
	13	+0
	14	+hello 5
	15	+hi

++:zero :one :few :other
++:nl
++1
++No matching clause: 5
++(0 1 4 9)
++([1 :x] [1 :y] [2 :x] [2 :y])
++abc
++Assert failed: nope
++Assert failed: (= 1 2)
++depth 0
++depth 3
++depth 0
++0
++hello 5
++hi

modified tests/test_namespaces.nim +16 -0 Viewed

@@ -22,6 +22,22 @@ proc rejects(src, message: string, roots: seq[string] = @[]) =
22	22	check rejected
23	23
24	24	suite "static namespace resolution":
	25	+ test "regex literals preserve their pattern source":
	26	+ let forms = readAll("#\"(?i)^did:[a-z0-9]+:\"")
	27	+ check forms.len == 1
	28	+ check forms[0].kind == kStr
	29	+ check forms[0].s == "(?i)^did:[a-z0-9]+:"
	30	+
	31	+ test "regex functions operate on literal pattern source":
	32	+ registerCore()
	33	+ let found = call(cellGet(varCell("re-find")),
	34	+ [mkStr("(?i)^did:[a-z0-9]+:"), mkStr("DID:plc:abc")])
	35	+ check equals(found, mkStr("DID:plc:"))
	36	+
	37	+ test "host namespaces resolve without placeholder source files":
	38	+ checkForms("(ns user (:require [clojure.string :as str])) (str/trim \" hi \")",
	39	+ "(clojure.string/trim \" hi \")")
	40	+
25	41	test "definitions resolve sequentially, including core shadowing":
26	42	checkForms("(inc 1) (def inc (fn [x] x)) (inc 2)",
27	43	"(clojure.core/inc 1) (def user/inc (fn [x] x)) (user/inc 2)")

    check rejected
  suite "static namespace resolution":
++  test "regex literals preserve their pattern source":
++    let forms = readAll("#\"(?i)^did:[a-z0-9]+:\"")
++    check forms.len == 1
++    check forms[0].kind == kStr
++    check forms[0].s == "(?i)^did:[a-z0-9]+:"
++
++  test "regex functions operate on literal pattern source":
++    registerCore()
++    let found = call(cellGet(varCell("re-find")),
++      [mkStr("(?i)^did:[a-z0-9]+:"), mkStr("DID:plc:abc")])
++    check equals(found, mkStr("DID:plc:"))
++
++  test "host namespaces resolve without placeholder source files":
++    checkForms("(ns user (:require [clojure.string :as str])) (str/trim \" hi \")",
++      "(clojure.string/trim \" hi \")")
++
    test "definitions resolve sequentially, including core shadowing":
      checkForms("(inc 1) (def inc (fn [x] x)) (inc 2)",
        "(clojure.core/inc 1) (def user/inc (fn [x] x)) (user/inc 2)")

Merge branch 'claude/freeqsay-compile-check-7ab647'