Commit 74e6afe8 authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

environment chain now ends with nil; saner environment handling overall

parent bf2afb39
......@@ -40,23 +40,19 @@ my $cons_counter = 0;
sub new_environment {
my ($parent) = @_;
$parent //= $Env;
my $env_level = defined($parent)
? $parent->{$n_environment_level} + 1
: 0;
my $env = bless({ $n_parentenv => $parent // $Env,
$n_environment_level => $env_level,
}, $n_Environment);
# warn("new environment[", $env->{$n_environment_level}, "] ",
# $env);
return $env;
my $env_level =
is_nil($parent) ? 0 : $parent->{$n_environment_level} + 1;
return bless({ $n_parentenv => $parent,
$n_environment_level => $env_level,
}, $n_Environment);
}
sub enter_environment {
my $env = new_environment(@_);
my ($parent) = @_;
my $env = new_environment($parent // $Env);
my $save_env = $Env;
$Env = $env;
set($the_environment, $env);
set($the_environment, $env, $env);
return $save_env;
}
......@@ -69,10 +65,9 @@ sub backto_environment {
sub env_vars {
my ($env, $noparents) = @_;
my %vars = ();
for (my $e = $env;
defined($e);
$e = $noparents ? undef : $e->{$n_parentenv}) {
for (my $e = $env; !is_nil($e); $e = $e->{$n_parentenv}) {
@vars{keys(%$e)} = 1;
last if $noparents;
}
return map { intern($_) } keys(%vars);
}
......@@ -174,9 +169,9 @@ sub function_env {
sub defvar {
my ($sym, $initial, $docstring) = @_;
$sym->{doc} = $docstring;
$sym->{doc} = $docstring // '';
my $name = symbol_name($sym);
$root_Env->{$name} = $initial unless defined($root_Env->{$name});
$root_Env->{$name} = $initial unless exists($root_Env->{$name});
return $sym;
}
......@@ -191,17 +186,18 @@ sub set {
stacktrace() unless defined($sym);
my $name = symbol_name($sym);
$env->{$name} = $value if $env;
for (my $env = $Env;
defined($env);
$env = $env->{$n_parentenv}) {
return $env->{$name} = $value if $env;
for (my $env = $Env; !is_nil($env); $env = $env->{$n_parentenv}) {
# warn("search env ", $env->{$n_env_name}, " for ", $name);
if (exists($env->{$name})) {
# warn("set $name in ", $env->{$n_env_name});
return $env->{$name} = $value;
}
}
error("set/setq for undefined variable %s", $sym)
if defined($value); # enable makunbound
if defined($value); # enable makunbound on undefined
# variables
}
sub intern {
......@@ -322,33 +318,15 @@ sub symbol_name {
}
sub symbol_value {
my ($ob, $envarg) = @_;
my $name = symbol_name($ob);
for (my $env = $envarg // $Env;
defined($env);
$env = $env->{$n_parentenv}) {
#warn(sprintf("sv search %s in env %s", $name, &$Princs($env)));
if (exists($env->{$name})) {
# warn(sprintf("sv found %s value %s",
# $name, &$Princs($env->{$name})));
return $env->{$name};
}
}
return undef;
}
sub symbol_value_in_env {
my ($ob, $env, $noparents) = @_;
$env //= $Env;
my $name = symbol_name($ob);
for (my $env = $Env;
defined($env);
$env = $noparents ? undef : $env->{$n_parentenv}) {
# warn(sprintf("svie search %s in env %s", $ob, $env));
for ( ; !is_nil($env); $env = $env->{$n_parentenv}) {
if (exists($env->{$name})) {
return $env->{$name};
}
last if $noparents;
}
return undef;
}
......@@ -375,18 +353,20 @@ sub init {
$t_Pair = intern("pair");
$t_Function = intern("function");
$root_Env = new_environment(); # cannot use enter_environment() here,
# as we don't yet have a $Env
$Nil = intern("nil"); # needed early for parent of $root_Env
$T = intern("t"); # needed early for is_nil()
# initialize the root environment
$root_Env = new_environment($Nil);
$Env = $root_Env;
$root_Env->{$n_env_name} = 'root_Env';
set($root_environment, $root_Env, $root_Env);
set($the_environment, $root_Env, $root_Env);
$Nil = intern("nil");
set($Nil, $Nil, $root_Env);
# only now we can begin to set variable values
defvar($root_environment, $root_Env);
defvar($the_environment, $root_Env);
$T = intern("t");
set($T, $T, $root_Env);
defvar($Nil, $Nil);
defvar($T, $T);
}
1;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment