GCC Code Coverage Report

Directory: ../src/
File: /home/joels/Current/lispbm/src/env.c
Date: 2024-08-06 17:32:21
Exec Total Coverage
Lines: 79 94 84.0%
Functions: 9 10 90.0%
Branches: 31 40 77.5%
Line Branch Exec Source
1 /*
2 Copyright 2018, 2020, 2021, 2024 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 <lbm_types.h>
19 #include <stdio.h>
20
21 #include "symrepr.h"
22 #include "heap.h"
23 #include "print.h"
24 #include "env.h"
25 #include "lbm_memory.h"
26
27 static lbm_value env_global[GLOBAL_ENV_ROOTS];
28
29 34888 int lbm_init_env(void) {
30
2/2
✓ Branch 0 taken 1116416 times.
✓ Branch 1 taken 34888 times.
 1151304 for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
31 1116416 env_global[i] = ENC_SYM_NIL;
32 }
33 34888 return 1;
34 }
35
36 7823073 lbm_value *lbm_get_global_env(void) {
37 7823073 return env_global;
38 }
39
40 // Copy the list structure of an environment.
41 28369784 lbm_value lbm_env_copy_spine(lbm_value env) {
42
43 28369784 lbm_value r = ENC_SYM_MERROR;
44 28369784 lbm_uint len = lbm_list_length(env);
45
46 28369784 lbm_value new_env = lbm_heap_allocate_list(len);
47
2/2
✓ Branch 0 taken 28280952 times.
✓ Branch 1 taken 88832 times.
 28369784 if (new_env != ENC_SYM_MERROR) {
48 28280952 lbm_value curr_tgt = new_env;
49 28280952 lbm_value curr_src = env;
50
2/2
✓ Branch 1 taken 112561932 times.
✓ Branch 2 taken 28280952 times.
 140842884 while (lbm_type_of(curr_tgt) == LBM_TYPE_CONS) {
51 112561932 lbm_set_car(curr_tgt, lbm_car(curr_src));
52 112561932 curr_tgt = lbm_cdr(curr_tgt);
53 112561932 curr_src = lbm_cdr(curr_src);
54 }
55 28280952 r = new_env;
56 }
57 28369784 return r;
58 }
59
60 // A less safe version of lookup. It should be fine unless env is corrupted.
61 636256480 bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {
62
63 636256480 lbm_value curr = env;
64
65
2/2
✓ Branch 1 taken 1852712288 times.
✓ Branch 2 taken 106068201 times.
 1958780489 while (lbm_is_ptr(curr)) {
66 1852712288 lbm_value c = lbm_ref_cell(curr)->car;
67
2/2
✓ Branch 1 taken 530188279 times.
✓ Branch 2 taken 1322524009 times.
 1852712288 if ((lbm_ref_cell(c)->car) == sym) {
68 530188279 *res = lbm_ref_cell(c)->cdr;
69 530188279 return true;
70 }
71 1322524009 curr = lbm_ref_cell(curr)->cdr;
72 }
73 106068201 return false;
74 }
75
76 106068593 bool lbm_global_env_lookup(lbm_value *res, lbm_value sym) {
77 106068593 lbm_uint dec_sym = lbm_dec_sym(sym);
78 106068593 lbm_uint ix = dec_sym & GLOBAL_ENV_MASK;
79 106068593 lbm_value curr = env_global[ix];
80
81
2/2
✓ Branch 1 taken 106064057 times.
✓ Branch 2 taken 4536 times.
 106068593 while (lbm_is_ptr(curr)) {
82 106064057 lbm_value c = lbm_ref_cell(curr)->car;
83
1/2
✓ Branch 1 taken 106064057 times.
✗ Branch 2 not taken.
 106064057 if ((lbm_ref_cell(c)->car) == sym) {
84 106064057 *res = lbm_ref_cell(c)->cdr;
85 106064057 return true;
86 }
87 ✗ curr = lbm_ref_cell(curr)->cdr;
88 }
89 4536 return false;
90 }
91
92 ✗ lbm_value lbm_env_lookup(lbm_value sym, lbm_value env) {
93 ✗ lbm_value curr = env;
94
95 ✗ while (lbm_type_of(curr) == LBM_TYPE_CONS) {
96 ✗ lbm_value car_val = lbm_car(curr);
97 ✗ if (lbm_car(car_val) == sym) {
98 ✗ return lbm_cdr(car_val);
99 }
100 ✗ curr = lbm_cdr(curr);
101 }
102 ✗ return ENC_SYM_NOT_FOUND;
103 }
104
105 // TODO: env set should ideally copy environment if it has to update
106 // in place. This has never come up as an issue, the rest of the code
107 // must be very well behaved.
108 21829308 lbm_value lbm_env_set(lbm_value env, lbm_value key, lbm_value val) {
109
110 21829308 lbm_value curr = env;
111 lbm_value new_env;
112 lbm_value keyval;
113
114
2/2
✓ Branch 1 taken 28340654 times.
✓ Branch 2 taken 2280072 times.
 30620726 while(lbm_type_of(curr) == LBM_TYPE_CONS) {
115 28340654 lbm_value car_val = lbm_car(curr);
116
2/2
✓ Branch 1 taken 19549236 times.
✓ Branch 2 taken 8791418 times.
 28340654 if (lbm_car(car_val) == key) {
117 19549236 lbm_set_cdr(car_val,val);
118 19549236 return env;
119 }
120 8791418 curr = lbm_cdr(curr);
121 }
122
123 2280072 keyval = lbm_cons(key,val);
124
2/2
✓ Branch 1 taken 1114 times.
✓ Branch 2 taken 2278958 times.
 2280072 if (lbm_type_of(keyval) == LBM_TYPE_SYMBOL) {
125 1114 return keyval;
126 }
127
128 2278958 new_env = lbm_cons(keyval, env);
129 2278958 return new_env;
130 }
131
132 // TODO: same remark as lbm_set_env
133 84 lbm_value lbm_env_set_functional(lbm_value env, lbm_value key, lbm_value val) {
134
135 84 lbm_value keyval = lbm_cons(key, val);
136
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 84 times.
 84 if (lbm_type_of(keyval) == LBM_TYPE_SYMBOL) {
137 ✗ return keyval;
138 }
139
140 84 lbm_value curr = env;
141
142
2/2
✓ Branch 1 taken 56 times.
✓ Branch 2 taken 56 times.
 112 while(lbm_type_of(curr) == LBM_TYPE_CONS) {
143
2/2
✓ Branch 1 taken 28 times.
✓ Branch 2 taken 28 times.
 56 if (lbm_caar(curr) == key) {
144 28 lbm_set_car(curr,keyval);
145 28 return env;
146 }
147 28 curr = lbm_cdr(curr);
148 }
149
150 56 lbm_value new_env = lbm_cons(keyval, env);
151 56 return new_env;
152 }
153
154 277353188 lbm_value lbm_env_modify_binding(lbm_value env, lbm_value key, lbm_value val) {
155
156 277353188 lbm_value curr = env;
157
158
2/2
✓ Branch 1 taken 588159992 times.
✓ Branch 2 taken 3641260 times.
 591801252 while (lbm_type_of(curr) == LBM_TYPE_CONS) {
159 588159992 lbm_value car_val = lbm_car(curr);
160
2/2
✓ Branch 1 taken 273711928 times.
✓ Branch 2 taken 314448064 times.
 588159992 if (lbm_car(car_val) == key) {
161 273711928 lbm_set_cdr(car_val, val);
162 273711928 return env;
163 }
164 314448064 curr = lbm_cdr(curr);
165
166 }
167 3641260 return ENC_SYM_NOT_FOUND;
168 }
169
170 1680280 lbm_value lbm_env_drop_binding(lbm_value env, lbm_value key) {
171
172 1680280 lbm_value curr = env;
173 // If key is first in env
174
2/2
✓ Branch 2 taken 1680196 times.
✓ Branch 3 taken 84 times.
 1680280 if (lbm_car(lbm_car(curr)) == key) {
175 1680196 return lbm_cdr(curr);
176 }
177
178 84 lbm_value prev = env;
179 84 curr = lbm_cdr(curr);
180
181
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 84 times.
 84 while (lbm_type_of(curr) == LBM_TYPE_CONS) {
182 ✗ if (lbm_caar(curr) == key) {
183 ✗ lbm_set_cdr(prev, lbm_cdr(curr));
184 ✗ return env;
185 }
186 ✗ prev = curr;
187 ✗ curr = lbm_cdr(curr);
188 }
189 84 return ENC_SYM_NOT_FOUND;
190 }
191