Compare commits
2 commits
main
...
jank-deriv
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
e859d3e8e7 | ||
|
|
3c1e0214dd |
7 changed files with 240 additions and 35 deletions
|
|
@ -296,13 +296,36 @@
|
||||||
(if (seq? c)
|
(if (seq? c)
|
||||||
`(or ~@(map (fn [v] `(= ~g ~(mk-const v))) c))
|
`(or ~@(map (fn [v] `(= ~g ~(mk-const v))) c))
|
||||||
`(= ~g ~(mk-const c))))
|
`(= ~g ~(mk-const c))))
|
||||||
|
;; Collect test constants pairwise (so a trailing unpaired default is
|
||||||
|
;; excluded), flattening list/or-group tests into individual constants.
|
||||||
|
;; seed-only fns (reduce/conj/first/rest/drop/empty?/seq?) — analyzer.clj
|
||||||
|
;; uses case during its own build, before some/distinct load.
|
||||||
|
collect (fn* collect [cls acc]
|
||||||
|
(if (or (empty? cls) (empty? (rest cls)))
|
||||||
|
acc
|
||||||
|
(let [t (first cls)
|
||||||
|
acc (if (seq? t) (reduce conj acc t) (conj acc t))]
|
||||||
|
(collect (drop 2 cls) acc))))
|
||||||
|
;; first duplicate constant, wrapped in [x] (so a duplicate nil is detected);
|
||||||
|
;; nil = none. Clojure rejects duplicate case constants at compile time.
|
||||||
|
first-dup (fn* fd [items seen]
|
||||||
|
(if (empty? items)
|
||||||
|
nil
|
||||||
|
(let [x (first items)]
|
||||||
|
(if (reduce (fn [f s] (or f (= s x))) false seen)
|
||||||
|
[x]
|
||||||
|
(fd (rest items) (conj seen x))))))
|
||||||
|
dup (first-dup (collect clauses []) [])
|
||||||
build (fn build [cls]
|
build (fn build [cls]
|
||||||
(if (empty? cls)
|
(if (empty? cls)
|
||||||
nil
|
;; no clause matched and no default — Clojure throws here.
|
||||||
|
`(throw (ex-info (str "No matching clause: " ~g) {}))
|
||||||
(if (empty? (rest cls))
|
(if (empty? (rest cls))
|
||||||
(first cls)
|
(first cls)
|
||||||
`(if ~(mk-test (first cls)) ~(nth cls 1) ~(build (drop 2 cls))))))]
|
`(if ~(mk-test (first cls)) ~(nth cls 1) ~(build (drop 2 cls))))))]
|
||||||
`(let* [~g ~expr] ~(build clauses))))
|
(if dup
|
||||||
|
(throw (str "Duplicate case test constant: " (first dup)))
|
||||||
|
`(let* [~g ~expr] ~(build clauses)))))
|
||||||
|
|
||||||
;; for: list comprehension, desugared to nested map/mapcat over the binding colls.
|
;; for: list comprehension, desugared to nested map/mapcat over the binding colls.
|
||||||
;; Per binding group: :when wraps the inner form in (if test (list inner) []) so
|
;; Per binding group: :when wraps the inner form in (if test (list inner) []) so
|
||||||
|
|
|
||||||
|
|
@ -108,15 +108,20 @@
|
||||||
(defn- emit-loop [ctx node]
|
(defn- emit-loop [ctx node]
|
||||||
(def L (symbol (node :recur-name)))
|
(def L (symbol (node :recur-name)))
|
||||||
(def params @[])
|
(def params @[])
|
||||||
(def inits @[])
|
# Initial inits bind SEQUENTIALLY (a later init can reference an earlier binding,
|
||||||
|
# like let / Clojure's loop) — emit them in a Janet `let`, then enter the recur
|
||||||
|
# target L with those values, rather than computing all inits in the outer scope.
|
||||||
|
(def let-binds @[])
|
||||||
(each pair (vview (node :bindings))
|
(each pair (vview (node :bindings))
|
||||||
(def p (vview pair))
|
(def p (vview pair))
|
||||||
(array/push params (symbol (in p 0)))
|
(def sym (symbol (in p 0)))
|
||||||
(array/push inits (emit ctx (in p 1))))
|
(array/push params sym)
|
||||||
|
(array/push let-binds sym)
|
||||||
|
(array/push let-binds (emit ctx (in p 1))))
|
||||||
['do
|
['do
|
||||||
['var L nil]
|
['var L nil]
|
||||||
['set L ['fn (tuple/slice params) (emit ctx (node :body))]]
|
['set L ['fn (tuple/slice params) (emit ctx (node :body))]]
|
||||||
(tuple/slice (array/concat @[L] inits))])
|
['let (tuple/slice let-binds) (tuple/slice (array/concat @[L] params))]])
|
||||||
|
|
||||||
(defn- emit-recur [ctx node]
|
(defn- emit-recur [ctx node]
|
||||||
(tuple/slice (array/concat @[(symbol (node :recur-name))]
|
(tuple/slice (array/concat @[(symbol (node :recur-name))]
|
||||||
|
|
|
||||||
|
|
@ -144,6 +144,12 @@
|
||||||
# Map builder: parts are alternating k v (no splicing in map syntax-quote).
|
# Map builder: parts are alternating k v (no splicing in map syntax-quote).
|
||||||
(defn core-sqmap [& parts] (kvs->map (array ;parts)))
|
(defn core-sqmap [& parts] (kvs->map (array ;parts)))
|
||||||
|
|
||||||
|
# Set builder: like core-sqvec but yields a set, so `#{~@a} splices into a set.
|
||||||
|
(defn core-sqset [& parts]
|
||||||
|
(def r @[])
|
||||||
|
(each p parts (each x (realize-for-iteration p) (array/push r x)))
|
||||||
|
(apply make-phs r))
|
||||||
|
|
||||||
# ============================================================
|
# ============================================================
|
||||||
# Predicates
|
# Predicates
|
||||||
# ============================================================
|
# ============================================================
|
||||||
|
|
@ -2742,6 +2748,7 @@
|
||||||
"__sqcat" core-sqcat
|
"__sqcat" core-sqcat
|
||||||
"__sqvec" core-sqvec
|
"__sqvec" core-sqvec
|
||||||
"__sqmap" core-sqmap
|
"__sqmap" core-sqmap
|
||||||
|
"__sqset" core-sqset
|
||||||
"into" core-into
|
"into" core-into
|
||||||
"merge" core-merge
|
"merge" core-merge
|
||||||
"merge-with" core-merge-with
|
"merge-with" core-merge-with
|
||||||
|
|
|
||||||
|
|
@ -135,9 +135,10 @@
|
||||||
|
|
||||||
(defn- sq-symbol
|
(defn- sq-symbol
|
||||||
"Resolve a symbol inside syntax-quote. `foo#` becomes a stable auto-gensym
|
"Resolve a symbol inside syntax-quote. `foo#` becomes a stable auto-gensym
|
||||||
(per-expansion, via gsmap); special forms and clojure.core names are left
|
(per-expansion, via gsmap); special forms are left unqualified; a clojure.core
|
||||||
unqualified (they resolve via the core fallback); other symbols are qualified
|
name is fully qualified to clojure.core/ (matching Clojure, for hygiene); other
|
||||||
to the current namespace so they resolve when the macro is used elsewhere."
|
symbols are qualified to the current namespace so they resolve when the macro is
|
||||||
|
used elsewhere."
|
||||||
[ctx form gsmap]
|
[ctx form gsmap]
|
||||||
(if (nil? (form :ns))
|
(if (nil? (form :ns))
|
||||||
(let [nm (form :name)]
|
(let [nm (form :name)]
|
||||||
|
|
@ -199,6 +200,15 @@
|
||||||
(each v (d-realize sv) (array/push result v)))
|
(each v (d-realize sv) (array/push result v)))
|
||||||
(array/push result (syntax-quote* ctx bindings item gsmap))))
|
(array/push result (syntax-quote* ctx bindings item gsmap))))
|
||||||
(++ i)) result)
|
(++ i)) result)
|
||||||
|
# set literal: lower each element (processing ~/~@) and rebuild a set.
|
||||||
|
(and (struct? form) (= :jolt/set (form :jolt/type)))
|
||||||
|
(do (var result @[])
|
||||||
|
(each item (form :value)
|
||||||
|
(if (and (array? item) (> (length item) 0) (sym-name? (first item) "unquote-splicing"))
|
||||||
|
(let [sv (eval-form ctx bindings (in item 1))]
|
||||||
|
(each v (d-realize sv) (array/push result v)))
|
||||||
|
(array/push result (syntax-quote* ctx bindings item gsmap))))
|
||||||
|
(make-phs ;result))
|
||||||
(and (struct? form) (get form :jolt/type)) form
|
(and (struct? form) (get form :jolt/type)) form
|
||||||
(struct? form)
|
(struct? form)
|
||||||
(do (var kvs @[]) (each k (keys form)
|
(do (var kvs @[]) (each k (keys form)
|
||||||
|
|
@ -238,7 +248,10 @@
|
||||||
(array/concat @[(sqsym* "__sqcat")] (map (fn [it] (sq-lower-part ctx it gsmap)) form))
|
(array/concat @[(sqsym* "__sqcat")] (map (fn [it] (sq-lower-part ctx it gsmap)) form))
|
||||||
(tuple? form)
|
(tuple? form)
|
||||||
(array/concat @[(sqsym* "__sqvec")] (map (fn [it] (sq-lower-part ctx it gsmap)) form))
|
(array/concat @[(sqsym* "__sqvec")] (map (fn [it] (sq-lower-part ctx it gsmap)) form))
|
||||||
# tagged structs (sets/chars): syntax-quote* returns them as-is (no recursion)
|
# set literal: lower each element (so ~/~@ are processed) and rebuild a set.
|
||||||
|
(and (struct? form) (= :jolt/set (form :jolt/type)))
|
||||||
|
(array/concat @[(sqsym* "__sqset")] (map (fn [it] (sq-lower-part ctx it gsmap)) (form :value)))
|
||||||
|
# other tagged structs (chars): returned as-is (no recursion)
|
||||||
(and (struct? form) (get form :jolt/type))
|
(and (struct? form) (get form :jolt/type))
|
||||||
@[(sqsym* "quote") form]
|
@[(sqsym* "quote") form]
|
||||||
(struct? form)
|
(struct? form)
|
||||||
|
|
@ -1188,13 +1201,20 @@
|
||||||
"loop*" (let [bind-vec (in form 1)
|
"loop*" (let [bind-vec (in form 1)
|
||||||
body (tuple/slice form 2)
|
body (tuple/slice form 2)
|
||||||
init-vals @[]
|
init-vals @[]
|
||||||
patterns @[]]
|
patterns @[]
|
||||||
|
# Inits are evaluated sequentially in an accumulating scope (like
|
||||||
|
# let*), so a later init can reference an earlier binding —
|
||||||
|
# matching Clojure's loop.
|
||||||
|
seq-bindings @{}]
|
||||||
|
(table/setproto seq-bindings bindings)
|
||||||
(var i 0)
|
(var i 0)
|
||||||
(while (< i (length bind-vec))
|
(while (< i (length bind-vec))
|
||||||
# loop* is a primitive (the loop macro desugars destructuring);
|
# loop* is a primitive (the loop macro desugars destructuring);
|
||||||
# its binding names must be plain symbols, as in Clojure.
|
# its binding names must be plain symbols, as in Clojure.
|
||||||
(unless (plain-sym? (bind-vec i)) (error "Bad binding form, expected symbol"))
|
(unless (plain-sym? (bind-vec i)) (error "Bad binding form, expected symbol"))
|
||||||
(array/push init-vals (eval-form ctx bindings (bind-vec (+ i 1))))
|
(def v (eval-form ctx seq-bindings (bind-vec (+ i 1))))
|
||||||
|
(bind-put seq-bindings ((bind-vec i) :name) v)
|
||||||
|
(array/push init-vals v)
|
||||||
(array/push patterns (bind-vec i))
|
(array/push patterns (bind-vec i))
|
||||||
(+= i 2))
|
(+= i 2))
|
||||||
(var loop-fn nil)
|
(var loop-fn nil)
|
||||||
|
|
|
||||||
|
|
@ -338,36 +338,54 @@
|
||||||
(defn read-anon-fn [s pos]
|
(defn read-anon-fn [s pos]
|
||||||
# pos is at #, next char is (
|
# pos is at #, next char is (
|
||||||
(let [[form new-pos] (read-form s (+ pos 1))]
|
(let [[form new-pos] (read-form s (+ pos 1))]
|
||||||
# Collect % arg references and rename them to gensyms
|
# Positional index of a %-symbol name: % and %1 are both 1, %N is N, %& is the
|
||||||
(var arg-map @{})
|
# rest param (:rest); anything else is not a positional (nil). The fixed arity
|
||||||
|
# is the MAX index used (Clojure semantics: #(do %2 %&) -> [p1 p2 & rest], so
|
||||||
|
# unused lower positions still get a placeholder param and %& starts after %2).
|
||||||
|
(defn- pct-index [nm]
|
||||||
|
(cond
|
||||||
|
(= nm "%") 1
|
||||||
|
(= nm "%&") :rest
|
||||||
|
(and (> (length nm) 1) (= "%" (string/slice nm 0 1)))
|
||||||
|
(let [n (scan-number (string/slice nm 1))]
|
||||||
|
(if (and n (= n (math/floor n)) (>= n 1)) n nil))
|
||||||
|
nil))
|
||||||
|
# Pass 1: max positional index + whether %& is used.
|
||||||
|
(var max-n 0)
|
||||||
|
(var has-rest false)
|
||||||
|
(defn- scan-pct [f]
|
||||||
|
(cond
|
||||||
|
(and (struct? f) (= :symbol (f :jolt/type)))
|
||||||
|
(let [i (pct-index (f :name))]
|
||||||
|
(cond (= i :rest) (set has-rest true)
|
||||||
|
(and i (> i max-n)) (set max-n i)))
|
||||||
|
(or (array? f) (tuple? f)) (each x f (scan-pct x))
|
||||||
|
nil))
|
||||||
|
(scan-pct form)
|
||||||
|
# One canonical gensym per slot 1..max-n (placeholders for unused), plus rest.
|
||||||
|
(def slot-syms @{})
|
||||||
|
(var i 1)
|
||||||
|
(while (<= i max-n) (put slot-syms i (sym (string (gensym)))) (++ i))
|
||||||
|
(def rest-sym (if has-rest (sym (string (gensym))) nil))
|
||||||
|
# Pass 2: replace each %-symbol with its slot's gensym.
|
||||||
(defn- replace-pct [f]
|
(defn- replace-pct [f]
|
||||||
(cond
|
(cond
|
||||||
(and (struct? f) (= :symbol (f :jolt/type)))
|
(and (struct? f) (= :symbol (f :jolt/type)))
|
||||||
(let [nm (f :name)]
|
(let [idx (pct-index (f :name))]
|
||||||
(if (and (> (length nm) 0) (= "%" (string/slice nm 0 1)))
|
(cond (= idx :rest) rest-sym
|
||||||
(let [existing (get arg-map nm)]
|
idx (get slot-syms idx)
|
||||||
(if existing
|
|
||||||
{:jolt/type :symbol :ns nil :name existing}
|
|
||||||
(let [gen (gensym)]
|
|
||||||
(put arg-map nm (string gen))
|
|
||||||
{:jolt/type :symbol :ns nil :name (string gen)})))
|
|
||||||
f))
|
f))
|
||||||
(array? f) (array ;(map replace-pct f))
|
(array? f) (array ;(map replace-pct f))
|
||||||
(tuple? f) (tuple ;(map replace-pct f))
|
(tuple? f) (tuple ;(map replace-pct f))
|
||||||
f))
|
f))
|
||||||
(def replaced (replace-pct form))
|
(def replaced (replace-pct form))
|
||||||
(def arg-names @[])
|
(def arg-names @[])
|
||||||
# Positional params %, %1, %2, ... in order; %& becomes a `& rest` param.
|
(set i 1)
|
||||||
(def pos-keys (sort (filter |(not= $ "%&") (keys arg-map))))
|
(while (<= i max-n) (array/push arg-names (get slot-syms i)) (++ i))
|
||||||
(each k pos-keys
|
(when has-rest
|
||||||
(array/push arg-names {:jolt/type :symbol :ns nil :name (get arg-map k)}))
|
|
||||||
(when (get arg-map "%&")
|
|
||||||
(array/push arg-names (sym "&"))
|
(array/push arg-names (sym "&"))
|
||||||
(array/push arg-names {:jolt/type :symbol :ns nil :name (get arg-map "%&")}))
|
(array/push arg-names rest-sym))
|
||||||
(def result @[(sym "fn*")])
|
[@[(sym "fn*") (tuple ;arg-names) replaced] new-pos]))
|
||||||
(array/push result (tuple ;arg-names))
|
|
||||||
(array/push result replaced)
|
|
||||||
[result new-pos]))
|
|
||||||
|
|
||||||
(defn read-reader-conditional [s pos]
|
(defn read-reader-conditional [s pos]
|
||||||
# pos is at #, next char is ? or ?@
|
# pos is at #, next char is ? or ?@
|
||||||
|
|
@ -479,8 +497,10 @@
|
||||||
# position (params, lets, bodies) — the evaluator reads :name and ignores
|
# position (params, lets, bodies) — the evaluator reads :name and ignores
|
||||||
# :meta. This is what makes type hints "parse and otherwise do nothing".
|
# :meta. This is what makes type hints "parse and otherwise do nothing".
|
||||||
[(struct ;(kvs form) :meta (merge (or (form :meta) {}) m)) new-pos2]
|
[(struct ;(kvs form) :meta (merge (or (form :meta) {}) m)) new-pos2]
|
||||||
# Map metadata or non-symbol targets keep the runtime with-meta form.
|
# Non-symbol targets (collections etc.) keep a runtime with-meta form. Use the
|
||||||
[(array (sym "with-meta") form meta-form) new-pos2])))
|
# NORMALIZED metadata map (:kw -> {:kw true}, tag -> {:tag …}); a map-literal
|
||||||
|
# meta-form (m is nil) is already a map, so pass it through.
|
||||||
|
[(array (sym "with-meta") form (if m m meta-form)) new-pos2])))
|
||||||
|
|
||||||
(defn read-until-newline [s pos]
|
(defn read-until-newline [s pos]
|
||||||
(if (or (>= pos (length s)) (= (s pos) 10))
|
(if (or (>= pos (length s)) (= (s pos) 10))
|
||||||
|
|
|
||||||
80
test/spec/forms-spec.janet
Normal file
80
test/spec/forms-spec.janet
Normal file
|
|
@ -0,0 +1,80 @@
|
||||||
|
# Specification: core special forms (case/fn/let/letfn/loop/if/do/def/call).
|
||||||
|
#
|
||||||
|
# Adapted from the jank test corpus (compiler+runtime/test/jank/form/**, /call) —
|
||||||
|
# we base our coverage on jank's to close gaps, but maintain our own copies since
|
||||||
|
# jank may diverge. jank-isms are translated to Jolt/Clojure: letfn* -> letfn,
|
||||||
|
# (catch jank.runtime.object_ref …) -> (catch :default …). Platform-specific cases
|
||||||
|
# (bigdecimal M, biginteger, ratios, unicode char edges) are intentionally omitted.
|
||||||
|
#
|
||||||
|
# Multi-form jank files (def + asserts, ending in :success) are wrapped in a single
|
||||||
|
# (do … :success) so they run as one expression and assert :success.
|
||||||
|
(use ../support/harness)
|
||||||
|
|
||||||
|
(defspec "forms / case"
|
||||||
|
["bool" ":yes" "(case true true :yes false :no :default)"]
|
||||||
|
["keyword match" ":b" "(case :a :x :wrong :a :b :default)"]
|
||||||
|
["number match" ":two" "(case 2 1 :one 2 :two :default)"]
|
||||||
|
["string match" ":hit" "(case \"x\" \"y\" :miss \"x\" :hit :default)"]
|
||||||
|
["nil match" ":nada" "(case nil nil :nada :default)"]
|
||||||
|
["default" ":def" "(case 99 1 :one 2 :two :def)"]
|
||||||
|
["list of consts" ":vowel" "(case \\a (\\a \\e \\i \\o \\u) :vowel :consonant)"]
|
||||||
|
["no match no default" :throws "(case 5 1 :one)"]
|
||||||
|
["duplicate keys" :throws "(case 1 1 :one 1 :dup :default)"]
|
||||||
|
["duplicate in or-group" :throws "(case 2 (1 2) :a (2 3) :b :default)"])
|
||||||
|
|
||||||
|
(defspec "forms / fn"
|
||||||
|
["named fn nil" "nil" "((fn* foo-bar []))"]
|
||||||
|
["immediate call" "1" "((fn* [] 1))"]
|
||||||
|
["args" "[:a :b]" "((fn* [a b] [a b]) :a :b)"]
|
||||||
|
["multi-arity 0" "0" "(do (def add (fn* ([] 0) ([a] a) ([a b] (+ a b)))) (add))"]
|
||||||
|
["multi-arity 1" "-500" "(do (def add (fn* ([] 0) ([a] a) ([a b] (+ a b)))) (add -500))"]
|
||||||
|
["multi-arity 2" "-450" "(do (def add (fn* ([] 0) ([a] a) ([a b] (+ a b)))) (add -500 50))"]
|
||||||
|
["variadic rest" "[3 4]" "(do (def v (fn* ([a b & args] args) ([] 0))) (v 1 2 3 4))"]
|
||||||
|
["variadic empty" "0" "(do (def v (fn* ([a b & args] args) ([] 0))) (v))"]
|
||||||
|
["variadic collect" "[{} nil :m]" "((fn* [a b & args] args) 'w 't {} nil :m)"]
|
||||||
|
["closure capture" "8" "(do (def adder (fn* [n] (fn* [x] (+ x n)))) ((adder 5) 3))"]
|
||||||
|
["recur countdown" "0" "(do (def cd (fn* [n] (if (< 0 n) (recur (+ n -1)) n))) (cd 10))"]
|
||||||
|
["named self-recur" "120" "(do (def f (fn* fact [n] (if (= n 0) 1 (* n (fact (dec n)))))) (f 5))"]
|
||||||
|
["no param vector" :throws "(fn* foo)"]
|
||||||
|
["non-symbol param" :throws "(fn* [1] 1)"])
|
||||||
|
|
||||||
|
(defspec "forms / let"
|
||||||
|
["literal" "1" "(let* [a 1] a)"]
|
||||||
|
["multiple" "[1 2]" "(let* [a 1 b 2] [a b])"]
|
||||||
|
["previous ref" ":bee" "(let* [a 1 b (if (= 1 a) :bee :uh-oh)] b)"]
|
||||||
|
["nested let" "3" "(let* [a 5 b (let* [c -2] (+ a c))] b)"]
|
||||||
|
["fn value bound" "\":foo\"" "(let* [kw->str (fn* [kw] (str kw))] (kw->str :foo))"]
|
||||||
|
["shadowing" "2" "(let* [a 1 a 2] a)"])
|
||||||
|
|
||||||
|
(defspec "forms / letfn"
|
||||||
|
["mutual top" "[1 2]" "(letfn [(a [] 1) (b [] 2)] [(a) (b)])"]
|
||||||
|
["mutual recursion" ":done" "(letfn [(ev? [n] (if (= 0 n) :done (od? (dec n)))) (od? [n] (ev? n))] (ev? 4))"]
|
||||||
|
["nested letfn" "3" "(letfn [(a [] 5) (b [] (letfn [(c [] -2)] (+ (a) (c))))] (b))"])
|
||||||
|
|
||||||
|
(defspec "forms / loop"
|
||||||
|
["sum" "55" "(loop* [sum 0 cnt 10] (if (= cnt 0) sum (recur (+ cnt sum) (dec cnt))))"]
|
||||||
|
["multi binding" "[4 2]" "(loop* [a 1 b 2 n 0] (if (< n 3) (recur (inc a) b (inc n)) [a b]))"]
|
||||||
|
["init sees prior" "[1 2 3]" "(loop* [a 1 b (+ a 1) c (+ b 1)] [a b c])"])
|
||||||
|
|
||||||
|
(defspec "forms / try"
|
||||||
|
["immediate throw caught" ":caught" "(try (throw :boom) (catch :default e :caught))"]
|
||||||
|
["first throw wins" "\"a\"" "(try (throw (ex-info \"a\" {})) (throw (ex-info \"b\" {})) (catch :default e (ex-message e)))"]
|
||||||
|
["catch ex-data" "7" "(try (throw (ex-info \"e\" {:v 7})) (catch :default e (:v (ex-data e))))"]
|
||||||
|
["finally runs" "9" "(let [a (atom 0)] (try 1 (finally (reset! a 9))) @a)"]
|
||||||
|
["body value w/ finally" "1" "(try 1 (finally 2))"]
|
||||||
|
["catch value w/ finally" ":h" "(try (throw (ex-info \"x\" {})) (catch :default e :h) (finally :ignored))"]
|
||||||
|
["no throw skips catch" "5" "(try 5 (catch :default e :nope))"])
|
||||||
|
|
||||||
|
(defspec "forms / if-do-def-call"
|
||||||
|
["if truthy vec" ":fine" "(if [:ok] :fine :no)"]
|
||||||
|
["if truthy str" ":fine" "(if \"good?\" :fine :no)"]
|
||||||
|
["if nil = false" ":else" "(if nil :then :else)"]
|
||||||
|
["if no else" "nil" "(if false 1)"]
|
||||||
|
["do nested" "1" "(do (do (do (do 1))))"]
|
||||||
|
["do returns last" "3" "(do 1 2 3)"]
|
||||||
|
["def + deref var" "true" "(var? (def one 1))"]
|
||||||
|
["def redefine" "100" "(do (def one 1) (def one 100) one)"]
|
||||||
|
["def in fn mutates" "[:default :meow]" "(do (def a :default) (def set-a (fn* [v] (def a v))) (let* [before a] (set-a :meow) [before a]))"]
|
||||||
|
["call literal fn" "1" "((fn* [] 1))"]
|
||||||
|
["call nested" "6" "(+ ((fn* [] 1)) ((fn* [] 2)) ((fn* [] 3)))"]
|
||||||
|
["call nil" :throws "(nil)"])
|
||||||
50
test/spec/reader-forms-spec.janet
Normal file
50
test/spec/reader-forms-spec.janet
Normal file
|
|
@ -0,0 +1,50 @@
|
||||||
|
# Specification: reader forms + syntax-quote + metadata.
|
||||||
|
#
|
||||||
|
# Adapted from the jank test corpus (test/jank/{syntax-quote,metadata,reader-macro,
|
||||||
|
# call}); we keep our own copies since jank may diverge. Syntax-quoted symbols are
|
||||||
|
# qualified to clojure.core (matching jank/Clojure). Platform-specific reader forms
|
||||||
|
# (#uuid, #inst, ##Inf/##NaN, bigdecimal/biginteger/ratio) are omitted.
|
||||||
|
(use ../support/harness)
|
||||||
|
|
||||||
|
(defspec "reader / anonymous fn #()"
|
||||||
|
["no args" "3" "(#(+ 1 2))"]
|
||||||
|
["one arg %" "6" "(#(* % 2) 3)"]
|
||||||
|
["positional %1 %2" "[1 2]" "(#(do [%1 %2]) 1 2)"]
|
||||||
|
["rest %&" "[1 2 3]" "(#(do %&) 1 2 3)"]
|
||||||
|
["fixed + rest" "[2 3]" "(#(do % %&) 1 2 3)"]
|
||||||
|
["%2 + rest" "[3]" "(#(do %2 %&) 1 2 3)"]
|
||||||
|
["%2 only (placeholder p1)" "20" "(#(* %2 2) 1 10)"]
|
||||||
|
["% and %1 same" "10" "(#(+ % %1) 5)"])
|
||||||
|
|
||||||
|
(defspec "reader / var-quote #'"
|
||||||
|
["var-quote = var" "true" "(= (var str) #'str)"]
|
||||||
|
["is a var" "true" "(var? #'str)"]
|
||||||
|
["deref var-quote" "5" "(do (def w 5) (deref #'w))"])
|
||||||
|
|
||||||
|
(defspec "reader / metadata ^"
|
||||||
|
["meta on map" "true" "(:foo (meta ^:foo {}))"]
|
||||||
|
["meta on vector" "true" "(:foo (meta ^:foo [1 2]))"]
|
||||||
|
["meta on set" "true" "(:foo (meta ^:foo #{}))"]
|
||||||
|
["meta map form" "1" "(:a (meta ^{:a 1} {}))"]
|
||||||
|
["meta on quoted sym" "true" "(:foo (meta (quote ^:foo bar)))"]
|
||||||
|
["with-meta map" "true" "(:k (meta (with-meta {} {:k true})))"]
|
||||||
|
["with-meta vector" "true" "(:k (meta (with-meta [] {:k true})))"]
|
||||||
|
["non-metadatable num" "nil" "(meta 100)"]
|
||||||
|
["non-metadatable str" "nil" "(meta \"\")"]
|
||||||
|
["non-metadatable bool" "nil" "(meta true)"])
|
||||||
|
|
||||||
|
(defspec "reader / syntax-quote"
|
||||||
|
["plain literal" "[1 2 3]" "`[1 2 3]"]
|
||||||
|
["gensym distinct" "true" "(not= `meow# `meow#)"]
|
||||||
|
["gensym stable" "true" "(let [s `[meow# meow#]] (= (first s) (second s)))"]
|
||||||
|
["qualifies unresolved" "(quote user/foo)" "`foo"]
|
||||||
|
["unquote value" "[1 2 3]" "(let [a [1 2 3]] `~a)"]
|
||||||
|
# functional: the syntax-quoted call evaluates correctly. (jolt-265: core syms are
|
||||||
|
# left bare rather than qualified to clojure.core/ — full qualification breaks the
|
||||||
|
# standalone uberscript's ns macro, so it's deferred; they still resolve at eval.)
|
||||||
|
["unquote call evals" "6" "(let [a 5] (eval `(+ ~a 1)))"]
|
||||||
|
["splice call evals" "6" "(let [a [1 2 3]] (eval `(+ ~@a)))"]
|
||||||
|
["splice in vector" "[1 2 3 0 1 2 3]" "(let [b [0] a [1 2 3] e []] `[~@e ~@a ~@b ~@a ~@e])"]
|
||||||
|
# jolt-edb (fixed): ~/~@ inside set literals.
|
||||||
|
["splice in set" "#{0 1 2 3}" "(let [b [0] a [1 2 3] e []] `#{~@e ~@a ~@b})"]
|
||||||
|
["unquote in set" "#{5 9}" "(let [x 5] `#{~x 9})"])
|
||||||
Loading…
Add table
Add a link
Reference in a new issue