diff --git a/devscripts/scm/__init__.py b/devscripts/scm/__init__.py new file mode 100644 index 000000000..81d45a6ab --- /dev/null +++ b/devscripts/scm/__init__.py @@ -0,0 +1,2 @@ +from .primitives import * +from .srfi_1 import * diff --git a/devscripts/scm/primitives.py b/devscripts/scm/primitives.py new file mode 100644 index 000000000..224a471cb --- /dev/null +++ b/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) diff --git a/devscripts/scm/srfi_1.py b/devscripts/scm/srfi_1.py new file mode 100644 index 000000000..806929b38 --- /dev/null +++ b/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)))