X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/e2a3c9236277551b174d522db7161c4eec29f97f..05c1e7c3367de14f38e81e9ecdc0a36904dbc13e:/mdw-base.lisp diff --git a/mdw-base.lisp b/mdw-base.lisp index 269b398..37a3068 100644 --- a/mdw-base.lisp +++ b/mdw-base.lisp @@ -30,14 +30,17 @@ (:use #:common-lisp) (:export #:compile-time-defun #:show - #:stringify #:listify #:fix-pair #:pairify #:parse-body + #:stringify #:mappend #:listify #:fix-pair #:pairify #:parse-body #:whitespace-char-p #:slot-uninitialized #:nlet #:while #:case2 #:ecase2 #:with-gensyms #:let*/gensyms #:with-places #:locp #:locf #:ref #:with-locatives #:update-place #:update-place-after - #:incf-after #:decf-after)) + #:incf-after #:decf-after + #:fixnump) + #+cmu (:import-from #:extensions #:fixnump)) + (in-package #:mdw.base) ;;;-------------------------------------------------------------------------- @@ -50,11 +53,17 @@ (defun ,name ,args ,@body))) (defmacro show (x) - "Debugging tool: print the expression X and its value." + "Debugging tool: print the expression X and its values." (let ((tmp (gensym))) - `(let ((,tmp ,x)) - (format t "~&~S: ~S~%" ',x ,tmp) - ,tmp))) + `(let ((,tmp (multiple-value-list ,x))) + (format t "~&") + (pprint-logical-block (*standard-output* nil :per-line-prefix ";; ") + (format t + "~S = ~@_~:I~:[#~;~:*~{~S~^ ~_~}~]" + ',x + ,tmp)) + (terpri) + (values-list ,tmp)))) (defun stringify (str) "Return a string representation of STR. Strings are returned unchanged; @@ -66,6 +75,12 @@ (t (with-output-to-string (s) (princ str s))))) +(defun mappend (function list &rest more-lists) + "Apply FUNCTION to corresponding elements of LIST and MORE-LISTS, yielding + a list. Return the concatenation of all the resulting lists. Like + mapcan, but nondestructive." + (apply #'append (apply #'mapcar function list more-lists))) + (compile-time-defun listify (x) "If X is a (possibly empty) list, return X; otherwise return (list X)." (if (listp x) x (list x))) @@ -124,6 +139,13 @@ (and decls (list (cons 'declare decls))) forms)))))))) +#-cmu +(progn + (declaim (inline fixnump)) + (defun fixnump (object) + "Answer non-nil if OBJECT is a fixnum, or nil if it isn't." + (typep object 'fixnum))) + ;;;-------------------------------------------------------------------------- ;;; Generating symbols.