Head

GCC Code Coverage Report

Directory:	../src/		Exec	Total	Coverage
File:	/home/joels/Current/lispbm/src/env.c	Lines:	80	95	84.2 %
Date:	2025-01-19 11:10:47	Branches:	33	42	78.6 %


/*
    Copyright 2018, 2020, 2021, 2024 Joel Svensson    svenssonjoel@yahoo.se

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

#include <lbm_types.h>
#include <stdio.h>

#include "symrepr.h"
#include "heap.h"
#include "print.h"
#include "env.h"
#include "lbm_memory.h"

static lbm_value env_global[GLOBAL_ENV_ROOTS];

int lbm_init_env(void) {
  for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
    env_global[i] = ENC_SYM_NIL;
  }
  return 1;
}

lbm_uint lbm_get_global_env_size(void) {
  lbm_uint n = 0;
  for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
    lbm_value curr = env_global[i];
    while (lbm_is_cons(curr)) {
      n++;
      curr = lbm_cdr(curr);
    }
  }
  return n;
}

lbm_value *lbm_get_global_env(void) {
  return env_global;
}

// Copy the list structure of an environment.
lbm_value lbm_env_copy_spine(lbm_value env) {

  lbm_value r = ENC_SYM_MERROR;
  lbm_uint len = lbm_list_length(env);

  lbm_value new_env = lbm_heap_allocate_list(len);
  if (new_env != ENC_SYM_MERROR) {
    lbm_value curr_tgt = new_env;
    lbm_value curr_src = env;
    while (lbm_type_of(curr_tgt) == LBM_TYPE_CONS) {
      lbm_set_car(curr_tgt, lbm_car(curr_src));
      curr_tgt = lbm_cdr(curr_tgt);
      curr_src = lbm_cdr(curr_src);
    }
    r = new_env;
  }
  return r;
}

// A less safe version of lookup. It should be fine unless env is corrupted.
bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {
  lbm_value curr = env;

  while (lbm_is_ptr(curr)) {
    lbm_cons_t *pair = lbm_ref_cell(lbm_ref_cell(curr)->car);
    if ((pair->car == sym)
        && (pair->cdr != ENC_SYM_PLACEHOLDER)) {
      *res = pair->cdr;
      return true;
    }
    curr = lbm_ref_cell(curr)->cdr;
  }
  return false;
}

bool lbm_global_env_lookup(lbm_value *res, lbm_value sym) {
  lbm_uint dec_sym = lbm_dec_sym(sym);
  lbm_uint ix = dec_sym & GLOBAL_ENV_MASK;
  lbm_value curr = env_global[ix];

  while (lbm_is_ptr(curr)) {
    lbm_value c = lbm_ref_cell(curr)->car;
    if ((lbm_ref_cell(c)->car) == sym) {
      *res = lbm_ref_cell(c)->cdr;
      return true;
    }
    curr = lbm_ref_cell(curr)->cdr;
  }
  return false;
}

// TODO: env set should ideally copy environment if it has to update
// in place. This has never come up as an issue, the rest of the code
// must be very well behaved.
lbm_value lbm_env_set(lbm_value env, lbm_value key, lbm_value val) {

  lbm_value curr = env;
  lbm_value new_env;
  lbm_value keyval;

  while(lbm_type_of(curr) == LBM_TYPE_CONS) {
    lbm_value car_val = lbm_car(curr);
    if (lbm_car(car_val) == key) {
      lbm_set_cdr(car_val,val);
      return env;
    }
    curr = lbm_cdr(curr);
  }

  keyval = lbm_cons(key,val);
  if (lbm_type_of(keyval) == LBM_TYPE_SYMBOL) {
    return keyval;
  }

  new_env = lbm_cons(keyval, env);
  return new_env;
}

// TODO: same remark as lbm_set_env
lbm_value lbm_env_set_functional(lbm_value env, lbm_value key, lbm_value val) {

  lbm_value keyval = lbm_cons(key, val);
  if (lbm_type_of(keyval) == LBM_TYPE_SYMBOL) {
    return keyval;
  }

  lbm_value curr = env;

  while(lbm_type_of(curr) == LBM_TYPE_CONS) {
    if (lbm_caar(curr) == key) {
      lbm_set_car(curr,keyval);
      return env;
    }
    curr = lbm_cdr(curr);
  }

  lbm_value new_env = lbm_cons(keyval, env);
  return new_env;
}

lbm_value lbm_env_modify_binding(lbm_value env, lbm_value key, lbm_value val) {

  lbm_value curr = env;

  while (lbm_type_of(curr) == LBM_TYPE_CONS) {
    lbm_value car_val = lbm_car(curr);
    if (lbm_car(car_val) == key) {
      lbm_set_cdr(car_val, val);
      return env;
    }
    curr = lbm_cdr(curr);

  }
  return ENC_SYM_NOT_FOUND;
}

lbm_value lbm_env_drop_binding(lbm_value env, lbm_value key) {

  lbm_value curr = env;
  // If key is first in env
  if (lbm_car(lbm_car(curr)) == key) {
    return lbm_cdr(curr);
  }

  lbm_value prev = env;
  curr = lbm_cdr(curr);

  while (lbm_type_of(curr) == LBM_TYPE_CONS) {
    if (lbm_caar(curr) == key) {
      lbm_set_cdr(prev, lbm_cdr(curr));
      return env;
    }
    prev = curr;
    curr = lbm_cdr(curr);
  }
  return ENC_SYM_NOT_FOUND;
}


Generated by: GCOVR (Version 4.2)

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		43176	int lbm_init_env(void) {
30	✓✓	1424808	for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
31		1381632	env_global[i] = ENC_SYM_NIL;
32			}
33		43176	return 1;
34			}
35
36			lbm_uint lbm_get_global_env_size(void) {
37			lbm_uint n = 0;
38			for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
39			lbm_value curr = env_global[i];
40			while (lbm_is_cons(curr)) {
41			n++;
42			curr = lbm_cdr(curr);
43			}
44			}
45			return n;
46			}
47
48		7145721	lbm_value *lbm_get_global_env(void) {
49		7145721	return env_global;
50			}
51
52			// Copy the list structure of an environment.
53		632378	lbm_value lbm_env_copy_spine(lbm_value env) {
54
55		632378	lbm_value r = ENC_SYM_MERROR;
56		632378	lbm_uint len = lbm_list_length(env);
57
58		632378	lbm_value new_env = lbm_heap_allocate_list(len);
59	✓✓	632378	if (new_env != ENC_SYM_MERROR) {
60		632002	lbm_value curr_tgt = new_env;
61		632002	lbm_value curr_src = env;
62	✓✓	2186184	while (lbm_type_of(curr_tgt) == LBM_TYPE_CONS) {
63		1554182	lbm_set_car(curr_tgt, lbm_car(curr_src));
64		1554182	curr_tgt = lbm_cdr(curr_tgt);
65		1554182	curr_src = lbm_cdr(curr_src);
66			}
67		632002	r = new_env;
68			}
69		632378	return r;
70			}
71
72			// A less safe version of lookup. It should be fine unless env is corrupted.
73		146141910	bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {
74		146141910	lbm_value curr = env;
75
76	✓✓	419321910	while (lbm_is_ptr(curr)) {
77		393275714	lbm_cons_t *pair = lbm_ref_cell(lbm_ref_cell(curr)->car);
78	✓✓	393275714	if ((pair->car == sym)
79	✓✓	120095798	&& (pair->cdr != ENC_SYM_PLACEHOLDER)) {
80		120095714	*res = pair->cdr;
81		120095714	return true;
82			}
83		273180000	curr = lbm_ref_cell(curr)->cdr;
84			}
85		26046196	return false;
86			}
87
88		26046644	bool lbm_global_env_lookup(lbm_value *res, lbm_value sym) {
89		26046644	lbm_uint dec_sym = lbm_dec_sym(sym);
90		26046644	lbm_uint ix = dec_sym & GLOBAL_ENV_MASK;
91		26046644	lbm_value curr = env_global[ix];
92
93	✓✓	26046644	while (lbm_is_ptr(curr)) {
94		26041408	lbm_value c = lbm_ref_cell(curr)->car;
95	✓✗	26041408	if ((lbm_ref_cell(c)->car) == sym) {
96		26041408	*res = lbm_ref_cell(c)->cdr;
97		26041408	return true;
98			}
99			curr = lbm_ref_cell(curr)->cdr;
100			}
101		5236	return false;
102			}
103
104			// TODO: env set should ideally copy environment if it has to update
105			// in place. This has never come up as an issue, the rest of the code
106			// must be very well behaved.
107		21852944	lbm_value lbm_env_set(lbm_value env, lbm_value key, lbm_value val) {
108
109		21852944	lbm_value curr = env;
110			lbm_value new_env;
111			lbm_value keyval;
112
113	✓✓	30644540	while(lbm_type_of(curr) == LBM_TYPE_CONS) {
114		28341224	lbm_value car_val = lbm_car(curr);
115	✓✓	28341224	if (lbm_car(car_val) == key) {
116		19549628	lbm_set_cdr(car_val,val);
117		19549628	return env;
118			}
119		8791596	curr = lbm_cdr(curr);
120			}
121
122		2303316	keyval = lbm_cons(key,val);
123	✓✓	2303316	if (lbm_type_of(keyval) == LBM_TYPE_SYMBOL) {
124		910	return keyval;
125			}
126
127		2302406	new_env = lbm_cons(keyval, env);
128		2302406	return new_env;
129			}
130
131			// TODO: same remark as lbm_set_env
132		84	lbm_value lbm_env_set_functional(lbm_value env, lbm_value key, lbm_value val) {
133
134		84	lbm_value keyval = lbm_cons(key, val);
135	✗✓	84	if (lbm_type_of(keyval) == LBM_TYPE_SYMBOL) {
136			return keyval;
137			}
138
139		84	lbm_value curr = env;
140
141	✓✓	112	while(lbm_type_of(curr) == LBM_TYPE_CONS) {
142	✓✓	56	if (lbm_caar(curr) == key) {
143		28	lbm_set_car(curr,keyval);
144		28	return env;
145			}
146		28	curr = lbm_cdr(curr);
147			}
148
149		56	lbm_value new_env = lbm_cons(keyval, env);
150		56	return new_env;
151			}
152
153		26704594	lbm_value lbm_env_modify_binding(lbm_value env, lbm_value key, lbm_value val) {
154
155		26704594	lbm_value curr = env;
156
157	✓✓	61432994	while (lbm_type_of(curr) == LBM_TYPE_CONS) {
158		57791510	lbm_value car_val = lbm_car(curr);
159	✓✓	57791510	if (lbm_car(car_val) == key) {
160		23063110	lbm_set_cdr(car_val, val);
161		23063110	return env;
162			}
163		34728400	curr = lbm_cdr(curr);
164
165			}
166		3641484	return ENC_SYM_NOT_FOUND;
167			}
168
169		1680280	lbm_value lbm_env_drop_binding(lbm_value env, lbm_value key) {
170
171		1680280	lbm_value curr = env;
172			// If key is first in env
173	✓✓	1680280	if (lbm_car(lbm_car(curr)) == key) {
174		1680196	return lbm_cdr(curr);
175			}
176
177		84	lbm_value prev = env;
178		84	curr = lbm_cdr(curr);
179
180	✗✓	84	while (lbm_type_of(curr) == LBM_TYPE_CONS) {
181			if (lbm_caar(curr) == key) {
182			lbm_set_cdr(prev, lbm_cdr(curr));
183			return env;
184			}
185			prev = curr;
186			curr = lbm_cdr(curr);
187			}
188		84	return ENC_SYM_NOT_FOUND;
189			}