# HG changeset patch # User Steve Losh # Date 1602026474 14400 # Node ID c15cbbfc3d37a17d5576b48d0a0dc956c71bc7bb # Parent 33ec50895f68ea8950ddc82701f16832c433e311 Add bits/hex/code-char/char-code and characters diff -r 33ec50895f68 -r c15cbbfc3d37 src/base.lisp --- a/src/base.lisp Fri Aug 07 14:50:01 2020 -0400 +++ b/src/base.lisp Tue Oct 06 19:21:14 2020 -0400 @@ -61,20 +61,6 @@ (setf *stack* (car *previous*)))) -;;;; Misc --------------------------------------------------------------------- -(defun sh (command &key (input "") output) - (uiop:run-program command - :output (when output :string) - :input (make-string-input-stream input))) - -(defun pbcopy (object) - (sh '("pbcopy") :input (aesthetic-string object)) - (values)) - -(defun pbpaste () - (values (sh '("pbpaste") :output t))) - - ;;;; Help --------------------------------------------------------------------- (defun first-letter (command) (let ((ch (aref (symbol-name command) 0))) @@ -107,7 +93,7 @@ ~@ What happens when a form is read depends on the form:~@ ~@ - * Numbers are pushed onto the stack.~@ + * Numbers and characters are pushed onto the stack.~@ * Symbols run commands.~@ * Quoted forms are pushed onto the stack.~@ ~@ @@ -272,6 +258,14 @@ "Do nothing.") +;;;; Commands/Misc ------------------------------------------------------------ +(define-command char-code (char) + (push! (char-code char))) + +(define-command code-char (code) + (push! (code-char code))) + + ;;;; Special Forms ------------------------------------------------------------ (defgeneric special-form (symbol &rest body)) @@ -306,7 +300,7 @@ (with-errors-handled (catch :do-not-add-undo-state (etypecase input - ((or number string) (push! input)) + ((or number string character) (push! input)) (symbol (command input)) (cons (apply 'special-form input))) (save-stack)))) diff -r 33ec50895f68 -r c15cbbfc3d37 src/math.lisp --- a/src/math.lisp Fri Aug 07 14:50:01 2020 -0400 +++ b/src/math.lisp Tue Oct 06 19:21:14 2020 -0400 @@ -86,6 +86,22 @@ (setf *print-base* n *read-base* n)) +(define-command bits (x) + "Pop the top of the stack and print its binary representation." + (unless (typep x '(integer 0 *)) + (error "BITS requires a nonnegative integer.")) + (format t "~v,'0,' ,4:B~%" + (let ((chunks (ceiling (integer-length x) 4))) + (+ (* 4 chunks) ; actual bits + (1- chunks))) ; comma chars + x)) + +(define-command hex (x) + "Pop the top of the stack and print its hex representation." + (unless (typep x '(integer 0 *)) + (error "HEX requires a nonnegative integer.")) + (format t "~X~%" x)) + (define-command base10 () "Set the print base and read base for numbers to base 10." (let ((pb *print-base*)