Updates for recent Hy changes

.travis.yml

@@ -1,9 +1,9 @@
 language: python
 python:
-  - "2.7"
-  - "3.3"
   - "3.4"
-  - "pypy"
-install: pip install -r requirements.txt --allow-all-external
+  - "3.5"
+  - "3.6"
+  - "pypy3.5"
+install: pip install -r requirements.txt
 script:
-  - nosetests
+  - nosetests tests

README.md

@@ -27,17 +27,11 @@ $ pip install -r requirements.txt
 Usage
 -----
 
-The library can be used either via the `bin/hydiomatic.hy` script:
-
+The library can be used either via the `hydiomatic` script:
 ```shell
-$ bin/hydiomatic.hy -d FILENAME
+$ hydiomatic -d FILENAME
 ```
-
-For more information on what the script can do, run `bin/hydiomatic.hy
---help`.
-
-Or programmatically:
-
+or programmatically:
 ```clojure
 (import [hydiomatic.core [*]])
 
@@ -47,6 +41,17 @@ Or programmatically:
 ;     (print (+ 1 2 3) [a b {"c" (inc a)}]))
 ```
 
+For more information on what the script can do, run `hydiomatic --help`.
+
+Example
+--------
+
+Here's an example of Hydiomatic updating itself from an older Hy syntax:
+```shell
+$ git show 5d3c958:bin/hydiomatic.hy > old_hydiomatic.hy
+$ hydiomatic -d old_hydiomatic.hy
+```
+
 License
 -------
 

hydiomatic/__init__.py

@@ -0,0 +1 @@
+import hy

hydiomatic/core.hy

@@ -14,11 +14,27 @@
 ;; You should have received a copy of the GNU Lesser General Public
 ;; License along with this program. If not, see <http://www.gnu.org/licenses/>.
 
-(import [adderall.dsl [*]]
-        [hydiomatic.rules [*]]
-        [hy.contrib.walk [prewalk]])
-(require adderall.dsl)
-(require hy.contrib.anaphoric)
+(import hy.contrib.walk
+        [adderall.dsl [*]]
+        [adderall.internal [ConsPair car cdr]])
+(import [hydiomatic.rules [*]])
+
+(require [hy.contrib.walk [let]])
+(require [hy.extra.anaphoric [*]])
+(require [adderall.dsl [*]])
+
+
+;; Patch the original `walk` so that it handles cons pairs.
+(setv orig-walk hy.contrib.walk.walk)
+(defn cons-walk [inner outer form]
+  "A cons-aware version of `walk`"
+  (if (instance? ConsPair form)
+      (outer (ConsPair (inner (car form))
+                       (inner (cdr form))))
+      (orig-walk inner outer form)))
+(setv hy.contrib.walk.walk cons-walk)
+
+(import [hy.contrib.walk [prewalk]])
 
 (defn simplify-step-by-rule [rule expr]
   (let [alts (run* [q] (rule expr q))]
@@ -48,10 +64,10 @@
   (cleanup-step (simplify-step* expr rules)))
 
 (defn simplify* [expr &optional [rules rules/default]]
-  (setv new-expr (prewalk (xi simplify-step* x1 rules) expr))
+  (setv new-expr (prewalk #%(simplify-step* %1 rules) expr))
   (unless (= new-expr expr)
-    (while true
-      (setv res (prewalk (xi simplify-step* x1 rules) new-expr))
+    (while True
+      (setv res (prewalk #%(simplify-step* %1 rules) new-expr))
       (when (= res new-expr)
         (break))
       (setv new-expr res)))
@@ -62,11 +78,11 @@
 
 (defn simplifications [expr &optional [rules rules/default]]
   (setv stages [expr])
-  (setv new-expr (prewalk (xi simplify-step* x1 rules) expr))
+  (setv new-expr (prewalk #%(simplify-step* %1 rules) expr))
   (unless (= new-expr expr)
     (.append stages (cleanup-step new-expr))
-    (while true
-      (setv res (prewalk (xi simplify-step* x1 rules) new-expr))
+    (while True
+      (setv res (prewalk #%(simplify-step* %1 rules) new-expr))
       (when (= res new-expr)
         (break))
       (setv new-expr res)

hydiomatic/macros.hy

@@ -15,18 +15,23 @@
 ;; License along with this program. If not, see <http://www.gnu.org/licenses/>.
 
 (import [adderall.dsl [*]])
-(require adderall.dsl)
+
+(require [adderall.dsl [*]])
+(require [hy.contrib.walk [let]])
+
 
 (eval-and-compile
  (defn rule [rule]
    (if (instance? HyExpression rule)
      `[~rule]
-     (let [[pat subst] rule]
-       `[(prep
-          (≡ expr ~pat)
-          (≡ out ~subst))]))))
+     (let [pat (first rule)
+           subst (second rule)]
+         `[(prep (≡ expr ~pat)
+                 (≡ out ~subst))]))))
 
 (defmacro defrules [aliases &rest rules]
-  `(defn-alias [~@aliases] [expr out]
-     (condᵉ
-      ~@(map rule rules))))
+  `(do
+     (require [adderall.internal [defn-alias]])
+     (defn-alias [~@aliases] [expr out]
+         (condᵉ
+           ~@(map rule rules)))))

hydiomatic/rules.hy

@@ -14,6 +14,7 @@
 ;; You should have received a copy of the GNU Lesser General Public
 ;; License along with this program. If not, see <http://www.gnu.org/licenses/>.
 
+(import [adderall.dsl [*]])
 (import [hydiomatic.rulesets.arithmetico [*]]
         [hydiomatic.rulesets.quoteo [*]]
         [hydiomatic.rulesets.control-structo [*]]
@@ -23,29 +24,30 @@
         [hydiomatic.rulesets.optimo [*]]
         [hydiomatic.rulesets.warningso [*]]
         [hydiomatic.rulesets.grand-cleanupo [*]]
-        [hydiomatic.rulesets.jokeo [*]]
-        [adderall.dsl [*]])
-(require adderall.dsl)
-(require hydiomatic.macros)
+        [hydiomatic.rulesets.jokeo [*]])
 
-(def rules/default
+(require [adderall.dsl [*]])
+(require [hydiomatic.macros [*]])
+
+
+(setv rules/default
   [rules/arithmeticᵒ
    rules/quoteᵒ
    rules/equalityᵒ
    rules/control-structᵒ
    rules/collectionᵒ
    rules/syntaxᵒ])
 
-(def rules/experimental
+(setv rules/experimental
   (+ rules/default
      [rules/optimᵒ]))
 
-(def rules/grand-cleanup
+(setv rules/grand-cleanup
   (+ rules/default
      [rules/grand-cleanupᵒ]))
 
-(def rules/warnings
+(setv rules/warnings
   [rules/warningsᵒ])
 
-(def rules/jokes
+(setv rules/jokes
   [rules/joke/canadaᵒ])

hydiomatic/rulesets/arithmetico.hy

@@ -14,9 +14,12 @@
 ;; You should have received a copy of the GNU Lesser General Public
 ;; License along with this program. If not, see <http://www.gnu.org/licenses/>.
 
+(import hy)
 (import [adderall.dsl [*]])
-(require adderall.dsl)
-(require hydiomatic.macros)
+
+(require [adderall.dsl [*]])
+(require [hydiomatic.macros [*]])
+
 
 (defrules [rules/arithmeticᵒ rules/arithmetico]
   ;; (+ 0 x), (+ x 0) => x
@@ -28,10 +31,10 @@
   [`(* ~?x 1) ?x]
 
   ;; (+ x (+ ...)) => (+ x ...)
-  [`(+ ~?x (+ . ~?xs)) `(+ ~?x . ~?xs)]
+  [`(+ ~?x ~(cons '+ ?xs)) (cons '+ ?x ?xs)]
 
   ;; (* x (* ...)) => (* x ...)
-  [`(* ~?x (* . ~?xs)) `(* ~?x . ~?xs)]
+  [`(* ~?x ~(cons '* ?xs)) (cons '* ?x ?xs)]
 
   ;; (+ x 1), (+ 1 x) => (inc x)
   [`(+ ~?x 1) `(inc ~?x)]

hydiomatic/rulesets/collectiono.hy

@@ -15,8 +15,9 @@
 ;; License along with this program. If not, see <http://www.gnu.org/licenses/>.
 
 (import [adderall.dsl [*]])
-(require adderall.dsl)
-(require hydiomatic.macros)
+
+(require [adderall.dsl [*]])
+(require [hydiomatic.macros [*]])
 
 (defrules [rules/collectionᵒ rules/collectiono]
   ;; (get x 0) => (first x)

hydiomatic/rulesets/control_structo.hy

@@ -14,66 +14,68 @@
 ;; You should have received a copy of the GNU Lesser General Public
 ;; License along with this program. If not, see <http://www.gnu.org/licenses/>.
 
-(import [adderall.dsl [*]]
-        [adderall.extra.misc [*]]
-        [hy [HyString]])
-(require adderall.dsl)
-(require hydiomatic.macros)
+(import [hy [HyString]]
+        [adderall.dsl [*]]
+        [adderall.extra.misc [*]])
+
+(require [adderall.dsl [*]])
+(require [hydiomatic.macros [*]])
+
 
 (defrules [rules/control-structᵒ rules/control-structo]
-  ;; (if test y nil) => (when test y)
-  [`(if ~?test ~?yes-branch nil)
+  ;; (if test y None) => (when test y)
+  [`(if ~?test ~?yes-branch None)
    `(when ~?test ~?yes-branch)]
 
-  ;; (if test nil n) => (unless test n)
-  [`(if ~?test nil ~?no-branch)
+  ;; (if test None n) => (unless test n)
+  [`(if ~?test None ~?no-branch)
    `(unless ~?test ~?no-branch)]
 
   ;; (if (not test) a b) => (if-not test a b)
-  [`(if (not ~?test) . ~?branches)
-   `(if-not ~?test . ~?branches)]
+  [(cons `if `(not ~?test) ?branches)
+   (cons `if-not ?test ?branches)]
 
   ;; (if test (do y)) => (when test y)
-  [`(if ~?test (do . ~?y))
-   `(when ~?test . ~?y)]
+  [`(if ~?test ~(cons `do ?y))
+   (cons `when ?test ?y)]
 
   ;; (when (not test) stuff) => (unless test stuff)
-  [`(when (not ~?test) . ~?body)
-   `(unless ~?test . ~?body)]
+  [(cons `when `(not ~?test) ?body)
+   (cons `unless ?test ?body)]
 
   ;; (do x) => x
   [`(do ~?body) ?body]
 
   ;; (when test (do x)) => (when test x)
-  [`(when ~?test (do . ~?body))
-   `(when ~?test . ~?body)]
+  [`(when ~?test ~(cons `do ?body))
+   (cons `when ?test ?body)]
 
   ;; (unless test (do x)) => (unless test x)
-  [`(unless ~?test (do . ~?body))
-   `(unless ~?test . ~?body)]
+  [`(unless ~?test ~(cons `do ?body))
+   (cons `unless ?test ?body)]
 
   ;; (fn [...] (do x)) => (fn [...] x)
-  [`(fn ~?args (do . ~?body))
-   `(fn ~?args . ~?body)]
+  [`(fn ~?args ~(cons `do ?body))
+   (cons `fn ?args ?body)]
 
   ;; (fn [...] "docstring" (do x)) => (fn [...] "docstring" x)
-  [`(fn ~?args ~?docstring (do . ~?body))
-   `(fn ~?args ~?docstring . ~?body)]
+  [`(fn ~?args ~?docstring ~(cons `do ?body))
+   (cons `fn ?args ?docstring ?body)]
 
   ;; (try (do ...)) => (try ...)
-  [`(try (do . ~?body)) `(try . ~?body)]
+  [`(try ~(cons `do ?body)) (cons `try ?body)]
 
   ;; (defn [...] (do x)) => (defn [...] x)
   ;; (defun [...] (do x)) => (defun [...] x)
   ;; (defn [...] "..." (do x)) => (defn "..." [...] x)
   ;; (defun [...] "..." (do x)) => (defun "..." [...] x)
   (prep
    (condᵉ
-    [(≡ expr `(~?op ~?name ~?args (do . ~?body)))
-     (≡ out `(~?op ~?name ~?args . ~?body))]
-    [(≡ expr `(~?op ~?name ~?args ~?docstring (do . ~?body)))
+    [(≡ expr `(~?op ~?name ~?args ~(cons `do ?body)))
+     (≡ out (cons ?op ?name ?args ?body))]
+    [(≡ expr `(~?op ~?name ~?args ~?docstring ~(cons `do ?body)))
      (typeᵒ ?docstring HyString)
-     (≡ out `(~?op ~?name ~?args ~?docstring . ~?body))])
+     (≡ out (cons ?op ?name ?args ?docstring ?body))])
    (memberᵒ ?op `[defn defun defn-alias defun-alias]))
 
   ;; (if test a) => (when test a)
@@ -89,17 +91,19 @@
     (else (≡ out `(~?new-op ~?test ~?branch)))))
 
   ;; (let [...] (do ...)) => (let [...] ...)
-  [`(let ~?bindings (do . ~?exprs)) `(let ~?bindings . ~?exprs)]
+  [`(let ~?bindings ~(cons `do ?exprs))
+   (cons `let ?bindings ?exprs)]
 
   ;; (loop [...] (do ...)) => (loop [...] ...)
-  [`(loop ~?bindings (do . ~?exprs)) `(loop ~?bindings . ~?exprs)]
+  [`(loop ~?bindings ~(cons `do ?exprs))
+   (cons `loop ?bindings ?exprs)]
 
   ;; (loop [] (when ... (recur))) => (while ... ...)
   (prep
-   (≡ expr `(loop [] (when ~?test . ~?body)))
+   (≡ expr `(loop [] ~(cons `when ?test ?body)))
    (appendᵒ ?exprs [`(recur)] ?body)
    (project [?exprs ?test]
-            (≡ out (HyExpression `(while ~?test . ~?exprs)))))
+            (≡ out (HyExpression (cons `while ?test ?exprs)))))
 
-  ;; (while true (yield func)) => (repeatedly func)
-  [`(while true (yield ~?func)) `(repeatedly ~?func)])
+  ;; (while True (yield func)) => (repeatedly func)
+  [`(while True (yield ~?func)) `(repeatedly ~?func)])