Head

GCC Code Coverage Report

Directory:	../src/		Exec	Total	Coverage
File:	/home/joels/Current/lispbm/src/extensions/matvec_extensions.c	Lines:	184	188	97.9 %
Date:	2024-12-05 14:36:58	Branches:	69	116	59.5 %


/*
    Copyright 2023 Joel Svensson        svenssonjoel@yahoo.se

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

#include "extensions.h"
#include "lbm_utils.h"
#include "lbm_custom_type.h"

#include <math.h>

static const char *vector_float_desc = "Vector-Float";
static const char *matrix_float_desc = "Matrix-Float";

typedef struct {
  lbm_uint size;
  float data[1];
} vector_float_t;

static bool common_destructor(lbm_uint value) {
  lbm_free((void*)value);
  return true;
}

static lbm_value vector_float_allocate(lbm_uint size) {
  vector_float_t *mem = lbm_malloc( 1 * sizeof(lbm_uint) +
                                    size * sizeof(float));
  if (!mem) return ENC_SYM_MERROR;
  mem->size = size;
  lbm_value res = 0;
  lbm_custom_type_create((lbm_uint)mem,
                         common_destructor,
                         vector_float_desc,
                         &res);
  return res;
}

static bool is_vector_float(lbm_value v) {
  return (lbm_is_custom(v) && ((lbm_uint)lbm_get_custom_descriptor(v) == (lbm_uint)vector_float_desc));
}

/* **************************************************
 * Matrices stored in row-major form
 */

typedef struct {
  lbm_uint rows;
  lbm_uint cols;
  float data[1];
} matrix_float_t;

static lbm_value matrix_float_allocate(unsigned int rows, unsigned int cols) {
  matrix_float_t *mem = lbm_malloc(1 * sizeof(lbm_uint) +
                                   1 * sizeof(lbm_uint) +
                                   rows * cols * sizeof(float));
  if (!mem) return ENC_SYM_MERROR;
  mem->rows = rows;
  mem->cols = cols;
  lbm_value res = 0;
  lbm_custom_type_create((lbm_uint)mem,
                         common_destructor,
                         matrix_float_desc,
                         &res);
  return res;
}

static bool is_matrix_float(lbm_value m) {
  return (lbm_is_custom(m) && (lbm_uint)lbm_get_custom_descriptor(m) == (lbm_uint)matrix_float_desc);
}

/* **************************************************
 * Extension implementations
 */

static lbm_value ext_vector(lbm_value *args, lbm_uint argn) {

  LBM_CHECK_NUMBER_ALL();

  if (argn < 1) return ENC_SYM_TERROR;

  lbm_value vec = vector_float_allocate(argn);
  if (lbm_is_error(vec)) return vec;

  vector_float_t *lvec = (vector_float_t*)lbm_get_custom_value(vec);

  for (lbm_uint i = 0; i < argn; i ++) {
    lvec->data[i] = lbm_dec_as_float(args[i]);
  }
  return vec;
}

static lbm_value ext_list_to_vector(lbm_value *args, lbm_uint argn) {

  lbm_value res = ENC_SYM_TERROR;

  if (argn == 1 &&
      lbm_is_list(args[0])) {

    bool nums = true;
    unsigned int len = lbm_list_length_pred(args[0], &nums, lbm_is_number);

    if (len > 0 && nums) {
      lbm_value vec = vector_float_allocate(len);
      if (lbm_is_error(vec)) return vec;
      vector_float_t *lvec = (vector_float_t*)lbm_get_custom_value(vec);

      lbm_value curr = args[0];
      unsigned int i = 0;
      while (lbm_is_cons(curr)) {
        lvec->data[i] = lbm_dec_as_float(lbm_car(curr));
        i ++;
        curr = lbm_cdr(curr);
      }
      res = vec;
    }
  }
  return res;
}

static lbm_value ext_vector_to_list(lbm_value *args, lbm_uint argn) {

  lbm_value res = ENC_SYM_TERROR;
  if (argn == 1 && is_vector_float(args[0])) {
    vector_float_t *lvec = (vector_float_t*)lbm_get_custom_value(args[0]);

    lbm_value result = lbm_heap_allocate_list(lvec->size);
    if (lbm_is_cons(result)) {
      lbm_value curr = result;
      for (lbm_uint i = 0; i < lvec->size; i ++) {
        lbm_value f_val = lbm_enc_float(lvec->data[i]);
        if (lbm_is_error(f_val)) {
          result = f_val;
          break;
        }
        lbm_set_car(curr, f_val);
        curr = lbm_cdr(curr);
      }
      res = result;
    }
  }
  return res;
}

static lbm_value ext_vproj(lbm_value *args, lbm_uint argn) {
  lbm_value res = ENC_SYM_TERROR;
  if (argn == 2 &&
      is_vector_float(args[0]) &&
      lbm_is_number(args[1])) {
    vector_float_t *vec = (vector_float_t*)lbm_get_custom_value(args[0]);
    uint32_t i = lbm_dec_as_u32(args[1]);
    if (i < vec->size) {
      res = lbm_enc_float(vec->data[i]);
    }
  }
  return res;
}

static lbm_value ext_axpy(lbm_value *args, lbm_uint argn ) {

  lbm_value res = ENC_SYM_TERROR;

  if (argn != 3) return res;
  lbm_value a = args[0];
  lbm_value x = args[1];
  lbm_value y = args[2];

  if (is_vector_float(x) && is_vector_float(y) && lbm_is_number(a)) {

    float alpha = lbm_dec_as_float(a);
    vector_float_t *X = (vector_float_t*)lbm_get_custom_value(x);
    vector_float_t *Y = (vector_float_t*)lbm_get_custom_value(y);

    if (X->size == Y->size) {

      lbm_uint res_size = X->size;

      res = vector_float_allocate(res_size);
      if (!lbm_is_symbol_merror(res)) {

        vector_float_t *R = (vector_float_t*)lbm_get_custom_value(res);

        for (unsigned i = 0; i < res_size; i ++) {
          R->data[i] = alpha * X->data[i] + Y->data[i];
        }
      }
    }
  }
  return res;
}

static lbm_value ext_dot(lbm_value *args, lbm_uint argn) {

  lbm_value res = ENC_SYM_TERROR;

  if (argn != 2) return res;
  lbm_value x = args[0];
  lbm_value y = args[1];

  if (is_vector_float(x) && is_vector_float(y)) {

    vector_float_t *X = (vector_float_t*)lbm_get_custom_value(x);
    vector_float_t *Y = (vector_float_t*)lbm_get_custom_value(y);

    if (X->size == Y->size) {
      lbm_uint res_size = X->size;

      float f_res = 0;
      for (unsigned i = 0; i < res_size; i ++) {
        f_res +=  X->data[i] * Y->data[i];
      }
      res = lbm_enc_float(f_res);
    }
  }
  return res;
}

static float vector_float_mag(vector_float_t *v) {
    float mag = 0.0;
    for (unsigned int i = 0; i < v->size; i ++) {
      mag += (v->data[i] * v->data[i]);
    }
    mag = sqrtf(mag);
    return mag;
}

static lbm_value ext_mag(lbm_value *args, lbm_uint argn) {
  lbm_value res = ENC_SYM_TERROR;

  if (argn == 1 &&
      is_vector_float(args[0])) {
    vector_float_t *v = (vector_float_t *)lbm_get_custom_value(args[0]);
    float mag = vector_float_mag(v);
    res = lbm_enc_float(mag);
  }
  return res;
}

static lbm_value ext_vmult(lbm_value *args, lbm_uint argn) {
  lbm_value res = ENC_SYM_TERROR;
  if (argn == 2 &&
      lbm_is_number(args[0]) &&
      is_vector_float(args[1])) {

    float alpha = lbm_dec_as_float(args[0]);
    vector_float_t *x = (vector_float_t *)lbm_get_custom_value(args[1]);
    lbm_value y = vector_float_allocate(x->size);
    res = y;
    if (!lbm_is_error(y)) {
      vector_float_t *y_vec = (vector_float_t *)lbm_get_custom_value(y);
      for (unsigned int i = 0; i < x->size; i ++) {
        y_vec->data[i] = alpha * x->data[i];
      }
    }
  }
  return res;
}

static lbm_value ext_list_to_matrix(lbm_value *args, lbm_uint argn) {

  lbm_value res = ENC_SYM_TERROR;

  if (argn == 2 &&
      lbm_is_number(args[0]) &&
      lbm_is_list(args[1])) {

    bool nums = true;
    unsigned int len = lbm_list_length_pred(args[1], &nums, lbm_is_number);

    if (len > 0 && nums) {
      uint32_t cols = lbm_dec_as_u32(args[0]);
      uint32_t rows = len / cols;

      if (len % cols == 0) {
        lbm_value mat = matrix_float_allocate(rows, cols);
        if (lbm_is_error(mat)) return mat;
        matrix_float_t *lmat = (matrix_float_t*)lbm_get_custom_value(mat);

        lbm_value curr = args[1];
        unsigned int i = 0;
        while (lbm_is_cons(curr)) {
          lmat->data[i] = lbm_dec_as_float(lbm_car(curr));
          i ++;
          curr = lbm_cdr(curr);
        }
        res = mat;
      }
    }
  }
  return res;
}

static lbm_value ext_matrix_to_list(lbm_value *args, lbm_uint argn) {

  lbm_value res = ENC_SYM_TERROR;
  if (argn == 1 && is_matrix_float(args[0])) {
    matrix_float_t *lmat = (matrix_float_t*)lbm_get_custom_value(args[0]);
    lbm_uint size = lmat->rows * lmat->cols;

    res = lbm_heap_allocate_list(size);
    if (lbm_is_cons(res)) {
      lbm_value curr = res;
      for (unsigned int i = 0; i < size; i ++) {
        lbm_value f_val = lbm_enc_float(lmat->data[i]);
        if (lbm_is_error(f_val)) {
          res = f_val;
          break;
        }
        lbm_set_car(curr, f_val);
        curr = lbm_cdr(curr);
      }
    }
  }
  return res;
}



/* **************************************************
 * Initialization
 */

void lbm_matvec_extensions_init(void) {
  // Vectors
  lbm_add_extension("vector", ext_vector);
  lbm_add_extension("list-to-vector", ext_list_to_vector);
  lbm_add_extension("vector-to-list", ext_vector_to_list);
  lbm_add_extension("vproj", ext_vproj);
  lbm_add_extension("axpy", ext_axpy);
  lbm_add_extension("dot", ext_dot);
  lbm_add_extension("mag", ext_mag);
  lbm_add_extension("vmult", ext_vmult);

  // Matrices
  lbm_add_extension("list-to-matrix", ext_list_to_matrix);
  lbm_add_extension("matrix-to-list", ext_matrix_to_list);
}



Generated by: GCOVR (Version 4.2)

Line	Branch	Exec	Source
1			/*
2			Copyright 2023 Joel Svensson svenssonjoel@yahoo.se
3
4			This program is free software: you can redistribute it and/or modify
5			it under the terms of the GNU General Public License as published by
6			the Free Software Foundation, either version 3 of the License, or
7			(at your option) any later version.
8
9			This program is distributed in the hope that it will be useful,
10			but WITHOUT ANY WARRANTY; without even the implied warranty of
11			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12			GNU General Public License for more details.
13
14			You should have received a copy of the GNU General Public License
15			along with this program. If not, see <http://www.gnu.org/licenses/>.
16			*/
17
18			#include "extensions.h"
19			#include "lbm_utils.h"
20			#include "lbm_custom_type.h"
21
22			#include <math.h>
23
24			static const char *vector_float_desc = "Vector-Float";
25			static const char *matrix_float_desc = "Matrix-Float";
26
27			typedef struct {
28			lbm_uint size;
29			float data[1];
30			} vector_float_t;
31
32		28	static bool common_destructor(lbm_uint value) {
33		28	lbm_free((void*)value);
34		28	return true;
35			}
36
37		420	static lbm_value vector_float_allocate(lbm_uint size) {
38		420	vector_float_t mem = lbm_malloc( 1 sizeof(lbm_uint) +
39			size * sizeof(float));
40	✗✓	420	if (!mem) return ENC_SYM_MERROR;
41		420	mem->size = size;
42		420	lbm_value res = 0;
43		420	lbm_custom_type_create((lbm_uint)mem,
44			common_destructor,
45			vector_float_desc,
46			&res);
47		420	return res;
48			}
49
50		504	static bool is_vector_float(lbm_value v) {
51	✓✓✓✗	504	return (lbm_is_custom(v) && ((lbm_uint)lbm_get_custom_descriptor(v) == (lbm_uint)vector_float_desc));
52			}
53
54			/* **************************************************
55			* Matrices stored in row-major form
56			*/
57
58			typedef struct {
59			lbm_uint rows;
60			lbm_uint cols;
61			float data[1];
62			} matrix_float_t;
63
64		28	static lbm_value matrix_float_allocate(unsigned int rows, unsigned int cols) {
65		28	matrix_float_t mem = lbm_malloc(1 sizeof(lbm_uint) +
66		28	1 * sizeof(lbm_uint) +
67		28	rows * cols * sizeof(float));
68	✗✓	28	if (!mem) return ENC_SYM_MERROR;
69		28	mem->rows = rows;
70		28	mem->cols = cols;
71		28	lbm_value res = 0;
72		28	lbm_custom_type_create((lbm_uint)mem,
73			common_destructor,
74			matrix_float_desc,
75			&res);
76		28	return res;
77			}
78
79		28	static bool is_matrix_float(lbm_value m) {
80	✓✗✓✗	28	return (lbm_is_custom(m) && (lbm_uint)lbm_get_custom_descriptor(m) == (lbm_uint)matrix_float_desc);
81			}
82
83			/* **************************************************
84			* Extension implementations
85			*/
86
87		196	static lbm_value ext_vector(lbm_value *args, lbm_uint argn) {
88
89	✗✓	196	LBM_CHECK_NUMBER_ALL();
90
91	✗✓	196	if (argn < 1) return ENC_SYM_TERROR;
92
93		196	lbm_value vec = vector_float_allocate(argn);
94	✗✓	196	if (lbm_is_error(vec)) return vec;
95
96		196	vector_float_t lvec = (vector_float_t)lbm_get_custom_value(vec);
97
98	✓✓	896	for (lbm_uint i = 0; i < argn; i ++) {
99		700	lvec->data[i] = lbm_dec_as_float(args[i]);
100			}
101		196	return vec;
102			}
103
104		140	static lbm_value ext_list_to_vector(lbm_value *args, lbm_uint argn) {
105
106		140	lbm_value res = ENC_SYM_TERROR;
107
108	✓✗✓✗	280	if (argn == 1 &&
109		140	lbm_is_list(args[0])) {
110
111		140	bool nums = true;
112		140	unsigned int len = lbm_list_length_pred(args[0], &nums, lbm_is_number);
113
114	✓✗✓✗	140	if (len > 0 && nums) {
115		140	lbm_value vec = vector_float_allocate(len);
116	✗✓	140	if (lbm_is_error(vec)) return vec;
117		140	vector_float_t lvec = (vector_float_t)lbm_get_custom_value(vec);
118
119		140	lbm_value curr = args[0];
120		140	unsigned int i = 0;
121	✓✓	644	while (lbm_is_cons(curr)) {
122		504	lvec->data[i] = lbm_dec_as_float(lbm_car(curr));
123		504	i ++;
124		504	curr = lbm_cdr(curr);
125			}
126		140	res = vec;
127			}
128			}
129		140	return res;
130			}
131
132		112	static lbm_value ext_vector_to_list(lbm_value *args, lbm_uint argn) {
133
134		112	lbm_value res = ENC_SYM_TERROR;
135	✓✗✓✗	112	if (argn == 1 && is_vector_float(args[0])) {
136		112	vector_float_t lvec = (vector_float_t)lbm_get_custom_value(args[0]);
137
138		112	lbm_value result = lbm_heap_allocate_list(lvec->size);
139	✓✗	112	if (lbm_is_cons(result)) {
140		112	lbm_value curr = result;
141	✓✓	504	for (lbm_uint i = 0; i < lvec->size; i ++) {
142		392	lbm_value f_val = lbm_enc_float(lvec->data[i]);
143	✗✓	392	if (lbm_is_error(f_val)) {
144			result = f_val;
145			break;
146			}
147		392	lbm_set_car(curr, f_val);
148		392	curr = lbm_cdr(curr);
149			}
150		112	res = result;
151			}
152			}
153		112	return res;
154			}
155
156		112	static lbm_value ext_vproj(lbm_value *args, lbm_uint argn) {
157		112	lbm_value res = ENC_SYM_TERROR;
158	✓✗✓✗	224	if (argn == 2 &&
159	✓✗	224	is_vector_float(args[0]) &&
160		112	lbm_is_number(args[1])) {
161		112	vector_float_t vec = (vector_float_t)lbm_get_custom_value(args[0]);
162		112	uint32_t i = lbm_dec_as_u32(args[1]);
163	✓✗	112	if (i < vec->size) {
164		112	res = lbm_enc_float(vec->data[i]);
165			}
166			}
167		112	return res;
168			}
169
170		56	static lbm_value ext_axpy(lbm_value *args, lbm_uint argn ) {
171
172		56	lbm_value res = ENC_SYM_TERROR;
173
174	✗✓	56	if (argn != 3) return res;
175		56	lbm_value a = args[0];
176		56	lbm_value x = args[1];
177		56	lbm_value y = args[2];
178
179	✓✗✓✗ ✓✗	56	if (is_vector_float(x) && is_vector_float(y) && lbm_is_number(a)) {
180
181		56	float alpha = lbm_dec_as_float(a);
182		56	vector_float_t X = (vector_float_t)lbm_get_custom_value(x);
183		56	vector_float_t Y = (vector_float_t)lbm_get_custom_value(y);
184
185	✓✗	56	if (X->size == Y->size) {
186
187		56	lbm_uint res_size = X->size;
188
189		56	res = vector_float_allocate(res_size);
190	✓✗	56	if (!lbm_is_symbol_merror(res)) {
191
192		56	vector_float_t R = (vector_float_t)lbm_get_custom_value(res);
193
194	✓✓	280	for (unsigned i = 0; i < res_size; i ++) {
195		224	R->data[i] = alpha * X->data[i] + Y->data[i];
196			}
197			}
198			}
199			}
200		56	return res;
201			}
202
203		28	static lbm_value ext_dot(lbm_value *args, lbm_uint argn) {
204
205		28	lbm_value res = ENC_SYM_TERROR;
206
207	✗✓	28	if (argn != 2) return res;
208		28	lbm_value x = args[0];
209		28	lbm_value y = args[1];
210
211	✓✗✓✗	28	if (is_vector_float(x) && is_vector_float(y)) {
212
213		28	vector_float_t X = (vector_float_t)lbm_get_custom_value(x);
214		28	vector_float_t Y = (vector_float_t)lbm_get_custom_value(y);
215
216	✓✗	28	if (X->size == Y->size) {
217		28	lbm_uint res_size = X->size;
218
219		28	float f_res = 0;
220	✓✓	112	for (unsigned i = 0; i < res_size; i ++) {
221		84	f_res += X->data[i] * Y->data[i];
222			}
223		28	res = lbm_enc_float(f_res);
224			}
225			}
226		28	return res;
227			}
228
229		56	static float vector_float_mag(vector_float_t *v) {
230		56	float mag = 0.0;
231	✓✓	280	for (unsigned int i = 0; i < v->size; i ++) {
232		224	mag += (v->data[i] * v->data[i]);
233			}
234		56	mag = sqrtf(mag);
235		56	return mag;
236			}
237
238		84	static lbm_value ext_mag(lbm_value *args, lbm_uint argn) {
239		84	lbm_value res = ENC_SYM_TERROR;
240
241	✓✗✓✓	168	if (argn == 1 &&
242		84	is_vector_float(args[0])) {
243		56	vector_float_t v = (vector_float_t )lbm_get_custom_value(args[0]);
244		56	float mag = vector_float_mag(v);
245		56	res = lbm_enc_float(mag);
246			}
247		84	return res;
248			}
249
250		28	static lbm_value ext_vmult(lbm_value *args, lbm_uint argn) {
251		28	lbm_value res = ENC_SYM_TERROR;
252	✓✗✓✗	56	if (argn == 2 &&
253	✓✗	56	lbm_is_number(args[0]) &&
254		28	is_vector_float(args[1])) {
255
256		28	float alpha = lbm_dec_as_float(args[0]);
257		28	vector_float_t x = (vector_float_t )lbm_get_custom_value(args[1]);
258		28	lbm_value y = vector_float_allocate(x->size);
259		28	res = y;
260	✓✗	28	if (!lbm_is_error(y)) {
261		28	vector_float_t y_vec = (vector_float_t )lbm_get_custom_value(y);
262	✓✓	112	for (unsigned int i = 0; i < x->size; i ++) {
263		84	y_vec->data[i] = alpha * x->data[i];
264			}
265			}
266			}
267		28	return res;
268			}
269
270		28	static lbm_value ext_list_to_matrix(lbm_value *args, lbm_uint argn) {
271
272		28	lbm_value res = ENC_SYM_TERROR;
273
274	✓✗✓✗	56	if (argn == 2 &&
275	✓✗	56	lbm_is_number(args[0]) &&
276		28	lbm_is_list(args[1])) {
277
278		28	bool nums = true;
279		28	unsigned int len = lbm_list_length_pred(args[1], &nums, lbm_is_number);
280
281	✓✗✓✗	28	if (len > 0 && nums) {
282		28	uint32_t cols = lbm_dec_as_u32(args[0]);
283		28	uint32_t rows = len / cols;
284
285	✓✗	28	if (len % cols == 0) {
286		28	lbm_value mat = matrix_float_allocate(rows, cols);
287	✗✓	28	if (lbm_is_error(mat)) return mat;
288		28	matrix_float_t lmat = (matrix_float_t)lbm_get_custom_value(mat);
289
290		28	lbm_value curr = args[1];
291		28	unsigned int i = 0;
292	✓✓	280	while (lbm_is_cons(curr)) {
293		252	lmat->data[i] = lbm_dec_as_float(lbm_car(curr));
294		252	i ++;
295		252	curr = lbm_cdr(curr);
296			}
297		28	res = mat;
298			}
299			}
300			}
301		28	return res;
302			}
303
304		28	static lbm_value ext_matrix_to_list(lbm_value *args, lbm_uint argn) {
305
306		28	lbm_value res = ENC_SYM_TERROR;
307	✓✗✓✗	28	if (argn == 1 && is_matrix_float(args[0])) {
308		28	matrix_float_t lmat = (matrix_float_t)lbm_get_custom_value(args[0]);
309		28	lbm_uint size = lmat->rows * lmat->cols;
310
311		28	res = lbm_heap_allocate_list(size);
312	✓✗	28	if (lbm_is_cons(res)) {
313		28	lbm_value curr = res;
314	✓✓	280	for (unsigned int i = 0; i < size; i ++) {
315		252	lbm_value f_val = lbm_enc_float(lmat->data[i]);
316	✗✓	252	if (lbm_is_error(f_val)) {
317			res = f_val;
318			break;
319			}
320		252	lbm_set_car(curr, f_val);
321		252	curr = lbm_cdr(curr);
322			}
323			}
324			}
325		28	return res;
326			}
327
328
329
330			/* **************************************************
331			* Initialization
332			*/
333
334		21672	void lbm_matvec_extensions_init(void) {
335			// Vectors
336		21672	lbm_add_extension("vector", ext_vector);
337		21672	lbm_add_extension("list-to-vector", ext_list_to_vector);
338		21672	lbm_add_extension("vector-to-list", ext_vector_to_list);
339		21672	lbm_add_extension("vproj", ext_vproj);
340		21672	lbm_add_extension("axpy", ext_axpy);
341		21672	lbm_add_extension("dot", ext_dot);
342		21672	lbm_add_extension("mag", ext_mag);
343		21672	lbm_add_extension("vmult", ext_vmult);
344
345			// Matrices
346		21672	lbm_add_extension("list-to-matrix", ext_list_to_matrix);
347		21672	lbm_add_extension("matrix-to-list", ext_matrix_to_list);
348		21672	}
349