Commit a02110c4 authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

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

parent dde8a6a3

Builtin.pm

+28 −22
Original line number Diff line number Diff line
@@ -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

+10 −8
Original line number Diff line number Diff line
@@ -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;

        };