From b72638e60b6636b479b79bbf0047cf7409f58820 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Sun, 10 Dec 2017 16:51:25 -0800 Subject: [PATCH] altos/scheme: add list-copy A lot easier as a built-in; the obvious scheme version is recursive. Signed-off-by: Keith Packard --- src/scheme/ao_scheme.h | 3 +++ src/scheme/ao_scheme_builtin.c | 13 +++++++++++ src/scheme/ao_scheme_builtin.txt | 1 + src/scheme/ao_scheme_cons.c | 38 +++++++++++++++++++++++++++++++- 4 files changed, 54 insertions(+), 1 deletion(-) diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h index 4655b2a9..2fa1ed60 100644 --- a/src/scheme/ao_scheme.h +++ b/src/scheme/ao_scheme.h @@ -634,6 +634,9 @@ ao_scheme_cons_display(ao_poly); int ao_scheme_cons_length(struct ao_scheme_cons *cons); +struct ao_scheme_cons * +ao_scheme_cons_copy(struct ao_scheme_cons *cons); + /* string */ extern const struct ao_scheme_type ao_scheme_string_type; diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index 397ce032..6f9e1390 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -197,6 +197,19 @@ ao_scheme_do_length(struct ao_scheme_cons *cons) return ao_scheme_int_poly(ao_scheme_cons_length(ao_scheme_poly_cons(ao_scheme_arg(cons, 0)))); } +ao_poly +ao_scheme_do_list_copy(struct ao_scheme_cons *cons) +{ + struct ao_scheme_cons *new; + + if (!ao_scheme_check_argc(_ao_scheme_atom_length, cons, 1, 1)) + return AO_SCHEME_NIL; + if (!ao_scheme_check_argt(_ao_scheme_atom_length, cons, 0, AO_SCHEME_CONS, 1)) + return AO_SCHEME_NIL; + new = ao_scheme_cons_copy(ao_scheme_poly_cons(ao_scheme_arg(cons, 0))); + return ao_scheme_cons_poly(new); +} + ao_poly ao_scheme_do_quote(struct ao_scheme_cons *cons) { diff --git a/src/scheme/ao_scheme_builtin.txt b/src/scheme/ao_scheme_builtin.txt index b7261ce1..17f5ea0c 100644 --- a/src/scheme/ao_scheme_builtin.txt +++ b/src/scheme/ao_scheme_builtin.txt @@ -8,6 +8,7 @@ f_lambda cdr f_lambda cons f_lambda last f_lambda length +f_lambda list_copy list-copy nlambda quote atom quasiquote atom unquote diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c index 21ee10cc..02512e15 100644 --- a/src/scheme/ao_scheme_cons.c +++ b/src/scheme/ao_scheme_cons.c @@ -112,7 +112,7 @@ ao_scheme_cons_cdr(struct ao_scheme_cons *cons) if (cdr == AO_SCHEME_NIL) return NULL; if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) { - (void) ao_scheme_error(AO_SCHEME_INVALID, "improper list"); + (void) ao_scheme_error(AO_SCHEME_INVALID, "improper cdr %v", cdr); return NULL; } return ao_scheme_poly_cons(cdr); @@ -124,6 +124,42 @@ ao_scheme__cons(ao_poly car, ao_poly cdr) return ao_scheme_cons_poly(ao_scheme_cons_cons(car, cdr)); } +struct ao_scheme_cons * +ao_scheme_cons_copy(struct ao_scheme_cons *cons) +{ + struct ao_scheme_cons *head = NULL; + struct ao_scheme_cons *tail = NULL; + + while (cons) { + struct ao_scheme_cons *new; + ao_poly cdr; + + ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(1, head); + ao_scheme_poly_stash(0, ao_scheme_cons_poly(tail)); + new = ao_scheme_alloc(sizeof (struct ao_scheme_cons)); + cons = ao_scheme_cons_fetch(0); + head = ao_scheme_cons_fetch(1); + tail = ao_scheme_poly_cons(ao_scheme_poly_fetch(0)); + if (!new) + return AO_SCHEME_NIL; + new->car = cons->car; + new->cdr = AO_SCHEME_NIL; + if (!head) + head = new; + else + tail->cdr = ao_scheme_cons_poly(new); + tail = new; + cdr = cons->cdr; + if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) { + tail->cdr = cdr; + break; + } + cons = ao_scheme_poly_cons(cdr); + } + return head; +} + void ao_scheme_cons_free(struct ao_scheme_cons *cons) { -- 2.30.2