Updates for recent Hy changes

Beyond simple syntax and function signature updates, the biggest changes are in the handling/use of--the now missing--`cons`. Also, some rules have been added that reflect these Hy language changes, as well. They still need tests. A particularly good test/demo could involve the automatic application of these very changes! Perhaps only a subset could be reasonably performed, since some changes (e.g. the "lifting"/pulling out of `cons`es from quoted forms) aren't part of the current rulesets. We might be able to add them, or use the opportunity to demonstrate user-level modifications/additions to the rules.
hylang · Oct 1, 2018 · f7e56e2 · f7e56e2
1 parent 5d3c958
commit f7e56e2
Show file tree

Hide file tree

Showing 20 changed files with 317 additions and 238 deletions.
diff --git a/.travis.yml b/.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
diff --git a/bin/hydiomatic.hy b/bin/hydiomatic.hy
@@ -15,10 +15,9 @@
 ;; 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.importer [import-file-to-hst]]
-        [argparse]
-        [sys]
-        [hy]
+(import sys
+        argparse
+        [hy.importer [hy-parse]]
         [hy.cmdline [HyREPL]]
         [hy.completer [completion]]
         [hydiomatic.core [simplify]]
@@ -28,24 +27,31 @@
         [hydiomatic.utils [hypprint hypformat]]
         [difflib [unified-diff]])
 
+(require [hy.contrib.walk [let]])
+
+(defn parse-file [filename]
+  (with [f (open filename "rb")]
+    (setv source-str (.decode (.read f) "utf-8"))
+    (hy-parse source-str)))
+
 (defn launch-repl []
   (setv sys.ps1 ";=> ")
   (setv sys.ps2 "    ")
 
   (with [(completion)]
         (setv hr (HyREPL))
-        (.runsource hr "(import [hydiomatic.core [*]] [hydiomatic.rules [*]]) (require hydiomatic.utils)")
+        (.runsource hr "(import [hydiomatic.core [*]] [hydiomatic.rules [*]])\n(require [hydiomatic.utils [*]])")
         (.interact hr "hydiomatic")))
 
 (defn process-file [transform printer fn rules]
   (if rules
-    (apply printer [(transform (import-file-to-hst fn) rules)]
+    (apply printer [(transform (parse-file fn) rules)]
            {"outermost" true})
-    (apply printer [(transform (import-file-to-hst fn))]
+    (apply printer [(transform (parse-file fn))]
            {"outermost" true})))
 
 (defn do-diff [fn rules]
-  (let [original (process-file identity hypformat fn nil)
+  (let [original (process-file identity hypformat fn None)
         simplified (process-file simplify hypformat fn rules)]
     (for [line (apply unified-diff [original simplified]
                       {"fromfile" (+ fn ".orig")
@@ -63,7 +69,7 @@
 
 (when (= --name-- "__main__")
 
-  (def parser (apply argparse.ArgumentParser []
+  (setv parser (apply argparse.ArgumentParser []
                      {"prog" "hydiomatic"
                              "usage" "%(prog)s [options] FILE"
                              "formatter_class" argparse.RawDescriptionHelpFormatter}))
@@ -93,7 +99,7 @@
          {"nargs" argparse.REMAINDER
                   "help" argparse.SUPPRESS})
 
-  (def options (.parse_args parser (rest sys.argv)))
+  (setv options (.parse_args parser (rest sys.argv)))
 
   (cond
    [options.repl (launch-repl)]
@@ -111,7 +117,7 @@
                               options.jokes))]
 
    [options.warnings
-    (process-file simplify (fn [_ &optional [outermost nil]]) (first options.args)
+    (process-file simplify (fn [_ &optional [outermost None]]) (first options.args)
                   rules/warnings)]
 
    [options.diff

diff --git a/hydiomatic/__init__.py b/hydiomatic/__init__.py
@@ -0,0 +1 @@
+import hy
diff --git a/hydiomatic/core.hy b/hydiomatic/core.hy
@@ -14,11 +14,14 @@
 ;; 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 [prewalk]]
+        [adderall.dsl [*]])
+(import [hydiomatic.rules [*]])
+
+(require [hy.contrib.walk [let]])
+(require [hy.extra.anaphoric [*]])
+(require [adderall.dsl [*]])
+
 
 (defn simplify-step-by-rule [rule expr]
   (let [alts (run* [q] (rule expr q))]
@@ -48,10 +51,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 +65,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)

diff --git a/hydiomatic/macros.hy b/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)))))
diff --git a/hydiomatic/rules.hy b/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ᵒ])
diff --git a/hydiomatic/rulesets/arithmetico.hy b/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)]

diff --git a/hydiomatic/rulesets/collectiono.hy b/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)

diff --git a/hydiomatic/rulesets/control_structo.hy b/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)])