├── LICENSE ├── README.rst ├── hyskell.hy ├── setup.py └── test_hyskell.hy /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 Ryan Gonzalez 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.rst: -------------------------------------------------------------------------------- 1 | Hyskell 2 | ======= 3 | 4 | This brings two functional-ish things to Hy: accumulating for loops and unions/pattern matching. Just prefix your files with this: 5 | 6 | .. code-block:: hy 7 | 8 | (require hyskell) 9 | 10 | accfor 11 | ****** 12 | 13 | `accfor` is a `for` loop that is actually an iterator. It's basically `genexpr` with a nicer syntax that can take anything; not just a single expression. 14 | 15 | .. code-block:: hy 16 | 17 | (print (list (accfor [x [1 2 3]] x))) ; prints [1 2 3] 18 | 19 | defunion 20 | ******** 21 | 22 | Defines a union type: 23 | 24 | .. code-block:: hy 25 | 26 | (defunion Node 27 | (Nint val) 28 | (Nstr val)) 29 | 30 | This example defines three types: `Node` (a base class), `Nint` (a class with one attribute: val), and `Nstr` (same as `Nint`). 31 | 32 | You can use the types like any other type: 33 | 34 | .. code-block:: hy 35 | 36 | (setv i (Nint 7)) 37 | (setv s (Nstr "abc")) 38 | 39 | match 40 | ***** 41 | 42 | True ML-style pattern matching: 43 | 44 | .. code-block:: hy 45 | 46 | (match value 47 | [[1 2 3] (print "Got list [1 2 3]")] ; against a list 48 | [[:a 2 3] (print "Got list with a =" a)] ; grab values with : 49 | [(, 1 2) (print "Got tuple (1, 2)")] ; against a tuple 50 | [1 (print "Got 1")] ; against an int or string 51 | [(Nint :v) (print "Got Nint with v =" v)] ; against a union branch 52 | [(Nstr (:val "abc")) (print "Got Nstr with val of abc")] ; use : at the beginning of an expression to test attributes 53 | [(Nstr _) (print "Got Nstr")] ; use _ to ignore values 54 | [[1 2 ...] (print "Got list that starts with 1 and 2")] ; use ... to allow extra items at the end 55 | [[_ _ ...] (print "Got list with >= 2 elements")] ; use ... with _ to do cool stuff 56 | [_ (print "Got something weird!")]) ; you can also use _ for a fallthrough statement 57 | 58 | If none of the branches match, a `hyskell.MatchFailure` exception is thrown. 59 | 60 | Examples 61 | ******** 62 | 63 | See `test_hyskell.hy` for the unit tests, written using `HyTest `_. 64 | -------------------------------------------------------------------------------- /hyskell.hy: -------------------------------------------------------------------------------- 1 | (import [hy.models.string [HyString]] 2 | [hy.models.symbol [HySymbol]] 3 | [hy.models.list [HyList]] 4 | [hy.models.keyword [HyKeyword]] 5 | [hy.models.expression [HyExpression]]) 6 | 7 | (defclass MatchFailure [Exception] []) 8 | 9 | (defn match-failed [] 10 | (raise (MatchFailure "match failed"))) 11 | 12 | (defn try-func [f] 13 | (try 14 | (do (f) true) 15 | (except [] false))) 16 | 17 | (defmacro accfor [args &rest body] 18 | (setv names (cut args 0 nil 2)) 19 | `(genexpr ((fn [~@names] ~@body) ~@names) [~@args])) 20 | 21 | (defmacro defunion [name &rest types] 22 | (setv base `(defclass ~name [object] [])) 23 | (setv classes (accfor [t types] 24 | (setv fields (HyList (cdr t))) 25 | (setv field-slist (HyList (map HyString fields))) 26 | (setv field-mlist (list (accfor [f fields] `(. self ~f)))) 27 | (defn mk-fmstr [s] 28 | (HyString (.join ", " (accfor [f fields] (% "%s=%%%s" (, f s)))))) 29 | (setv field-sfmstr (mk-fmstr "s")) 30 | (setv field-rfmstr (mk-fmstr "r")) 31 | (setv sname (HyString (car t))) 32 | (defn mk-fmfn [v] 33 | `(% "%s(%s)" (, ~sname (% ~v (, ~@field-mlist))))) 34 | `(defclass ~(get t 0) [~name] 35 | [--init-- (fn [self ~@fields] 36 | (for [x (zip ~field-slist ~fields)] 37 | (setattr self (get x 0) (get x 1))) 38 | (setv self.-fields ~field-slist) 39 | nil 40 | )] 41 | [--str-- (fn [self] ~(mk-fmfn field-sfmstr))] 42 | [--repr-- (fn [self] ~(mk-fmfn field-rfmstr))]))) 43 | (setv result (list (+ [base] (list classes)))) 44 | `(do ~@result nil)) 45 | 46 | (defmacro match [x &rest branches] 47 | (defn get-tp [p] 48 | (cond 49 | [(isinstance p HyExpression) 50 | (cond 51 | [(= (car p) `,) "tupl-match"] 52 | [(.startswith (car p) "\ufdd0:") "keyword-arg"] 53 | [true "data-match"])] 54 | [(isinstance p HySymbol) 55 | (if (= p `_) "fallthough" "test-value")] 56 | [(isinstance p HyList) "list-match"] 57 | [(isinstance p HyKeyword) "grap-value"] 58 | [true "test-value"])) 59 | 60 | (defn map-fields [func var p f] 61 | (setv res []) 62 | (for [[i x] (enumerate p)] 63 | (if (= x (HySymbol "...")) 64 | (break)) 65 | (res.append (func (f (HyInteger i)) x))) 66 | (and res (reduce + res))) 67 | 68 | (defn match-base [func var p fields no-slc] 69 | (unless no-slc (setv p (cut p 1))) 70 | (map-fields func var p (fn [i] (if fields `(getattr ~var (get (. ~var -fields) ~i)) 71 | `(get ~var ~i))))) 72 | 73 | (defn cond-match-base [var p &optional t no-slc fields] 74 | (setv p2 (if no-slc p (cut p 1))) 75 | (+ [`(isinstance ~var ~(or t (get p 0))) ] 76 | (match-base recurse-cond var p fields no-slc))) 77 | 78 | (defn body-match-base [var p &optional fields no-slc] 79 | (match-base recurse-body var p fields no-slc)) 80 | 81 | (defn get-kw-path [var p] 82 | (setv base (get var 2 1 1)) 83 | `(. ~base ~(HySymbol (cut (car p) 2)))) 84 | 85 | (defn recurse-cond [var p] 86 | (setv tp (get-tp p)) 87 | (cond 88 | [(= tp "data-match") (cond-match-base var p :fields true)] 89 | [(= tp "tupl-match") (cond-match-base var p :t `tuple)] 90 | [(= tp "list-match") (cond-match-base var p :t `list :no-slc true)] 91 | [(= tp "test-value") [`(and (.try-func (--import-- "hyskell") 92 | (fn [] ~var)) (= ~var ~p))]] 93 | [(= tp "keyword-arg") (if (!= (len p) 2) 94 | (macro-error p "keyword matches need 2 args")) 95 | ; [`(. ~base ~(HySymbol (cut (car p) 2)))] 96 | (recurse-cond (get-kw-path var p) (get p 1))] 97 | [(= tp "fallthough") [`(.try-func (--import-- "hyskell") (fn [] ~var))]] 98 | [true []])) 99 | 100 | (defn recurse-body [var p] 101 | (setv tp (get-tp p)) 102 | (cond 103 | [(= tp "data-match") (body-match-base var p :fields true)] 104 | [(= tp "tupl-match") (body-match-base var p)] 105 | [(= tp "list-match") (body-match-base var p :no-slc true)] 106 | [(= tp "grap-value") [`(setv ~(HySymbol (cut p 2)) ~var)]] 107 | [(= tp "keyword-arg") (recurse-body (get-kw-path var p) (get p 1))] 108 | [true []])) 109 | 110 | (setv var (.replace (gensym) x)) 111 | 112 | (.replace `(do 113 | (setv ~var ~x) 114 | (cond ~@(accfor [branch branches] 115 | (if (< (len branch) 2) 116 | (macro-error branch "branch requires >= two items")) 117 | (setv tag (get branch 0)) 118 | (setv cond `(and true true ~@(recurse-cond var tag))) 119 | (setv code `(do ~@(recurse-body var tag) ~@(cut branch 1))) 120 | (cond.replace tag) 121 | (code.replace (get branch 1)) 122 | (.replace `[~cond ~code] tag)) 123 | [true (.match-failed (--import-- "hyskell"))])) x)) 124 | -------------------------------------------------------------------------------- /setup.py: -------------------------------------------------------------------------------- 1 | try: 2 | # assert False 3 | from setuptools import setup 4 | from setuptools.command.install import install 5 | from setuptools.command.install_lib import install_lib 6 | kw = {'install_requires': 'hy >= 0.9.12'} 7 | except: 8 | from distutils.core import setup 9 | from distutils.command.install import install 10 | from distutils.command.install_lib import install_lib 11 | kw = {} 12 | 13 | # XXX: This is a hack 14 | import os, shutil 15 | 16 | orig_run = install_lib.run 17 | 18 | def run(self): 19 | self.skip_build = True 20 | if not os.path.isdir(self.build_dir): 21 | os.makedirs(os.path.join(os.path.curdir, self.build_dir)) 22 | shutil.copy('hyskell.hy', os.path.join(self.build_dir, 'hyskell.hy')) 23 | orig_run(self) 24 | 25 | install_lib.run = run 26 | 27 | assert install.sub_commands[0][0] == 'install_lib' 28 | install.sub_commands[0] = (install.sub_commands[0][0], lambda *_: True) 29 | 30 | version = '0.1' 31 | 32 | try: 33 | with open('README.rst', 'r') as f: 34 | readme = f.read() 35 | except: 36 | readme = '' 37 | 38 | setup(name='Hyskell', 39 | version=version, 40 | description='Functional-ish stuff for Hy', 41 | long_description=readme, 42 | author='Ryan Gonzalez', 43 | classifiers=[ 44 | 'License :: OSI Approved :: MIT License', 45 | 'Operating System :: OS Independent', 46 | 'Topic :: Software Development :: Testing' 47 | ], 48 | requires=['hy (>=0.9.12)'], 49 | **kw) 50 | -------------------------------------------------------------------------------- /test_hyskell.hy: -------------------------------------------------------------------------------- 1 | (require hyskell) 2 | (require hytest) 3 | 4 | (defunion Node 5 | (Nint p ival) 6 | (Nstr p sval)) 7 | 8 | (test-set test-accfor 9 | (test = (list (accfor [x [1 2 3] y [4 5 6]] [x y])) 10 | [[1 4] [1 5] [1 6] [2 4] [2 5] [2 6] [3 4] [3 5] [3 6]])) 11 | 12 | (test-set test-defunion 13 | (setv i (Nint 0 7)) 14 | (setv s (Nstr 1 "s")) 15 | (test = i.ival 7) 16 | (test = s.sval "s") 17 | (test = i.p 0) 18 | (test = s.p 1) 19 | (test true (isinstance i Node)) 20 | (test true (isinstance s Node)) 21 | (test = i.-fields ["p" "ival"]) 22 | (test = s.-fields ["p" "sval"])) 23 | 24 | (test-set test-match 25 | (match [1 2 3] 26 | [[1 2 3] nil]) 27 | (match [1 2 3] 28 | [[1 :b 3] (test = b 2)]) 29 | (match [1 2 3] 30 | [:v (test = v [1 2 3])]) 31 | (match [1 2 3] 32 | [_ nil]) 33 | 34 | (match (, 1 2 3) 35 | [(, :a :b 3) 36 | (test = a 1) 37 | (test = b 2)]) 38 | 39 | (match (Nint 0 2) 40 | [(Nint :p 2) (test = p 0)]) 41 | 42 | (setv x 2) 43 | (match 2 [x nil]) 44 | 45 | (match [1 2] 46 | [[1 _] nil]) 47 | 48 | (match [1] 49 | [[1 _] (fail-test "")] 50 | [_ nil]) 51 | 52 | (match (Nint 1 2) 53 | [(Nint) nil]) 54 | 55 | (match (Nint 1 2) 56 | [(Nint (:p 1) (:ival 2)) nil])) 57 | --------------------------------------------------------------------------------