Commit c71a9dd5 authored by Juergen Nickelsen's avatar Juergen Nickelsen

slight optimization of expression type determination

parent a02110c4
......@@ -316,10 +316,11 @@ sub Blet_star {
($def, $defs) = cxr($defs);
my $var;
my $value;
if (symbolp($def)) {
my $type = type_of($def);
if ($type eq "Symbol") {
$var = $def;
$value = $Nil;
} elsif (consp($def)) {
} elsif ($type eq "Pair") {
$var = is_sym(car($def));
$value = Eval(is_def(cadr($def)));
} else {
......@@ -358,10 +359,11 @@ sub Blet {
($def, $defs) = cxr($defs);
my $var;
my $value;
if (symbolp($def)) {
my $type = type_of($def);
if ($type eq "Symbol") {
$var = $def;
$value = $Nil;
} elsif (consp($def)) {
} elsif ($type eq "Pair") {
$var = is_sym(car($def));
$value = Eval(is_def(cadr($def)));
} else {
......@@ -860,13 +862,10 @@ sub Bfmakunbound {
sub Btype_of {
my ($ob) = checkargs($_[0], 'e');
if (symbolp($ob)) {
return $t_Symbol;
} elsif (consp($ob)) {
return $t_Pair;
} elsif (functionp($ob)) {
return $t_Function;
} elsif (numberp($ob)) {
my $type = type_of($ob);
return intern(lc($type)) unless $type eq "scalar";
if (numberp($ob)) {
return $t_Number;
} else {
return $t_String;
......
......@@ -204,13 +204,14 @@ sub evalfun {
my $result;
while (--$max) {
if (functionp($ob)) {
my $type = type_of($ob);
if ($type eq "Function") {
#debugl("evalfun function: %s", $ob);
$result = $ob;
$result = $ob;
last;
} elsif (is_nil($ob)) {
return error("nil function %s", $orig);
} elsif (symbolp($ob)) {
} elsif ($type eq "Symbol") {
my $symbol = $ob;
if (my $func = symbol_function($ob)) {
$ob = $func;
......@@ -224,14 +225,14 @@ sub evalfun {
return error("undefined function %s",
symbol_name($symbol))
unless defined($ob);
} elsif (consp($ob)) {
} elsif ($type eq "Pair") {
my $form = $ob;
$ob = Eval($ob);
#debugl("evalfun form %s returns %s", $form, $ob);
return error("function form yields undefined: %s",
$form)
unless defined($ob);
} elsif (!defined($ob)) {
} elsif ($type eq "undef") {
return error("undefined function %s", $orig);
} else {
return error("not a function: %s", $orig);
......@@ -255,12 +256,13 @@ sub Eval {
$eval_depth++;
$eval_counter++;
my $result;
if (symbolp($ob)) {
my $type = type_of($ob);
if ($type eq "Symbol") {
#debugl("expr is sym: %s", $ob);
$result = symbol_value($ob);
return error("unbound variable %s", symbol_name($ob))
unless defined($result);
} elsif (consp($ob)) {
} elsif ($type eq "Pair") {
#debugl("expr is cons: %s", $ob);
my $func = evalfun(car($ob));
my $args = cdr($ob);
......
......@@ -17,7 +17,7 @@ use Exporter ();
BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw( intern cons list car cdr listp symbolp numberp stringp
consp symbol_name symbol_function functionp cxr
consp symbol_name symbol_function functionp cxr type_of
rplaca rplacd fset function put get symbol_plist
specialp caar cadr cdar cddr caaar caadr cadar caddr cdaar
cdadr cddar cdddr function_type function_code symbol_value
......@@ -89,6 +89,12 @@ sub function_documentation {
return $ob->{doc};
}
sub type_of {
my ($ob) = @_;
return "undef" unless defined($ob);
return ref($ob) || "scalar";
}
sub function {
my ($func, $is_special, $doc, $name) = @_;
my $type;
......
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