GCC Code Coverage Report

Directory: ../src/
File: /home/joels/Current/lispbm/src/env.c
Date: 2025-08-08 18:10:24
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 44370 bool lbm_init_env(void) {
30
2/2
✓ Branch 0 taken 1419840 times.
✓ Branch 1 taken 44370 times.
 1464210 for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
31 1419840 env_global[i] = ENC_SYM_NIL;
32 }
33 44370 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 21259290 lbm_value *lbm_get_global_env(void) {
49 21259290 return env_global;
50 }
51
52 // Copy the list structure of an environment.
53 1265511 lbm_value lbm_env_copy_spine(lbm_value env) {
54
55 1265511 lbm_value r = ENC_SYM_MERROR;
56 1265511 lbm_uint len = lbm_list_length(env);
57
58 1265511 lbm_value new_env = lbm_heap_allocate_list(len);
59
2/2
✓ Branch 0 taken 1264063 times.
✓ Branch 1 taken 1448 times.
 1265511 if (new_env != ENC_SYM_MERROR) {
60 1264063 lbm_value curr_tgt = new_env;
61 1264063 lbm_value curr_src = env;
62
2/2
✓ Branch 0 taken 3105844 times.
✓ Branch 1 taken 1264063 times.
 4369907 while (lbm_type_of(curr_tgt) == LBM_TYPE_CONS) {
63 3105844 lbm_set_car(curr_tgt, lbm_car(curr_src));
64 3105844 curr_tgt = lbm_cdr(curr_tgt);
65 3105844 curr_src = lbm_cdr(curr_src);
66 }
67 1264063 r = new_env;
68 }
69 1265511 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 437714728 bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {
75 437714728 lbm_value curr = env;
76
77
2/2
✓ Branch 0 taken 1334979071 times.
✓ Branch 1 taken 77066938 times.
 1412046009 while (lbm_is_ptr(curr)) {
78 1334979071 lbm_cons_t *cr = lbm_ref_cell(curr);
79
2/2
✓ Branch 0 taken 1334979068 times.
✓ Branch 1 taken 3 times.
 1334979071 if (lbm_is_ptr(cr->car)) {
80 1334979068 lbm_cons_t *pair = lbm_ref_cell(cr->car);
81
2/2
✓ Branch 0 taken 360647958 times.
✓ Branch 1 taken 974331110 times.
 1334979068 if ((pair->car == sym)
82
2/2
✓ Branch 0 taken 360647790 times.
✓ Branch 1 taken 168 times.
 360647958 && (pair->cdr != ENC_SYM_PLACEHOLDER)) {
83 360647790 *res = pair->cdr;
84 360647790 return true;
85 }
86 }
87 974331281 curr = cr->cdr;
88 }
89 77066938 return false;
90 }
91
92 77067763 bool lbm_global_env_lookup(lbm_value *res, lbm_value sym) {
93 77067763 lbm_uint dec_sym = lbm_dec_sym(sym);
94 77067763 lbm_uint ix = dec_sym & GLOBAL_ENV_MASK;
95 77067763 lbm_value curr = env_global[ix];
96
97
2/2
✓ Branch 0 taken 77056428 times.
✓ Branch 1 taken 12194 times.
 77068621 while (lbm_is_ptr(curr)) {
98 77056428 lbm_value c = lbm_ref_cell(curr)->car;
99
2/2
✓ Branch 0 taken 77055569 times.
✓ Branch 1 taken 858 times.
 77056427 if ((lbm_ref_cell(c)->car) == sym) {
100 77055569 *res = lbm_ref_cell(c)->cdr;
101 77055569 return true;
102 }
103 858 curr = lbm_ref_cell(curr)->cdr;
104 }
105 12194 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 49317492 lbm_value lbm_env_set(lbm_value env, lbm_value key, lbm_value val) {
112
113 49317492 lbm_value curr = env;
114 lbm_value new_env;
115 lbm_value keyval;
116
117
2/2
✓ Branch 0 taken 62288681 times.
✓ Branch 1 taken 4612807 times.
 66901488 while(lbm_type_of(curr) == LBM_TYPE_CONS) {
118 62288681 lbm_value car_val = lbm_car(curr);
119
2/2
✓ Branch 0 taken 44704685 times.
✓ Branch 1 taken 17583996 times.
 62288681 if (lbm_car(car_val) == key) {
120 44704685 lbm_set_cdr(car_val,val);
121 44704685 return env;
122 }
123 17583996 curr = lbm_cdr(curr);
124 }
125
126 4612807 keyval = lbm_cons(key,val);
127
2/2
✓ Branch 0 taken 1820 times.
✓ Branch 1 taken 4610987 times.
 4612807 if (lbm_type_of(keyval) == LBM_TYPE_SYMBOL) {
128 1820 return keyval;
129 }
130
131 4610987 new_env = lbm_cons(keyval, env);
132 4610987 return new_env;
133 }
134
135 49893857 lbm_value lbm_env_modify_binding(lbm_value env, lbm_value key, lbm_value val) {
136
137 49893857 lbm_value curr = env;
138
139
2/2
✓ Branch 0 taken 85989151 times.
✓ Branch 1 taken 2721540 times.
 88710691 while (lbm_type_of(curr) == LBM_TYPE_CONS) {
140 85989151 lbm_value car_val = lbm_car(curr);
141
2/2
✓ Branch 0 taken 47172317 times.
✓ Branch 1 taken 38816834 times.
 85989151 if (lbm_car(car_val) == key) {
142 47172317 lbm_set_cdr(car_val, val);
143 47172317 return env;
144 }
145 38816834 curr = lbm_cdr(curr);
146
147 }
148 2721540 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 3360568 lbm_value lbm_env_drop_binding(lbm_value env, lbm_value key) {
159
160 3360568 lbm_value curr = env;
161 // If key is first in env
162
2/2
✓ Branch 0 taken 3360396 times.
✓ Branch 1 taken 172 times.
 3360568 if (lbm_caar(curr) == key) {
163 3360396 return lbm_cdr(curr);
164 }
165
166 172 lbm_value prev = env;
167 172 curr = lbm_cdr(curr);
168
169
2/2
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 170 times.
 174 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 170 return ENC_SYM_NOT_FOUND;
178 }
179