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 <justus@g10code.com>
This commit is contained in:
Justus Winter 2017-04-04 12:02:54 +02:00
parent 3e91019a92
commit e1bb9326dc
No known key found for this signature in database
GPG Key ID: DD1A52F9DA8C9020
3 changed files with 8 additions and 4 deletions

View File

@ -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 ")))

View File

@ -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

View File

@ -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));