Head

GCC Code Coverage Report

Directory:	../src/		Exec	Total	Coverage
File:	/home/joels/Current/lispbm/src/extensions/loop_extensions.c	Lines:	51	55	92.7 %
Date:	2025-01-19 11:10:47	Branches:	4	8	50.0 %


/*
    Copyright 2023, 2025 Joel Svensson        svenssonjoel@yahoo.se
              2022       Benjamin Vedder      benjamin@vedder.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>

static lbm_uint sym_res;
static lbm_uint sym_loop;
static lbm_uint sym_break;
static lbm_uint sym_brk;
static lbm_uint sym_rst;
static lbm_uint sym_return;

static lbm_value ext_me_loopfor(lbm_value *args, lbm_uint argn) {
  if (argn != 5) {
    return ENC_SYM_EERROR;
  }

  lbm_value it = args[0];
  lbm_value start = args[1];
  lbm_value cond = args[2];
  lbm_value update = args[3];
  lbm_value body = args[4];

  // (call-cc-unsafe
  //  (lambda (break)
  //    (let ((loop (lambda (it res)
  //                  (if cond (loop update body) res))))
  //      (loop start nil))))

  lbm_value enc_sym_loop = lbm_enc_sym(sym_loop); // maybe do one time at init?
  lbm_value enc_sym_break = lbm_enc_sym(sym_break);
  lbm_value enc_sym_res = lbm_enc_sym(sym_res);

  return mk_call_cc(mk_lam(make_list(1, enc_sym_break),
                           mk_let(make_list(1,
                                            make_list(2,
                                                      enc_sym_loop,
                                                      mk_lam(make_list(2, it, enc_sym_res),
                                                             mk_if(cond,
                                                                   make_list(3, enc_sym_loop, update, body),
                                                                   enc_sym_res)))),
                                  make_list(3, enc_sym_loop, start, ENC_SYM_NIL))));
}

static lbm_value ext_me_loopwhile(lbm_value *args, lbm_uint argn) {
  if (argn != 2) {
    return ENC_SYM_EERROR;
  }

  lbm_value cond = args[0];
  lbm_value body = args[1];

  //(call-cc-unsafe
  // (lambda (break)
  //   (let ((loop (lambda (res)
  //                 (if cond (loop body) res))))
  //     (loop nil))))

  lbm_value enc_sym_loop = lbm_enc_sym(sym_loop); // maybe do one time at init?
  lbm_value enc_sym_break = lbm_enc_sym(sym_break);
  lbm_value enc_sym_res = lbm_enc_sym(sym_res);

  return mk_call_cc(mk_lam(make_list(1, enc_sym_break),
                           mk_let(make_list(1,
                                            make_list(2,
                                                      enc_sym_loop,
                                                      mk_lam(make_list(1, enc_sym_res),
                                                             mk_if(cond,
                                                                   make_list(2,enc_sym_loop, body),
                                                                   enc_sym_res)))),
                                  (make_list(2, enc_sym_loop, ENC_SYM_NIL)))));
}

static lbm_value ext_me_looprange(lbm_value *args, lbm_uint argn) {
  if (argn != 4) {
    return ENC_SYM_EERROR;
  }

  lbm_value it = args[0];
  lbm_value start = args[1];
  lbm_value end = args[2];
  lbm_value body = args[3];

  // (call-cc-unsafe
  //  (lambda (break)
  //   (let ((loop (lambda (it res)
  //                 (if (< it end)
  //                     (loop (+ it 1) body)
  //                   res))))
  //     (loop start nil))))

  lbm_value enc_sym_loop = lbm_enc_sym(sym_loop); // maybe do one time at init?
  lbm_value enc_sym_break = lbm_enc_sym(sym_break);
  lbm_value enc_sym_res = lbm_enc_sym(sym_res);

  return mk_call_cc(mk_lam(make_list(1, enc_sym_break),
                           mk_let(make_list(1,
                                            make_list(2,
                                                      enc_sym_loop,
                                                      mk_lam(make_list(2, it, enc_sym_res),
                                                             mk_if(mk_lt(it, end),
                                                                   make_list(3,
                                                                             enc_sym_loop,
                                                                             mk_inc(it),
                                                                             body),
                                                                   enc_sym_res)))),
                                  make_list(3, enc_sym_loop, start, ENC_SYM_NIL))));
}

// TODO: Something that does not work as expected with this
//       definition of loopforeach is (loopforeach e (list nil nil nil) ...).

static lbm_value ext_me_loopforeach(lbm_value *args, lbm_uint argn) {
  if (argn != 3) {
    return ENC_SYM_EERROR;
  }

  lbm_value it = args[0];
  lbm_value lst = args[1];
  lbm_value body = args[2];

  //(call-cc-unsafe
  // (lambda (break)
  //   (let ((loop (lambda (rst it res)
  //                 (if (eq it nil)
  //                     res
  //                   (loop (car rst) (cdr rst) body)))))
  //     (loop (car lst) (cdr lst) nil))))

  lbm_value enc_sym_loop = lbm_enc_sym(sym_loop); // maybe do one time at init?
  lbm_value enc_sym_break = lbm_enc_sym(sym_break);
  lbm_value enc_sym_res = lbm_enc_sym(sym_res);
  lbm_value enc_sym_rst = lbm_enc_sym(sym_rst);

  return mk_call_cc(mk_lam(make_list(1, enc_sym_break),
                           mk_let(make_list(1,
                                            make_list(2,
                                                      enc_sym_loop,
                                                      mk_lam(make_list(3,
                                                                       it,
                                                                       enc_sym_rst,
                                                                       enc_sym_res),
                                                             mk_if(mk_eq(it, ENC_SYM_NIL),
                                                                   enc_sym_res,
                                                                   (make_list(4,
                                                                              enc_sym_loop,
                                                                              mk_car(enc_sym_rst),
                                                                              mk_cdr(enc_sym_rst),
                                                                              body)))))),
                                  (make_list(4,
                                             enc_sym_loop,
                                             mk_car(lst),
                                             mk_cdr(lst),
                                             ENC_SYM_NIL)))));
}


void lbm_loop_extensions_init(void){
  lbm_add_symbol_const("a01", &sym_res);
  lbm_add_symbol_const("a02", &sym_loop);
  lbm_add_symbol_const("break", &sym_break);
  lbm_add_symbol_const("a03", &sym_brk);
  lbm_add_symbol_const("a04", &sym_rst);
  lbm_add_symbol_const("return", &sym_return);

  lbm_add_extension("me-loopfor", ext_me_loopfor);
  lbm_add_extension("me-loopwhile", ext_me_loopwhile);
  lbm_add_extension("me-looprange", ext_me_looprange);
  lbm_add_extension("me-loopforeach", ext_me_loopforeach);

}


Generated by: GCOVR (Version 4.2)

Line	Branch	Exec	Source
1			/*
2			Copyright 2023, 2025 Joel Svensson svenssonjoel@yahoo.se
3			2022 Benjamin Vedder benjamin@vedder.se
4
5			This program is free software: you can redistribute it and/or modify
6			it under the terms of the GNU General Public License as published by
7			the Free Software Foundation, either version 3 of the License, or
8			(at your option) any later version.
9
10			This program is distributed in the hope that it will be useful,
11			but WITHOUT ANY WARRANTY; without even the implied warranty of
12			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13			GNU General Public License for more details.
14
15			You should have received a copy of the GNU General Public License
16			along with this program. If not, see <http://www.gnu.org/licenses/>.
17			*/
18
19			#include <extensions.h>
20
21			static lbm_uint sym_res;
22			static lbm_uint sym_loop;
23			static lbm_uint sym_break;
24			static lbm_uint sym_brk;
25			static lbm_uint sym_rst;
26			static lbm_uint sym_return;
27
28		28	static lbm_value ext_me_loopfor(lbm_value *args, lbm_uint argn) {
29	✗✓	28	if (argn != 5) {
30			return ENC_SYM_EERROR;
31			}
32
33		28	lbm_value it = args[0];
34		28	lbm_value start = args[1];
35		28	lbm_value cond = args[2];
36		28	lbm_value update = args[3];
37		28	lbm_value body = args[4];
38
39			// (call-cc-unsafe
40			// (lambda (break)
41			// (let ((loop (lambda (it res)
42			// (if cond (loop update body) res))))
43			// (loop start nil))))
44
45		28	lbm_value enc_sym_loop = lbm_enc_sym(sym_loop); // maybe do one time at init?
46		28	lbm_value enc_sym_break = lbm_enc_sym(sym_break);
47		28	lbm_value enc_sym_res = lbm_enc_sym(sym_res);
48
49		28	return mk_call_cc(mk_lam(make_list(1, enc_sym_break),
50			mk_let(make_list(1,
51			make_list(2,
52			enc_sym_loop,
53			mk_lam(make_list(2, it, enc_sym_res),
54			mk_if(cond,
55			make_list(3, enc_sym_loop, update, body),
56			enc_sym_res)))),
57			make_list(3, enc_sym_loop, start, ENC_SYM_NIL))));
58			}
59
60		28	static lbm_value ext_me_loopwhile(lbm_value *args, lbm_uint argn) {
61	✗✓	28	if (argn != 2) {
62			return ENC_SYM_EERROR;
63			}
64
65		28	lbm_value cond = args[0];
66		28	lbm_value body = args[1];
67
68			//(call-cc-unsafe
69			// (lambda (break)
70			// (let ((loop (lambda (res)
71			// (if cond (loop body) res))))
72			// (loop nil))))
73
74		28	lbm_value enc_sym_loop = lbm_enc_sym(sym_loop); // maybe do one time at init?
75		28	lbm_value enc_sym_break = lbm_enc_sym(sym_break);
76		28	lbm_value enc_sym_res = lbm_enc_sym(sym_res);
77
78		28	return mk_call_cc(mk_lam(make_list(1, enc_sym_break),
79			mk_let(make_list(1,
80			make_list(2,
81			enc_sym_loop,
82			mk_lam(make_list(1, enc_sym_res),
83			mk_if(cond,
84			make_list(2,enc_sym_loop, body),
85			enc_sym_res)))),
86			(make_list(2, enc_sym_loop, ENC_SYM_NIL)))));
87			}
88
89		56	static lbm_value ext_me_looprange(lbm_value *args, lbm_uint argn) {
90	✗✓	56	if (argn != 4) {
91			return ENC_SYM_EERROR;
92			}
93
94		56	lbm_value it = args[0];
95		56	lbm_value start = args[1];
96		56	lbm_value end = args[2];
97		56	lbm_value body = args[3];
98
99			// (call-cc-unsafe
100			// (lambda (break)
101			// (let ((loop (lambda (it res)
102			// (if (< it end)
103			// (loop (+ it 1) body)
104			// res))))
105			// (loop start nil))))
106
107		56	lbm_value enc_sym_loop = lbm_enc_sym(sym_loop); // maybe do one time at init?
108		56	lbm_value enc_sym_break = lbm_enc_sym(sym_break);
109		56	lbm_value enc_sym_res = lbm_enc_sym(sym_res);
110
111		56	return mk_call_cc(mk_lam(make_list(1, enc_sym_break),
112			mk_let(make_list(1,
113			make_list(2,
114			enc_sym_loop,
115			mk_lam(make_list(2, it, enc_sym_res),
116			mk_if(mk_lt(it, end),
117			make_list(3,
118			enc_sym_loop,
119			mk_inc(it),
120			body),
121			enc_sym_res)))),
122			make_list(3, enc_sym_loop, start, ENC_SYM_NIL))));
123			}
124
125			// TODO: Something that does not work as expected with this
126			// definition of loopforeach is (loopforeach e (list nil nil nil) ...).
127
128		28	static lbm_value ext_me_loopforeach(lbm_value *args, lbm_uint argn) {
129	✗✓	28	if (argn != 3) {
130			return ENC_SYM_EERROR;
131			}
132
133		28	lbm_value it = args[0];
134		28	lbm_value lst = args[1];
135		28	lbm_value body = args[2];
136
137			//(call-cc-unsafe
138			// (lambda (break)
139			// (let ((loop (lambda (rst it res)
140			// (if (eq it nil)
141			// res
142			// (loop (car rst) (cdr rst) body)))))
143			// (loop (car lst) (cdr lst) nil))))
144
145		28	lbm_value enc_sym_loop = lbm_enc_sym(sym_loop); // maybe do one time at init?
146		28	lbm_value enc_sym_break = lbm_enc_sym(sym_break);
147		28	lbm_value enc_sym_res = lbm_enc_sym(sym_res);
148		28	lbm_value enc_sym_rst = lbm_enc_sym(sym_rst);
149
150		28	return mk_call_cc(mk_lam(make_list(1, enc_sym_break),
151			mk_let(make_list(1,
152			make_list(2,
153			enc_sym_loop,
154			mk_lam(make_list(3,
155			it,
156			enc_sym_rst,
157			enc_sym_res),
158			mk_if(mk_eq(it, ENC_SYM_NIL),
159			enc_sym_res,
160			(make_list(4,
161			enc_sym_loop,
162			mk_car(enc_sym_rst),
163			mk_cdr(enc_sym_rst),
164			body)))))),
165			(make_list(4,
166			enc_sym_loop,
167			mk_car(lst),
168			mk_cdr(lst),
169			ENC_SYM_NIL)))));
170			}
171
172
173		21588	void lbm_loop_extensions_init(void){
174		21588	lbm_add_symbol_const("a01", &sym_res);
175		21588	lbm_add_symbol_const("a02", &sym_loop);
176		21588	lbm_add_symbol_const("break", &sym_break);
177		21588	lbm_add_symbol_const("a03", &sym_brk);
178		21588	lbm_add_symbol_const("a04", &sym_rst);
179		21588	lbm_add_symbol_const("return", &sym_return);
180
181		21588	lbm_add_extension("me-loopfor", ext_me_loopfor);
182		21588	lbm_add_extension("me-loopwhile", ext_me_loopwhile);
183		21588	lbm_add_extension("me-looprange", ext_me_looprange);
184		21588	lbm_add_extension("me-loopforeach", ext_me_loopforeach);
185
186		21588	}