Commit 6d415ba6 authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

simplified plists: no extra props map, but the symbol's itself

parent 78779c2f

Builtin.pm

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


sub Bsymbol_plist {

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

        return array2list(symbol_plist($sym));

        return symbol_plist($sym);

}



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

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

        if ($type == $t_Symbol) {

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

                                  symbol_value($ob) // $Nil,

                                  symbol_function($ob) // $Nil,

                                  symbol_plist($ob));

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

        } elsif ($type == $t_Function) {

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

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

Sexp.pm

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


# types of sexprs:

#  - literal string or number

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

#               props => {}}

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

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

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

#               doc => $doc }



sub put {

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

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

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

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

}



sub get {

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

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

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

}



sub remprop {

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

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

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

}



sub symbol_plist {

        my ($ob) = @_;

        my @plist = {};

        my $result = $Nil;

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

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

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

        }

        return $result;

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

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

        }

        return @plist;

}



sub all_symbols {

tests/001-basics.lisp

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

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

(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 "not" '(not (not 'a)) "t")

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