core: Support destructure assign with multiple RHS args

Author: ingydotnet

core/src/yamlscript/constructor.clj

@@ -124,7 +124,7 @@
         [(Vec (->>
                 lets
                 flatten
-                (filter #(not= {:Sym 'def} %1))
+                (remove #(= {:Sym 'def} %1))
                 ;; Handle RHS is mapping
                 (partition 2)
                 (map #(let [[k v] %1]

core/src/yamlscript/transformer.clj

@@ -6,7 +6,7 @@
 
 (ns yamlscript.transformer
   (:require
-   [yamlscript.ast :refer [Lst Sym QSym]]
+   [yamlscript.ast :refer [Lst Sym QSym Vec]]
    [yamlscript.common]
    [yamlscript.transformers]
    [ys.dwim])
@@ -128,23 +128,6 @@
     [lhs rhs]
     [lhs rhs]))
 
-(defn transform-def-ops [lhs rhs]
-  (when (and
-          (vector? lhs)
-          (= 3 (count lhs))
-          (= 'def (:Sym (first lhs))))
-    (let [[a b c] lhs
-          lhs [a b]
-          op (:Sym c)
-          op (Sym (or ({'|| 'or
-                        '||| 'or?
-                        '+ 'add+
-                        '* 'mul+
-                        '/ 'div+
-                        '** 'pow} op) op))
-          rhs (Lst [op b rhs])]
-      [lhs rhs])))
-
 (defn swap-underscores [lhs rhs]
   (if-lets [_ (get-in lhs [0 :Sym])
             _ (some (partial = {:Sym '_}) lhs)
@@ -155,13 +138,13 @@
 
 (defn apply-transformer [key val]
   (let [[key val] (swap-underscores key val)]
-    (or (if-lets [name (or
+    (or
+      (when-lets [name (or
                          (get-in key [:Sym])
                          (get-in key [0 :Sym]))
                   sym (symbol (str "transform_" name))
                   transformer (ns-resolve transformers-ns sym)]
-          (transformer key val)
-          (transform-def-ops key val))
+        (transformer key val))
       [key val])))
 
 (defn transform-xmap [node]

core/src/yamlscript/transformers.clj

@@ -41,9 +41,37 @@
   (transform-with-else lhs rhs (Sym "=>")))
 
 ;;-----------------------------------------------------------------------------
-;; defn and fn
+;; def, defn and fn
 ;;-----------------------------------------------------------------------------
 
+(comment
+  (yamlscript.compiler/compile "
+!ys-0
+defn x():
+  a b =: c d")
+  )
+
+(defn transform_def [lhs rhs]
+  (cond
+    (= 2 (count lhs))
+    (let [rhs (if (and (vector? rhs) (> (count rhs) 1))
+                (Vec rhs)
+                rhs)]
+      [lhs rhs])
+    (= 3 (count lhs))
+    (let [[a b c] lhs
+          lhs [a b]
+          op (:Sym c)
+          op (Sym (or ({'|| 'or
+                        '||| 'or?
+                        '+ 'add+
+                        '* 'mul+
+                        '/ 'div+
+                        '** 'pow} op) op))
+          rhs (Lst [op b rhs])]
+      [lhs rhs])
+    :else [lhs rhs]))
+
 (defn transform_defn [lhs rhs]
   (when-lets [lhs (remove nil? lhs)
               lhs (vec lhs)
@@ -53,11 +81,11 @@
               xmap (:xmap rhs)
               _ (every? :Lst (->> xmap (partition 2) (map first)))
               xmap (reduce
-                      (fn [acc [lhs rhs]]
-                        (let [lhs (Vec (:Lst lhs))]
-                          (conj acc lhs rhs)))
-                      []
-                      (partition 2 xmap))
+                     (fn [acc [lhs rhs]]
+                       (let [lhs (Vec (:Lst lhs))]
+                         (conj acc lhs rhs)))
+                     []
+                     (partition 2 xmap))
               rhs {:xmap xmap}]
     [lhs rhs]))
 

core/src/yamlscript/util.clj

@@ -3,13 +3,19 @@
 
 (ns yamlscript.util)
 
-(declare die)
+(defn die
+  "Throw a string as an exception"
+  ([] (throw (Exception. "Died")))
+  ([msg] (throw (Exception. (str msg "\n"))))
+  ([x & xs] (die (apply str x xs))))
 
-(defmacro condf [x & clauses]
+(defmacro condf
+  "Like condp but with a function"
+  [x & clauses]
   `(condp (fn [f# x#] (f# x#)) ~x ~@clauses))
 
 (defmacro cond-lets
-  "if-lets but works like cond"
+  "Like cond-let but with more than one binding"
   {:style/indent [0]}
   [& clauses]
   (when clauses
@@ -19,20 +25,20 @@
           (die "Odd number of forms"))
        (cond-lets ~@(nnext clauses)))))
 
-(defn die
-  ([] (throw (Exception. "Died")))
-  ([msg] (throw (Exception. (str msg "\n"))))
-  ([x & xs] (die (apply str x xs))))
-
-(defn eprint [& xs]
+(defn eprint
+  "Print to stderr"
+  [& xs]
   (binding [*out* *err*]
     (apply print xs)))
 
-(defn eprintln [& xs]
+(defn eprintln
+  "Print to stderr with a newline"
+  [& xs]
   (binding [*out* *err*]
     (apply println xs)))
 
 (defmacro if-lets
+  "Like if-let but with more than one binding"
   ([bindings then]
    `(if-lets ~bindings ~then nil))
   ([bindings then else]
@@ -42,13 +48,17 @@
         ~else)
      then)))
 
-(defn macro? [x]
+(defn macro?
+  "Check if a symbol is a macro"
+  [x]
   (and
     (symbol? x)
     (when-let [x (resolve x)]
       (:macro (meta x)))))
 
-(defn type-name [x]
+(defn type-name
+  "Get the name of a type"
+  [x]
   (condf x
     map? "Map"
     set? "Set"
@@ -58,6 +68,7 @@
     (type x)))
 
 (defmacro when-lets
+  "Like when-let but with more than one binding"
   ([bindings & body]
    (if (seq bindings)
      `(when-let [~(first bindings) ~(second bindings)]

core/test/compiler.yaml

@@ -742,6 +742,16 @@
       (let [[a b c] [1 2 3] {:d d, :e e} {:d 4, :e 5}] (add+ a b c)))
 
 
+- name: Destructuring let with multiple RHS
+  yamlscript: |
+    !ys-0
+    defn foo():
+      +[a b c] =: 1 2 3
+      =>: a + b + c
+  clojure: |
+    (defn foo [] (let [[a b c] [1 2 3]] (add+ a b c)))
+
+
 - name: Destructuring def
   yamlscript: |
     !ys-0
@@ -750,6 +760,14 @@
     (+def [a b c] [1 2 3])
 
 
+- name: Destructuring def with multiple RHS
+  yamlscript: |
+    !ys-0
+    +[a b c] =: 1 2 3
+  clojure: |
+    (+def [a b c] [1 2 3])
+
+
 - name: Multi-arity defn
   yamlscript: |
     !ys-0