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.
This commit is contained in:
Alex Vong
parent
229ecdde27
commit
92f580152f
2
devscripts/scm/__init__.py
Normal file
2
devscripts/scm/__init__.py
Normal file
@ -0,0 +1,2 @@
|
||||
from .primitives import *
|
||||
from .srfi_1 import *
|
||||
196
devscripts/scm/primitives.py
Normal file
196
devscripts/scm/primitives.py
Normal file
@ -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)
|
||||
355
devscripts/scm/srfi_1.py
Normal file
355
devscripts/scm/srfi_1.py
Normal file
@ -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)))
|
||||
Loading…
x
Reference in New Issue
Block a user