Commit 19f51e9e authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

some Globals cleanup incl. a few renamings to improve consistency

parent fcfd5ce9
......@@ -17,11 +17,12 @@ BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw($Nil $T $n_Symbol $n_Pair $n_Function $n_function $special
$builtin $function $n_last_eval_stats
$Quote error $Leval $andRest $Lambda $Princs $n_last_error
$n_Quote error $Leval $andRest $Lambda $f_Princs
$n_last_error
$n_ARGS our $t_Symbol $t_Number $t_String $t_Pair
$t_Function $opt_stacktraces
ftrace $andOptional $n_Environment $n_parentenv
stacktrace $n_root_environment $root_environment
$andOptional $n_Environment $n_parentenv
$n_root_environment $root_environment
$n_environment_level $n_env_name
);
}
......@@ -55,15 +56,16 @@ our $n_ARGS = '*ARGS*';
our $n_Environment = 'Environment';
our $n_root_environment = '*root-environment*';
our $n_env_name = '*env-name*';
our $n_parentenv = '*parent-environment*';
our $n_Quote = 'quote';
our $Quote = 'quote';
our $Princs; # the printer function
# global function (value set in Print init)
our $f_Princs; # the printer function
# global option variable(s)
our $opt_stacktraces = 0; # print stacktraces with errors
# for some weird reason I cannot take a \&die reference
sub do_die {
die(@_);
......@@ -72,33 +74,9 @@ sub do_die {
sub error {
my ($msg, @data) = @_;
my $reporter = $opt_stacktraces ? \&confess : \&do_die;
@data = map {&$Princs($_)} @data;
@data = map {&$f_Princs($_)} @data;
$msg .= "\n" unless $msg =~ /\n$/;
&$reporter(sprintf($msg, @data));
}
sub ftrace {
#return unless $trace_on;
my (undef, undef, $line, $subr) = caller(1);
my (undef, undef, undef, $csubr) = caller(2);
$csubr //= "<toplevel>";
$_ //= "<undef>" for @_;
warn("FTRC $subr(" . join(", ", @_) .") from $csubr:$line");
}
sub stacktrace {
my $frame_no = 0;
my @frame = ();
say("STACKTRACE:");
while (my @data = caller($frame_no)) {
$frame[$frame_no] = \@data;
say(" ", join(":", $data[3], $frame[$frame_no-1][2]))
if $frame_no; # we need the $line from stack frame 0
# (which is where debug_stacktrace()
# was called from), but nothing else
# from that frame
$frame_no++;
}
}
1;
......@@ -128,7 +128,7 @@ sub print_list {
}
sub init {
$Princs = \&princs;
$f_Princs = \&princs;
}
1;
......@@ -74,7 +74,7 @@ sub Read {
$t = Read($in);
return read_error($in, "EOF in quote")
unless defined($t);
return list(intern($Quote), $t);
return list(intern($n_Quote), $t);
} elsif ($t eq '#\'') {
$t = Read($in);
return read_error($in, "EOF in #quote")
......
......@@ -5,6 +5,7 @@ package Sexp;
use warnings;
use strict;
use 5.014;
use Carp;
use Scalar::Util qw(looks_like_number);
use Data::Dumper;
......@@ -59,7 +60,7 @@ sub enter_environment {
sub backto_environment {
$Env = $_[0];
# warn("back to environment ", &$Princs($Env));
# warn("back to environment ", &$f_Princs($Env));
}
sub env_vars {
......@@ -188,7 +189,7 @@ sub bind {
sub set {
my ($sym, $value, $env) = @_;
stacktrace() unless defined($sym);
# confess("\$sym undefined") unless defined($sym);
my $name = symbol_name($sym);
return $env->{$name} = $value if $env;
......
......@@ -54,9 +54,9 @@ sub checkargs {
my $argno = 0;
my $optional = 0;
for my $desc (split('', $descriptor)) {
#warn("checkargs: desc $desc; arglist ", &$Princs($arglist));
#warn("checkargs: desc $desc; arglist ", &$f_Princs($arglist));
if ($desc eq 'R') {
#warn("checkargs: set $desc to ", &$Princs($arglist));
#warn("checkargs: set $desc to ", &$f_Princs($arglist));
push(@result, list2array($arglist));
last;
}
......@@ -72,7 +72,7 @@ sub checkargs {
last;
}
if ($desc eq 'r') {
#warn("checkargs: set $desc to ", &$Princs($arglist));
#warn("checkargs: set $desc to ", &$f_Princs($arglist));
push(@result, $arglist);
last;
}
......@@ -99,10 +99,10 @@ sub checkargs {
# not need to check the argument type
# any more
} elsif ($optional && is_nil($arg)) {
; # explicit nil arg for optional param is
# ok
; # explicit nil arg for optional param is
# ok
} elsif ($desc eq 'S') {
$arg = &$Princs($arg);
$arg = &$f_Princs($arg);
} elsif ($desc eq 'y') {
arg_type_error($argno, "symbol", $arg)
unless symbolp($arg);
......@@ -125,10 +125,10 @@ sub checkargs {
error("internal error, unknown arg descriptor %s",
$desc);
}
#warn("checkargs: set $desc to ", &$Princs($arg));
#warn("checkargs: set $desc to ", &$f_Princs($arg));
push(@result, $arg);
}
#warn("checkargs: return ", &$Princs(array2list(@result)));
#warn("checkargs: return ", &$f_Princs(array2list(@result)));
return @result;
}
......
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