Commit 0decbcd5 authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

Merge branch 'master' of ssh://git.w21.org/home/git/lis.pl

parents 52acf053 9be6b6d6

Builtin.pm

+2 −5
Original line number Original line Diff line number Diff line
@@ -84,7 +84,7 @@ sub Bignore { 




sub Bsymbol_plist {

sub Bsymbol_plist {

        my ($sym) = checkargs($_[0], 'y');

        my ($sym) = checkargs($_[0], 'y');

        return array2list(symbol_plist($sym));

        return symbol_plist($sym);

}

}





sub Bget {

sub Bget {
@@ -107,10 +107,7 @@ sub Bdescribe { 
        my ($ob) = checkargs($_[0], 'e');

        my ($ob) = checkargs($_[0], 'e');

        my $type = Btype_of(cons($ob, $Nil));

        my $type = Btype_of(cons($ob, $Nil));

        if ($type == $t_Symbol) {

        if ($type == $t_Symbol) {

                return array2list($type, symbol_name($ob),

                return array2list($type, $ob, symbol_plist($ob));

                                  symbol_value($ob) // $Nil,

                                  symbol_function($ob) // $Nil,

                                  symbol_plist($ob));

        } elsif ($type == $t_Function) {

        } elsif ($type == $t_Function) {

                return array2list(specialp($ob) ? $special : $function,

                return array2list(specialp($ob) ? $special : $function,

                                  consp($ob) ? $Lambda : $builtin,

                                  consp($ob) ? $Lambda : $builtin,

Sexp.pm

+5 −13
Original line number Original line Diff line number Diff line
@@ -31,40 +31,33 @@ my $cons_counter = 0; 




# types of sexprs:

# types of sexprs:

#  - literal string or number

#  - literal string or number

#  - symbol   { name => "name", value => $value, func => $function,

#  - symbol   { name => "name", value => $value, func => $function }

#               props => {}}

#  - pair     { car => ..., cdr => ... }

#  - pair     { car => ..., cdr => ... }

#  - function { type => 'expr|subr', spec => $is_special, func => $func,

#  - function { type => 'expr|subr', spec => $is_special, func => $func,

#               doc => $doc }

#               doc => $doc }





sub put {

sub put {

        my ($ob, $name, $value) = @_;

        my ($ob, $name, $value) = @_;

        $ob->{props} //= {};

        return $ob->{symbol_name($name)} = $value;

        return $ob->{props}->{symbol_name($name)} = $value;

}

}





sub get {

sub get {

        my ($ob, $name, $default) = @_;

        my ($ob, $name, $default) = @_;

        return $ob->{props}->{symbol_name($name)} // $default;

        return $ob->{symbol_name($name)} // $default;

}

}





sub remprop {

sub remprop {

        my ($ob, $name) = @_;

        my ($ob, $name) = @_;

        return delete($ob->{props}->{symbol_name($name)});

        return delete($ob->{symbol_name($name)});

}

}





sub symbol_plist {

sub symbol_plist {

        my ($ob) = @_;

        my ($ob) = @_;

        my @plist = {};

        my $result = $Nil;

        my $result = $Nil;

        while ((my ($key, $value) = each(%{$ob->{props} // {}}))) {

        while ((my ($key, $value) = each(%{$ob}))) {

                $result = cons(intern($key), cons($value, $result));

                $result = cons(intern($key), cons($value, $result));

        }

        }

        return $result;

        return $result;

        for (my $i = 0; $i <= $#plist; $i += 2) {

                $plist[$i] = intern($plist[$i]);

        }

        return @plist;

}

}





sub all_symbols {

sub all_symbols {
@@ -305,7 +298,6 @@ sub symbol_value { 




sub symbol_function {

sub symbol_function {

        my ($ob) = @_;

        my ($ob) = @_;

        return error("not a symbol: %s", $ob) unless symbolp($ob);

        return $ob->{func};

        return $ob->{func};

}

}

TODO

+2 −0
Original line number Original line Diff line number Diff line
@@ -2,6 +2,8 @@ 




*: to do; @: in progress; #: blocked; +: done; -: rejected

*: to do; @: in progress; #: blocked; +: done; -: rejected





  * do something sensible with (describe) for functions



  + command line options like lingo's -e -h -l -q

  + command line options like lingo's -e -h -l -q





  + change debug to (format, args, ...) style

  + change debug to (format, args, ...) style

tests/001-basics.lisp

+2 −1
Original line number Original line Diff line number Diff line 
(testcmp "zerop 0" '(zerop (- 3 3)) "t")

(testcmp "zerop 0" '(zerop (- 3 3)) "t")

(testcmp "zerop 0.0" '(zerop (- 3.4 3.4)) "t")

(testcmp "zerop 0.0" '(zerop (- 3.4 3.4)) "t")

(testcmp "zerop !0" '(zerop (- 3 3.4)) "nil")

(testcmp "zerop !0" '(zerop (- 3 3.4)) "nil")

(testcmp "describe" '(describe 'newsymbol) "(symbol \"newsymbol\" nil nil nil)")

(testcmp "describe" '(describe 'newsymbol)

         '(symbol newsymbol (name "newsymbol")))

(testcmp "null" '(null (null 'a)) "t")

(testcmp "null" '(null (null 'a)) "t")

(testcmp "not" '(not (not 'a)) "t")

(testcmp "not" '(not (not 'a)) "t")

(testcmp "princ" '(princ 'lala) "lala")

(testcmp "princ" '(princ 'lala) "lala")