From be78c20cdd93ed295bfee1aef1e9d2e9253b779c Mon Sep 17 00:00:00 2001 From: Justus Winter Date: Tue, 4 Apr 2017 12:02:54 +0200 Subject: gpgscm: Add and use opcode for reversing a list in place. * tests/gpgscm/lib.scm (string-split-pln): Use 'reverse!'. (string-rtrim): Likewise. * tests/gpgscm/opdefines.h (reverse!): New opcode. * tests/gpgscm/scheme.c (opexe_0): Handle new opcode. Signed-off-by: Justus Winter --- lib.scm | 8 ++++---- opdefines.h | 1 + scheme.c | 3 +++ 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/lib.scm b/lib.scm index 2cfe725..ed3d572 100644 --- a/lib.scm +++ b/lib.scm @@ -95,10 +95,10 @@ (let ((length (string-length haystack))) (define (split acc offset n) (if (>= offset length) - (reverse acc) + (reverse! acc) (let ((i (lookahead haystack offset))) (if (or (eq? i #f) (= 0 n)) - (reverse (cons (substring haystack offset length) acc)) + (reverse! (cons (substring haystack offset length) acc)) (split (cons (substring haystack offset i) acc) (+ i 1) (- n 1)))))) (split '() 0 n))) @@ -168,10 +168,10 @@ (define (string-rtrim predicate s) (if (string=? s "") "" - (let loop ((s' (reverse (string->list s)))) + (let loop ((s' (reverse! (string->list s)))) (if (predicate (car s')) (loop (cdr s')) - (list->string (reverse s')))))) + (list->string (reverse! s')))))) (assert (string=? "" (string-rtrim char-whitespace? ""))) (assert (string=? "foo" (string-rtrim char-whitespace? "foo "))) diff --git a/opdefines.h b/opdefines.h index bee2b6d..dd32d1e 100644 --- a/opdefines.h +++ b/opdefines.h @@ -147,6 +147,7 @@ _OP_DEF("newline", 0, 1, TST_OUTPORT, _OP_DEF("error", 1, INF_ARG, TST_NONE, OP_ERR0 ) _OP_DEF(0, 0, 0, 0, OP_ERR1 ) _OP_DEF("reverse", 1, 1, TST_LIST, OP_REVERSE ) +_OP_DEF("reverse!", 1, 1, TST_LIST, OP_REVERSE_IN_PLACE ) _OP_DEF("list*", 1, INF_ARG, TST_NONE, OP_LIST_STAR ) _OP_DEF("append", 0, INF_ARG, TST_NONE, OP_APPEND ) #if USE_PLIST diff --git a/scheme.c b/scheme.c index 655c246..f3a99fd 100644 --- a/scheme.c +++ b/scheme.c @@ -4682,6 +4682,9 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) { CASE(OP_REVERSE): /* reverse */ s_return(sc,reverse(sc, sc->NIL, car(sc->args))); + CASE(OP_REVERSE_IN_PLACE): /* reverse! */ + s_return(sc, reverse_in_place(sc, sc->NIL, car(sc->args))); + CASE(OP_LIST_STAR): /* list* */ s_return(sc,list_star(sc,sc->args)); -- cgit v1.2.3