Add a cons object and related mechanisms

Closes: #183

docs/language/core.rst

@@ -29,6 +29,48 @@ Returns true if argument is iterable and not a string.
    False
 
 
+cons
+----
+
+.. versionadded:: 0.9.13
+
+Usage: ``(cons a b)``
+
+Returns a fresh :ref:`cons cell <hycons>` with car `a` and cdr `b`.
+
+.. code-block:: clojure
+
+   => (setv a (cons 'hd 'tl))
+
+   => (= 'hd (car a))
+   True
+
+   => (= 'tl (cdr a))
+   True
+
+
+cons?
+-----
+
+.. versionadded:: 0.9.13
+
+Usage: ``(cons? foo)``
+
+Checks whether ``foo`` is a :ref:`cons cell <hycons>`.
+
+.. code-block:: clojure
+
+   => (setv a (cons 'hd 'tl))
+
+   => (cons? a)
+   True
+
+   => (cons? nil)
+   False
+
+   => (cons? [1 2 3])
+   False
+
 .. _dec-fn:
 
 dec
@@ -284,6 +326,28 @@ Contrast with :ref:`iterable?-fn`.
    => (iterator? (iter {:a 1 :b 2 :c 3}))
    True
 
+list*
+-----
+
+Usage: ``(list* head &rest tail)``
+
+Generate a chain of nested cons cells (a dotted list) containing the
+arguments. If the argument list only has one element, return it.
+
+.. code-block:: clojure
+
+   => (list* 1 2 3 4)
+   (1 2 3 . 4)
+
+   => (list* 1 2 3 [4])
+   [1, 2, 3, 4]
+
+   => (list* 1)
+   1
+
+   => (cons? (list* 1 2 3 4))
+   True
+
 .. _macroexpand-fn:
 
 macroexpand
@@ -863,5 +927,3 @@ Return an iterator from ``coll`` as long as predicate, ``pred`` returns True.
 
    => (list (take-while neg? [ 1 2 3 -4 5]))
    []
-
-

docs/language/internals.rst

@@ -172,6 +172,38 @@ keywords, that is keywords used by the language definition inside
 function signatures. Lambda-list keywords are symbols starting with a
 ``&``. The class inherits :ref:`HyString`
 
+.. _hycons:
+
+Cons Cells
+==========
+
+``hy.models.cons.HyCons`` is a representation of Python-friendly `cons
+cells`_.  Cons cells are especially useful to mimic features of "usual"
+LISP variants such as Scheme or Common Lisp.
+
+.. _cons cells: http://en.wikipedia.org/wiki/Cons
+
+A cons cell is a 2-item object, containing a ``car`` (head) and a
+``cdr`` (tail). In some Lisp variants, the cons cell is the fundamental
+building block, and S-expressions are actually represented as linked
+lists of cons cells. This is not the case in Hy, as the usual
+expressions are made of Python lists wrapped in a
+``HyExpression``. However, the ``HyCons`` mimicks the behavior of
+"usual" Lisp variants thusly:
+
+ - ``(cons something nil)`` is ``(HyExpression [something])``
+ - ``(cons something some-list)`` is ``((type some-list) (+ [something]
+   some-list))`` (if ``some-list`` inherits from ``list``).
+ - ``(get (cons a b) 0)`` is ``a``
+ - ``(slice (cons a b) 1)`` is ``b``
+
+Hy supports a dotted-list syntax, where ``'(a . b)`` means ``(cons 'a
+'b)`` and ``'(a b . c)`` means ``(cons 'a (cons 'b 'c))``. If the
+compiler encounters a cons cell at the top level, it raises a
+compilation error.
+
+``HyCons`` wraps the passed arguments (car and cdr) in Hy types, to ease
+the manipulation of cons cells in a macro context.
 
 Hy Internal Theory
 ==================

hy/__init__.py

@@ -32,6 +32,7 @@ from hy.models.symbol import HySymbol  # NOQA
 from hy.models.float import HyFloat  # NOQA
 from hy.models.dict import HyDict  # NOQA
 from hy.models.list import HyList  # NOQA
+from hy.models.cons import HyCons  # NOQA
 
 
 import hy.importer  # NOQA

hy/compiler.py

@@ -34,6 +34,7 @@ from hy.models.symbol import HySymbol
 from hy.models.float import HyFloat
 from hy.models.list import HyList
 from hy.models.dict import HyDict
+from hy.models.cons import HyCons
 
 from hy.errors import HyCompileError, HyTypeError
 
@@ -597,6 +598,24 @@ class HyASTCompiler(object):
             return imports, HyExpression([HySymbol(name),
                                           contents]).replace(form), False
 
+        elif isinstance(form, HyCons):
+            ret = HyExpression([HySymbol(name)])
+            nimport, contents, splice = self._render_quoted_form(form.car,
+                                                                 level)
+            if splice:
+                raise HyTypeError(form, "Can't splice dotted lists yet")
+            imports.update(nimport)
+            ret.append(contents)
+
+            nimport, contents, splice = self._render_quoted_form(form.cdr,
+                                                                 level)
+            if splice:
+                raise HyTypeError(form, "Can't splice the cdr of a cons")
+            imports.update(nimport)
+            ret.append(contents)
+
+            return imports, ret.replace(form), False
+
         elif isinstance(form, (HySymbol, HyLambdaListKeyword)):
             return imports, HyExpression([HySymbol(name),
                                           HyString(form)]).replace(form), False
@@ -2036,6 +2055,10 @@ class HyASTCompiler(object):
                             self.module_name)
         return Result()
 
+    @builds(HyCons)
+    def compile_cons(self, cons):
+        raise HyTypeError(cons, "Can't compile a top-level cons cell")
+
     @builds(HyInteger)
     def compile_integer(self, number):
         return ast.Num(n=long_type(number),

hy/core/language.hy

@@ -25,6 +25,8 @@
 
 
 (import [hy._compat [long-type]]) ; long for python2, int for python3
+(import [hy.models.cons [HyCons]])
+
 
 (defn _numeric-check [x]
   (if (not (numeric? x))
@@ -34,6 +36,14 @@
   "Checks whether item is a collection"
   (and (iterable? coll) (not (string? coll))))
 
+(defn cons [a b]
+  "Return a fresh cons cell with car = a and cdr = b"
+  (HyCons a b))
+
+(defn cons? [c]
+  "Check whether c can be used as a cons object"
+  (instance? HyCons c))
+
 (defn cycle [coll]
   "Yield an infinite repetition of the items in coll"
   (setv seen [])
@@ -193,6 +203,12 @@
   (try (= x (iter x))
        (catch [TypeError] false)))
 
+(defn list* [hd &rest tl]
+  "Return a dotted list construed from the elements of the argument"
+  (if (not tl)
+    hd
+    (cons hd (apply list* tl))))
+
 (defn macroexpand [form]
   "Return the full macro expansion of form"
   (import hy.macros)
@@ -314,9 +330,10 @@
   (_numeric_check n)
   (= n 0))
 
-(def *exports* '[calling-module-name coll? cycle dec distinct disassemble
-                 drop drop-while empty? even? first filter flatten float?
-                 gensym identity inc instance? integer integer? iterable?
-                 iterate iterator? macroexpand macroexpand-1 neg? nil?
-                 none? nth numeric? odd? pos? remove repeat repeatedly
-                 rest second string string? take take-nth take-while zero?])
+(def *exports* '[calling-module-name coll? cons cons? cycle dec distinct
+                 disassemble drop drop-while empty? even? first filter
+                 flatten float? gensym identity inc instance? integer
+                 integer? iterable? iterate iterator? list* macroexpand
+                 macroexpand-1 neg? nil? none? nth numeric? odd? pos?
+                 remove repeat repeatedly rest second string string?
+                 take take-nth take-while zero?])

hy/lex/parser.py

@@ -24,6 +24,7 @@ from functools import wraps
 from rply import ParserGenerator
 
 from hy.models.complex import HyComplex
+from hy.models.cons import HyCons
 from hy.models.dict import HyDict
 from hy.models.expression import HyExpression
 from hy.models.float import HyFloat
@@ -95,9 +96,40 @@ def real_main_empty(p):
     return []
 
 
+def reject_spurious_dots(*items):
+    "Reject the spurious dots from items"
+    for list in items:
+        for tok in list:
+            if tok == "." and type(tok) == HySymbol:
+                raise LexException("Malformed dotted list",
+                                   tok.start_line, tok.start_column)
+
+
 @pg.production("paren : LPAREN list_contents RPAREN")
 @set_boundaries
 def paren(p):
+    cont = p[1]
+
+    # Dotted lists are expressions of the form
+    # (a b c . d)
+    # that evaluate to nested cons cells of the form
+    # (a . (b . (c . d)))
+    if len(cont) >= 3 and isinstance(cont[-2], HySymbol) and cont[-2] == ".":
+
+        reject_spurious_dots(cont[:-2], cont[-1:])
+
+        if len(cont) == 3:
+            # Two-item dotted list: return the cons cell directly
+            return HyCons(cont[0], cont[2])
+        else:
+            # Return a nested cons cell
+            return HyCons(cont[0], paren([p[0], cont[1:], p[2]]))
+
+    # Warn preemptively on a malformed dotted list.
+    # Only check for dots after the first item to allow for a potential
+    # attribute accessor shorthand
+    reject_spurious_dots(cont[1:])
+
     return HyExpression(p[1])
 
 

hy/models/cons.py

@@ -0,0 +1,108 @@
+# Copyright (c) 2013 Nicolas Dandrimont <nicolas.dandrimont@crans.org>
+#
+# Permission is hereby granted, free of charge, to any person obtaining a
+# copy of this software and associated documentation files (the "Software"),
+# to deal in the Software without restriction, including without limitation
+# the rights to use, copy, modify, merge, publish, distribute, sublicense,
+# and/or sell copies of the Software, and to permit persons to whom the
+# Software is furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+# DEALINGS IN THE SOFTWARE.
+
+from hy.macros import _wrap_value
+from hy.models import HyObject
+from hy.models.expression import HyExpression
+from hy.models.symbol import HySymbol
+
+
+class HyCons(HyObject):
+    """
+    HyCons: a cons object.
+
+    Building a HyCons of something and a HyList really builds a HyList
+    """
+
+    __slots__ = ["car", "cdr"]
+
+    def __new__(cls, car, cdr):
+        if isinstance(cdr, list):
+
+            # Keep unquotes in the cdr of conses
+            if type(cdr) == HyExpression:
+                if len(cdr) > 0 and type(cdr[0]) == HySymbol:
+                    if cdr[0] in ("unquote", "unquote_splice"):
+                        return super(HyCons, cls).__new__(cls)
+
+            return cdr.__class__([_wrap_value(car)] + cdr)
+
+        elif cdr is None:
+            return HyExpression([_wrap_value(car)])
+
+        else:
+            return super(HyCons, cls).__new__(cls)
+
+    def __init__(self, car, cdr):
+        self.car = _wrap_value(car)
+        self.cdr = _wrap_value(cdr)
+
+    def __getitem__(self, n):
+        if n == 0:
+            return self.car
+        if n == slice(1, None):
+            return self.cdr
+
+        raise IndexError(
+            "Can only get the car ([0]) or the cdr ([1:]) of a HyCons")
+
+    def __setitem__(self, n, new):
+        if n == 0:
+            self.car = new
+            return
+        if n == slice(1, None):
+            self.cdr = new
+            return
+
+        raise IndexError(
+            "Can only set the car ([0]) or the cdr ([1:]) of a HyCons")
+
+    def __iter__(self):
+        yield self.car
+        try:
+            iterator = (i for i in self.cdr)
+        except TypeError:
+            if self.cdr is not None:
+                yield self.cdr
+                raise TypeError("Iteration on malformed cons")
+        else:
+            for i in iterator:
+                yield i
+
+    def replace(self, other):
+        if self.car is not None:
+            self.car.replace(other)
+        if self.cdr is not None:
+            self.cdr.replace(other)
+
+        HyObject.replace(self, other)
+
+    def __repr__(self):
+        if isinstance(self.cdr, self.__class__):
+            return "(%s %s)" % (repr(self.car), repr(self.cdr)[1:-1])
+        else:
+            return "(%s . %s)" % (repr(self.car), repr(self.cdr))
+
+    def __eq__(self, other):
+        return (
+            isinstance(other, self.__class__) and
+            self.car == other.car and
+            self.cdr == other.cdr
+        )

tests/__init__.py

@@ -2,6 +2,7 @@
 
 
 import hy  # noqa
+from .native_tests.cons import *  # noqa
 from .native_tests.defclass import *  # noqa
 from .native_tests.math import *  # noqa
 from .native_tests.native_macros import *  # noqa

tests/compilers/test_ast.py

@@ -475,3 +475,8 @@ def test_attribute_access():
     cant_compile("(. foo bar :baz [0] quux [frob])")
     cant_compile("(. foo bar baz (0) quux [frob])")
     cant_compile("(. foo bar baz [0] quux {frob})")
+
+
+def test_cons_correct():
+    """Ensure cons gets compiled correctly"""
+    can_compile("(cons a b)")

tests/lex/test_lex.py

@@ -1,4 +1,5 @@
 # Copyright (c) 2013 Paul Tagliamonte <paultag@debian.org>
+# Copyright (c) 2014 Nicolas Dandrimont <nicolas.dandrimont@crans.org>
 #
 # Permission is hereby granted, free of charge, to any person obtaining a
 # copy of this software and associated documentation files (the "Software"),
@@ -26,6 +27,8 @@ from hy.models.complex import HyComplex
 from hy.models.symbol import HySymbol
 from hy.models.string import HyString
 from hy.models.dict import HyDict
+from hy.models.list import HyList
+from hy.models.cons import HyCons
 
 from hy.lex import LexException, PrematureEndOfInput, tokenize
 
@@ -302,3 +305,32 @@ def test_lex_mangling_qmark():
     assert entry == [HySymbol("is_foo.bar")]
     entry = tokenize(".foo?.bar.baz?")
     assert entry == [HySymbol(".is_foo.bar.is_baz")]
+
+
+def test_simple_cons():
+    """Check that cons gets tokenized correctly"""
+    entry = tokenize("(a . b)")[0]
+    assert entry == HyCons(HySymbol("a"), HySymbol("b"))
+
+
+def test_dotted_list():
+    """Check that dotted lists get tokenized correctly"""
+    entry = tokenize("(a b c . (d . e))")[0]
+    assert entry == HyCons(HySymbol("a"),
+                           HyCons(HySymbol("b"),
+                                  HyCons(HySymbol("c"),
+                                         HyCons(HySymbol("d"),
+                                                HySymbol("e")))))
+
+
+def test_cons_list():
+    """Check that cons of something and a list gets tokenized as a list"""
+    entry = tokenize("(a . [])")[0]
+    assert entry == HyList([HySymbol("a")])
+    assert type(entry) == HyList
+    entry = tokenize("(a . ())")[0]
+    assert entry == HyExpression([HySymbol("a")])
+    assert type(entry) == HyExpression
+    entry = tokenize("(a b . {})")[0]
+    assert entry == HyDict([HySymbol("a"), HySymbol("b")])
+    assert type(entry) == HyDict

tests/models/test_cons.py

@@ -0,0 +1,56 @@
+# Copyright (c) 2013 Nicolas Dandrimont <nicolas.dandrimont@crans.org>
+#
+# Permission is hereby granted, free of charge, to any person obtaining a
+# copy of this software and associated documentation files (the "Software"),
+# to deal in the Software without restriction, including without limitation
+# the rights to use, copy, modify, merge, publish, distribute, sublicense,
+# and/or sell copies of the Software, and to permit persons to whom the
+# Software is furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+# DEALINGS IN THE SOFTWARE.
+
+from hy.models.cons import HyCons
+
+
+def test_cons_slicing():
+    """Check that cons slicing works as expected"""
+    cons = HyCons("car", "cdr")
+    assert cons[0] == "car"
+    assert cons[1:] == "cdr"
+    try:
+        cons[:]
+        assert True is False
+    except IndexError:
+        pass
+
+    try:
+        cons[1]
+        assert True is False
+    except IndexError:
+        pass
+
+
+def test_cons_replacing():
+    """Check that assigning to a cons works as expected"""
+    cons = HyCons("foo", "bar")
+    cons[0] = "car"
+
+    assert cons == HyCons("car", "bar")
+
+    cons[1:] = "cdr"
+    assert cons == HyCons("car", "cdr")
+
+    try:
+        cons[:] = "foo"
+        assert True is False
+    except IndexError:
+        pass

tests/models/test_list.py

@@ -2,8 +2,21 @@ from hy.models.list import HyList
 
 
 def test_list_add():
+    """Check that adding two HyLists generates a HyList"""
     a = HyList([1, 2, 3])
     b = HyList([3, 4, 5])
     c = a + b
     assert c == [1, 2, 3, 3, 4, 5]
     assert c.__class__ == HyList
+
+
+def test_list_slice():
+    """Check that slicing a HyList produces a HyList"""
+    a = HyList([1, 2, 3, 4])
+    sl1 = a[1:]
+    sl5 = a[5:]
+
+    assert type(sl1) == HyList
+    assert sl1 == HyList([2, 3, 4])
+    assert type(sl5) == HyList
+    assert sl5 == HyList([])

tests/native_tests/cons.hy

@@ -0,0 +1,63 @@
+(defn test-cons-mutability []
+  "Test the mutability of conses"
+  (setv tree (cons (cons 1 2) (cons 2 3)))
+  (setv (car tree) "foo")
+  (assert (= tree (cons "foo" (cons 2 3))))
+  (setv (cdr tree) "bar")
+  (assert (= tree (cons "foo" "bar"))))
+
+
+(defn test-cons-quoting []
+  "Test quoting of conses"
+  (assert (= (cons 1 2) (quote (1 . 2))))
+  (assert (= (quote foo) (car (quote (foo . bar)))))
+  (assert (= (quote bar) (cdr (quote (foo . bar))))))
+
+
+(defn test-cons-behavior []
+  "NATIVE: test the behavior of cons is consistent"
+  (defn t= [a b]
+    (and (= a b) (= (type a) (type b))))
+  (assert (t= (cons 1 2) '(1 . 2)))
+  (assert (t= (cons 1 nil) '(1)))
+  (assert (t= (cons nil 2) '(nil . 2)))
+  (assert (t= (cons 1 []) [1]))
+  (setv tree (cons (cons 1 2) (cons 2 3)))
+  (assert (t= (car tree) (cons 1 2)))
+  (assert (t= (cdr tree) (cons 2 3))))
+
+
+(defn test-cons-iteration []
+  "NATIVE: test the iteration behavior of cons"
+  (setv x '(0 1 2 3 4 . 5))
+  (setv it (iter x))
+  (for* [i (range 6)]
+    (assert (= i (next it))))
+  (assert
+   (= 'success
+      (try
+       (do
+        (next it)
+        'failurenext)
+       (except [e TypeError] (if (= e.args (, "Iteration on malformed cons"))
+                               'success
+                               'failureexc))
+       (except [e Exception] 'failureexc2)))))
+
+
+(defn test-cons? []
+  "NATIVE: test behavior of cons?"
+  (assert (cons? (cons 1 2)))
+  (assert (cons? '(1 . 2)))
+  (assert (cons? '(1 2 3 . 4)))
+  (assert (cons? (list* 1 2 3)))
+  (assert (not (cons? (cons 1 [2]))))
+  (assert (not (cons? (list* 1 nil)))))
+
+
+(defn test-list* []
+  "NATIVE: test behavior of list*"
+  (assert (= 1 (list* 1)))
+  (assert (= (cons 1 2) (list* 1 2)))
+  (assert (= (cons 1 (cons 2 3)) (list* 1 2 3)))
+  (assert (= '(1 2 3 4 . 5) (list* 1 2 3 4 5))))