Merge pull request #9 from jolt-lang/selmer-io-destructuring

Destructuring compliance, deps.edn comments, clojure.java.io shim

doc/grammar.ebnf

@@ -162,3 +162,21 @@ feature         = ":clj" | ":cljs" | ":default" | keyword ;
 (* Tagged literal: #tag form. Built-in tags include #inst and #uuid; others
    dispatch to a registered data-reader (else error). *)
 tagged-literal  = "#" , symbol , ws , form ;
+
+(* ── Destructuring (semantics, not reader syntax) ────────────────────────────
+   The reader produces plain vectors and maps; the binding forms (let, fn, loop,
+   doseq, for, defmacro params, …) interpret them as destructuring patterns:
+
+     binding        = symbol | seq-binding | map-binding ;
+     seq-binding    = "[" , { binding } , [ "&" , binding ] , [ ":as" , symbol ] , "]" ;
+     map-binding    = "{" , { binding , form           (* {local key} *)
+                            | ":keys" , "[" {symbol} "]"   (* x or ns/x  *)
+                            | ":strs" , "[" {symbol} "]"
+                            | ":syms" , "[" {symbol} "]"
+                            | ":or"   , map                (* defaults   *)
+                            | ":as"   , symbol } , "}" ;
+
+   A symbol in :keys/:syms may be namespaced (x/y): the namespaced key is looked
+   up but the local is the bare name (y). Destructuring a *sequence* with a
+   map-binding treats it as keyword args (alternating k v, or a trailing map) —
+   this is the fn/macro `[& {:keys [...]}]` form. *)

src/jolt/clojure/java/io.clj

@@ -0,0 +1,46 @@
+; Jolt Standard Library: clojure.java.io
+;
+; A Janet-backed shim: file I/O via Janet's file/ and os/ through the janet.*
+; interop bridge. It deals in plain path strings and Janet file handles, not
+; java.io objects — so JVM-specific interop on the results (.toURL, .lastModified,
+; …) won't work, but file/reader/writer/resource/copy/slurp do.
+
+(defn file
+  "A file path. With a parent and child, joins them with '/'."
+  ([path] (str path))
+  ([parent child] (str parent "/" child)))
+
+(defn as-file [x] (str x))
+
+(defn reader [x] (janet.file/open (str x) :r))
+(defn writer [x] (janet.file/open (str x) :w))
+(defn input-stream [x] (reader x))
+(defn output-stream [x] (writer x))
+
+(defn resource
+  "Returns a slurp-able path for `path` if it exists, else nil. (Clojure returns
+  a URL; a path works the same with slurp here, since there's no classpath.)"
+  [path]
+  (let [p (str path)] (when (janet.os/stat p) p)))
+
+(defn delete-file
+  ([f] (delete-file f false))
+  ([f silently]
+   (try (do (janet.os/rm (str f)) true)
+        (catch Throwable e (if silently false (throw e))))))
+
+(defn make-parents
+  "Create the parent directories of `f`."
+  [f]
+  (let [path (str f)
+        i (clojure.string/last-index-of path "/")]
+    (when (and i (pos? i))
+      (let [parent (subs path 0 i)]
+        (make-parents parent)
+        (when-not (janet.os/stat parent) (janet.os/mkdir parent))))))
+
+(defn copy
+  "Copy from a path/handle `in` to a path/handle `out`."
+  [in out]
+  (let [content (if (string? in) (slurp in) (janet.file/read in :all))]
+    (if (string? out) (spit out content) (janet.file/write out content))))

src/jolt/clojure/java_io.clj

@@ -1,37 +0,0 @@
-; Jolt Standard Library: clojure.java.io
-; File I/O using Janet's built-in file functions.
-
-(defn file
-  ([path] (string path))
-  ([parent child] (string parent "/" child)))
-
-(defn as-file [x] (if (string? x) x (str x)))
-
-(defn as-url [x] (str x))
-
-(defn delete-file [f &opt silently]
-  (try (os/rm f) true
-    ([err] (if silently false (error err)))))
-
-(defn make-parents [f]
-  (let [parent (string/replace f "/[^/]+$" "")]
-    (when (not= parent f)
-      (os/mkdir parent))))
-
-(defn reader [f]
-  (file/open f :r))
-
-(defn writer [f]
-  (file/open f :w))
-
-(defn input-stream [f]
-  (file/open f :r))
-
-(defn output-stream [f]
-  (file/open f :w))
-
-(defn resource [path] (slurp path))
-
-(defn copy [input output]
-  (let [content (if (string? input) (slurp input) (file/read input :all))]
-    (if (string? output) (spit output content) (file/write output content))))

src/jolt/deps.janet

@@ -8,12 +8,15 @@
 # jpm is loaded lazily (require, not import) so it's needed only at resolve time
 # (dev/build), never embedded in the shipped binary.
 
-# A typical deps.edn is also valid Janet data, so we read it with Janet's parser.
+(import ./reader :as reader)
-# (EDN-only forms — #{} sets, tagged literals, namespaced maps — aren't handled;
+
-# deps.edn rarely uses them in :deps/:paths.)
+# Read deps.edn with Jolt's reader (not Janet's parse) so EDN `;` line comments
+# are handled. It returns plain Janet data — structs with keyword keys, tuples —
+# which we walk directly. (#{} sets and tagged literals aren't expected in the
+# :deps/:paths we read.)
 (defn read-edn [path]
   (when (os/stat path)
-    (try (parse (slurp path)) ([_] nil))))
+    (try (reader/parse-string (slurp path)) ([_] nil))))
 
 (defn- jpm-fn [mod sym]
   (get-in (require mod) [sym :value]))

src/jolt/evaluator.janet

@@ -504,30 +504,49 @@
                     (+= di 1) (+= vi 1))))))
       # map pattern (struct/table that isn't a symbol)
       (or (struct? pat) (table? pat))
-        (do
+        (let [rv (d-realize val)
+              # Destructuring a sequential value as a map treats it as kwargs:
+              # alternating k/v pairs, or a single trailing map (Clojure's
+              # `[& {:keys ...}]`). A real map value is used as-is.
+              mval (if (and (indexed? rv) (not (or (struct? rv) (table? rv))))
+                     (if (and (= 1 (length rv))
+                              (let [e (in rv 0)] (or (struct? e) (table? e) (phm? e))))
+                       (in rv 0)
+                       (let [m @{}]
+                         (var i 0)
+                         (while (< (+ i 1) (length rv))
+                           (put m (in rv i) (in rv (+ i 1)))
+                           (+= i 2))
+                         m))
+                     val)]
           (def or-map (get pat :or))
           (def as-sym (get pat :as))
-          (when as-sym (destructure-bind ctx bindings as-sym val))
+          (when as-sym (destructure-bind ctx bindings as-sym mval))
-          # :keys (keyword lookup), :strs (string lookup), :syms (symbol lookup)
+          # :keys (keyword), :strs (string), :syms (symbol). A namespaced symbol
-          (each spec [[:keys (fn [nm] (keyword nm))]
+          # in :keys/:syms (x/y) looks up the namespaced key but binds local y.
-                      [:strs (fn [nm] nm)]
+          (each spec [[:keys :kw] [:strs :str] [:syms :sym]]
-                      [:syms (fn [nm] {:jolt/type :symbol :ns nil :name nm})]]
+            (let [kw (in spec 0) kind (in spec 1) names (get pat kw)]
-            (let [kw (in spec 0) keyf (in spec 1) names (get pat kw)]
               (when (and names (indexed? names))
                 (each s names
-                  (let [nm (if (and (struct? s) (= :symbol (s :jolt/type))) (s :name) (string s))
+                  (let [sym? (and (struct? s) (= :symbol (s :jolt/type)))
-                        v (d-get val (keyf nm))
+                        local (if sym? (s :name) (string s))
+                        nsp (and sym? (s :ns))
+                        key (case kind
+                              :kw (keyword (if nsp (string nsp "/" local) local))
+                              :str local
+                              :sym {:jolt/type :symbol :ns nsp :name local})
+                        v (d-get mval key)
                         v (if (nil? v)
-                            (let [d (find-or-default or-map nm)]
+                            (let [d (find-or-default or-map local)]
                               (if (= d :jolt/none) nil (eval-form ctx bindings d)))
                             v)]
-                    (bind-put bindings nm v))))))
+                    (bind-put bindings local v))))))
           # direct {local-pattern key-expr} entries (local may itself be a
           # nested vector/map pattern). Special keys are keywords; skip them.
           (each k (keys pat)
             (when (not (keyword? k))
               (let [key-val (eval-form ctx bindings (get pat k))
-                    v (d-get val key-val)]
+                    v (d-get mval key-val)]
                 (if (and (struct? k) (= :symbol (k :jolt/type)))
                   # symbol target: apply :or default if missing
                   (let [nm (k :name)
@@ -663,20 +682,22 @@
                      has-doc? (and (> (length rest-form) 0) (string? (first rest-form)))
                      args-form (if has-doc? (in rest-form 1) (first rest-form))
                      body (tuple/slice rest-form (if has-doc? 2 1))
-                     arg-info (parse-arg-names args-form)
+                     param-info (parse-params args-form)
-                     fixed-names (arg-info :fixed)
+                     fixed-pats (param-info :fixed)
-                     rest-name (arg-info :rest)
+                     rest-pat (param-info :rest)
                      defining-ns (ctx-current-ns ctx)]
                  (def macro-fn (fn [& macro-args]
                    (var new-bindings @{})
                    (table/setproto new-bindings bindings)
                    (put new-bindings "&env" @{})  # implicit &env for macro bodies (table — nil-safe)
                    (var i 0)
-                   (each a fixed-names
+                   # Destructure macro params (like fn), so [& [a & more :as all]]
-                     (bind-put new-bindings a (macro-args i))
+                   # and {:keys …} rest forms work in macro arglists.
+                   (each pat fixed-pats
+                     (destructure-bind ctx new-bindings pat (macro-args i))
                      (++ i))
-                   (when rest-name
+                   (when rest-pat
-                     (put new-bindings rest-name (tuple/slice macro-args i)))
+                     (destructure-bind ctx new-bindings rest-pat (tuple/slice macro-args i)))
                    # Use defining namespace for symbol resolution
                    (def saved-ns (ctx-current-ns ctx))
                    (ctx-set-current-ns ctx defining-ns)

test/spec/destructuring-spec.janet

@@ -30,3 +30,24 @@
   ["doseq destructure"  "12"     "(let [s (atom 0)] (doseq [[k v] {:a 4 :b 8}] (swap! s (fn [x] (+ x v)))) @s)"]
   ["for destructure"    "[3 7]"  "(for [[a b] [[1 2] [3 4]]] (+ a b))"]
   ["& rest in fn"       "[2 3]"  "((fn [a & more] more) 1 2 3)"])
+
+(defspec "destructure / associative extras"
+  [":strs"              "7"      "(let [{:strs [a]} {\"a\" 7}] a)"]
+  [":syms"              "8"      "(let [{:syms [a]} {(quote a) 8}] a)"]
+  ["namespaced :keys"   "3"      "(let [{:keys [x/y]} {:x/y 3}] y)"]
+  ["namespaced :syms"   "4"      "(let [{:syms [p/q]} {(quote p/q) 4}] q)"])
+
+(defspec "destructure / keyword args (& {:keys})"
+  ["fn kwargs"          "[1 2]"  "(do (defn f [& {:keys [a b]}] [a b]) (f :a 1 :b 2))"]
+  ["fn kwargs + fixed"  "[0 5]"  "(do (defn g [x & {:keys [a]}] [x a]) (g 0 :a 5))"]
+  ["fn kwargs :or"      "9"      "(do (defn h [& {:keys [a] :or {a 9}}] a) (h))"]
+  ["fn kwargs trailing map" "7"  "(do (defn k [& {:keys [a]}] a) (k {:a 7}))"])
+
+(defspec "destructure / macro params"
+  ["macro & [a & more :as all]"
+   "[1 [2 3] [1 2 3]]"
+   "(do (defmacro m [& [a & more :as all]] (list (quote quote) [a (vec more) (vec all)])) (m 1 2 3))"]
+  ["macro fixed destructure" "[2 1]"
+   "(do (defmacro mm [[a b]] (list (quote quote) [b a])) (mm [1 2]))"]
+  ["macro & {:keys}" "5"
+   "(do (defmacro mk [& {:keys [x]}] (list (quote quote) x)) (mk :x 5))"])