Merge branch 'master' of ssh://git.w21.org/home/git/lis.pl (85b52a05) · Commits · lisp / lis.pl

Builtin.pm

+11 −24

Original line number	Diff line number	Diff line
		@@ -25,6 +25,11 @@ sub Bbindings_depth {
		return bindings_depth();
		}

		sub Btruncate {
		my ($number) = checkargs($_[0], 'n');
		return int($number);
		}

		sub Bshell {
		my ($command, $return_output) = checkargs($_[0], 'S:e');
		my $result;
		@@ -58,11 +63,6 @@ sub Bsqrt {
		return sqrt($arg);
		}

		sub Bisqrt {
		my ($arg) = checkargs($_[0], 'n');
		return int(sqrt($arg));
		}

		sub Bsplit_string {
		my ($string, $sep, $nonulls) = checkargs($_[0], 'S:ee');
		my $re;
		@@ -395,23 +395,9 @@ sub Bload {
		return load($fname, $noerror, $nomessage);
		}

		sub Bapropos {
		my ($re) = checkargs($_[0], ':S');
		$re = '.' if is_nil($re);
		my $result = $Nil;
		my $end;
		for my $sym (sort {symbol_name($a) cmp symbol_name($b)} all_symbols()) {
		if (symbol_name($sym) =~ /$re/) {
		my $newpair = cons($sym, $Nil);
		if ($end) {
		rplacd($end, $newpair);
		$end = $newpair;
		} else {
		$end = $result = $newpair;
		}
		}
		}
		return $result;
		sub Bsymbols {
		checkargs($_[0], '');
		return array2list(all_symbols);
		}

		sub Beq {
		@@ -858,6 +844,8 @@ sub Btype_of {

		my @builtins = # [name, func, is_special, doc]
		(
		["truncate", \&Btruncate, 0,
		"return NUMBER truncated to integer towards zero"],
		["div", \&Bdiv, 0, "integer divide the first arg by all others"],
		["let*", \&Blet_star, 1,
		"evaluate body with local bindings: (let* ((var value) ...) body)"],
		@@ -933,7 +921,7 @@ my @builtins = # [name, func, is_special, doc]
		"define an anonymous special form from ARGS and &rest BODY"],
		["eq", \&Beq, 0,
		"return t if ARG1 and ARG2 are the same object, nil else"],
		["apropos", \&Bapropos, 0, "return a list of symbols matching ARG"],
		["symbols", \&Bsymbols, 0, "return a list of all symbols"],
		["princ", \&Bprinc, 0, "print ARG to standard output without quoting"],
		["princs", \&Bprincs, 0, "princ ARG to a string and return the string"],
		["prin1", \&Bprin1, 0, "print ARG suitable for read"],
		@@ -976,7 +964,6 @@ my @builtins = # [name, func, is_special, doc]
		["split-string", \&Bsplit_string, 0,
		"split STRING into parts SEPARATED by SEP and return the list"],
		["sqrt", \&Bsqrt, 0, "return the square root of numeric ARG"],
		["isqrt", \&Bsqrt, 0, "return the integer square root of numeric ARG"],
		["random", \&Brandom, 0,
		"return a random number a with 0 <= a < LIMIT (or 1)"],
		["read", \&Bread, 0,

Fundamental.lisp

+28 −3

Original line number	Diff line number	Diff line
		;; fundamental predefined Lisp functions
		;(debug t)

		(defun symbols ()
		"return a sorted list of all symbols"
		(apropos "."))
		(defun max (&rest numargs)
		"return the biggest of all (numeric) arguments"
		(if (null (cdr numargs))
		(car numargs)
		(let ((a (car numargs))
		(b (apply #'max (cdr numargs))))
		(if (< a b)
		b
		a))))

		(defun min (&rest numargs)
		"return the smallest of all (numeric) arguments"
		(if (null (cdr numargs))
		(car numargs)
		(let ((a (car numargs))
		(b (apply #'min (cdr numargs))))
		(if (< a b)
		a
		b))))

		(defun apropos (match)
		(sort (filter #'(lambda (sym) (re-match match (symbol-name sym)))
		(symbols))
		#'string<))

		(defun isqrt (num)
		"return the integer square root of NUM ARG"
		(truncate (sqrt num)))

		(defun caar (pair)
		"return the car of the car of PAIR"

Sexp.pm

+2 −53

Original line number	Diff line number	Diff line
		@@ -19,9 +19,8 @@ BEGIN {
		@EXPORT = qw( intern cons list car cdr listp symbolp numberp stringp
		consp symbol_name symbol_function functionp cxr type_of
		rplaca rplacd fset function put get symbol_plist
		specialp caar cadr cdar cddr caaar caadr cadar caddr cdaar
		cdadr cddar cdddr function_type function_code symbol_value
		set function_name is_nil all_symbols remprop
		specialp cadr cddr function_type function_code
		symbol_value set function_name is_nil all_symbols remprop
		function_documentation is_t cons_count function_args
		);
		}
		@@ -161,66 +160,16 @@ sub list {
		return cons($car, list(@obs));
		}

		sub caar {
		my ($ob) = @_;
		return $ob->{car}->{car} // $Nil;
		}

		sub cadr {
		my ($ob) = @_;
		return $ob->{cdr}->{car} // $Nil;
		}

		sub cdar {
		my ($ob) = @_;
		return $ob->{car}->{cdr} // $Nil;
		}

		sub cddr {
		my ($ob) = @_;
		return $ob->{cdr}->{cdr} // $Nil;
		}

		sub caaar {
		my ($ob) = @_;
		return $ob->{car}->{car}->{car} // $Nil;
		}

		sub caadr {
		my ($ob) = @_;
		return $ob->{cdr}->{car}->{car} // $Nil;
		}

		sub cadar {
		my ($ob) = @_;
		return $ob->{car}->{cdr}->{car} // $Nil;
		}

		sub caddr {
		my ($ob) = @_;
		return $ob->{cdr}->{cdr}->{car} // $Nil;
		}

		sub cdaar {
		my ($ob) = @_;
		return $ob->{car}->{car}->{cdr} // $Nil;
		}

		sub cdadr {
		my ($ob) = @_;
		return $ob->{cdr}->{car}->{cdr} // $Nil;
		}

		sub cddar {
		my ($ob) = @_;
		return $ob->{car}->{cdr}->{cdr} // $Nil;
		}

		sub cdddr {
		my ($ob) = @_;
		return $ob->{cdr}->{cdr}->{cdr} // $Nil;
		}

		sub car {
		my ($ob) = @_;
		return $ob->{car} // $Nil;

TODO

+14 −2

Original line number	Diff line number	Diff line
		@@ -2,9 +2,21 @@

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

		* do something sensible with (describe) for functions
		* environments and lexical scope

		* 031 and read errors
		* more of alists

		* floor, ceiling, round

		+ min, max

		+ "isqrt", "return the integer square root of numeric ARG"

		+ truncate

		+ do something sensible with (describe) for functions

		+ 031 and read errors

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

tests/036-truncate.lisp

0 → 100644

+4 −0

Original line number	Diff line number	Diff line
		(testcmp "truncate positive float" '(truncate (1+ 3.4)) 4)
		(testcmp "truncate positive int" '(truncate 3) 3)
		(testcmp "truncate negative float" '(truncate -3.4) -3)
		(testcmp "truncate negative int" '(truncate -3) -3)