GCC Code Coverage Report

Directory: ../src/
File: /home/joels/Current/lispbm/src/env.c
Date: 2025-10-28 15:15:18
Exec Total Coverage
Lines: 85 85 100.0%
Functions: 9 9 100.0%
Branches: 38 38 100.0%
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 66566 bool lbm_init_env(void) {
30
2/2
✓ Branch 0 taken 2130112 times.
✓ Branch 1 taken 66566 times.
 2196678 for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
31 2130112 env_global[i] = ENC_SYM_NIL;
32 }
33 66566 return true;
34 }
35
36 2 lbm_uint lbm_get_global_env_size(void) {
37 2 lbm_uint n = 0;
38
2/2
✓ Branch 0 taken 64 times.
✓ Branch 1 taken 2 times.
 66 for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
39 64 lbm_value curr = env_global[i];
40
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 64 times.
 66 while (lbm_is_cons(curr)) {
41 2 n++;
42 2 curr = lbm_cdr(curr);
43 }
44 }
45 2 return n;
46 }
47
48 31820521 lbm_value *lbm_get_global_env(void) {
49 31820521 return env_global;
50 }
51
52 // Copy the list structure of an environment.
53 1899374 lbm_value lbm_env_copy_spine(lbm_value env) {
54
55 1899374 lbm_value r = ENC_SYM_MERROR;
56 1899374 lbm_uint len = lbm_list_length(env);
57
58 1899374 lbm_value new_env = lbm_heap_allocate_list(len);
59
2/2
✓ Branch 0 taken 1897202 times.
✓ Branch 1 taken 2172 times.
 1899374 if (new_env != ENC_SYM_MERROR) {
60 1897202 lbm_value curr_tgt = new_env;
61 1897202 lbm_value curr_src = env;
62
2/2
✓ Branch 0 taken 4659860 times.
✓ Branch 1 taken 1897202 times.
 6557062 while (lbm_type_of(curr_tgt) == LBM_TYPE_CONS) {
63 4659860 lbm_set_car(curr_tgt, lbm_car(curr_src));
64 4659860 curr_tgt = lbm_cdr(curr_tgt);
65 4659860 curr_src = lbm_cdr(curr_src);
66 }
67 1897202 r = new_env;
68 }
69 1899374 return r;
70 }
71
72 // env_lookup that should be safe even in the presence of incorrectly
73 // structured env. Could be the case when user manually creates closure.
74 656888139 bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {
75 656888139 lbm_value curr = env;
76
77
2/2
✓ Branch 0 taken 2003526470 times.
✓ Branch 1 taken 115581287 times.
 2119107757 while (lbm_is_ptr(curr)) {
78 2003526470 lbm_cons_t *cr = lbm_ref_cell(curr);
79
2/2
✓ Branch 0 taken 2003526467 times.
✓ Branch 1 taken 3 times.
 2003526470 if (lbm_is_ptr(cr->car)) {
80 2003526467 lbm_cons_t *pair = lbm_ref_cell(cr->car);
81
2/2
✓ Branch 0 taken 541307104 times.
✓ Branch 1 taken 1462219363 times.
 2003526467 if ((pair->car == sym)
82
2/2
✓ Branch 0 taken 541306852 times.
✓ Branch 1 taken 252 times.
 541307104 && (pair->cdr != ENC_SYM_PLACEHOLDER)) {
83 541306852 *res = pair->cdr;
84 541306852 return true;
85 }
86 }
87 1462219618 curr = cr->cdr;
88 }
89 115581287 return false;
90 }
91
92 115580526 bool lbm_global_env_lookup(lbm_value *res, lbm_value sym) {
93 115580526 lbm_uint dec_sym = lbm_dec_sym(sym);
94 115580526 lbm_uint ix = dec_sym & GLOBAL_ENV_MASK;
95 115580526 lbm_value curr = env_global[ix];
96
97
2/2
✓ Branch 0 taken 115564024 times.
✓ Branch 1 taken 18309 times.
 115582333 while (lbm_is_ptr(curr)) {
98 115564024 lbm_value c = lbm_ref_cell(curr)->car;
99
2/2
✓ Branch 0 taken 115562217 times.
✓ Branch 1 taken 1807 times.
 115564024 if ((lbm_ref_cell(c)->car) == sym) {
100 115562217 *res = lbm_ref_cell(c)->cdr;
101 115562217 return true;
102 }
103 1807 curr = lbm_ref_cell(curr)->cdr;
104 }
105 18309 return false;
106 }
107
108 // TODO: env set should ideally copy environment if it has to update
109 // in place. This has never come up as an issue, the rest of the code
110 // must be very well behaved.
111 74007091 lbm_value lbm_env_set(lbm_value env, lbm_value key, lbm_value val) {
112
113 74007091 lbm_value curr = env;
114 lbm_value new_env;
115 lbm_value keyval;
116
117
2/2
✓ Branch 0 taken 93463765 times.
✓ Branch 1 taken 6919041 times.
 100382806 while(lbm_type_of(curr) == LBM_TYPE_CONS) {
118 93463765 lbm_value car_val = lbm_car(curr);
119
2/2
✓ Branch 0 taken 67088050 times.
✓ Branch 1 taken 26375715 times.
 93463765 if (lbm_car(car_val) == key) {
120 67088050 lbm_set_cdr(car_val,val);
121 67088050 return env;
122 }
123 26375715 curr = lbm_cdr(curr);
124 }
125
126 6919041 keyval = lbm_cons(key,val);
127
2/2
✓ Branch 0 taken 2730 times.
✓ Branch 1 taken 6916311 times.
 6919041 if (lbm_type_of(keyval) == LBM_TYPE_SYMBOL) {
128 2730 return keyval;
129 }
130
131 6916311 new_env = lbm_cons(keyval, env);
132 6916311 return new_env;
133 }
134
135 74472022 lbm_value lbm_env_modify_binding(lbm_value env, lbm_value key, lbm_value val) {
136
137 74472022 lbm_value curr = env;
138
139
2/2
✓ Branch 0 taken 128658702 times.
✓ Branch 1 taken 3896288 times.
 132554990 while (lbm_type_of(curr) == LBM_TYPE_CONS) {
140 128658702 lbm_value car_val = lbm_car(curr);
141
2/2
✓ Branch 0 taken 70575734 times.
✓ Branch 1 taken 58082968 times.
 128658702 if (lbm_car(car_val) == key) {
142 70575734 lbm_set_cdr(car_val, val);
143 70575734 return env;
144 }
145 58082968 curr = lbm_cdr(curr);
146
147 }
148 3896288 return ENC_SYM_NOT_FOUND;
149 }
150
151
152 // TODO: Drop binding should really return a new environment
153 // where the drop key/val is missing.
154 //
155 // The internal use of drop_binding in fundamental undefine
156 // is probably fine as we do not generally treat environments
157 // as first order values. If we did, drop_binding is too destructive!
158 5040852 lbm_value lbm_env_drop_binding(lbm_value env, lbm_value key) {
159
160 5040852 lbm_value curr = env;
161 // If key is first in env
162
2/2
✓ Branch 0 taken 5040593 times.
✓ Branch 1 taken 259 times.
 5040852 if (lbm_caar(curr) == key) {
163 5040593 return lbm_cdr(curr);
164 }
165
166 259 lbm_value prev = env;
167 259 curr = lbm_cdr(curr);
168
169
2/2
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 257 times.
 261 while (lbm_type_of(curr) == LBM_TYPE_CONS) {
170
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 2 times.
 4 if (lbm_caar(curr) == key) {
171 2 lbm_set_cdr(prev, lbm_cdr(curr));
172 2 return env;
173 }
174 2 prev = curr;
175 2 curr = lbm_cdr(curr);
176 }
177 257 return ENC_SYM_NOT_FOUND;
178 }
179