Skip to content

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

converted iterating lists to the ($arg, $arglist) = cxr($arglist) pattern

parent dde8a6a3
Hide whitespace changes
Inline Side-by-side
Showing with 38 additions and 30 deletions
Builtin.pm
View file @ a02110c4
......@@ -198,8 +198,9 @@ sub Bconcat {
my ($arglist) = @_;
my $result = "";
while (consp($arglist)) {
$result .= princs(car($arglist));
$arglist = cdr($arglist);
my $arg;
($arg, $arglist) = cxr($arglist);
$result .= princs($arg);
}
return $result;
}
......@@ -268,8 +269,9 @@ sub Blabels {
my @saved_funcs = ();
while (consp($defs)) {
my $def = car($defs);
error("malformed labels bindings: %s", $defs)
my $def;
($def, $defs) = cxr($defs);
error("malformed labels binding: %s", $def)
unless consp($def);
my $var = is_sym(car($def));
my $params = is_list(cadr($def));
......@@ -281,7 +283,6 @@ sub Blabels {
fset($var, $func);
#debug("bind symbol %s to function %s", $var, $func);
$defs = cdr($defs);
}
my $result;
# evaluate body forms
......@@ -311,7 +312,8 @@ sub Blet_star {
my $result = eval {
my $result;
while (consp($defs)) {
my $def = car($defs);
my $def;
($def, $defs) = cxr($defs);
my $var;
my $value;
if (symbolp($def)) {
......@@ -326,7 +328,6 @@ sub Blet_star {
$n_bindings += save_bindings($var);
set($var, $value);
#debug("bind symbol %s to %s", $var, $value);
$defs = cdr($defs);
}
# evaluate body forms
while (@body) {
......@@ -353,7 +354,8 @@ sub Blet {
my $result = eval {
my $result;
while (consp($defs)) {
my $def = car($defs);
my $def;
($def, $defs) = cxr($defs);
my $var;
my $value;
if (symbolp($def)) {
......@@ -368,7 +370,6 @@ sub Blet {
push(@bind_symbols, $var);
push(@new_values, $value);
#debug("bind symbol %s to %s", $var, $value);
$defs = cdr($defs);
}
$n_bindings += save_bindings(@bind_symbols);
for my $sym (@bind_symbols) {
......@@ -648,14 +649,15 @@ sub Band {
my ($arglist) = @_;
my $lastval;
while (consp($arglist)) {
my $value = Eval(car($arglist));
my $arg;
($arg, $arglist) = cxr($arglist);
my $value = Eval($arg);
unless (defined($value)) {
say("and: ", princs(car($arglist))) unless in_errset();
say("and: ", princs($arg)) unless in_errset();
return error($@);
}
return $Nil if is_nil($value);
$lastval = $value;
$arglist = cdr($arglist);
}
return $lastval;
}
......@@ -663,13 +665,14 @@ sub Band {
sub Bor {
my ($arglist) = @_;
while (consp($arglist)) {
my $value = Eval(car($arglist));
my $arg;
($arg, $arglist) = cxr($arglist);
my $value = Eval($arg);
unless (defined($value)) {
say("or: ", princs(car($arglist))) unless in_errset();
say("or: ", princs($arg)) unless in_errset();
return error($@);
}
return $value if !is_nil($value);
$arglist = cdr($arglist);
}
return $Nil;
}
......@@ -702,11 +705,12 @@ sub Bnum_equal {
#debug("val1 is %s", $val1);
$arglist = cdr($arglist);
while (consp($arglist)) {
my $val2 = is_num(car($arglist));
my $arg;
($arg, $arglist) = cxr($arglist);
my $val2 = is_num($arg);
#debug("val1 is %s", $val1);
#debug("val2 is %s arglist %s", $val2, $arglist);
return $Nil unless $val1 == $val2;
$arglist = cdr($arglist);
}
return $T;
}
......@@ -716,10 +720,11 @@ sub Bnum_less {
my $val = is_num(car($arglist));
$arglist = cdr($arglist);
while (consp($arglist)) {
my $newval = is_num(car($arglist));
my $arg;
($arg, $arglist) = cxr($arglist);
my $newval = is_num($arg);
return $Nil unless $val < $newval;
$val = $newval;
$arglist = cdr($arglist);
}
return $T;
}
......@@ -737,13 +742,14 @@ sub Bwhile {
my $body = $bodyforms;
while (consp($body)) {
my $value = Eval(car($body));
my $form;
($form, $body) = cxr($body);
my $value = Eval($form);
unless (defined($value)) {
say("while clause: ", princs(car($body)))
say("while clause: ", princs($form))
unless in_errset();
return error($@);
}
$body = cdr($body);
}
}
return $Nil;
......
Eval.pm
View file @ a02110c4
......@@ -90,22 +90,23 @@ sub debugl {
sub eval_args {
my ($arglist) = @_;
my $new = $Nil;
my $newlist = $Nil;
my $end;
#debugl("eval_args on %s", $arglist);
while (consp($arglist)) {
my $newpair = cons(Eval(car($arglist)), $Nil);
my $arg;
($arg, $arglist) = cxr($arglist);
my $newpair = cons(Eval($arg), $Nil);
if ($end) {
rplacd($end, $newpair);
$end = $newpair;
} else {
$end = $new = $newpair;
$end = $newlist = $newpair;
}
$arglist = cdr($arglist);
}
#debugl("eval_args returns %s", $new);
return $new;
#debugl("eval_args returns %s", $newlist);
return $newlist;
}
sub call_form {
......@@ -165,8 +166,9 @@ sub call_form {
}
# finally, evaluate body forms
while (consp($body)) {
$result = Eval(car($body));
$body = cdr($body);
my $form;
($form, $body) = cxr($body);
$result = Eval($form);
}
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