Commit d1302203 authored by Juergen Nickelsen's avatar Juergen Nickelsen

renamed global name variables for clarity; fixed Bdescribe for functions

parent 759fc8d6
......@@ -110,7 +110,7 @@ sub Bdescribe {
return array2list($type, $ob, symbol_plist($ob));
} elsif ($type == $t_Function) {
return array2list(specialp($ob) ? $special : $function,
consp($ob) ? $Lambda : $builtin,
consp($ob->{func}) ? $Lambda : $builtin,
function_documentation($ob), $ob);
} else {
return array2list($type, $ob);
......@@ -161,7 +161,7 @@ sub Berrset {
} else {
my $err = $@;
chomp($err);
set(intern($last_error), $err);
set(intern($n_last_error), $err);
return $Nil;
}
}
......@@ -468,7 +468,7 @@ sub Blambda {
sub Bkappa {
my ($params, $body) = checkargs($_[0], 'lr');
return make_lambda($params, $body, 1, $Lambda);
return make_lambda($params, $body, 1, $Kappa);
}
sub make_lambda {
......
......@@ -515,6 +515,7 @@
(eval-list bodyforms)))
(defspecial cond (&rest clauses)
"eval the car of each of CLAUSES until true, then the rest of this clause"
(if (null clauses)
nil
(let ((clause (car clauses)))
......
......@@ -14,13 +14,16 @@ use Exporter ();
my $debugfh = \*STDOUT;
BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw($Nil $T $Sym $Pair $Function $function $special $builtin
$Quote error $Leval $andRest $Lambda $Princs $last_error
$ARGS our $t_Symbol $t_Number $t_String $t_Pair $t_Function
@EXPORT = qw($Nil $T $n_Symbol $n_Pair $n_Function $n_function $special
$builtin $function
$Quote error $Leval $andRest $Lambda $Princs $n_last_error
$n_ARGS our $t_Symbol $t_Number $t_String $t_Pair
$t_Function
ftrace $andOptional $Kappa
);
}
# some symbols
our $Nil; # the nil symbol
our $T; # the t symbol
our $andRest; # the &rest token symbol
......@@ -30,20 +33,22 @@ our $Kappa; # the kappa symbol
our $Princs; # the printer function
our $special;
our $builtin;
our $function;
# object types
# object types, all Symbols
our $t_Symbol;
our $t_Number;
our $t_String;
our $t_Pair;
our $t_Function;
our $Sym = 'Symbol';
our $Pair = 'Pair';
our $Function = 'Function';
our $function = 'function';
our $last_error = '*last-error*';
our $ARGS = '*ARGS*';
# a few symbol names
our $n_Symbol = 'Symbol';
our $n_Pair = 'Pair';
our $n_Function = 'Function';
our $n_function = 'function';
our $n_last_error = '*last-error*';
our $n_ARGS = '*ARGS*';
our $Quote = 'quote';
......
......@@ -47,7 +47,7 @@ my @argv_save = @ARGV;
load("Fundamental.lisp", 0, $opt_quiet) or exit(1);
set(intern($ARGS), $Nil);
set(intern($n_ARGS), $Nil);
@ARGV = @argv_save;
ARGS2:
while ($ARGV[0] && $ARGV[0] =~ /^-/) {
......@@ -69,7 +69,7 @@ set(intern($ARGS), $Nil);
}
my $loadfile_arg = shift(@ARGV) // '';
set(intern($ARGS), array2list(@ARGV));
set(intern($n_ARGS), array2list(@ARGV));
if ($loadfile_arg) {
load($loadfile_arg);
......
......@@ -52,7 +52,7 @@ sub Read {
} elsif ($t eq '#\'') {
$t = Read($in);
return error("EOF in quote %s", $in) unless defined($t);
return list(intern($function), $t);
return list(intern($n_function), $t);
} elsif ($t eq '.') {
return error("found . where sexpr was expected: %s", $in);
} elsif (symbolp($t)) {
......
......@@ -93,7 +93,7 @@ sub function {
my $type;
if (ref($func) eq 'CODE') {
$type = 'subr';
} elsif (ref($func) eq $Pair) {
} elsif (ref($func) eq $n_Pair) {
$type = 'expr';
} else {
return error('function not subr or expr: %s', $func);
......@@ -101,7 +101,7 @@ sub function {
return error('function: is_special undef: %s', $func)
unless defined($is_special);
return bless({ func => $func, type => $type, spec => $is_special,
doc => $doc // '', name => $name }, $Function);
doc => $doc // '', name => $name }, $n_Function);
}
sub function_name {
......@@ -131,7 +131,7 @@ sub set {
sub intern {
my ($name) = @_;
return $symbols{$name} //= bless({ name => $name }, $Sym);
return $symbols{$name} //= bless({ name => $name }, $n_Symbol);
}
sub fset {
......@@ -144,7 +144,7 @@ sub fset {
sub cons {
my ($car, $cdr) = @_;
$cons_counter++;
return bless({ car => $car, cdr => $cdr }, $Pair);
return bless({ car => $car, cdr => $cdr }, $n_Pair);
}
sub cons_count {
......@@ -253,12 +253,12 @@ sub listp {
sub symbolp {
my ($ob) = @_;
return ref($ob) eq $Sym;
return ref($ob) eq $n_Symbol;
}
sub functionp {
my ($ob) = @_;
return ref($ob) eq $Function;
return ref($ob) eq $n_Function;
}
sub specialp {
......@@ -278,7 +278,7 @@ sub stringp {
sub consp {
my ($ob) = @_;
return ref($ob) eq $Pair;
return ref($ob) eq $n_Pair;
}
sub symbol_exists {
......@@ -314,6 +314,7 @@ $andRest = intern("&rest");
$andOptional = intern("&optional");
$special = intern("special");
$builtin = intern("builtin");
$function = intern($n_function);
$t_Symbol = intern("symbol");
$t_String = intern("string");
......
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