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

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

parents 52acf053 9be6b6d6
......@@ -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,
......
......@@ -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 {
......@@ -305,7 +298,6 @@ sub symbol_value {
sub symbol_function {
my ($ob) = @_;
return error("not a symbol: %s", $ob) unless symbolp($ob);
return $ob->{func};
}
......
......@@ -2,6 +2,8 @@
*: to do; @: in progress; #: blocked; +: done; -: rejected
* do something sensible with (describe) for functions
+ command line options like lingo's -e -h -l -q
+ change debug to (format, args, ...) style
......
(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")
......
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