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

Builtin.pm

@@ -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

@@ -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};
 }
 

TODO

@@ -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

tests/001-basics.lisp

 (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")