Head

GCC Code Coverage Report

Directory:	../src/		Exec	Total	Coverage
File:	/home/joels/Current/lispbm/src/env.c	Lines:	80	87	92.0 %
Date:	2024-12-05 14:36:58	Branches:	33	38	86.8 %


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