Commit bd721d25 authored by Erick's avatar Erick

Added the R7RS function vector-append

parent 6381431f
......@@ -18,7 +18,7 @@
;; USA.
;; Author: Erick Gallesio [eg@unice.fr]
;; Creation date: 26-Nov-2000 18:19 (eg)
;; Last file update: 6-Jul-2018 08:57 (eg)
;; Last file update: 6-Jul-2018 15:41 (eg)
;;
;; ======================================================================
......@@ -387,6 +387,7 @@ following: ,(fontified-code [#(0 (2 2 2 2) "Anna")])])
(insertdoc 'vector-set!)
(insertdoc 'list->vector)
(insertdoc 'string->vector)
(insertdoc 'vector-append)
(insertdoc 'vector-fill!)
(insertdoc 'vector-copy)
(insertdoc 'vector-copy!)
......
......@@ -22,7 +22,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: ??? 1993
* Last file update: 6-Jul-2018 08:45 (eg)
* Last file update: 6-Jul-2018 15:39 (eg)
*/
#include <string.h>
......@@ -359,6 +359,41 @@ DEFINE_PRIMITIVE("vector-copy", vector_copy, vsubr, (int argc, SCM *argv))
return z;
}
/*
<doc vector-append
* (vector-append vector ...)
*
* Returns a newly allocated vector whose elements are the
* concatenation of the elements of the given vectors.
*
* @lisp
* (vector-append #(a b c) #(d e f)) => #(a b c d e f)
* @end lisp
doc>
*/
DEFINE_PRIMITIVE("vector-append", vector_append, vsubr, (int argc, SCM *argv))
{
int i, len = 0, start = 0;
SCM z;
/* compute length of final result */
for (i = 0; i < argc; i++) {
if (!VECTORP(argv[-i])) error_bad_vector(argv[-i]);
len += VECTOR_SIZE(argv[-i]);
}
/* copy vectors */
z = STk_makevect(len, (SCM) NULL);
for (i = 0; i < argc; i++) {
int sz = VECTOR_SIZE(argv[-i]);
memcpy(VECTOR_DATA(z+start), VECTOR_DATA(argv[-i]), sz * sizeof(SCM));
start += sz *sizeof(SCM);
}
return z;
}
/*
<doc vector-fill!
* (vector-fill! vector fill)
......@@ -538,6 +573,7 @@ int STk_init_vector(void)
ADD_PRIMITIVE(vector_set);
ADD_PRIMITIVE(vector2list);
ADD_PRIMITIVE(list2vector);
ADD_PRIMITIVE(vector_append);
ADD_PRIMITIVE(vector_fill);
ADD_PRIMITIVE(vector_copy);
......
......@@ -22,7 +22,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-Apr-2011 20:58 (eg)
;;;; Last file update: 6-Jul-2018 15:17 (eg)
;;;; Last file update: 6-Jul-2018 15:45 (eg)
;;;;
(require "test")
......@@ -232,6 +232,14 @@
(test "string->vector.3" #(#\B #\C) (string->vector "ABC" 1))
(test "string->vector.4" #(#\B) (string->vector "ABC" 1 2))
(test "chibi vector-append.1" #() (vector-append #()))
(test "chibi vector-append.2" #() (vector-append #() #()))
(test "chibi vector-append.3" #(a b c) (vector-append #() #(a b c)))
(test "chibi vector-append.4" #(a b c) (vector-append #(a b c) #()))
(test "chibi vector-append.5" #(a b c d e) (vector-append #(a b c) #(d e)))
(test "chibi vector-append.6" #(a b c d e f) (vector-append #(a b c) #(d e) #(f)))
;;------------------------------------------------------------------
(test-subsection "Lists and Pairs")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment