Skip to content

L
lis.pl
Commit ca1e9dd4 authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files
Options

explicit init functions; set() fix made environments work

parent 27cf4c8e
Hide whitespace changes
Inline Side-by-side
Showing with 62 additions and 45 deletions
Builtin.pm
View file @ ca1e9dd4
......@@ -995,11 +995,13 @@ my @builtins = # [name, func, is_special, doc]
"show all vars in ENV, &optional not in NOPARENTS"],
);
for my $b (@builtins) {
my ($name, $func, $is_special, $doc) = @$b;
my $namesym = intern($name);
fset($namesym, function($func, $is_special, $doc, $namesym));
#warn("defined builtin $name");
sub init {
for my $b (@builtins) {
my ($name, $func, $is_special, $doc) = @$b;
my $namesym = intern($name);
fset($namesym, function($func, $is_special, $doc, $namesym));
#warn("defined builtin $name");
}
}
1;
Global.pm
View file @ ca1e9dd4
......@@ -23,7 +23,7 @@ BEGIN {
$the_environment $n_the_environment $n_Environment
$n_parentenv $Env $root_Env
stacktrace $n_root_environment $root_environment
$n_environment_level
$n_environment_level $n_env_name
);
}
......@@ -61,6 +61,7 @@ our $n_Environment = 'Environment';
our $n_the_environment = '*the-environment*';
our $n_root_environment = '*root-environment*';
our $n_environment_level = '*environment-level*';
our $n_env_name = '*env-name*';
our $n_parentenv = '*parent-environment*';
......
Lis.pl
View file @ ca1e9dd4
......@@ -10,6 +10,7 @@ use Global;
use Util;
use Sexp;
use Builtin;
use Print;
use Interp;
# -e -h -l -q -x
......@@ -18,7 +19,7 @@ my $interactive = 1; # run interactively; this gets switched
# off by file and -e arguments
my $opt_quiet = 0; # be quiet
my $opt_interactive = 0; # interactive despite file or -e arg
my $error = 0; # potential error exit
my $error = 0; # potential error exit
my @argv_save = @ARGV;
......@@ -46,6 +47,9 @@ my @argv_save = @ARGV;
}
}
Sexp::init();
Builtin::init();
Print::init();
load("Fundamental.lisp", 0, $opt_quiet) or exit(1);
set(intern($n_ARGS), $Nil);
......@@ -57,14 +61,14 @@ set(intern($n_ARGS), $Nil);
last ARGS2;
} elsif (/e/) {
my $v = eval_string(shift(@ARGV) || usage(1),
$opt_quiet);
$error = !defined($v);
$opt_quiet);
$error = !defined($v);
$interactive = 0;
} elsif (/h/) {
} elsif (/l/) {
my $v = load(shift(@ARGV) || usage(1),
0, $opt_quiet);
$error = !defined($v);
0, $opt_quiet);
$error = !defined($v);
} elsif (/i/) {
} elsif (/q/) {
} else {
......@@ -78,14 +82,14 @@ set(intern($n_ARGS), array2list(@ARGV));
if ($loadfile_arg) {
my $v = load($loadfile_arg);
$error = !defined($v);
$error = !defined($v);
$interactive = 0;
}
if ($interactive || $opt_interactive) {
my $v = repl(\*STDIN, !$opt_quiet);
print("\n");
$error = !defined($v);
$error = !defined($v);
}
exit($error);
......
Print.pm
View file @ ca1e9dd4
......@@ -87,6 +87,7 @@ sub print_environment {
$ob->{$n_environment_level},
refaddr($ob));
$result .= join(',', keys(%$ob));
$result .= '>';
return $result;
}
......@@ -128,6 +129,8 @@ sub print_list {
return $result;
}
$Princs = \&princs;
sub init {
$Princs = \&princs;
}
1;
Sexp.pm
View file @ ca1e9dd4
......@@ -43,10 +43,12 @@ my $env_level = 0;
sub new_environment {
my (@vars) = @_;
my $env = bless({ $n_parentenv => $Env,
$n_environment_level => $env_level++,
$n_environment_level => $env_level,
$n_env_name => "Env-$env_level",
@vars }, $n_Environment);
warn("new environment[", $Env->{$n_environment_level}, "] ",
$env);
$env_level++;
# warn("new environment[", $env->{$n_environment_level}, "] ",
# $env);
return $env;
}
......@@ -60,7 +62,7 @@ sub enter_environment {
sub leave_environment {
$Env = $Env->{$n_parentenv};
set($the_environment, $Env);
warn("back to environment ", &$Princs($Env));
# warn("back to environment ", &$Princs($Env));
$env_level--;
}
......@@ -190,12 +192,12 @@ sub set {
defined($env);
$env = $env->{$n_parentenv}) {
if (exists($env->{$name})) {
warn("set $name in ", $env);
# warn("set $name in ", $env->{$n_env_name});
return $env->{$name} = $value;
}
}
warn("set $name in root ", $root_Env);
return $root_Env->{$sym} = $value;
# warn("set $name in ", $root_Env->{$n_env_name});
return $root_Env->{$name} = $value;
}
sub intern {
......@@ -321,7 +323,8 @@ sub symbol_value {
for (my $env = $Env;
defined($env);
$env = $env->{$n_parentenv}) {
warn(sprintf("sv search %s in env %s", $ob, $env));
# warn(sprintf("sv search %s in env %s",
# symbol_name($ob), $env->{$n_env_name}));
if (exists($env->{$name})) {
return $env->{$name};
}
......@@ -336,7 +339,7 @@ sub symbol_value_in_env {
for (my $env = $Env;
defined($env);
$env = $noparents ? undef : $env->{$n_parentenv}) {
warn(sprintf("svie search %s in env %s", $ob, $env));
# warn(sprintf("svie search %s in env %s", $ob, $env));
if (exists($env->{$name})) {
return $env->{$name};
}
......@@ -350,32 +353,36 @@ sub symbol_function {
return $ob->{func};
}
$Kappa = intern("kappa");
$Lambda = intern("lambda");
$andRest = intern("&rest");
$andOptional = intern("&optional");
$special = intern("special");
$builtin = intern("builtin");
$function = intern($n_function);
$the_environment = intern($n_the_environment);
$root_environment = intern($n_root_environment);
sub init {
$t_Symbol = intern("symbol");
$t_String = intern("string");
$t_Number = intern("number");
$t_Pair = intern("pair");
$t_Function = intern("function");
$Kappa = intern("kappa");
$Lambda = intern("lambda");
$andRest = intern("&rest");
$andOptional = intern("&optional");
$special = intern("special");
$builtin = intern("builtin");
$function = intern($n_function);
$the_environment = intern($n_the_environment);
$root_environment = intern($n_root_environment);
$root_Env = new_environment(); # cannot use enter_environment() here,
$t_Symbol = intern("symbol");
$t_String = intern("string");
$t_Number = intern("number");
$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
$Env = $root_Env;
set($root_environment, $root_Env, $root_Env);
set($the_environment, $root_Env, $root_Env);
$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);
$Nil = intern("nil");
set($Nil, $Nil, $root_Env);
$T = intern("t");
set($T, $T, $root_Env);
$T = intern("t");
set($T, $T, $root_Env);
}
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