From f7e56e2810f5331b207680260de64ea290314b9d Mon Sep 17 00:00:00 2001 From: "Brandon T. Willard" Date: Sun, 30 Sep 2018 22:08:56 -0500 Subject: [PATCH 1/3] 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. --- .travis.yml | 10 +- bin/hydiomatic.hy | 28 +++-- hydiomatic/__init__.py | 1 + hydiomatic/core.hy | 25 ++-- hydiomatic/macros.hy | 21 ++-- hydiomatic/rules.hy | 20 ++-- hydiomatic/rulesets/arithmetico.hy | 11 +- hydiomatic/rulesets/collectiono.hy | 5 +- hydiomatic/rulesets/control_structo.hy | 72 ++++++------ hydiomatic/rulesets/equalityo.hy | 26 ++-- hydiomatic/rulesets/grand_cleanupo.hy | 94 ++++++++++----- hydiomatic/rulesets/jokeo.hy | 9 +- hydiomatic/rulesets/optimo.hy | 20 ++-- hydiomatic/rulesets/quoteo.hy | 5 +- hydiomatic/rulesets/syntaxo.hy | 33 ++++-- hydiomatic/rulesets/warningso.hy | 36 +++--- hydiomatic/utils.hy | 19 +-- setup.py | 7 +- tests/__init__.py | 2 +- ...hydiomatic_tests.hy => test_hydiomatic.hy} | 111 +++++++++--------- 20 files changed, 317 insertions(+), 238 deletions(-) rename tests/{hydiomatic_tests.hy => test_hydiomatic.hy} (86%) diff --git a/.travis.yml b/.travis.yml index 54e912a..1fe2455 100644 --- 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 index 1310b74..f6882f5 100755 --- 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 . -(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 index e69de29..ce0f1ad 100644 --- a/hydiomatic/__init__.py +++ b/hydiomatic/__init__.py @@ -0,0 +1 @@ +import hy diff --git a/hydiomatic/core.hy b/hydiomatic/core.hy index fcc5c6d..df96502 100644 --- 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 . -(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 index 7aea259..a404782 100644 --- a/hydiomatic/macros.hy +++ b/hydiomatic/macros.hy @@ -15,18 +15,23 @@ ;; License along with this program. If not, see . (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 index 77c4e62..99065bd 100644 --- 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 . +(import [adderall.dsl [*]]) (import [hydiomatic.rulesets.arithmetico [*]] [hydiomatic.rulesets.quoteo [*]] [hydiomatic.rulesets.control-structo [*]] @@ -23,12 +24,13 @@ [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ᵒ @@ -36,16 +38,16 @@ 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 index 6f1ffad..7682af5 100644 --- 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 . +(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 index 1572832..71912d7 100644 --- a/hydiomatic/rulesets/collectiono.hy +++ b/hydiomatic/rulesets/collectiono.hy @@ -15,8 +15,9 @@ ;; License along with this program. If not, see . (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 index 3d9c88e..195cd7a 100644 --- a/hydiomatic/rulesets/control_structo.hy +++ b/hydiomatic/rulesets/control_structo.hy @@ -14,54 +14,56 @@ ;; You should have received a copy of the GNU Lesser General Public ;; License along with this program. If not, see . -(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) @@ -69,11 +71,11 @@ ;; (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)]) diff --git a/hydiomatic/rulesets/equalityo.hy b/hydiomatic/rulesets/equalityo.hy index e72a01e..ad508fc 100644 --- a/hydiomatic/rulesets/equalityo.hy +++ b/hydiomatic/rulesets/equalityo.hy @@ -15,8 +15,10 @@ ;; License along with this program. If not, see . (import [adderall.dsl [*]]) -(require adderall.dsl) -(require hydiomatic.macros) + +(require [adderall.dsl [*]]) +(require [hydiomatic.macros [*]]) + (defrules [rules/equalityᵒ rules/equalityo] ;; (= (% n 2) 0) => (even? n) @@ -36,22 +38,22 @@ ;; neg? [`(< ~?x 0) `(neg? ~?x)] - ;; nil? - [`(is ~?x nil) `(nil? ~?x)] - [`(is nil ~?x) `(nil? ~?x)] + ;; none? + [`(is ~?x None) `(none? ~?x)] + [`(is None ~?x) `(none? ~?x)] - ;; none? => nil? - [`(none? ~?x) `(nil? ~?x)] + ;; nil? => none? + [`(nil? ~?x) `(none? ~?x)] ;; (not (is ...)) => (is-not ...) - [`(not (is . ~?xs)) `(is-not . ~?xs)] + [`(not ~(cons `is ?xs)) (cons `is-not ?xs)] ;; (not (= ...)) => (!= ...) - [`(not (= . ~?xs)) `(!= . ~?xs)] + [`(not ~(cons `= ?xs)) (cons `!= ?xs)] ;; (not (in ...)) => (not-in ...) - [`(not (in . ~?xs)) `(not-in . ~?xs)] + [`(not ~(cons `in ?xs)) (cons `not-in ?xs)] ;; (if-not (is ...) ...) => (if (is-not ...) ...) - [`(if-not (is . ~?xs) . ~?ys) - `(if (is-not . ~?xs) . ~?ys)]) + [(cons `if-not (cons `is ?xs) ?ys) + (cons `if (cons `is-not ?xs) ?ys)]) diff --git a/hydiomatic/rulesets/grand_cleanupo.hy b/hydiomatic/rulesets/grand_cleanupo.hy index 74c4c2f..cd675de 100644 --- a/hydiomatic/rulesets/grand_cleanupo.hy +++ b/hydiomatic/rulesets/grand_cleanupo.hy @@ -17,8 +17,10 @@ (import [adderall.dsl [*]] [adderall.extra.misc [*]] [hy [HySymbol HyList HyExpression]]) -(require adderall.dsl) -(require hydiomatic.macros) + +(require [adderall.dsl [*]]) +(require [hydiomatic.macros [*]]) + (defn simple-flatten [coll] (setv new-coll []) @@ -29,15 +31,15 @@ (defn transform-bindingᵒ [in out] (prep (condᵉ [(typeᵒ in HyList) (≡ out in)] - (else (≡ out `[~in nil]))))) + (else (≡ out `[~in None]))))) (defn transform-conditionᵒ [in out] (prep (consᵒ ?test ?effects in) (firstᵒ ?effects ?effect) (condᵉ - [(≡ ?effect `(do . ~?body)) - (≡ ?result `(~?test . ~?body)) + [(≡ ?effect (cons 'do ?body)) + (≡ ?result (cons ?test ?body)) (project [?result] (≡ out (HyList ?result)))] (else (≡ in out))))) @@ -63,14 +65,14 @@ (defn transform-defnᵒ [in out] (prep - (≡ in `[~?name (fn . ~?body)]) - (≡ out `(defn ~?name . ~?body)))) + (≡ in `[~?name ~(cons 'fn ?body)]) + (≡ out (cons 'defn ?name ?body)))) (defrules [rules/grand-cleanupᵒ rules/grand-cleanupo] - ;; (let [[x 1] [y 2] z] ...) => (let [x 1 y 2 z nil] ...) - ;; (with [[x 1] [y 2] z] ...) => (with [x 1 y 2 z nil] ...) + ;; (let [[x 1] [y 2] z] ...) => (let [x 1 y 2 z None] ...) + ;; (with [[x 1] [y 2] z] ...) => (with [x 1 y 2 z None] ...) (prep - (≡ expr `(~?op ~?bindings . ~?body)) + (≡ expr (cons ?op ?bindings ?body)) (memberᵒ ?op `[let with]) (transform-listᵒ transform-bindingᵒ ?bindings ?new-bindings) (project [?new-bindings] @@ -78,11 +80,11 @@ (condᵉ [(≡ ?op `let) (≡ ?new-op `$hydiomatic/let$)] [(≡ ?op `with) (≡ ?new-op `$hydiomatic/with$)]) - (≡ out `(~?new-op ~?flat-bindings . ~?body))) + (≡ out (cons ?new-op ?flat-bindings ?body))) ;; (for [...] (do ...)) => (for [...] ...) - [`(for ~?bindings (do . ~?body)) - `(for ~?bindings . ~?body)] + [`(for ~?bindings ~(cons 'do ?body)) + (cons 'for ?bindings ?body)] ;; (cond [(test) (do ...)] ;; [(test2) (effect)]) @@ -90,9 +92,9 @@ ;; (cond [(test) ...] ;; [(test2) (effect)]) (prep - (≡ expr `(cond . ~?conditions)) + (≡ expr (cons 'cond ?conditions)) (transform-listᵒ transform-conditionᵒ ?conditions ?new-conditions) - (≡ out `(cond . ~?new-conditions))) + (≡ out (cons 'cond ?new-conditions))) ;; (defclass A [...] ;; [[x 1] @@ -118,56 +120,84 @@ (transform-listᵒ transform-defnᵒ ?fns ?new-fns)) (condᵉ [(emptyᵒ ?docstring) - (≡ ?new-form `($hydiomatic/defclass$ ~?name ~?base-list - ~?new-vars . ~?new-fns))] + (≡ ?new-form (cons '$hydiomatic/defclass$ ?name ?base-list + ?new-vars ?new-fns))] (else - (≡ ?new-form `($hydiomatic/defclass$ ~?name ~?base-list - ~?docstring - ~?new-vars . ~?new-fns)))) + (≡ ?new-form (cons '$hydiomatic/defclass$ ?name ?base-list + ?docstring + ?new-vars ?new-fns)))) (project [?new-form] (≡ out (HyExpression ?new-form)))) + ;; TODO: Add a test! + [`(require ~?lib) `(require [~?lib [*]])] + + ;; TODO: Add a test! + [`(import [~?lib]) `(import ~?lib)] + + ;; TODO: Add a test! + [`(list-comp ~?body [~?x ~?bindings]) + `(lfor ~?x ~?bindings ~?body)] + ;; (slice) is now (cut) - [`(slice . ~?body) `(cut . ~?body)] + [(cons 'slice ?body) (cons 'cut ?body)] ;; (throw) is now (rise) - [`(throw . ~?body) `(raise . ~?body)] + [(cons 'throw ?body) (cons 'raise ?body)] ;; (catch) is now (except) - [`(catch . ~?body) `(except . ~?body)] + [(cons 'catch ?body) (cons 'except ?body)] ;; (progn) is now (do) - [`(progn . ~?body) `(do . ~?body)] + [(cons 'progn ?body) (cons 'do ?body)] ;; (defun) is now (defn) - [`(defun . ~?body) `(defn . ~?body)] + [(cons 'defun ?body) (cons 'defn ?body)] + + ;; (def) is now (setv) + [(cons 'def ?body) (cons 'setv ?body)] ;; (lisp-if) and (lisp-if-not) are now (lif) and (lif-not) - [`(lisp-if . ~?body) `(lif . ~?body)] - [`(lisp-if-not . ~?body) `(lif-not . ~?body)] + [(cons 'lisp-if ?body) (cons 'lif ?body)] + [(cons 'lisp-if-not ?body) (cons 'lif-not ?body)] + + ;; null => None + [`null `None] + + ;; nill => None + [`nil `None] - ;; null => nil - [`null `nil] + ;; true => True + [`true `True] + + ;; false => False + [`false `False] ;; zipwith => map [`zipwith `map] ;; filterfalse => remove - [`filterfalse `remove]) + [`filterfalse `remove] + + ;; (car . cdr) => (cons car cdr) + ;; XXX FIXME TODO: This will result in a `cons` object dependency! + [`(~?car . ~?cdr) (cons ?car ?cdr)]) (defrules [rules/grand-cleanup-finishᵒ rules/grand-cleanup-finisho] ;; $hydiomatic/let$ => let ;; $hydiomatic/with$ => with (prep - (≡ expr `(~?op . ~?args)) + (≡ expr (cons ?op ?args)) (memberᵒ ?op `[$hydiomatic/let$ $hydiomatic/with$ $hydiomatic/defclass$]) (condᵉ + ;; TODO: `let` isn't builtin anymore, so should we include the `require` + ;; statement? [(≡ ?op `$hydiomatic/let$) (≡ ?new-op `let)] [(≡ ?op `$hydiomatic/with$) (≡ ?new-op `with)] [(≡ ?op `$hydiomatic/defclass$) (≡ ?new-op `defclass)]) - (≡ out `(~?new-op . ~?args)))) + (≡ out (cons ?new-op ?args)))) diff --git a/hydiomatic/rulesets/jokeo.hy b/hydiomatic/rulesets/jokeo.hy index 9e902cc..6ce19a2 100644 --- a/hydiomatic/rulesets/jokeo.hy +++ b/hydiomatic/rulesets/jokeo.hy @@ -17,14 +17,15 @@ (import [adderall.dsl [*]] [adderall.extra.misc [*]] [hy [HySymbol]]) -(require adderall.dsl) -(require hydiomatic.macros) + +(require [adderall.dsl [*]]) +(require [hydiomatic.macros [*]]) (defrules [rules/joke/canadaᵒ rules/joke/canadao] ;; foo? => foo, eh? (prep (typeᵒ expr HySymbol) (project [expr] - (if (.startswith expr "is_") - (≡ out (HySymbol (+ (cut expr 3) ", eh?"))) + (if (.startswith (mangle expr) "is_") + (≡ out (HySymbol (+ (cut (mangle expr) 3) ", eh?"))) (≡ out expr))))) diff --git a/hydiomatic/rulesets/optimo.hy b/hydiomatic/rulesets/optimo.hy index 4a943b9..40f50ca 100644 --- a/hydiomatic/rulesets/optimo.hy +++ b/hydiomatic/rulesets/optimo.hy @@ -17,11 +17,13 @@ (import [adderall.dsl [*]] [adderall.extra.misc [*]] [hy [HyExpression HyString]]) -(require adderall.dsl) -(require hydiomatic.macros) + +(require [hy.contrib.walk [let]]) +(require [adderall.dsl [*]]) +(require [hydiomatic.macros [*]]) (defn --transform-bindings-- [bindings body] - (let [new-bindings (list-comp `(setv ~@x) [x bindings])] + (let [new-bindings (lfor x bindings `(setv ~@x))] (+ new-bindings body))) (defrules [rules/optimᵒ rules/optimo] @@ -31,12 +33,12 @@ (memberᵒ ?op `[defn defun defn-alias defun-alias]) (condᵉ [(≡ expr `(~?op ~?fname ~?params - (let ~?bindings . ~?body))) - (≡ ?c `(~?op ~?fname ~?params . ~?new-body))] + ~(cons `let ?bindings ?body))) + (≡ ?c (cons ?op ?fname ?params ?new-body))] [(≡ expr `(~?op ~?fname ~?params ~?docstring - (let ~?bindings . ~?body))) + ~(cons `let ?bindings ?body))) (typeᵒ ?docstring HyString) - (≡ ?c `(~?op ~?fname ~?params ~?docstring . ~?new-body))]) + (≡ ?c (cons ?op ?fname ?params ?docstring ?new-body))]) (project [?bindings ?body] (≡ ?new-body (--transform-bindings-- ?bindings ?body))) (project [?c] @@ -46,8 +48,8 @@ ;; (for certain values of foo) (prep (condᵉ - [(≡ expr `(~?f ~?xs (~?op . ~?xs)))] - [(≡ expr `(~?f ~?xs ~?docstring (~?op . ~?xs)))]) + [(≡ expr `(~?f ~?xs ~(cons ?op ?xs)))] + [(≡ expr `(~?f ~?xs ~?docstring ~(cons ?op ?xs)))]) (memberᵒ ?f `[fn lambda]) (condᵉ [(memberᵒ ?op `[and or not ~ del diff --git a/hydiomatic/rulesets/quoteo.hy b/hydiomatic/rulesets/quoteo.hy index e11b27b..5960a5d 100644 --- a/hydiomatic/rulesets/quoteo.hy +++ b/hydiomatic/rulesets/quoteo.hy @@ -15,8 +15,9 @@ ;; License along with this program. If not, see . (import [adderall.dsl [*]]) -(require adderall.dsl) -(require hydiomatic.macros) + +(require [adderall.dsl [*]]) +(require [hydiomatic.macros [*]]) (defrules [rules/quoteᵒ rules/quoteo] ;; `~x => x diff --git a/hydiomatic/rulesets/syntaxo.hy b/hydiomatic/rulesets/syntaxo.hy index d0babea..64322c0 100644 --- a/hydiomatic/rulesets/syntaxo.hy +++ b/hydiomatic/rulesets/syntaxo.hy @@ -17,17 +17,18 @@ (import [adderall.dsl [*]] [adderall.extra.misc [*]] [hy [HyExpression HyList]]) -(require adderall.dsl) -(require hydiomatic.macros) + +(require [adderall.dsl [*]]) +(require [hydiomatic.macros [*]]) (defrules [rules/syntaxᵒ rules/syntaxo] ;; (defn foo (x) ...) => (defn foo [x] ...) (prep (memberᵒ ?op `[defn defun defn-alias defun-alias]) - (≡ expr `(~?op ~?fname ~?params . ~?body)) + (≡ expr (cons ?op ?fname ?params ?body)) (typeᵒ ?params HyExpression) (project [?params] - (≡ out `(~?op ~?fname ~(HyList ?params) . ~?body)))) + (≡ out (cons ?op ?fname (HyList ?params) ?body)))) ;; (isinstance x klass) => (instance? klass x) [`(isinstance ~?x ~?klass) `(instance? ~?klass ~?x)] @@ -54,12 +55,18 @@ ;; (-> (-> x) y) => (-> x y) (prep - (≡ expr `(-> ~?inner . ~?y)) - (≡ ?inner `(-> . ~?x)) - (≡ ?o `(-> . ~?x)) - (typeᵒ ?inner HyExpression) - (typeᵒ ?x HyExpression) - (typeᵒ ?y HyExpression) + (≡ expr (cons `-> ?inner ?y)) + (≡ ?inner (cons `-> ?x)) + (≡ ?o (cons `-> ?x)) + ;; TODO: This is cumbersome; is there a better expectation for the desired + ;; output type of `cons?` Should we change `cons` to always output a + ;; HyExpression? + (condᵉ [(typeᵒ ?inner HyExpression)] + [(typeᵒ ?inner list)]) + (condᵉ [(typeᵒ ?x HyExpression)] + [(typeᵒ ?x list)]) + (condᵉ [(typeᵒ ?y HyExpression)] + [(typeᵒ ?y list)]) (appendᵒ ?o ?y out)) ;; (kwapply (.foo bar baz) {...}) => (apply bar.foo [baz] {...}) @@ -68,9 +75,9 @@ (typeᵒ ?target HyExpression) (firstᵒ ?target ?method) (project [?method] - (≡ true (.startswith ?method ".")) + (≡ True (.startswith ?method ".")) (fresh [?m ?o] - (≡ ?target `(~?m ~?o . ~?params)) + (≡ ?target (cons ?m ?o ?params)) (typeᵒ ?o HySymbol) (project [?params ?m ?o] (≡ ?new-params (HyList ?params)) @@ -79,7 +86,7 @@ ;; (kwapply (foo bar baz) {...} => (apply foo [bar baz] {...}) (prep - (≡ expr `(kwapply (~?method . ~?params) ~?kwargs)) + (≡ expr `(kwapply ~(cons ?method ?params) ~?kwargs)) (project [?params] (≡ ?new-params (HyList ?params))) (≡ out `(apply ~?method ~?new-params ~?kwargs)))) diff --git a/hydiomatic/rulesets/warningso.hy b/hydiomatic/rulesets/warningso.hy index ac53098..7a2d3fe 100644 --- a/hydiomatic/rulesets/warningso.hy +++ b/hydiomatic/rulesets/warningso.hy @@ -18,9 +18,11 @@ [adderall.extra.misc [*]] [hydiomatic.utils [*]] [hy [HySymbol HyString]]) -(require adderall.dsl) -(require adderall.debug) -(require hydiomatic.macros) + +(require [adderall.dsl [*]]) +(require [adderall.debug [*]]) +(require [hydiomatic.macros [*]]) + (defn recmemberᵒ [v l] (condᵉ @@ -28,7 +30,7 @@ (fresh [f r] (consᵒ f r l) (condᵉ - [(recmemberᵒ v f) #ss] + [(recmemberᵒ v f) s#] (else (recmemberᵒ v r))))] (else (≡ v l)))) @@ -41,34 +43,34 @@ (defrules [rules/warningsᵒ rules/warningso] ;; (fn [x, y] (foo x y)) => WARN on using x,! (prep - (≡ expr `(~?op ~?vars . ~?body)) + (≡ expr (cons ?op ?vars ?body)) (memberᵒ ?op `[fn defn defun defmacro]) (memberᵒ ?x ?vars) (typeᵒ ?x HySymbol) (project [?x] (≡ ?xstripped (.rstrip ?x ",")) (if (.endswith ?x ",") - #ss - #uu)) + s# + u#)) (recmemberᵒ ?xstripped ?body) (condᵉ - [(recmemberᵒ ?x ?body) #uu] - (else #ss)) + [(recmemberᵒ ?x ?body) u#] + (else s#)) (project [expr ?x ?xstripped] (suggest expr ?x (HySymbol ?xstripped))) - #uu) + u#) ;; A function without a docstring is a bad function. (prep - (≡ expr `(~?op ~?name ~?vars . ~?body)) + (≡ expr (cons ?op ?name ?vars ?body)) (memberᵒ ?op `[fn defn defun defmacro]) (consᵒ ?docstring ?rest ?body) (project [?docstring ?rest ?name] (if (= (type ?docstring) HyString) - #ss + s# (log (.format "; Function `{0}` has no docstring." (.rstrip (hypformat ?name)))))) - #uu) + u#) ;; (firstᵒ l f) (restᵒ l r) => (consᵒ f r l) (prep (condᵉ @@ -84,7 +86,7 @@ (.rstrip (hypformat ?foexp)) (.rstrip (hypformat ?roexp)) (.rstrip (hypformat `(consᵒ ~?f ~?r ~?l)))))) - #uu) + u#) ;; CAPITAL symbols are the same as *ear-muffed* ones, and earmuffs ;; are more hydiomatic. @@ -93,8 +95,8 @@ (project [expr] (do (if (.isupper expr) - #ss - #uu))) + s# + u#))) (project [expr] (≡ ?suggestion (+ "*" (.lower expr) "*"))) (project [?suggestion] @@ -103,4 +105,4 @@ (log (.format "; Instead of `{0}`, consider using `{1}`." (.rstrip (hypformat expr)) (.rstrip (hypformat ?suggested-symbol))))) - #uu)) + u#)) diff --git a/hydiomatic/utils.hy b/hydiomatic/utils.hy index 1e3eab1..395af25 100644 --- a/hydiomatic/utils.hy +++ b/hydiomatic/utils.hy @@ -14,17 +14,18 @@ ;; You should have received a copy of the GNU Lesser General Public ;; License along with this program. If not, see . +(import sys) (import [hy [HyExpression HySymbol HyInteger HyString HyDict - HyKeyword HyCons]] - [sys]) + HyKeyword]]) + +(require [hy.contrib.walk [let]]) + (defn -hystringify [value] (let [sv (string value)] (if (.startswith sv "is_") (+ (cut sv 3) "?") - (if (= sv "None") - "nil" - sv)))) + sv))) (defn -pprint [form] (cond @@ -46,15 +47,15 @@ (-pprint (list form))] [(cons? form) (+ "(" (-pprint (first form)) " . " (-pprint (rest form)) ")")] - [true - nil])) + [True + None])) -(defn hypprint [form &optional [outermost false]] +(defn hypprint [form &optional [outermost False]] (if outermost (list (map hypprint form)) (print (-pprint form)))) -(defn hypformat [form &optional [outermost false]] +(defn hypformat [form &optional [outermost False]] (if outermost (list (map hypformat form)) (+ (-pprint form) "\n"))) diff --git a/setup.py b/setup.py index 4dd4b6a..0a096f1 100755 --- a/setup.py +++ b/setup.py @@ -20,19 +20,22 @@ setup( name="hydiomatic", version="0.1.1", - install_requires = ['hy>=0.10', 'adderall>=0.1.1'], + install_requires=['hy>=0.15', 'adderall>=2.0.0'], packages=find_packages(exclude=['tests']), package_data={ 'hydiomatic': ['*.hy'], 'hydiomatic.rulesets': ['*.hy'], }, - scripts = ['bin/hydiomatic.hy'], + scripts=['bin/hydiomatic.hy'], + test_suite='nose.collector', + tests_require=['nose'], author="Gergely Nagy", author_email="algernon@madhouse-project.org", long_description="""Static code analyser for Hy""", license="LGPL-3", url="https://github.com/hylang/hydiomatic", platforms=['any'], + python_requires='>=3.4', classifiers=[ "Development Status :: 3 - Alpha", "Intended Audience :: Developers", diff --git a/tests/__init__.py b/tests/__init__.py index 85497f4..7ac3e19 100644 --- a/tests/__init__.py +++ b/tests/__init__.py @@ -1,3 +1,3 @@ import hy -from .hydiomatic_tests import * +from .test_hydiomatic import * diff --git a/tests/hydiomatic_tests.hy b/tests/test_hydiomatic.hy similarity index 86% rename from tests/hydiomatic_tests.hy rename to tests/test_hydiomatic.hy index d09bfd7..45804d8 100644 --- a/tests/hydiomatic_tests.hy +++ b/tests/test_hydiomatic.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 . -(import [hydiomatic.core [*]] +(import [hy [HyDict HyList]] [hydiomatic.rules [*]] - [hy [HyDict HyList]]) + [hydiomatic.core [*]]) + +(require [hy.contrib.walk [let]]) + (defmacro assert-step [expr expected] `(assert (= (simplify-step '~expr rules/experimental) @@ -28,7 +31,8 @@ (defmacro/g! wrap-stdout [&rest body] `(do - (import [sys] [io [StringIO]]) + (import sys + [io [StringIO]]) (setv ~g!old-stdout sys.stdout) (setv sys.stdout (StringIO)) (setv ~g!result (do ~@body)) @@ -51,38 +55,38 @@ (assert-step `~x x)) (defn test-rules-control-structo [] - (assert-step (if true :yes nil) - (when true :yes)) - (assert-step (if true nil :no) - (unless true :no)) - (assert-step (if true (do (and this that))) - (when true (and this that))) - (assert-step (if true ~@a) - (if true ~@a)) - (assert-step (when (not true) :hello) - (unless true :hello)) + (assert-step (if True :yes None) + (when True :yes)) + (assert-step (if True None :no) + (unless True :no)) + (assert-step (if True (do (and this that))) + (when True (and this that))) + (assert-step (if True ~@a) + (if True ~@a)) + (assert-step (when (not True) :hello) + (unless True :hello)) (assert-step (do something) something) - (assert-step (when true (do stuff)) - (when true stuff)) - (assert-step (unless true (do stuff)) - (unless true stuff)) - (assert-step (if (not true) a b) - (if-not true a b)) - (assert-step (if (not true) a) - (if-not true a)) - (assert-step (if-not true a) - (unless true a)) - (assert-step (if-not true ~@a) - (if-not true ~@a)) + (assert-step (when True (do stuff)) + (when True stuff)) + (assert-step (unless True (do stuff)) + (unless True stuff)) + (assert-step (if (not True) a b) + (if-not True a b)) + (assert-step (if (not True) a) + (if-not True a)) + (assert-step (if-not True a) + (unless True a)) + (assert-step (if-not True ~@a) + (if-not True ~@a)) (assert-step (fn [a b c] (do (+ a b c) (inc a))) (fn [a b c] (+ a b c) (inc a))) (assert-step (fn [a b c] "This is my docstring!" (do (+ a b c) (inc a))) (fn [a b c] "This is my docstring!" (+ a b c) (inc a))) - (assert-step (try (do (something) (catch [e Exception] (pass)))) - (try (something) (catch [e Exception] (pass)))) + (assert-step (try (do (something) (except [e Exception] None))) + (try (something) (except [e Exception] None))) (assert-step (defn foo [a b c] (do (+ a b c) (inc a))) (defn foo [a b c] (+ a b c) (inc a))) (assert-step (defn foo [a b c] "This is my docstring!" @@ -91,8 +95,8 @@ (+ a b c) (inc a))) (assert-step (defn foo [a b c] something (do (+ a b c) (inc a))) (defn foo [a b c] something (do (+ a b c) (inc a)))) - (assert-step (if true a) - (when true a)) + (assert-step (if True a) + (when True a)) (assert-step (let [[a 1] [b 2]] (do (print a b) (+ a b))) @@ -108,12 +112,12 @@ (print i) (when (< i 10) (recur (inc i))))) - (assert-step (loop [] (when true (print "zing") (recur))) - (while true (print "zing"))) - (assert-step (while true (yield (lambda [] - true))) + (assert-step (loop [] (when True (print "zing") (recur))) + (while True (print "zing"))) + (assert-step (while True (yield (lambda [] + True))) (repeatedly (lambda [] - true)))) + True)))) (defn test-rules-equalityo [] (assert-step (= 0 x) (zero? x)) @@ -121,9 +125,9 @@ (assert-step (< 0 x) (pos? x)) (assert-step (> x 0) (pos? x)) (assert-step (< x 0) (neg? x)) - (assert-step (is n nil) (nil? n)) - (assert-step (is nil n) (nil? n)) - (assert-step (none? n) (nil? n)) + (assert-step (is n None) (none? n)) + (assert-step (is None n) (none? n)) + (assert-step (none? n) (none? n)) (assert-step (= (% n 2) 0) (even? n)) (assert-step (= (% n 2) 1) (odd? n)) (assert-step (not (is a b c)) (is-not a b c)) @@ -248,8 +252,8 @@ (let [[y (inc x)]] (print x y)))) - (assert-step (fn [x] (nil? x)) - nil?) + (assert-step (fn [x] (none? x)) + none?) (assert-step (fn [x] (+ x 2)) (fn [x] (+ x 2))) (assert-step (fn [a b] (mix a b)) @@ -277,10 +281,10 @@ (* a b (inc c))) (assert-simplify [a b (+ 2 1) `~x] [a b (inc 2) x]) - (assert-simplify (if true (do this) (do that)) - (if true this that)) - (assert-simplify (def a {"foo" (+ 1 1)}) - (def a {"foo" (inc 1)})) + (assert-simplify (if True (do this) (do that)) + (if True this that)) + (assert-simplify (setv a {"foo" (+ 1 1)}) + (setv a {"foo" (inc 1)})) (assert-simplify (= (len coll) 0) (empty? coll)) (assert-simplify (defmacro if-truth [test &rest branches] @@ -326,7 +330,7 @@ (defn test-grand-cleanup [] (assert-cleanup (let [x] x) - (let [x nil] x)) + (let [x None] x)) (assert-cleanup (let [[x 1] [y (+ x 2)]] (, x y)) @@ -335,14 +339,14 @@ (, x y))) (assert-cleanup (with [[x 1] [y 2] z] (, x y z)) - (with [x 1 y 2 z nil] + (with [x 1 y 2 z None] (, x y z))) (assert-cleanup (let [[[x y] [1 2]] z [a (+ x y)]] (, a z)) (let [[x y] [1 2] - z nil + z None a (+ x y)] (, a z))) (assert-cleanup (defn some-function [] @@ -432,16 +436,17 @@ "docstring" (len args))) - (assert-cleanup (lisp-if test true false) - (lif test true false)) - (assert-cleanup (lisp-if-not test false true) - (lif-not test false true)) + (assert-cleanup (lisp-if test True False) + (lif test True False)) + (assert-cleanup (lisp-if-not test False True) + (lif-not test False True)) (assert-cleanup null - nil) + None) (assert-cleanup (defn foo [] null) - (defn foo [] nil)) + (defn foo [] None)) + ;; XXX TODO: There is no zipwith in Hy or Python (anymore, at least). (assert-cleanup (zipwith operator.add [1 2 3] [4 5 6]) (map operator.add [1 2 3] [4 5 6])) @@ -453,4 +458,4 @@ ~expected))) (defn test-jokes [] - (assert-joke foo? (HySymbol "foo, eh?"))) + (assert-joke foo? (HySymbol "foo, eh?"))) From b0858ab3bfaffffc7e078b5a08d50e97c49eb2a6 Mon Sep 17 00:00:00 2001 From: "Brandon T. Willard" Date: Mon, 1 Oct 2018 12:59:45 -0500 Subject: [PATCH 2/3] Fix console script and add an example to the README --- README.md | 23 ++++---- hydiomatic/rulesets/syntaxo.hy | 16 +++--- bin/hydiomatic.hy => hydiomatic/scripts.hy | 62 +++++++++++----------- setup.py | 5 +- tests/test_hydiomatic.hy | 29 +++++++--- 5 files changed, 83 insertions(+), 52 deletions(-) rename bin/hydiomatic.hy => hydiomatic/scripts.hy (72%) diff --git a/README.md b/README.md index e8a102f..c9153ce 100644 --- a/README.md +++ b/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 ------- diff --git a/hydiomatic/rulesets/syntaxo.hy b/hydiomatic/rulesets/syntaxo.hy index 64322c0..27eff78 100644 --- a/hydiomatic/rulesets/syntaxo.hy +++ b/hydiomatic/rulesets/syntaxo.hy @@ -69,9 +69,10 @@ [(typeᵒ ?y list)]) (appendᵒ ?o ?y out)) - ;; (kwapply (.foo bar baz) {...}) => (apply bar.foo [baz] {...}) + ;; ([kw]apply (.foo bar baz) {...}) => (bar.foo #* [baz] #** {...}) (prep - (≡ expr `(kwapply ~?target ~?kwargs)) + (condᵉ [(≡ expr `(kwapply ~?target ~?kwargs))] + [(≡ expr `(apply ~?target ~?kwargs))]) (typeᵒ ?target HyExpression) (firstᵒ ?target ?method) (project [?method] @@ -82,11 +83,14 @@ (project [?params ?m ?o] (≡ ?new-params (HyList ?params)) (≡ ?call-name (+ ?o ?m))))) - (≡ out `(apply ~?call-name ~?new-params ~?kwargs))) + (≡ out `(~?call-name #* ~?new-params #** ~?kwargs))) - ;; (kwapply (foo bar baz) {...} => (apply foo [bar baz] {...}) + ;; ([kw]apply (foo bar baz) {...} => (foo #* [bar baz] #** {...}) (prep - (≡ expr `(kwapply ~(cons ?method ?params) ~?kwargs)) + (condᵉ [(≡ expr `(kwapply ~(cons ?method ?params) ~?kwargs))] + [(≡ expr `(apply ~(cons ?method ?params) ~?kwargs))] + ;; TODO: Do we need a kwapply version of the following? + [(≡ expr `(apply ~?method ~?params ~?kwargs))]) (project [?params] (≡ ?new-params (HyList ?params))) - (≡ out `(apply ~?method ~?new-params ~?kwargs)))) + (≡ out `(~?method #* ~?new-params #** ~?kwargs)))) diff --git a/bin/hydiomatic.hy b/hydiomatic/scripts.hy similarity index 72% rename from bin/hydiomatic.hy rename to hydiomatic/scripts.hy index f6882f5..fcee9b5 100755 --- a/bin/hydiomatic.hy +++ b/hydiomatic/scripts.hy @@ -45,16 +45,16 @@ (defn process-file [transform printer fn rules] (if rules - (apply printer [(transform (parse-file fn) rules)] - {"outermost" true}) - (apply printer [(transform (parse-file fn))] - {"outermost" true}))) + (printer #* [(transform (parse-file fn) rules)] + #** {"outermost" True}) + (printer #* [(transform (parse-file fn))] + #** {"outermost" True}))) (defn do-diff [fn rules] (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") + (for [line (unified-diff #* [original simplified] + #** {"fromfile" (+ fn ".orig") "tofile" fn})] (sys.stdout.write line)))) @@ -67,36 +67,38 @@ rules/experimental rules/default)))) -(when (= --name-- "__main__") - - (setv parser (apply argparse.ArgumentParser [] - {"prog" "hydiomatic" - "usage" "%(prog)s [options] FILE" - "formatter_class" argparse.RawDescriptionHelpFormatter})) - - (apply parser.add_argument ["--repl" "-r"] - {"action" "store_true" +(defn main [&rest args] + (setv parser (argparse.ArgumentParser #* [] + #** {"prog" + "hydiomatic" + "usage" + "%(prog)s [options] FILE" + "formatter_class" + argparse.RawDescriptionHelpFormatter})) + + (parser.add_argument #* ["--repl" "-r"] + #** {"action" "store_true" "help" "Launch a REPL instead of simplifying a file"}) - (apply parser.add_argument ["--dry-run" "-n"] - {"action" "store_true" + (parser.add_argument #* ["--dry-run" "-n"] + #** {"action" "store_true" "help" "Output the parsed file without simplification"}) - (apply parser.add_argument ["--diff" "-d"] - {"action" "store_true" + (parser.add_argument #* ["--diff" "-d"] + #** {"action" "store_true" "help" "Print a unified diff of the original and the simplified file."}) - (apply parser.add_argument ["--experimental" "-e"] - {"action" "store_true" + (parser.add_argument #* ["--experimental" "-e"] + #** {"action" "store_true" "help" "Use experimental rules too, with potential false positives."}) - (apply parser.add_argument ["--warnings" "-w"] - {"action" "store_true" + (parser.add_argument #* ["--warnings" "-w"] + #** {"action" "store_true" "help" "Instead of transforming, print warnings that have no transformation."}) - (apply parser.add_argument ["--grand-cleanup" "-g"] - {"action" "store_true" + (parser.add_argument #* ["--grand-cleanup" "-g"] + #** {"action" "store_true" "help" "Use the Grand Cleanup rules too."}) - (apply parser.add_argument ["--jokes" "-j"] - {"action" "store_true" + (parser.add_argument #* ["--jokes" "-j"] + #** {"action" "store_true" "help" "Use joke rules only."}) - (apply parser.add_argument ["args"] - {"nargs" argparse.REMAINDER + (parser.add_argument #* ["args"] + #** {"nargs" argparse.REMAINDER "help" argparse.SUPPRESS}) (setv options (.parse_args parser (rest sys.argv))) @@ -126,7 +128,7 @@ options.grand_cleanup options.jokes)))] - [true + [True (process-file simplify hypprint (first options.args) (pick-rules options.experimental options.grand_cleanup diff --git a/setup.py b/setup.py index 0a096f1..613f49c 100755 --- a/setup.py +++ b/setup.py @@ -26,7 +26,6 @@ 'hydiomatic': ['*.hy'], 'hydiomatic.rulesets': ['*.hy'], }, - scripts=['bin/hydiomatic.hy'], test_suite='nose.collector', tests_require=['nose'], author="Gergely Nagy", @@ -36,6 +35,10 @@ url="https://github.com/hylang/hydiomatic", platforms=['any'], python_requires='>=3.4', + entry_points={ + 'console_scripts': + ['hydiomatic = hydiomatic.scripts:main',] + }, classifiers=[ "Development Status :: 3 - Alpha", "Intended Audience :: Developers", diff --git a/tests/test_hydiomatic.hy b/tests/test_hydiomatic.hy index 45804d8..67902fe 100644 --- a/tests/test_hydiomatic.hy +++ b/tests/test_hydiomatic.hy @@ -180,20 +180,37 @@ (-> a b c d)) (assert-step (-> a) a) + (assert-step (apply (.method self param1 param2) + {"key" "value"}) + (self.method #* [param1 param2] + #** {"key" "value"})) (assert-step (kwapply (.method self param1 param2) {"key" "value"}) - (apply self.method [param1 param2] - {"key" "value"})) + (self.method #* [param1 param2] + #** {"key" "value"})) + (assert-step (apply (.method (some-stuff)) + {"key" "value"}) + (.method #* [(some-stuff)] + #** {"key" "value"})) (assert-step (kwapply (.method (some-stuff)) {"key" "value"}) - (apply .method [(some-stuff)] - {"key" "value"})) + (.method #* [(some-stuff)] + #** {"key" "value"})) + (assert-step (apply (method param1 param2) + {"key" "value"}) + (method #* [param1 param2] + #** {"key" "value"})) (assert-step (kwapply (method param1 param2) {"key" "value"}) - (apply method [param1 param2] - {"key" "value"}))) + (method #* [param1 param2] + #** {"key" "value"})) + + (assert-step (apply method [param1 param2] + {"key" "value"}) + (method #* [param1 param2] + #** {"key" "value"}))) (defn test-rules-optimo [] (assert-step (defn foo [x] From 150b5893f83541774fffb3328c7361da6a4310dc Mon Sep 17 00:00:00 2001 From: "Brandon T. Willard" Date: Fri, 5 Oct 2018 17:51:27 -0500 Subject: [PATCH 3/3] Add tests for new rules and disable old style `let/with` conversion --- hydiomatic/core.hy | 17 +- hydiomatic/rulesets/grand_cleanupo.hy | 82 +++++--- hydiomatic/rulesets/syntaxo.hy | 14 +- tests/test_hydiomatic.hy | 287 +++++++++++++------------- 4 files changed, 225 insertions(+), 175 deletions(-) diff --git a/hydiomatic/core.hy b/hydiomatic/core.hy index df96502..bce722c 100644 --- a/hydiomatic/core.hy +++ b/hydiomatic/core.hy @@ -14,8 +14,9 @@ ;; You should have received a copy of the GNU Lesser General Public ;; License along with this program. If not, see . -(import [hy.contrib.walk [prewalk]] - [adderall.dsl [*]]) +(import hy.contrib.walk + [adderall.dsl [*]] + [adderall.internal [ConsPair car cdr]]) (import [hydiomatic.rules [*]]) (require [hy.contrib.walk [let]]) @@ -23,6 +24,18 @@ (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))] (if (empty? alts) diff --git a/hydiomatic/rulesets/grand_cleanupo.hy b/hydiomatic/rulesets/grand_cleanupo.hy index cd675de..9a1f35c 100644 --- a/hydiomatic/rulesets/grand_cleanupo.hy +++ b/hydiomatic/rulesets/grand_cleanupo.hy @@ -16,9 +16,12 @@ (import [adderall.dsl [*]] [adderall.extra.misc [*]] + [adderall.internal [ConsPair]] + [hydiomatic.utils [hypprint hypformat]] [hy [HySymbol HyList HyExpression]]) (require [adderall.dsl [*]]) +(require [adderall.debug [*]]) (require [hydiomatic.macros [*]]) @@ -30,8 +33,9 @@ (defn transform-bindingᵒ [in out] (prep - (condᵉ [(typeᵒ in HyList) (≡ out in)] - (else (≡ out `[~in None]))))) + (condᵉ [(typeᵒ in HyList) (≡ out in)] + ;; FIXME: This is the problematic None pairing step. + (else (≡ out `[~in None]))))) (defn transform-conditionᵒ [in out] (prep @@ -69,18 +73,23 @@ (≡ out (cons 'defn ?name ?body)))) (defrules [rules/grand-cleanupᵒ rules/grand-cleanupo] + ;; TODO FIXME: Given the new, strict argument pairing in `let`, + ;; this logic is now too eager and splits up valid + ;; binding pairs, reassigning each element to `None` + ;; (e.g. [x y] -> [x None y None]). + ;; (let [[x 1] [y 2] z] ...) => (let [x 1 y 2 z None] ...) ;; (with [[x 1] [y 2] z] ...) => (with [x 1 y 2 z None] ...) - (prep - (≡ expr (cons ?op ?bindings ?body)) - (memberᵒ ?op `[let with]) - (transform-listᵒ transform-bindingᵒ ?bindings ?new-bindings) - (project [?new-bindings] - (≡ ?flat-bindings (simple-flatten ?new-bindings))) - (condᵉ - [(≡ ?op `let) (≡ ?new-op `$hydiomatic/let$)] - [(≡ ?op `with) (≡ ?new-op `$hydiomatic/with$)]) - (≡ out (cons ?new-op ?flat-bindings ?body))) + ;; (prep + ;; (≡ expr (cons ?op ?bindings ?body)) + ;; (memberᵒ ?op `[let with]) + ;; (transform-listᵒ transform-bindingᵒ ?bindings ?new-bindings) + ;; (project [?new-bindings] + ;; (≡ ?flat-bindings (simple-flatten ?new-bindings))) + ;; (condᵉ + ;; [(≡ ?op `let) (≡ ?new-op `$hydiomatic/let$)] + ;; [(≡ ?op `with) (≡ ?new-op `$hydiomatic/with$)]) + ;; (≡ out (cons ?new-op ?flat-bindings ?body))) ;; (for [...] (do ...)) => (for [...] ...) [`(for ~?bindings ~(cons 'do ?body)) @@ -129,13 +138,13 @@ (project [?new-form] (≡ out (HyExpression ?new-form)))) - ;; TODO: Add a test! - [`(require ~?lib) `(require [~?lib [*]])] + (prep + (≡ expr `(require ~?lib)) + (condᵉ [(typeᵒ ?lib HySymbol)]) + (≡ `(require [~?lib [*]]) out)) - ;; TODO: Add a test! [`(import [~?lib]) `(import ~?lib)] - ;; TODO: Add a test! [`(list-comp ~?body [~?x ~?bindings]) `(lfor ~?x ~?bindings ~?body)] @@ -180,8 +189,24 @@ [`filterfalse `remove] ;; (car . cdr) => (cons car cdr) - ;; XXX FIXME TODO: This will result in a `cons` object dependency! - [`(~?car . ~?cdr) (cons ?car ?cdr)]) + (prep + (≡ expr `(~?car . ~?cdr)) + (≡ ?cons-out `(cons ~?car ~?cdr)) + ;; At the very least, let's give a warning about the necessary + ;; import. + (project [expr] + (log (.format (+ "; TODO XXX FIXME: Cons objects have been removed, " + "consider refactoring: `{0}`.\n" + "; This cons has been replaced by cons and ConsPair from " + "`adderall.internal`.\n; You will need to manually " + "include these dependencies.") + (.rstrip (hypformat expr))))) + ;; TODO Find a better way to automatically add the import. + ;; E.g. at the beginning of the file. + #_(≡ out `(do + (import [adderall.internal [cons ConsPair]]) + ~?cons-out)) + (≡ out ?cons-out))) (defrules [rules/grand-cleanup-finishᵒ rules/grand-cleanup-finisho] ;; $hydiomatic/let$ => let @@ -192,12 +217,21 @@ $hydiomatic/with$ $hydiomatic/defclass$]) (condᵉ - ;; TODO: `let` isn't builtin anymore, so should we include the `require` - ;; statement? [(≡ ?op `$hydiomatic/let$) - (≡ ?new-op `let)] + (≡ ?new-op `let) + (project [expr] + (log (.format (+ "; TODO XXX FIXME: The `let` macro has been relocated to `hy.contrib.walk`.\n" + "; You will need to manually include this dependency.") + (.rstrip (hypformat expr))))) + (≡ out (cons ?new-op ?args)) + ;; TODO: Check the appropriate context for the presence (or lack) of this + ;; import. + #_(≡ out `(do + (require [hy.contrib.walk [let]]) + ~(cons ?new-op ?args)))] [(≡ ?op `$hydiomatic/with$) - (≡ ?new-op `with)] + (≡ ?new-op `with) + (≡ out (cons ?new-op ?args))] [(≡ ?op `$hydiomatic/defclass$) - (≡ ?new-op `defclass)]) - (≡ out (cons ?new-op ?args)))) + (≡ ?new-op `defclass) + (≡ out (cons ?new-op ?args))]))) diff --git a/hydiomatic/rulesets/syntaxo.hy b/hydiomatic/rulesets/syntaxo.hy index 27eff78..5552bea 100644 --- a/hydiomatic/rulesets/syntaxo.hy +++ b/hydiomatic/rulesets/syntaxo.hy @@ -86,11 +86,11 @@ (≡ out `(~?call-name #* ~?new-params #** ~?kwargs))) ;; ([kw]apply (foo bar baz) {...} => (foo #* [bar baz] #** {...}) + ;; ([kw]apply foo bar baz {...} => (foo #* [bar baz] #** {...}) (prep - (condᵉ [(≡ expr `(kwapply ~(cons ?method ?params) ~?kwargs))] - [(≡ expr `(apply ~(cons ?method ?params) ~?kwargs))] - ;; TODO: Do we need a kwapply version of the following? - [(≡ expr `(apply ~?method ~?params ~?kwargs))]) - (project [?params] - (≡ ?new-params (HyList ?params))) - (≡ out `(~?method #* ~?new-params #** ~?kwargs)))) + (condᵉ [(≡ expr `(~?op ~(cons ?method ?params) ~?kwargs))] + [(≡ expr `(~?op ~?method ~?params ~?kwargs))]) + (memberᵒ ?op `[kwapply apply]) + (project [?params] + (≡ ?new-params (HyList ?params))) + (≡ out `(~?method #* ~?new-params #** ~?kwargs)))) diff --git a/tests/test_hydiomatic.hy b/tests/test_hydiomatic.hy index 67902fe..e820192 100644 --- a/tests/test_hydiomatic.hy +++ b/tests/test_hydiomatic.hy @@ -14,21 +14,13 @@ ;; You should have received a copy of the GNU Lesser General Public ;; License along with this program. If not, see . -(import [hy [HyDict HyList]] +(import [nose.tools [eq_]] + [hy [HyDict HyList]] [hydiomatic.rules [*]] [hydiomatic.core [*]]) (require [hy.contrib.walk [let]]) - -(defmacro assert-step [expr expected] - `(assert (= (simplify-step '~expr rules/experimental) - '~expected))) - -(defmacro assert-simplify [expr expected] - `(assert (= (simplify '~expr rules/experimental) - '~expected))) - (defmacro/g! wrap-stdout [&rest body] `(do (import sys @@ -40,6 +32,9 @@ (setv sys.stdout ~g!old-stdout) [~g!stdout ~g!result])) +(defmacro assert-step [expr expected] + `(eq_ (simplify-step '~expr rules/experimental) '~expected)) + (defn test-rules-arithmetico [] (assert-step (+ 2 1) (inc 2)) (assert-step (+ 1 2) (inc 2)) @@ -55,18 +50,15 @@ (assert-step `~x x)) (defn test-rules-control-structo [] - (assert-step (if True :yes None) - (when True :yes)) - (assert-step (if True None :no) - (unless True :no)) + (assert-step (if True :yes None) (when True :yes)) + (assert-step (if True None :no) (unless True :no)) (assert-step (if True (do (and this that))) (when True (and this that))) - (assert-step (if True ~@a) - (if True ~@a)) + (assert-step (if True ~@a) (if True ~@a)) (assert-step (when (not True) :hello) (unless True :hello)) (assert-step (do something) - something) + something) (assert-step (when True (do stuff)) (when True stuff)) (assert-step (unless True (do stuff)) @@ -98,16 +90,16 @@ (assert-step (if True a) (when True a)) (assert-step (let [[a 1] [b 2]] - (do (print a b) - (+ a b))) + (do (print a b) + (+ a b))) (let [[a 1] [b 2]] - (print a b) - (+ a b))) + (print a b) + (+ a b))) (assert-step (loop [[i 1]] (do - (print i) - (when (< i 10) - (recur (inc i))))) + (print i) + (when (< i 10) + (recur (inc i))))) (loop [[i 1]] (print i) (when (< i 10) @@ -120,19 +112,19 @@ True)))) (defn test-rules-equalityo [] - (assert-step (= 0 x) (zero? x)) - (assert-step (= x 0) (zero? x)) - (assert-step (< 0 x) (pos? x)) - (assert-step (> x 0) (pos? x)) - (assert-step (< x 0) (neg? x)) - (assert-step (is n None) (none? n)) - (assert-step (is None n) (none? n)) - (assert-step (none? n) (none? n)) - (assert-step (= (% n 2) 0) (even? n)) - (assert-step (= (% n 2) 1) (odd? n)) - (assert-step (not (is a b c)) (is-not a b c)) - (assert-step (not (= a b c)) (!= a b c)) - (assert-step (not (in a b c)) (not-in a b c)) + (assert-step (= 0 x) (zero? x)) + (assert-step (= x 0) (zero? x)) + (assert-step (< 0 x) (pos? x)) + (assert-step (> x 0) (pos? x)) + (assert-step (< x 0) (neg? x)) + (assert-step (is n None) (none? n)) + (assert-step (is None n) (none? n)) + (assert-step (none? n) (none? n)) + (assert-step (= (% n 2) 0) (even? n)) + (assert-step (= (% n 2) 1) (odd? n)) + (assert-step (not (is a b c)) (is-not a b c)) + (assert-step (not (= a b c)) (!= a b c)) + (assert-step (not (in a b c)) (not-in a b c)) (assert-step (if-not (is condition False) 'yes 'no) (if (is-not condition False) 'yes 'no))) @@ -152,20 +144,15 @@ (assert-step (defn foo (a b c) "docstring!" (+ a b c)) (defn foo [a b c] "docstring!" (+ a b c))) (let [alt (simplify-step '(defn foo (a b c) (+ a b c)))] - (assert (= (type (get alt 2)) - HyList))) + (eq_ (type (get alt 2)) HyList)) (let [alt (simplify-step '(defun foo (a b c) (+ a b c)))] - (assert (= (type (get alt 2)) - HyList))) + (eq_ (type (get alt 2)) HyList)) (let [alt (simplify-step '(defn-alias [foo bar] (a b c) (+ a b c)))] - (assert (= (type (get alt 2)) - HyList))) + (eq_ (type (get alt 2)) HyList)) (let [alt (simplify-step '(defun-alias [foo bar] (a b c) (+ a b c)))] - (assert (= (type (get alt 2)) - HyList))) + (eq_ (type (get alt 2)) HyList)) (let [alt (simplify-step '(defn foo (a b c) "docstring!" (+ a b c)))] - (assert (= (type (get alt 2)) - HyList))) + (eq_ (type (get alt 2)) HyList)) (assert-step (isinstance x foo) (instance? foo x)) (assert-step (instance? float x) (float? x)) @@ -181,27 +168,27 @@ (assert-step (-> a) a) (assert-step (apply (.method self param1 param2) - {"key" "value"}) + {"key" "value"}) (self.method #* [param1 param2] - #** {"key" "value"})) + #** {"key" "value"})) (assert-step (kwapply (.method self param1 param2) {"key" "value"}) (self.method #* [param1 param2] - #** {"key" "value"})) + #** {"key" "value"})) (assert-step (apply (.method (some-stuff)) - {"key" "value"}) + {"key" "value"}) (.method #* [(some-stuff)] - #** {"key" "value"})) + #** {"key" "value"})) (assert-step (kwapply (.method (some-stuff)) {"key" "value"}) (.method #* [(some-stuff)] - #** {"key" "value"})) + #** {"key" "value"})) (assert-step (apply (method param1 param2) - {"key" "value"}) + {"key" "value"}) (method #* [param1 param2] - #** {"key" "value"})) + #** {"key" "value"})) (assert-step (kwapply (method param1 param2) {"key" "value"}) (method #* [param1 param2] @@ -215,38 +202,38 @@ (defn test-rules-optimo [] (assert-step (defn foo [x] (let [[y (inc x)]] - (print x y))) + (print x y))) (defn foo [x] (setv y (inc x)) (print x y))) (assert-step (defun foo [x] (let [[y (inc x)]] - (print x y))) + (print x y))) (defun foo [x] (setv y (inc x)) (print x y))) (assert-step (defn-alias [foo bar] [x] (let [[y (inc x)]] - (print x y))) + (print x y))) (defn-alias [foo bar] [x] (setv y (inc x)) (print x y))) (assert-step (defun-alias [foo bar] [x] (let [[y (inc x)]] - (print x y))) + (print x y))) (defun-alias [foo bar] [x] (setv y (inc x)) (print x y))) (assert-step (defn foo [x a &optional [foo 'bar]] (let [[y (inc x)]] - (print x y))) + (print x y))) (defn foo [x a &optional [foo 'bar]] (setv y (inc x)) (print x y))) (assert-step (defn foo [x] (let [[y (inc x)] [z (inc y)]] - (print x y) - (+ x y z))) + (print x y) + (+ x y z))) (defn foo [x] (setv y (inc x)) (setv z (inc y)) @@ -255,7 +242,7 @@ (assert-step (defn foo [x] "This is my docstring" (let [[y (inc x)]] - (print x y))) + (print x y))) (defn foo [x] "This is my docstring" (setv y (inc x)) @@ -263,11 +250,11 @@ (assert-step (defn foo [x] (make-something) (let [[y (inc x)]] - (print x y))) + (print x y))) (defn foo [x] (make-something) (let [[y (inc x)]] - (print x y)))) + (print x y)))) (assert-step (fn [x] (none? x)) none?) @@ -286,97 +273,103 @@ (assert-step () ()) (assert-step (inc 2) (inc 2)) (assert-step [a] [a]) - (assert (= (type (simplify '[])) - HyList))) + (eq_ (type (simplify '[])) HyList)) + +(defmacro assert-simplify [expr expected] + `(eq_ (simplify '~expr rules/experimental) '~expected)) (defn test-simplify [] (assert-simplify (something (+ 1 (+ 1))) (something (inc 1))) (assert-simplify (* 2 (* 3 (+ 5 (+ 1)))) - (* 2 3 (inc 5))) + (* 2 3 (inc 5))) (assert-simplify (* a (* b (+ c (+ 1)))) - (* a b (inc c))) + (* a b (inc c))) (assert-simplify [a b (+ 2 1) `~x] - [a b (inc 2) x]) + [a b (inc 2) x]) (assert-simplify (if True (do this) (do that)) - (if True this that)) + (if True this that)) (assert-simplify (setv a {"foo" (+ 1 1)}) - (setv a {"foo" (inc 1)})) + (setv a {"foo" (inc 1)})) (assert-simplify (= (len coll) 0) - (empty? coll)) + (empty? coll)) (assert-simplify (defmacro if-truth [test &rest branches] - (if (not (is ~test)) ~@branches)) - (defmacro if-truth [test &rest branches] - (if (is-not ~test) ~@branches))) + (if (not (is ~test)) ~@branches)) + (defmacro if-truth [test &rest branches] + (if (is-not ~test) ~@branches))) (assert-simplify {"foo" "bar"} {"foo" "bar"}) - (assert (= (type (simplify '{"foo" "bar"})) - HyDict))) + (eq_ (type (simplify '{"foo" "bar"})) HyDict)) (defn test-warnings [] - (assert (= (wrap-stdout - (simplify-step '(defn nodocs [a] (inc a)) - rules/warnings)) - ["; Function `nodocs` has no docstring.\n" - `(defn nodocs [a] (inc a))])) - - (assert (= (wrap-stdout - (simplify-step '(fn [a, b] (+ a b)) - rules/warnings)) - ["; In `(fn [a, b] (+ a b))`, you may want to use `a` instead of `a,` in the arglist.\n" - `(fn [a, b] (+ a b))])) - - (assert (= (wrap-stdout - (simplify-step '(fresh [f r] - (firstᵒ l f) - (restᵒ l r)) - rules/warnings)) - ["; Instead of `(firstᵒ l f)` and `(restᵒ l r)`, consider using `(consᵒ f r l)`.\n" - `(fresh [f r] - (firstᵒ l f) - (restᵒ l r))])) - (assert (= (wrap-stdout - (simplify '(def FOO "bar") + (eq_ (wrap-stdout (simplify-step '(defn nodocs [a] (inc a)) + rules/warnings)) + ["; Function `nodocs` has no docstring.\n" + `(defn nodocs [a] (inc a))]) + + (eq_ (wrap-stdout + (simplify-step '(fn [a, b] (+ a b)) rules/warnings)) - ["; Instead of `FOO`, consider using `*foo*`.\n" - `(def FOO "bar")]))) + ["; In `(fn [a, b] (+ a b))`, you may want to use `a` instead of `a,` in the arglist.\n" + `(fn [a, b] (+ a b))]) + + (eq_ (wrap-stdout + (simplify-step '(fresh [f r] + (firstᵒ l f) + (restᵒ l r)) + rules/warnings)) + ["; Instead of `(firstᵒ l f)` and `(restᵒ l r)`, consider using `(consᵒ f r l)`.\n" + `(fresh [f r] + (firstᵒ l f) + (restᵒ l r))]) + (eq_ (wrap-stdout + (simplify '(def FOO "bar") + rules/warnings)) + ["; Instead of `FOO`, consider using `*foo*`.\n" + `(def FOO "bar")])) (defmacro assert-cleanup [expr expected] - `(assert (= (simplify '~expr rules/grand-cleanup) - '~expected))) + `(eq_ (simplify '~expr rules/grand-cleanup) '~expected)) (defn test-grand-cleanup [] (assert-cleanup (let [x] x) - (let [x None] x)) - (assert-cleanup (let [[x 1] - [y (+ x 2)]] - (, x y)) - (let [x 1 - y (+ x 2)] - (, x y))) - (assert-cleanup (with [[x 1] [y 2] z] - (, x y z)) - (with [x 1 y 2 z None] - (, x y z))) - (assert-cleanup (let [[[x y] [1 2]] - z - [a (+ x y)]] - (, a z)) - (let [[x y] [1 2] - z None - a (+ x y)] - (, a z))) - (assert-cleanup (defn some-function [] - (let [[x 1]] - x)) - (defn some-function [] - (let [x 1] - x))) + (let [x] x) + #_(let [x None] x)) + ;; Don't break perfectly fine `let`s. + (assert-cleanup (let [x y] x) + (let [x y] x)) + ;; TODO: We can't reinstate these until some form of `let` argument pairing is + ;; implemented; otherwise, the test that follows (and all well-formatted `let` + ;; bindings) will be broken. + #_(assert-cleanup (let [[x 1] + [y (+ x 2)]] + (, x y)) + (let [x 1 + y (+ x 2)] + (, x y))) + #_(assert-cleanup (let [[[x y] [1 2]] + z + [a (+ x y)]] + (, a z)) + (let [[x y] [1 2] + ;; TODO: Same as above. + ;; z None + z + a (+ x y)] + (, a z))) + #_(assert-cleanup (with [[x 1] [y 2] z] + (, x y z)) + (with [x 1 y 2 z None] + (, x y z))) + #_(assert-cleanup (defn some-function [] + (let [[x 1]] x)) + (defn some-function [] + (let [x 1] x))) (assert-cleanup (for [x (range 5) y (range 5)] (do - (print x y) - (, x y))) + (print x y) + (, x y))) (for [x (range 5) y (range 5)] (print x y) @@ -433,13 +426,13 @@ (assert-cleanup (throw) (raise)) (assert-cleanup (try - (do-something) - (catch [e Exception] - (handle-it!))) + (do-something) + (catch [e Exception] + (handle-it!))) (try - (do-something) - (except [e Exception] - (handle-it!)))) + (do-something) + (except [e Exception] + (handle-it!)))) (assert-cleanup (progn something something-else) @@ -463,16 +456,26 @@ (assert-cleanup (defn foo [] null) (defn foo [] None)) - ;; XXX TODO: There is no zipwith in Hy or Python (anymore, at least). (assert-cleanup (zipwith operator.add [1 2 3] [4 5 6]) (map operator.add [1 2 3] [4 5 6])) (assert-cleanup (filterfalse odd? [1 2 3 4 5 6 7]) - (remove odd? [1 2 3 4 5 6 7]))) + (remove odd? [1 2 3 4 5 6 7])) + + (assert-cleanup (require blah) (require [blah [*]])) + (assert-cleanup (import [blah]) (import blah)) + + (assert-cleanup (list-comp (print x) [x (range 10)]) + (lfor x (range 10) (print x))) + + (assert-cleanup (car . cdr) + (cons car cdr) + #_(do + (import [adderall.internal [cons ConsPair]]) + (cons car cdr)))) (defmacro assert-joke [expr expected] - `(assert (= (simplify '~expr rules/jokes) - ~expected))) + `(eq_ (simplify '~expr rules/jokes) ~expected)) (defn test-jokes [] (assert-joke foo? (HySymbol "foo, eh?")))