GCC Code Coverage Report

Directory: ../src/
File: /home/joels/Current/lispbm/src/extensions/loop_extensions.c
Date: 2024-08-06 17:32:21
Exec Total Coverage
Lines: 43 47 91.5%
Functions: 6 6 100.0%
Branches: 12 24 50.0%
Line Branch Exec Source
1 /*
2 Copyright 2023 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 #include <stdarg.h>
21
22 static lbm_uint sym_res;
23 static lbm_uint sym_loop;
24 static lbm_uint sym_break;
25 static lbm_uint sym_brk;
26 static lbm_uint sym_rst;
27
28 1792 static lbm_value make_list(unsigned int n, ...) {
29 lbm_value res;
30 va_list valist;
31 1792 va_start(valist, n);
32 1792 res = lbm_heap_allocate_list_init_va(n, valist);
33 1792 va_end(valist);
34 1792 return res;
35 }
36
37 28 static lbm_value ext_me_loopfor(lbm_value *args, lbm_uint argn) {
38
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 28 times.
 28 if (argn != 5) {
39 ✗ return ENC_SYM_EERROR;
40 }
41
42 28 lbm_value it = args[0];
43 28 lbm_value start = args[1];
44 28 lbm_value cond = args[2];
45 28 lbm_value update = args[3];
46 28 lbm_value body = args[4];
47
48 // (let ((loop (lambda (it res break) (if cond (loop update body break) res)))) (call-cc (lambda (brk) (loop start nil brk))))
49
50 28 return make_list(3,
51 lbm_enc_sym(SYM_LET),
52 make_list(1,
53 make_list(2,
54 lbm_enc_sym(sym_loop),
55 make_list(3,
56 lbm_enc_sym(SYM_LAMBDA),
57 make_list(3, it, lbm_enc_sym(sym_res), lbm_enc_sym(sym_break)),
58 make_list(4,
59 lbm_enc_sym(SYM_IF),
60 cond,
61 make_list(4, lbm_enc_sym(sym_loop), update, body, lbm_enc_sym(sym_break)),
62 lbm_enc_sym(sym_res))))),
63 make_list(2,
64 lbm_enc_sym(SYM_CALLCC),
65 make_list(3,
66 lbm_enc_sym(SYM_LAMBDA),
67 make_list(1, lbm_enc_sym(sym_brk)),
68 make_list(4, lbm_enc_sym(sym_loop), start, ENC_SYM_NIL, lbm_enc_sym(sym_brk)))));
69 }
70
71 28 static lbm_value ext_me_loopwhile(lbm_value *args, lbm_uint argn) {
72
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 28 times.
 28 if (argn != 2) {
73 ✗ return ENC_SYM_EERROR;
74 }
75
76 28 lbm_value cond = args[0];
77 28 lbm_value body = args[1];
78
79 // (let ((loop (lambda (res break) (if cond (loop body break) res)))) (call-cc (lambda (brk) (loop nil brk))))
80
81 28 return make_list(3,
82 lbm_enc_sym(SYM_LET),
83 make_list(1,
84 make_list(2,
85 lbm_enc_sym(sym_loop),
86 make_list(3,
87 lbm_enc_sym(SYM_LAMBDA),
88 make_list(2, lbm_enc_sym(sym_res), lbm_enc_sym(sym_break)),
89 make_list(4,
90 lbm_enc_sym(SYM_IF),
91 cond,
92 make_list(3, lbm_enc_sym(sym_loop), body, lbm_enc_sym(sym_break)),
93 lbm_enc_sym(sym_res))))),
94 make_list(2,
95 lbm_enc_sym(SYM_CALLCC),
96 make_list(3,
97 lbm_enc_sym(SYM_LAMBDA),
98 make_list(1, lbm_enc_sym(sym_brk)),
99 make_list(3, lbm_enc_sym(sym_loop), ENC_SYM_NIL, lbm_enc_sym(sym_brk)))));
100 }
101
102 56 static lbm_value ext_me_looprange(lbm_value *args, lbm_uint argn) {
103
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 56 times.
 56 if (argn != 4) {
104 ✗ return ENC_SYM_EERROR;
105 }
106
107 56 lbm_value it = args[0];
108 56 lbm_value start = args[1];
109 56 lbm_value end = args[2];
110 56 lbm_value body = args[3];
111
112 // (let ((loop (lambda (it res break) (if (< it end) (loop (+ it 1) body break) res)))) (call-cc (lambda (brk) (loop start nil brk))))
113
114 56 return make_list(3,
115 lbm_enc_sym(SYM_LET),
116 make_list(1,
117 make_list(2,
118 lbm_enc_sym(sym_loop),
119 make_list(3,
120 lbm_enc_sym(SYM_LAMBDA),
121 make_list(3, it, lbm_enc_sym(sym_res), lbm_enc_sym(sym_break)),
122 make_list(4,
123 lbm_enc_sym(SYM_IF),
124 make_list(3, lbm_enc_sym(SYM_LT), it, end),
125 make_list(4, lbm_enc_sym(sym_loop), make_list(3, lbm_enc_sym(SYM_ADD), it, lbm_enc_i(1)), body, lbm_enc_sym(sym_break)),
126 lbm_enc_sym(sym_res))))),
127 make_list(2,
128 lbm_enc_sym(SYM_CALLCC),
129 make_list(3,
130 lbm_enc_sym(SYM_LAMBDA),
131 make_list(1, lbm_enc_sym(sym_brk)),
132 make_list(4, lbm_enc_sym(sym_loop), start, ENC_SYM_NIL, lbm_enc_sym(sym_brk)))));
133 }
134
135 28 static lbm_value ext_me_loopforeach(lbm_value *args, lbm_uint argn) {
136
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 28 times.
 28 if (argn != 3) {
137 ✗ return ENC_SYM_EERROR;
138 }
139
140 28 lbm_value it = args[0];
141 28 lbm_value lst = args[1];
142 28 lbm_value body = args[2];
143
144 // (let ((loop (lambda (it rst res break) (if (eq it nil) res (loop (car rst) (cdr rst) body break))))) (call-cc (lambda (brk) (loop (car lst) (cdr lst) nil brk))))
145
146 28 return make_list(3,
147 lbm_enc_sym(SYM_LET),
148 make_list(1,
149 make_list(2,
150 lbm_enc_sym(sym_loop),
151 make_list(3,
152 lbm_enc_sym(SYM_LAMBDA),
153 make_list(4, it, lbm_enc_sym(sym_rst), lbm_enc_sym(sym_res), lbm_enc_sym(sym_break)),
154 make_list(4,
155 lbm_enc_sym(SYM_IF),
156 make_list(3, lbm_enc_sym(SYM_EQ), it, ENC_SYM_NIL),
157 lbm_enc_sym(sym_res),
158 make_list(5,
159 lbm_enc_sym(sym_loop),
160 make_list(2, lbm_enc_sym(SYM_CAR), lbm_enc_sym(sym_rst)),
161 make_list(2, lbm_enc_sym(SYM_CDR), lbm_enc_sym(sym_rst)),
162 body,
163 lbm_enc_sym(sym_break))
164 )))),
165 make_list(2,
166 lbm_enc_sym(SYM_CALLCC),
167 make_list(3,
168 lbm_enc_sym(SYM_LAMBDA),
169 make_list(1, lbm_enc_sym(sym_brk)),
170 make_list(5,
171 lbm_enc_sym(sym_loop),
172 make_list(2, lbm_enc_sym(SYM_CAR), lst),
173 make_list(2, lbm_enc_sym(SYM_CDR), lst),
174 ENC_SYM_NIL,
175 lbm_enc_sym(sym_brk)))));
176 }
177
178 const char *loop_extensions_dyn_load[4] = {
179 "(define loopfor (macro (it start cnd update body) (me-loopfor it start cnd update body)))",
180 "(define loopwhile (macro (cnd body) (me-loopwhile cnd body)))",
181 "(define looprange (macro (it start end body) (me-looprange it start end body)))",
182 "(define loopforeach (macro (it lst body) (me-loopforeach it lst body)))"
183 };
184
185 17444 bool lbm_loop_extensions_init(void) {
186
187 17444 lbm_add_symbol_const("a01", &sym_res);
188 17444 lbm_add_symbol_const("a02", &sym_loop);
189 17444 lbm_add_symbol_const("break", &sym_break);
190 17444 lbm_add_symbol_const("a03", &sym_brk);
191 17444 lbm_add_symbol_const("a04", &sym_rst);
192
193 17444 bool res = true;
194
2/4
✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
 17444 res = res && lbm_add_extension("me-loopfor", ext_me_loopfor);
195
2/4
✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
 17444 res = res && lbm_add_extension("me-loopwhile", ext_me_loopwhile);
196
2/4
✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
 17444 res = res && lbm_add_extension("me-looprange", ext_me_looprange);
197
2/4
✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
 17444 res = res && lbm_add_extension("me-loopforeach", ext_me_loopforeach);
198 17444 return res;
199 }
200