Impl. of (scheme list) == (srfi 1) in Python.

scheme_list.py

"""
scheme_list.py -- by andydude

This is an implementation of (scheme list) == (srfi 1) in Python.
"""

import itertools
from typing import Callable
from scheme_base import (
    car,
    cdr,
    cons,
    null_q,
    pair_q)

def any_s(pred, *lists):
    return any(map(pred, *lists))
def every(pred, *lists):
    return all(map(pred, *lists))

def find(pred, clist):
    return car(find_tail(pred, clist))

def find_tail(pred, clist):
    for ei, el in enumerate(clist):
        if pred(el):
            return clist[ei:]
    return None
        
def assoc(key, alist, cmp=None):
    if cmp is None:
        cmp = lambda a, b: a == b
    d = cdr(list)
    a = car(list)
    while len(d):
        if cmp(key, car(a)):
            return d        
        d = cdr(d)
        a = car(d)
    return None

def member(key, list, cmp=None):
    if cmp is None:
        cmp = lambda a, b: a == b
    d = cdr(list)
    a = car(list)
    while len(d):
        if cmp(key, a):
            return d        
        d = cdr(d)
        a = car(d)
    return None
        
memq = member
memv = member

def for_each(proc, *lists):
    for l in zip(*lists):
        proc(*l)

def length(ls):
    return len(ls)

def pair_for_each(proc, *lists):
    raise NotImplementedError

def map_s(proc, *lists):
    return [
        proc(*l)
        for l in zip(*lists)]


def iota(count, start=0, step=1):
    assert isinstance(count, int)
    assert isinstance(start, int)
    assert isinstance(step, int)
    stop = start + count*step
    return list(range(start, stop, step))

#def python_range_length(start, stop=None, step=None):
#    # CPython implementation of this function
#    # is probably more complicated than it needs to be:
#    #
#    # if 0 < step and start < stop:
#    #     return (stop - start - 1 + step)/step
#    # elif step < 0 and stop < start:
#    #     return (stop - start + 1 + step)/step
#    # else:
#    #     return 0
#    return (stop - start)/step
#
#def python_range(start, stop=None, step=1):
#    if stop is None:
#        stop = start
#        start = 0
#    count = (stop - start)/step
#    return iota(count, start, step)


# def fold2(kons, knil, list):
#     if null_q(list):
#         return knil
#     else:
#         a, d = car(list), cdr(list)
#         return fold2(kons, kons(a, knil), d)
# 		
# def foldr2(kons, knil, list):
#     if null_q(list):
#         return knil
#     else:
#         a, d = car(list), cdr(list)
#         return kons(a, foldr2(kons, knil, d))

def pair_fold2(kons, knil, list):
    if null_q(list):
        return knil
    else:
        a, d = car(list), cdr(list)
        return pair_fold2(kons, kons(list, knil), d)
    
def pair_foldr2(kons, knil, list):
    if null_q(list):
        return knil
    else:
        a, d = car(list), cdr(list)
        return kons(list, pair_foldr2(kons, knil, d))

def fold(kons, knil, *lists):
    from .scheme_base import car, cdr, null_q
    assert isinstance(kons, Callable)
    if any(map(null_q, lists)):
        return knil
    cars, cdrs = (
        list(map(car, lists)),
        list(map(cdr, lists)))
    return fold(
        kons, kons(*(cars + [knil])), *cdrs)


def fold_right(kons, knil, *lists):
    from .scheme_base import car, cdr, null_q
    assert isinstance(kons, Callable)
    if any(map(null_q, lists)):
        return knil
    cars, cdrs = (
        list(map(car, lists)),
        list(map(cdr, lists)))
    return kons(*(cars + [
        fold_right(kons, knil, *cdrs)]))

def pair_fold(kons, knil, *lists):
    from .scheme_base import car, cdr, null_q
    assert isinstance(kons, Callable)
    if any(map(null_q, lists)):
        return knil
    cars, cdrs = (
        list(map(car, lists)),
        list(map(cdr, lists)))
    return pair_fold(
        kons, kons(*(list(lists) + [knil])), *cdrs)


def pair_fold_right(kons, knil, *lists):
    from .scheme_base import car, cdr, null_q
    assert isinstance(kons, Callable)
    if any(map(null_q, lists)):
        return knil
    cars, cdrs = (
        list(map(car, lists)),
        list(map(cdr, lists)))
    return kons(*(list(lists) + [
        pair_fold_right(kons, knil, *cdrs)]))



def reduce(kons, knil, list):
    assert isinstance(kons, Callable)
    if len(list) == 0:
        return knil
    else:
        return fold(kons, list[0], list[1:])

    
def reduce_right(kons, knil, list):
    assert isinstance(kons, Callable)
    if len(list) == 0:
        return knil
    else:
        return fold_right(kons, list[-1], list[:-1])

    
def unfold(pred, f, g, seed, tailgen=None):
    """
    (define (unfold p f g seed tail)
      (if (p seed)
        (tail-gen seed)
        (cons (f seed) (unfold p f g (g seed))))
    """
    assert isinstance(pred, Callable)
    assert isinstance(f, Callable)
    assert isinstance(g, Callable)
    if tailgen is None:
        tailgen = lambda seed: []
    if pred(seed):
        return tailgen(seed)
    else:
        return cons(f(seed),
                    unfold(pred, f, g,
                           g(seed),
                           tailgen))

    
def unfold_right(pred, f, g, seed, tail=None):
    """
    (define (unfold-right p f g seed tail)
      (let lp ((seed seed) (lis tail))
        (if (p seed)
            lis
            (lp (g seed) (cons (f seed) lis))))
    """
    assert isinstance(pred, Callable)
    assert isinstance(f, Callable)
    assert isinstance(g, Callable)
    if tail is None:
        tail = []
    if pred(seed):
        return tail
    else:
        return unfold_right(pred, f, g,
                            g(seed),
                            cons(f(seed),
                                 tail))


def car_n_cdr(list):
    return car(list), cdr(list)

def set_car_x(list, a):
    list[0] = a
def set_cdr_x(_list, d):
    assert isinstance(value, list)
    a = _list.pop(0)
    _list.clear()
    _list.append(a)
    _list.extend(d)
    

def xcons(d, a):
    return cons(a, d)

def list_ref(list, index):
    return list[index]
def list_index(pred, *lists):
    pass

def first(list): return list[0]
def second(list): return list[1]
def third(list): return list[2]
def fourth(list): return list[3]
def fifth(list): return list[4]
def sixth(list): return list[5]
def seventh(list): return list[6]
def eighth(list): return list[7]
def ninth(list): return list[8]
def tenth(list): return list[9]




if __name__ == '__main__':
    actual_defs = [
        name
        for name in list(locals())
        if name[0] != '_']
    expect_defs = [
	"alist_cons",
        "alist_copy",
        "alist_delete",
        "alist_delete_x",
        "any_s",
        "append",
        "append_x",
        "append_map",
        "append_map_x",
        "append_reverse",
        "append_reverse_x",
        "assoc",
        "assq",
        "assv",
        "break",
        "break_x",
        "car",
        "car_n_cdr",
        "cdr",
        "circular_list",
        "circular_list_q",
        "concatenate",
        "concatenate_x",
        "cons",
        "cons*",
        "count",
        "count",
        "delete",
        "delete_x",
        "delete_duplicates",
        "delete_duplicates_x",
        "dotted_list_q",
        "drop",
        "drop_right",
        "drop_right_x",
        "drop_while",
        "eighth",
        "every",
        "fifth",
        "filter",
        "filter_x",
        "filter_map",
        "find",
        "find_tail",
        "first",
        "fold",
        "fold_right",
        "for_each",
        "fourth",
        "iota",
        "last",
        "last_pair",
        "length",
        "length+",
        "list_s",
        "list_copy",
        "list_index",
        "list_ref",
        "list_tabulate",
        "list_eq",
        # TODO
        # "lset_adjoin",
        # "lset_diff_n_intersection",
        # "lset_diff_n_intersection_x",
        # "lset_difference",
        # "lset_difference_x",
        # "lset_intersection",
        # "lset_intersection_x",
        # "lset_union",
        # "lset_union_x",
        # "lset_xor",
        # "lset_xor_x",
        # "lset_le",
        # "lset_eq",
        "make_list",
        "map_s",
        "map_x",
        "map_in_order",
        "member",
        "memq",
        "memv",
        "ninth",
        "not_pair_q",
        "null_list_q",
        "null_q",
        "pair_fold",
        "pair_fold_right",
        "pair_for_each",
        "pair_q",
        "partition",
        "partition_x",
        "partitioning",
        "proper_list_q",
        "reduce",
        "reduce_right",
        "remove",
        "remove_x",
        "reverse",
        "reverse_x",
        "second",
        "set_car_x",
        "set_cdr_x",
        "seventh",
        "side_effects",
        "sixth",
        "span",
        "span_x",
        "split_at",
        "split_at_x",
        "take",
        "take_x",
        "take_right",
        "take_while",
        "take_while_x",
        "tenth",
        "third",
        "unfold",
        "unfold_right",
        "unzip1",
        "unzip2",
        "unzip3",
        "unzip4",
        "unzip5",
        "xcons",
        "zip_s"]

    if set(actual_defs) != set(expect_defs):
        for name in sorted(list(set(actual_defs) - set(expect_defs))):
            print("- extra", name)
        for name in sorted(list(set(expect_defs) - set(actual_defs))):
            print("- missing", name)