Add a minimal scm module to provide Scheme-like data types and procedures.

primitives.py implements a minimal subset of Scheme primitives.
srfi_1.py implements a minimal subset of SRFI-1: List Library.

* devscripts/scm/__init__.py: New file.
* devscripts/scm/primitives.py: New file.
* devscripts/scm/srfi_1.py: New file.

devscripts/scm/__init__.py

@@ -0,0 +1,2 @@
+from .primitives import *
+from .srfi_1 import *

devscripts/scm/primitives.py

@@ -0,0 +1,196 @@
+from __future__ import unicode_literals
+
+import re
+import sys
+
+
+"""
+Module implemeting a minimal subset of Scheme primitives in term of Python
+
+In Scheme:
+    apply car cdr cons display even? length list list->lst lst->list lst->tuple
+    list? null? object->string odd? pair? string? string->symbol symbol->string
+    symbol? tuple->lst
+
+In Python:
+    apply car cdr cons display is_even length list list_to_lst lst_to_list
+    lst_to_tuple is_list is_null object_to_string is_odd is_pair is_string
+    string_to_symbol symbol_to_string is_symbol tuple_to_lst
+
+"""
+
+# standalone primitives
+
+if sys.version_info < (3, 0):
+    def display(obj): print(obj.encode("utf-8"))
+else:
+    def display(obj): print(obj)
+
+def is_even(x): return x % 2 == 0
+
+def is_odd(x): return x % 2 != 0
+
+if sys.version_info < (3, 0):
+    is_string = lambda obj: isinstance(obj, (str, basestring))
+else:
+    is_string = lambda obj: isinstance(obj, str)
+
+if sys.version_info < (3, 0):
+    object_to_string = lambda obj: unicode(obj)
+else:
+    object_to_string = lambda obj: str(obj)
+
+# nil-related primitives
+
+class _Nil:
+    """internal class implementing the empty lst type"""
+    def __repr__(self): return "()"
+
+    def __str__(self): return "()"
+
+# Many Scheme implementations don't have nil and use '() instead,
+# but we can't do that as we don't know how to get quoting works in Python...
+nil = _Nil()
+
+def is_null(x): return x is nil
+
+
+# pair/lst-related primitives
+
+class _Pair:
+    """internal class implementing the pair type"""
+    def __init__(self, car, cdr):
+        self.car = car
+        self.cdr = cdr
+        if cdr is nil or is_list(cdr):
+            self.is_list = True
+        else:
+            self.is_list = False
+
+    def __repr__(self):
+        """
+        Simulate representation of pair and list in Scheme REPL
+
+        In general, cons(x, y) is called a pair and is represented by (x . y)
+
+        However, if y is the empty lst, then cons(x, y) is called a lst
+        (avoid confusing with the procedure list,
+        treat list as a verb and lst as a noun)
+        and is represented by (x)
+
+        Moroever, if y is a lst and represented by (foo),
+        then cons(x,y) is also a lst and is represented by (x foo)
+
+        """
+        pattern = r"^\(|\)$"
+        if self.cdr is nil:
+            return "(" + repr(self.car) + ")"
+        elif self.is_list:
+            return "(" + repr(self.car) + " " + \
+                re.sub(pattern, "", repr(self.cdr)) + ")"
+        else:
+            return "(" + repr(self.car) + " . " + repr(self.cdr) + ")"
+
+    def __str__(self):
+        """
+        Same as __repr__.
+
+        Except repr(self.car) and repr(self.cdr) are replaced by
+        object_to_string(self.car) and object_to_string(self.cdr) respectively.
+
+        """
+        pattern = r"^\(|\)$"
+        if self.is_list:
+            return "(" + object_to_string(self.car) + " " + \
+                re.sub(pattern, "", object_to_string(self.cdr)) + ")"
+        else:
+            return "(" + object_to_string(self.car) + " . " + \
+                object_to_string(self.cdr) + ")"
+
+    def __eq__(self, x):
+        return isinstance(x, _Pair) and self.car == x.car and self.cdr == x.cdr
+
+def cons(a, b): return _Pair(a, b)
+
+def car(pair): return pair.car
+
+def cdr(pair): return pair.cdr
+
+def is_pair(x): return isinstance(x, _Pair)
+
+def is_list(x):
+    if x is nil:
+        return True
+    elif isinstance(x, _Pair):
+        return x.is_list
+    else:
+        return False
+
+def list(*arg_tup):
+    """build a lst from any number of elements"""
+    if arg_tup is ():
+        return nil
+    else:
+        return cons(arg_tup[0], list(*arg_tup[1:]))
+
+def tuple_to_lst(tup):
+    """convert Python tuple to Scheme lst"""
+    if not tup:
+        return nil
+    else:
+        return cons(tup[0], tuple_to_lst(tup[1:]))
+
+def lst_to_tuple(lst):
+    """convert Scheme lst to Python tuple"""
+    if lst is nil:
+        return ()
+    else:
+        return (lst.car,) + lst_to_tuple(lst.cdr)
+
+def apply(proc, lst):
+    """apply procedure proc to a Scheme lst"""
+    return proc(*lst_to_tuple(lst))
+
+def list_to_lst(list_):
+    """convert Python list to Scheme lst"""
+    if not list_:
+        return nil
+    else:
+        return cons(list_[0], list_to_lst(list_[1:]))
+
+def lst_to_list(lst):
+    """convert Scheme lst to Python list"""
+    if lst is nil:
+        return []
+    else:
+        return [lst.car,] + lst_to_list(lst.cdr)
+
+
+# symbol-related primitives
+
+# maintain a dictionary of symbol, to avoid duplication of _Symbol object
+_symbol_dict = {}
+
+class _Symbol:
+    """internal class implementing the symbol type"""
+    def __init__(self, string):
+        self.string = string
+        _symbol_dict[string] = self
+
+    def __repr__(self):
+        """remove leading and trailing quote from repr(self.string)"""
+        pattern = r"^'|^\"|\"$|'$"
+        return re.sub(pattern, "", repr(self.string))
+
+    def __str__(self):
+        return object_to_string(self.string)
+
+def string_to_symbol(string):
+    """convert Python string to Scheme symbol"""
+    if string not in _symbol_dict:
+        _symbol_dict[string] = _Symbol(string)
+    return _symbol_dict[string]
+
+def symbol_to_string(symbol): return object_to_string(symbol)
+
+def is_symbol(x): return isinstance(_Symbol)

devscripts/scm/srfi_1.py

@@ -0,0 +1,355 @@
+from __future__ import unicode_literals
+
+from .primitives import *
+
+
+"""
+Module implemeting a minimal subset of SRFI-1: List Library
+
+In Scheme:
+    append caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr
+    caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr
+    cdadar cdaddr cddaar cddadr cdddar cddddr concatenate drop-while every
+    filter first fold iota last length list list_ref lset-difference map reduce
+    reverse take-while
+
+In Python:
+    append caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr
+    caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr
+    cdadar cdaddr cddaar cddadr cdddar cddddr concatenate drop_while every
+    filter first fold iota last length list list_ref lset_difference map reduce
+    reverse take_while
+
+"""
+
+# Use these procedures with caution,
+# as too much car/cdr-ing may hinder readability
+
+def caar(obj): return car(car(obj))
+
+def cadr(obj): return car(cdr(obj))
+
+def cdar(obj): return cdr(car(obj))
+
+def cddr(obj): return cdr(cdr(obj))
+
+def caaar(obj): return car(car(car(obj)))
+
+def caadr(obj): return car(car(cdr(obj)))
+
+def cadar(obj): return car(cdr(car(obj)))
+
+def caddr(obj): return car(cdr(cdr(obj)))
+
+def cdaar(obj): return cdr(car(car(obj)))
+
+def cdadr(obj): return cdr(car(cdr(obj)))
+
+def cddar(obj): return cdr(cdr(car(obj)))
+
+def cdddr(obj): return cdr(cdr(cdr(obj)))
+
+def caaaar(obj): return car(car(car(car(obj))))
+
+def caaadr(obj): return car(car(car(cdr(obj))))
+
+def caadar(obj): return car(car(cdr(car(obj))))
+
+def caaddr(obj): return car(car(cdr(cdr(obj))))
+
+def cadaar(obj): return car(cdr(car(car(obj))))
+
+def cadadr(obj): return car(cdr(car(cdr(obj))))
+
+def caddar(obj): return car(cdr(cdr(car(obj))))
+
+def cadddr(obj): return car(cdr(cdr(cdr(obj))))
+
+def cdaaar(obj): return cdr(car(car(car(obj))))
+
+def cdaadr(obj): return cdr(car(car(cdr(obj))))
+
+def cdadar(obj): return cdr(car(cdr(car(obj))))
+
+def cdaddr(obj): return cdr(car(cdr(cdr(obj))))
+
+def cddaar(obj): return cdr(cdr(car(car(obj))))
+
+def cddadr(obj): return cdr(cdr(car(cdr(obj))))
+
+def cdddar(obj): return cdr(cdr(cdr(car(obj))))
+
+def cddddr(obj): return cdr(cdr(cdr(cdr(obj))))
+
+def length(lst):
+    """compute length of lst"""
+    def length_loop(lst, count):
+        if lst is nil:
+            return count
+        else:
+            return length_loop(cdr(lst),
+                               count + 1)
+    return length_loop(lst, 0)
+
+def list_ref(lst, k):
+    """return the k^th element of lst"""
+    if k == 0:
+        return car(lst)
+    else:
+        return list_ref(cdr(lst), k - 1)
+
+def iota(count):
+    """return lst from 0 to (count - 1)"""
+    def iota_loop(loop_count):
+        if loop_count == count:
+            return nil
+        else:
+            return cons(loop_count,
+                        iota_loop(loop_count + 1))
+    return iota_loop(0)
+
+def _any(proc, arg_lst):
+    """
+    any for procedures that take a single argument
+
+    Apply proc to every element in arg_lst
+    Return True is any of the result is True
+    Otherwise, return False
+
+    """
+    if arg_lst is nil:
+        return False
+    elif proc(car(arg_lst)):
+        return True
+    else:
+        return _any(proc, cdr(arg_lst))
+
+def _every(proc, arg_lst):
+    """
+    every for procedures that take a single argument
+
+    Apply proc to every element in arg_lst
+    Return True is every result is True
+    Otherwise, return False
+
+    """
+    if arg_lst is nil:
+        return True
+    elif not proc(car(arg_lst)):
+        return False
+    else:
+        return _every(proc, cdr(arg_lst))
+
+def _map(proc, lst):
+    """
+    map for procedures that take a single argument
+
+    Apply proc to every element in arg_lst and return the resulting lst
+
+    """
+    if lst is nil:
+        return nil
+    else:
+        return cons(proc(car(lst)),
+                    _map(proc, cdr(lst)))
+
+def map(proc, *tuple_of_lst):
+    """
+    map for procedures that take any number of arguments, including 1
+
+    Apply proc to the n^th element in lst from lst_of_lst
+    and return the resulting lst
+
+    """
+    lst_of_lst = tuple_to_lst(tuple_of_lst)
+    if _every(is_null, lst_of_lst):
+        return nil
+    elif _any(is_null, lst_of_lst):
+        raise IndexError("some of the lists are differed in length!")
+    else:
+        return cons(apply(proc,
+                          _map(car, lst_of_lst)),
+                    apply(map, cons(proc,
+                                    _map(cdr, lst_of_lst))))
+
+def _fold(proc, init, lst):
+    """
+    fold for procedures that take a single argument
+
+    If lst is the empty lst, return init
+    Otherwise, apply proc to the first element of lst and init in this order
+    Now, the result becomes the new init
+
+    """
+
+    if lst is nil:
+        return init
+    else:
+        return _fold(proc, proc(car(lst), init), cdr(lst))
+
+def reduce(proc, default, lst):
+    """
+    If lst is the empty lst, return default
+    Otherwise, apply proc to the second element in lst
+    and the first element from lst in this order
+    Now, the result becomes the element after the remaining first element
+
+    """
+    if lst is nil:
+        return default
+    elif cdr(lst) is nil:
+        return car(lst)
+    else:
+        return _fold(proc, car(lst), cdr(lst))
+
+def any(proc, *tuple_of_lst):
+    """
+    any for procedures that take any number of arguments, including 1
+
+    Apply proc to the n^th element in lst from lst_of_lst
+    Return True is any of the result is True
+    Otherwise, return False
+
+    """
+    lst_of_lst = tuple_to_lst(tuple_of_lst)
+    return reduce(lambda x, y: x or y,
+                  False,
+                  apply(_map, cons(proc,
+                                   lst_of_lst)))
+
+def every(proc, *tuple_of_lst):
+    """
+    every for procedures that take any number of arguments, including 1
+
+    Apply proc to the n^th element in lst from lst_of_lst
+    Return True is any of the result is True
+    Otherwise, return False
+
+    """
+    lst_of_lst = tuple_to_lst(tuple_of_lst)
+    return reduce(lambda x, y: x and y,
+                  True,
+                  apply(_map, cons(proc,
+                                   lst_of_lst)))
+
+def reverse(lst):
+    """reverse a given lst"""
+    return _fold(cons, nil, lst)
+
+def filter(proc, lst):
+    """
+    Apply proc to elements in lst
+    Remove those evaluated to False and return the resulting lst
+
+    """
+    def filter_loop(proc, lst, accum):
+        if lst is nil:
+            return accum
+        elif proc(car(lst)):
+            return filter_loop(proc, cdr(lst), cons(car(lst), accum))
+        else:
+            return filter_loop(proc,
+                               cdr(lst),
+                               accum)
+    return reverse(filter_loop(proc, lst, nil))
+
+def first(lst):
+    """return the first element of lst, usually used with last"""
+    return car(lst)
+
+def last(lst):
+    """return the last element of lst, usually used with first"""
+    return car(reverse(lst))
+
+def _append(lst1, lst2):
+    """
+    append for procedure that takes a single argument
+
+    Append 2 lst into a single lst
+
+    """
+
+    return _fold(cons, lst2, reverse(lst1))
+
+def append(*tuple_of_lst):
+    """
+    append for procedures that take any number of arguments, including 1
+
+    Append any number of lst into a single lst
+
+    """
+
+    lst_of_lst = tuple_to_lst(tuple_of_lst)
+    return reduce(_append, nil, reverse(lst_of_lst))
+
+def concatenate(lst_of_lst):
+    """concatenate lst_of_lst into a single lst"""
+    return apply(append, lst_of_lst)
+
+def fold(proc, init, *tuple_of_lst):
+    """
+    fold for procedures that take any number of arguments, including 1
+
+    If every element in lst_of_lst is the empty lst, return init
+    Otherwise, apply proc to the first element of every element in lst_of_lst
+    and init in this order
+    Now, the result becomes the new init
+
+    """
+
+    lst_of_lst = tuple_to_lst(tuple_of_lst)
+    if _every(is_null, lst_of_lst):
+        return init
+    elif _any(is_null, lst_of_lst):
+        raise IndexError("some of the lists are differed in length!")
+    else:
+        return apply(fold, cons(proc,
+                                cons(apply(proc,
+                                           append(_map(car, lst_of_lst),
+                                                  list(init))),
+                                     _map(cdr, lst_of_lst))))
+
+def lset_difference(comparator, lst, *tuple_of_lst):
+    def _lset_difference(comparator, lst1, lst2):
+        """treat lst1 and lst2 as sets and compute lst1 \ lst2"""
+        return filter(lambda x: _every(lambda y: not comparator(x, y),
+                                       lst2),
+                      lst1)
+    lst_of_lst = tuple_to_lst(tuple_of_lst)
+    if lst_of_lst is nil:
+        return lst
+    else:
+        return apply(lset_difference,
+                     cons(comparator,
+                          cons(_lset_difference(comparator,
+                                                lst,
+                                                car(lst_of_lst)),
+                               cdr(lst_of_lst))))
+
+def drop_while(pred, lst):
+    """
+    While predicate evaluates to True, drops the element
+
+    Return the lst if predicate evaluates to False or if lst is empty
+
+    """
+    if lst is nil:
+        return nil
+    elif not pred(car(lst)):
+        return lst
+    else:
+        return drop_while(pred, cdr(lst))
+
+def take_while(pred, lst):
+    """
+    While predicate evaluates to True, takes the element
+
+    Return the empty lst if predicate evaluates to False or if lst is empty
+
+    """
+    if lst is nil:
+        return nil
+    elif not pred(car(lst)):
+        return nil
+    else:
+        return cons(car(lst), take_while(pred, cdr(lst)))