GCC Code Coverage Report

Directory: ../src/
File: /home/joels/Current/lispbm/src/env.c
Date: 2025-10-27 19:12:55
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 22390 bool lbm_init_env(void) {
30
2/2
✓ Branch 0 taken 716480 times.
✓ Branch 1 taken 22390 times.
 738870 for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
31 716480 env_global[i] = ENC_SYM_NIL;
32 }
33 22390 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 10967035 lbm_value *lbm_get_global_env(void) {
49 10967035 return env_global;
50 }
51
52 // Copy the list structure of an environment.
53 633814 lbm_value lbm_env_copy_spine(lbm_value env) {
54
55 633814 lbm_value r = ENC_SYM_MERROR;
56 633814 lbm_uint len = lbm_list_length(env);
57
58 633814 lbm_value new_env = lbm_heap_allocate_list(len);
59
2/2
✓ Branch 0 taken 633090 times.
✓ Branch 1 taken 724 times.
 633814 if (new_env != ENC_SYM_MERROR) {
60 633090 lbm_value curr_tgt = new_env;
61 633090 lbm_value curr_src = env;
62
2/2
✓ Branch 0 taken 1553964 times.
✓ Branch 1 taken 633090 times.
 2187054 while (lbm_type_of(curr_tgt) == LBM_TYPE_CONS) {
63 1553964 lbm_set_car(curr_tgt, lbm_car(curr_src));
64 1553964 curr_tgt = lbm_cdr(curr_tgt);
65 1553964 curr_src = lbm_cdr(curr_src);
66 }
67 633090 r = new_env;
68 }
69 633814 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 220192160 bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {
75 220192160 lbm_value curr = env;
76
77
2/2
✓ Branch 0 taken 669998410 times.
✓ Branch 1 taken 38618842 times.
 708617252 while (lbm_is_ptr(curr)) {
78 669998410 lbm_cons_t *cr = lbm_ref_cell(curr);
79
2/2
✓ Branch 0 taken 669998407 times.
✓ Branch 1 taken 3 times.
 669998410 if (lbm_is_ptr(cr->car)) {
80 669998407 lbm_cons_t *pair = lbm_ref_cell(cr->car);
81
2/2
✓ Branch 0 taken 181573402 times.
✓ Branch 1 taken 488425005 times.
 669998407 if ((pair->car == sym)
82
2/2
✓ Branch 0 taken 181573318 times.
✓ Branch 1 taken 84 times.
 181573402 && (pair->cdr != ENC_SYM_PLACEHOLDER)) {
83 181573318 *res = pair->cdr;
84 181573318 return true;
85 }
86 }
87 488425092 curr = cr->cdr;
88 }
89 38618842 return false;
90 }
91
92 38617290 bool lbm_global_env_lookup(lbm_value *res, lbm_value sym) {
93 38617290 lbm_uint dec_sym = lbm_dec_sym(sym);
94 38617290 lbm_uint ix = dec_sym & GLOBAL_ENV_MASK;
95 38617290 lbm_value curr = env_global[ix];
96
97
2/2
✓ Branch 0 taken 38612858 times.
✓ Branch 1 taken 6255 times.
 38619113 while (lbm_is_ptr(curr)) {
98 38612858 lbm_value c = lbm_ref_cell(curr)->car;
99
2/2
✓ Branch 0 taken 38611035 times.
✓ Branch 1 taken 1823 times.
 38612858 if ((lbm_ref_cell(c)->car) == sym) {
100 38611035 *res = lbm_ref_cell(c)->cdr;
101 38611035 return true;
102 }
103 1823 curr = lbm_ref_cell(curr)->cdr;
104 }
105 6255 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 24692818 lbm_value lbm_env_set(lbm_value env, lbm_value key, lbm_value val) {
112
113 24692818 lbm_value curr = env;
114 lbm_value new_env;
115 lbm_value keyval;
116
117
2/2
✓ Branch 0 taken 31176079 times.
✓ Branch 1 taken 2309261 times.
 33485340 while(lbm_type_of(curr) == LBM_TYPE_CONS) {
118 31176079 lbm_value car_val = lbm_car(curr);
119
2/2
✓ Branch 0 taken 22383557 times.
✓ Branch 1 taken 8792522 times.
 31176079 if (lbm_car(car_val) == key) {
120 22383557 lbm_set_cdr(car_val,val);
121 22383557 return env;
122 }
123 8792522 curr = lbm_cdr(curr);
124 }
125
126 2309261 keyval = lbm_cons(key,val);
127
2/2
✓ Branch 0 taken 910 times.
✓ Branch 1 taken 2308351 times.
 2309261 if (lbm_type_of(keyval) == LBM_TYPE_SYMBOL) {
128 910 return keyval;
129 }
130
131 2308351 new_env = lbm_cons(keyval, env);
132 2308351 return new_env;
133 }
134
135 25380565 lbm_value lbm_env_modify_binding(lbm_value env, lbm_value key, lbm_value val) {
136
137 25380565 lbm_value curr = env;
138
139
2/2
✓ Branch 0 taken 43475020 times.
✓ Branch 1 taken 1575888 times.
 45050908 while (lbm_type_of(curr) == LBM_TYPE_CONS) {
140 43475020 lbm_value car_val = lbm_car(curr);
141
2/2
✓ Branch 0 taken 23804677 times.
✓ Branch 1 taken 19670343 times.
 43475020 if (lbm_car(car_val) == key) {
142 23804677 lbm_set_cdr(car_val, val);
143 23804677 return env;
144 }
145 19670343 curr = lbm_cdr(curr);
146
147 }
148 1575888 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 1680289 lbm_value lbm_env_drop_binding(lbm_value env, lbm_value key) {
159
160 1680289 lbm_value curr = env;
161 // If key is first in env
162
2/2
✓ Branch 0 taken 1680199 times.
✓ Branch 1 taken 90 times.
 1680289 if (lbm_caar(curr) == key) {
163 1680199 return lbm_cdr(curr);
164 }
165
166 90 lbm_value prev = env;
167 90 curr = lbm_cdr(curr);
168
169
2/2
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 88 times.
 92 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 88 return ENC_SYM_NOT_FOUND;
178 }
179