From b30af2ce9f8224f137202db05a5dbb18a0610588 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Sun, 16 Aug 2020 16:54:18 +0200 Subject: [PATCH] core: make-vector: Move to core. * src/vector.c (make_vector_): Rename from make_vector__. Add parameter. Fix double allocation. (make_vector): Rename from make_vector_. Use arity n. Update users. --- include/mes/builtins.h | 2 +- include/mes/mes.h | 3 ++- mes/module/mes/scm.mes | 3 --- mes/module/srfi/srfi-43.mes | 2 +- src/builtins.c | 2 +- src/eval-apply.c | 4 ++-- src/hash.c | 2 +- src/stack.c | 2 +- src/vector.c | 22 ++++++++++++++++------ tests/vector.test | 4 ++-- 10 files changed, 27 insertions(+), 19 deletions(-) diff --git a/include/mes/builtins.h b/include/mes/builtins.h index 0d3a4539..09d44d61 100644 --- a/include/mes/builtins.h +++ b/include/mes/builtins.h @@ -169,7 +169,7 @@ SCM struct_length (SCM x); SCM struct_ref (SCM x, SCM i); SCM struct_set_x (SCM x, SCM i, SCM e); /* src/vector.c */ -SCM make_vector_ (SCM n); +SCM make_vector (SCM x); SCM vector_length (SCM x); SCM vector_ref (SCM x, SCM i); SCM vector_entry (SCM x); diff --git a/include/mes/mes.h b/include/mes/mes.h index de395bfa..11df1a35 100644 --- a/include/mes/mes.h +++ b/include/mes/mes.h @@ -130,7 +130,7 @@ SCM make_ref (SCM x); SCM make_string (char const *s, size_t length); SCM make_string0 (char const *s); SCM make_string_port (SCM x); -SCM make_vector__ (long k); +SCM make_vector_ (long k, SCM e); SCM mes_builtins (SCM a); SCM push_cc (SCM p1, SCM p2, SCM a, SCM c); SCM struct_ref_ (SCM x, long i); @@ -147,6 +147,7 @@ long length__ (SCM x); size_t bytes_cells (size_t length); void assert_max_string (size_t i, char const *msg, char *string); void assert_msg (int check, char *msg); +void assert_number (char const *name, SCM x); void copy_cell (SCM to, SCM from); void gc_ (); void gc_init (); diff --git a/mes/module/mes/scm.mes b/mes/module/mes/scm.mes index b874299a..dadd3589 100644 --- a/mes/module/mes/scm.mes +++ b/mes/module/mes/scm.mes @@ -193,9 +193,6 @@ ;; Vector (define (vector . rest) (list->vector rest)) -(define (make-vector n . x) - (if (null? x) (core:make-vector n) - (list->vector (apply make-list (cons n x))))) (define (vector-copy x) (list->vector (vector->list x))) diff --git a/mes/module/srfi/srfi-43.mes b/mes/module/srfi/srfi-43.mes index bb590f67..5ab749cc 100644 --- a/mes/module/srfi/srfi-43.mes +++ b/mes/module/srfi/srfi-43.mes @@ -26,7 +26,7 @@ (define (vector-map f v) (let* ((k (vector-length v)) - (n (core:make-vector k))) + (n (make-vector k))) (let loop ((i 0)) (if (= i k) n (begin diff --git a/src/builtins.c b/src/builtins.c index 64883ab6..dae42312 100644 --- a/src/builtins.c +++ b/src/builtins.c @@ -262,7 +262,7 @@ mes_builtins (SCM a) /*:((internal)) */ a = init_builtin (builtin_type, "struct-ref", 2, &struct_ref, a); a = init_builtin (builtin_type, "struct-set!", 3, &struct_set_x, a); /* src/vector.c */ - a = init_builtin (builtin_type, "core:make-vector", 1, &make_vector_, a); + a = init_builtin (builtin_type, "make-vector", -1, &make_vector, a); a = init_builtin (builtin_type, "vector-length", 1, &vector_length, a); a = init_builtin (builtin_type, "vector-ref", 2, &vector_ref, a); a = init_builtin (builtin_type, "vector-entry", 1, &vector_entry, a); diff --git a/src/eval-apply.c b/src/eval-apply.c index 0b9e8960..e0413377 100644 --- a/src/eval-apply.c +++ b/src/eval-apply.c @@ -971,7 +971,7 @@ call_with_current_continuation: gc_push_frame (); x = make_continuation (g_continuations); g_continuations = g_continuations + 1; - v = make_vector__ (STACK_SIZE - g_stack); + v = make_vector_ (STACK_SIZE - g_stack, cell_unspecified); for (i = g_stack; i < STACK_SIZE; i = i + 1) vector_set_x_ (v, i - g_stack, g_stack_array[i]); CONTINUATION (x) = v; @@ -979,7 +979,7 @@ call_with_current_continuation: push_cc (cons (CAR (R1), cons (x, cell_nil)), x, R0, cell_vm_call_with_current_continuation2); goto apply; call_with_current_continuation2: - v = make_vector__ (STACK_SIZE - g_stack); + v = make_vector_ (STACK_SIZE - g_stack, cell_unspecified); for (i = g_stack; i < STACK_SIZE; i = i + 1) vector_set_x_ (v, i - g_stack, g_stack_array[i]); CONTINUATION (R2) = v; diff --git a/src/hash.c b/src/hash.c index 1a5315d3..f6e0e68a 100644 --- a/src/hash.c +++ b/src/hash.c @@ -193,7 +193,7 @@ make_hash_table_ (long size) size = 100; SCM hashq_type = make_hashq_type (); - SCM buckets = make_vector__ (size); + SCM buckets = make_vector_ (size, cell_unspecified); SCM values = cell_nil; values = cons (buckets, values); values = cons (make_number (size), values); diff --git a/src/stack.c b/src/stack.c index 6d2de5a7..b7491c80 100644 --- a/src/stack.c +++ b/src/stack.c @@ -79,7 +79,7 @@ make_stack (SCM stack) /*:((arity . n)) */ { SCM stack_type = make_stack_type (); long size = (STACK_SIZE - g_stack) / FRAME_SIZE; - SCM frames = make_vector__ (size); + SCM frames = make_vector_ (size, cell_unspecified); long i; for (i = 0; i < size; i = i + 1) { diff --git a/src/vector.c b/src/vector.c index 337e22ed..b6f990ad 100644 --- a/src/vector.c +++ b/src/vector.c @@ -30,21 +30,31 @@ #endif SCM -make_vector__ (long k) +make_vector_ (long k, SCM e) { + SCM x = alloc (1); SCM v = alloc (k); - SCM x = make_cell (TVECTOR, k, v); + TYPE (x) = TVECTOR; + LENGTH (x) = k; + VECTOR (x) = v; long i; for (i = 0; i < k; i = i + 1) - copy_cell (cell_ref (v, i), vector_entry (cell_unspecified)); + copy_cell (cell_ref (v, i), vector_entry (e)); return x; } SCM -make_vector_ (SCM n) +make_vector (SCM x) /*:((arity . n)) */ { - return make_vector__ (VALUE (n)); + SCM k = CAR (x); + assert_number ("make-vector", k); + long n = VALUE (k); + SCM e = cell_unspecified; + if (CDR (x) != cell_nil) + e = CADR (x); + + return make_vector_ (n, e); } SCM @@ -101,7 +111,7 @@ vector_set_x (SCM x, SCM i, SCM e) SCM list_to_vector (SCM x) { - SCM v = make_vector__ (length__ (x)); + SCM v = make_vector_ (length__ (x), cell_unspecified); SCM p = VECTOR (v); while (x != cell_nil) { diff --git a/tests/vector.test b/tests/vector.test index ca7d3e1f..0bf8c185 100755 --- a/tests/vector.test +++ b/tests/vector.test @@ -39,8 +39,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests (pass-if "vector?" (vector? #(1 2 c))) (pass-if "vector-length" (seq? (vector-length #(1)) 1)) -(if (not guile?) - (pass-if "core:make-vector" (sequal? (core:make-vector 3) #(*unspecified* *unspecified* *unspecified*)))) +(pass-if "make-vector" (sequal? (make-vector 3) #(*unspecified* *unspecified* *unspecified*))) +(pass-if "make-vector 1" (sequal? (make-vector 3 0) #(0 0 0))) (pass-if "vector-ref" (seq? (vector-ref #(0 1) 1) 1)) (pass-if "vector-set!" (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #(0 q)))