- ) is just a convenient shorthand
;;; and complements multiple-value-list.
(defun values (&rest val-forms)
"Produce multiple values (zero or more). Each arg is one value.
See also `multiple-value-bind', which is one way to examine the
multiple values produced by a form. If the containing form or caller
does not check specially to see multiple values, it will see only
the first value."
(setq *mvalues-values* val-forms)
(setq *mvalues-count* (length *mvalues-values*))
(car *mvalues-values*))
(defun values-list (&optional val-forms)
"Produce multiple values (zero or more). Each element of LIST is one value.
This is equivalent to (apply 'values LIST)."
(cond ((nlistp val-forms)
(error "Argument to values-list must be a list, not `%s'"
(prin1-to-string val-forms))))
(setq *mvalues-values* val-forms)
(setq *mvalues-count* (length *mvalues-values*))
(car *mvalues-values*))
;;; Callers that want to see the multiple values use these macros.
(defmacro multiple-value-list (form)
"Execute FORM and return a list of all the (multiple) values FORM produces.
See `values' and `multiple-value-bind'."
(list 'progn
(list 'setq '*mvalues-count* nil)
(list 'let (list (list 'it '(gensym)))
(list 'set 'it form)
(list 'if '*mvalues-count*
(list 'copy-sequence '*mvalues-values*)
(list 'progn
(list 'setq '*mvalues-count* 1)
(list 'setq '*mvalues-values*
(list 'list (list 'symbol-value 'it)))
(list 'copy-sequence '*mvalues-values*))))))
(defmacro multiple-value-call (function &rest args)
"Call FUNCTION on all the values produced by the remaining arguments.
(multiple-value-call '+ (values 1 2) (values 3 4)) is 10."
(let* ((result (gentemp))
(arg (gentemp)))
(list 'apply (list 'function (eval function))
(list 'let* (list (list result '()))
(list 'dolist (list arg (list 'quote args) result)
(list 'setq result
(list 'append
result
(list 'multiple-value-list
(list 'eval arg)))))))))
(defmacro multiple-value-bind (vars form &rest body)
"Bind VARS to the (multiple) values produced by FORM, then do BODY.
VARS is a list of variables; each is bound to one of FORM's values.
If FORM doesn't make enough values, the extra variables are bound to nil.
(Ordinary forms produce only one value; to produce more, use `values'.)
Extra values are ignored.
BODY (zero or more forms) is executed with the variables bound,
then the bindings are unwound."
(let* ((vals (gentemp)) ;name for intermediate values
(clauses (mv-bind-clausify ;convert into clauses usable
vars vals))) ; in a let form
(list* 'let*
(cons (list vals (list 'multiple-value-list form))
clauses)
body)))
(defmacro multiple-value-setq (vars form)
"Set VARS to the (multiple) values produced by FORM.
VARS is a list of variables; each is set to one of FORM's values.
If FORM doesn't make enough values, the extra variables are set to nil.
(Ordinary forms produce only one value; to produce more, use `values'.)
Extra values are ignored."
(let* ((vals (gentemp)) ;name for intermediate values
(clauses (mv-bind-clausify ;convert into clauses usable
vars vals))) ; in a setq (after append).
(list 'let*
(list (list vals (list 'multiple-value-list form)))
(cons 'setq (apply (function append) clauses)))))
(defmacro multiple-value-prog1 (form &rest body)
"Evaluate FORM, then BODY, then produce the same values FORM produced.
Thus, (multiple-value-prog1 (values 1 2) (foobar)) produces values 1 and 2.
This is like `prog1' except that `prog1' would produce only one value,
which would be the first of FORM's values."
(let* ((heldvalues (gentemp)))
(cons 'let*
(cons (list (list heldvalues (list 'multiple-value-list form)))
(append body (list (list 'values-list heldvalues)))))))
;;; utility functions
;;;
;;; mv-bind-clausify makes the pairs needed to have the variables in
;;; the variable list correspond with the values returned by the form.
;;; vals is a fresh symbol that intervenes in all the bindings.
(defun mv-bind-clausify (vars vals)
"MV-BIND-CLAUSIFY VARS VALS => Auxiliary list
Forms a list of pairs `(,(nth i vars) (nth i vals)) for i from 0 to
the length of VARS (a list of symbols). VALS is just a fresh symbol."
(if (or (nlistp vars)
(notevery 'symbolp vars))
(error "expected a list of symbols, not `%s'"
(prin1-to-string vars)))
(let* ((nvars (length vars))
(clauses '()))
(dotimes (n nvars clauses)
(setq clauses (cons (list (nth n vars)
(list 'nth n vals)) clauses)))))
;;;; end of cl-multiple-values.el
;;;; ARITH
;;;; This file provides integer arithmetic extensions. Although
;;;; Emacs Lisp doesn't really support anything but integers, that
;;;; has still to be made to look more or less standard.
;;;;
;;;;
;;;; Cesar Quiroz @ UofR DofCSc - Dec. 1986
;;;; (quiroz@cs.rochester.edu)
(defsubst plusp (number)
"True if NUMBER is strictly greater than zero."
(> number 0))
(defsubst minusp (number)
"True if NUMBER is strictly less than zero."
(< number 0))
(defsubst oddp (number)
"True if INTEGER is not divisible by 2."
(/= (% number 2) 0))
(defsubst evenp (number)
"True if INTEGER is divisible by 2."
(= (% number 2) 0))
(defsubst abs (number)
"Return the absolute value of NUMBER."
(if (< number 0)
(- number)
number))
(defsubst signum (number)
"Return -1, 0 or 1 according to the sign of NUMBER."
(cond ((< number 0)
-1)
((> number 0)
1)
(t ;exactly zero
0)))
(defun gcd (&rest integers)
"Return the greatest common divisor of all the arguments.
The arguments must be integers. With no arguments, value is zero."
(let ((howmany (length integers)))
(cond ((= howmany 0)
0)
((= howmany 1)
(abs (car integers)))
((> howmany 2)
(apply (function gcd)
(cons (gcd (nth 0 integers) (nth 1 integers))
(nthcdr 2 integers))))
(t ;howmany=2
;; essentially the euclidean algorithm
(when (zerop (* (nth 0 integers) (nth 1 integers)))
(error "a zero argument is invalid for `gcd'"))
(do* ((absa (abs (nth 0 integers))) ; better to operate only
(absb (abs (nth 1 integers))) ;on positives.
(dd (max absa absb)) ; setup correct order for the
(ds (min absa absb)) ;succesive divisions.
;; intermediate results
(q 0)
(r 0)
;; final results
(done nil) ; flag: end of iterations
(result 0)) ; final value
(done result)
(setq q (/ dd ds))
(setq r (% dd ds))
(cond ((zerop r) (setq done t) (setq result ds))
(t (setq dd ds) (setq ds r))))))))
(defun lcm (integer &rest more)
"Return the least common multiple of all the arguments.
The arguments must be integers and there must be at least one of them."
(let ((howmany (length more))
(a integer)
(b (nth 0 more))
prod ; intermediate product
(yetmore (nthcdr 1 more)))
(cond ((zerop howmany)
(abs a))
((> howmany 1) ; recursive case
(apply (function lcm)
(cons (lcm a b) yetmore)))
(t ; base case, just 2 args
(setq prod (* a b))
(cond
((zerop prod)
0)
(t
(/ (abs prod) (gcd a b))))))))
(defun isqrt (number)
"Return the integer square root of NUMBER.
NUMBER must not be negative. Result is largest integer less than or
equal to the real square root of the argument."
;; The method used here is essentially the Newtonian iteration
;; x[n+1] <- (x[n] + Number/x[n]) / 2
;; suitably adapted to integer arithmetic.
;; Thanks to Philippe Schnoebelen