Skip to content

Instantly share code, notes, and snippets.

@kawakami-o3

kawakami-o3/hyperspec-examples.cl

Created March 21, 2018 15:32
Show Gist options
  • Save kawakami-o3/1d40ea6d068ce5bd8759d720aaee5864 to your computer and use it in GitHub Desktop.
Save kawakami-o3/1d40ea6d068ce5bd8759d720aaee5864 to your computer and use it in GitHub Desktop.
Download ZIP
Examples in HyperSpec
Raw
hyperspec-examples.cl
; HyperSpec/Body/s_flet_.htm
(defun foo (x flag)
(macrolet ((fudge (z)
;The parameters x and flag are not accessible
; at this point; a reference to flag would be to
; the global variable of that name.
` (if flag (* ,z ,z) ,z)))
;The parameters x and flag are accessible here.
(+ x
(fudge x)
(fudge (+ x 1)))))
==
(defun foo (x flag)
(+ x
(if flag (* x x) x)
(if flag (* (+ x 1) (+ x 1)) (+ x 1))))
; HyperSpec/Body/m_tpcase.htm
;;; (Note that the parts of this example which use TYPE-OF
;;; are implementation-dependent.)
(defun what-is-it (x)
(format t "~&~S is ~A.~%"
x (typecase x
(float "a float")
(null "a symbol, boolean false, or the empty list")
(list "a list")
(t (format nil "a(n) ~(~A~)" (type-of x))))))
=> WHAT-IS-IT
(map 'nil #'what-is-it '(nil (a b) 7.0 7 box))
>> NIL is a symbol, boolean false, or the empty list.
>> (A B) is a list.
>> 7.0 is a float.
>> 7 is a(n) integer.
>> BOX is a(n) symbol.
=> NIL
(setq x 1/3)
=> 1/3
(ctypecase x
(integer (* x 4))
(symbol (symbol-value x)))
>> Error: The value of X, 1/3, is neither an integer nor a symbol.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Specify a value to use instead.
>> 2: Return to Lisp Toplevel.
>> Debug> :CONTINUE 1
>> Use value: 3.7
>> Error: The value of X, 3.7, is neither an integer nor a symbol.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Specify a value to use instead.
>> 2: Return to Lisp Toplevel.
>> Debug> :CONTINUE 1
>> Use value: 12
=> 48
x => 12
; HyperSpec/Body/s_mult_1.htm
(setq temp '(1 2 3)) => (1 2 3)
(multiple-value-prog1
(values-list temp)
(setq temp nil)
(values-list temp)) => 1, 2, 3
; HyperSpec/Body/f_user_h.htm
(pathnamep (user-homedir-pathname)) => true
; HyperSpec/Body/f_signum.htm
(signum 0) => 0
(signum 99) => 1
(signum 4/5) => 1
(signum -99/100) => -1
(signum 0.0) => 0.0
(signum #c(0 33)) => #C(0.0 1.0)
(signum #c(7.5 10.0)) => #C(0.6 0.8)
(signum #c(0.0 -14.7)) => #C(0.0 -1.0)
(eql (signum -0.0) -0.0) => true
; HyperSpec/Body/f_nth.htm
(nth 0 '(foo bar baz)) => FOO
(nth 1 '(foo bar baz)) => BAR
(nth 3 '(foo bar baz)) => NIL
(setq 0-to-3 (list 0 1 2 3)) => (0 1 2 3)
(setf (nth 2 0-to-3) "two") => "two"
0-to-3 => (0 1 "two" 3)
; HyperSpec/Body/f_consp.htm
(consp nil) => false
(consp (cons 1 2)) => true
; HyperSpec/Body/f_file_e.htm
; HyperSpec/Body/f_identi.htm
(identity 101) => 101
(mapcan #'identity (list (list 1 2 3) '(4 5 6))) => (1 2 3 4 5 6)
; HyperSpec/Body/f_clas_1.htm
(class-of 'fred) => #<BUILT-IN-CLASS SYMBOL 610327300>
(class-of 2/3) => #<BUILT-IN-CLASS RATIO 610326642>
(defclass book () ()) => #<STANDARD-CLASS BOOK 33424745>
(class-of (make-instance 'book)) => #<STANDARD-CLASS BOOK 33424745>
(defclass novel (book) ()) => #<STANDARD-CLASS NOVEL 33424764>
(class-of (make-instance 'novel)) => #<STANDARD-CLASS NOVEL 33424764>
(defstruct kons kar kdr) => KONS
(class-of (make-kons :kar 3 :kdr 4)) => #<STRUCTURE-CLASS KONS 250020317>
; HyperSpec/Body/m_in_pkg.htm
; HyperSpec/Body/f_cp_lis.htm
(setq lst (list 1 (list 2 3))) => (1 (2 3))
(setq slst lst) => (1 (2 3))
(setq clst (copy-list lst)) => (1 (2 3))
(eq slst lst) => true
(eq clst lst) => false
(equal clst lst) => true
(rplaca lst "one") => ("one" (2 3))
slst => ("one" (2 3))
clst => (1 (2 3))
(setf (caadr lst) "two") => "two"
lst => ("one" ("two" 3))
slst => ("one" ("two" 3))
clst => (1 ("two" 3))
; HyperSpec/Body/v_pr_ar.htm
; HyperSpec/Body/f_opsetf.htm
; HyperSpec/Body/f_gensym.htm
(setq sym1 (gensym)) => #:G3142
(symbol-package sym1) => NIL
(setq sym2 (gensym 100)) => #:G100
(setq sym3 (gensym 100)) => #:G100
(eq sym2 sym3) => false
(find-symbol "G100") => NIL, NIL
(gensym "T") => #:T3143
(gensym) => #:G3144
; HyperSpec/Body/f_comp_3.htm
(complexp 1.2d2) => false
(complexp #c(5/3 7.2)) => true
; HyperSpec/Body/f_sl.htm
(/ 12 4) => 3
(/ 13 4) => 13/4
(/ -8) => -1/8
(/ 3 4 5) => 3/20
(/ 0.5) => 2.0
(/ 20 5) => 4
(/ 5 20) => 1/4
(/ 60 -2 3 5.0) => -2.0
(/ 2 #c(2 2)) => #C(1/2 -1/2)
; HyperSpec/Body/m_nth_va.htm
(nth-value 0 (values 'a 'b)) => A
(nth-value 1 (values 'a 'b)) => B
(nth-value 2 (values 'a 'b)) => NIL
(let* ((x 83927472397238947423879243432432432)
(y 32423489732)
(a (nth-value 1 (floor x y)))
(b (mod x y)))
(values a b (= a b)))
=> 3332987528, 3332987528, true
; HyperSpec/Body/v_b_1_b.htm
(boole boole-ior 1 16) => 17
(boole boole-and -2 5) => 4
(boole boole-eqv 17 15) => -31
; HyperSpec/Body/f_search.htm
(search "dog" "it's a dog's life") => 7
(search '(0 1) '(2 4 6 1 3 5) :key #'oddp) => 2
; HyperSpec/Body/f_mk_syn.htm
(setq a-stream (make-string-input-stream "a-stream")
b-stream (make-string-input-stream "b-stream"))
=> #<String Input Stream>
(setq s-stream (make-synonym-stream 'c-stream))
=> #<SYNONYM-STREAM for C-STREAM>
(setq c-stream a-stream)
=> #<String Input Stream>
(read s-stream) => A-STREAM
(setq c-stream b-stream)
=> #<String Input Stream>
(read s-stream) => B-STREAM
; HyperSpec/Body/f_comp_2.htm
(complex 0) => 0
(complex 0.0) => #C(0.0 0.0)
(complex 1 1/2) => #C(1 1/2)
(complex 1 .99) => #C(1.0 0.99)
(complex 3/2 0.0) => #C(1.5 0.0)
; HyperSpec/Body/f_stm_ex.htm
(with-open-file (stream "test" :direction :output)
(stream-external-format stream))
=> :DEFAULT
OR=> :ISO8859/1-1987
OR=> (:ASCII :SAIL)
OR=> ACME::PROPRIETARY-FILE-FORMAT-17
OR=> #<FILE-FORMAT :ISO646-1983 2343673>
; HyperSpec/Body/m_defgen.htm
; HyperSpec/Body/f_bt_and.htm
(bit-and (setq ba #*11101010) #*01101011) => #*01101010
(bit-and #*1100 #*1010) => #*1000
(bit-andc1 #*1100 #*1010) => #*0010
(setq rba (bit-andc2 ba #*00110011 t)) => #*11001000
(eq rba ba) => true
(bit-not (setq ba #*11101010)) => #*00010101
(setq rba (bit-not ba
(setq tba (make-array 8
:element-type 'bit))))
=> #*00010101
(equal rba tba) => true
(bit-xor #*1100 #*1010) => #*0110
; HyperSpec/Body/s_eval_w.htm
(eval-when (:compile-toplevel :load-toplevel :execute)
(set-macro-character #\$ #'(lambda (stream char)
(declare (ignore char))
(list 'dollar (read stream))))) => T
; HyperSpec/Body/v_pr_lin.htm
(let ((*print-right-margin* 25) (*print-lines* 3))
(pprint '(progn (setq a 1 b 2 c 3 d 4))))
>> (PROGN (SETQ A 1
>> B 2
>> C 3 ..))
=> <no values>
; HyperSpec/Body/f_upgrad.htm
; HyperSpec/Body/f_sqrt_.htm
(sqrt 9.0) => 3.0
(sqrt -9.0) => #C(0.0 3.0)
(isqrt 9) => 3
(sqrt 12) => 3.4641016
(isqrt 12) => 3
(isqrt 300) => 17
(isqrt 325) => 18
(sqrt 25)
=> 5
OR=> 5.0
(isqrt 25) => 5
(sqrt -1) => #C(0.0 1.0)
(sqrt #c(0 2)) => #C(1.0 1.0)
; HyperSpec/Body/f_rassoc.htm
(setq alist '((1 . "one") (2 . "two") (3 . 3)))
=> ((1 . "one") (2 . "two") (3 . 3))
(rassoc 3 alist) => (3 . 3)
(rassoc "two" alist) => NIL
(rassoc "two" alist :test 'equal) => (2 . "two")
(rassoc 1 alist :key #'(lambda (x) (if (numberp x) (/ x 3)))) => (3 . 3)
(rassoc 'a '((a . b) (b . c) (c . a) (z . a))) => (C . A)
(rassoc-if #'stringp alist) => (1 . "one")
(rassoc-if-not #'vectorp alist) => (3 . 3)
; HyperSpec/Body/f_file_s.htm
; HyperSpec/Body/m_mult_1.htm
(multiple-value-list (floor -3 4)) => (-1 1)
; HyperSpec/Body/f_mach_v.htm
(machine-version) => "KL-10, microcode 9"
; HyperSpec/Body/v_termin.htm
(progn (prin1 'foo) (prin1 'bar *terminal-io*))
>> FOOBAR
=> BAR
(with-output-to-string (*standard-output*)
(prin1 'foo)
(prin1 'bar *terminal-io*))
>> BAR
=> "FOO"
; HyperSpec/Body/m_w_open.htm
(setq p (merge-pathnames "test"))
=> #<PATHNAME :HOST NIL :DEVICE device-name :DIRECTORY directory-name
:NAME "test" :TYPE NIL :VERSION :NEWEST>
(with-open-file (s p :direction :output :if-exists :supersede)
(format s "Here are a couple~%of test data lines~%")) => NIL
(with-open-file (s p)
(do ((l (read-line s) (read-line s nil 'eof)))
((eq l 'eof) "Reached end of file.")
(format t "~&*** ~A~%" l)))
>> *** Here are a couple
>> *** of test data lines
=> "Reached end of file."
; HyperSpec/Body/f_mask_f.htm
(mask-field (byte 1 5) -1) => 32
(setq a 15) => 15
(mask-field (byte 2 0) a) => 3
a => 15
(setf (mask-field (byte 2 0) a) 1) => 1
a => 13
; HyperSpec/Body/f_not.htm
(not nil) => T
(not '()) => T
(not (integerp 'sss)) => T
(not (integerp 1)) => NIL
(not 3.7) => NIL
(not 'apple) => NIL
; HyperSpec/Body/f_del_fi.htm
(with-open-file (s "delete-me.text" :direction :output :if-exists :error))
=> NIL
(setq p (probe-file "delete-me.text")) => #P"R:>fred>delete-me.text.1"
(delete-file p) => T
(probe-file "delete-me.text") => false
(with-open-file (s "delete-me.text" :direction :output :if-exists :error)
(delete-file s))
=> T
(probe-file "delete-me.text") => false
; HyperSpec/Body/m_defi_5.htm
(define-condition peg/hole-mismatch
(blocks-world-error)
((peg-shape :initarg :peg-shape
:reader peg/hole-mismatch-peg-shape)
(hole-shape :initarg :hole-shape
:reader peg/hole-mismatch-hole-shape))
(:report (lambda (condition stream)
(format stream "A ~A peg cannot go in a ~A hole."
(peg/hole-mismatch-peg-shape condition)
(peg/hole-mismatch-hole-shape condition)))))
; HyperSpec/Body/s_the.htm
(the symbol (car (list (gensym)))) => #:G9876
(the fixnum (+ 5 7)) => 12
(the (values) (truncate 3.2 2)) => 1, 1.2
(the integer (truncate 3.2 2)) => 1, 1.2
(the (values integer) (truncate 3.2 2)) => 1, 1.2
(the (values integer float) (truncate 3.2 2)) => 1, 1.2
(the (values integer float symbol) (truncate 3.2 2)) => 1, 1.2
(the (values integer float symbol t null list)
(truncate 3.2 2)) => 1, 1.2
(let ((i 100))
(declare (fixnum i))
(the fixnum (1+ i))) => 101
(let* ((x (list 'a 'b 'c))
(y 5))
(setf (the fixnum (car x)) y)
x) => (5 B C)
; HyperSpec/Body/f_procla.htm
(defun declare-variable-types-globally (type vars)
(proclaim `(type ,type ,@vars))
type)
;; Once this form is executed, the dynamic variable *TOLERANCE*
;; must always contain a float.
(declare-variable-types-globally 'float '(*tolerance*))
=> FLOAT
; HyperSpec/Body/v_ar_tot.htm
; HyperSpec/Body/f_eql.htm
(eql 'a 'b) => false
(eql 'a 'a) => true
(eql 3 3) => true
(eql 3 3.0) => false
(eql 3.0 3.0) => true
(eql #c(3 -4) #c(3 -4)) => true
(eql #c(3 -4.0) #c(3 -4)) => false
(eql (cons 'a 'b) (cons 'a 'c)) => false
(eql (cons 'a 'b) (cons 'a 'b)) => false
(eql '(a . b) '(a . b))
=> true
OR=> false
(progn (setq x (cons 'a 'b)) (eql x x)) => true
(progn (setq x '(a . b)) (eql x x)) => true
(eql #\A #\A) => true
(eql "Foo" "Foo")
=> true
OR=> false
(eql "Foo" (copy-seq "Foo")) => false
(eql "FOO" "foo") => false
; HyperSpec/Body/f_mk_pn.htm
;; Implementation A -- an implementation with access to a single
;; Unix file system. This implementation happens to never display
;; the `host' information in a namestring, since there is only one host.
(make-pathname :directory '(:absolute "public" "games")
:name "chess" :type "db")
=> #P"/public/games/chess.db"
;; Implementation B -- an implementation with access to one or more
;; VMS file systems. This implementation displays `host' information
;; in the namestring only when the host is not the local host.
;; It uses a double colon to separate a host name from the host's local
;; file name.
(make-pathname :directory '(:absolute "PUBLIC" "GAMES")
:name "CHESS" :type "DB")
=> #P"SYS$DISK:[PUBLIC.GAMES]CHESS.DB"
(make-pathname :host "BOBBY"
:directory '(:absolute "PUBLIC" "GAMES")
:name "CHESS" :type "DB")
=> #P"BOBBY::SYS$DISK:[PUBLIC.GAMES]CHESS.DB"
;; Implementation C -- an implementation with simultaneous access to
;; multiple file systems from the same Lisp image. In this
;; implementation, there is a convention that any text preceding the
;; first colon in a pathname namestring is a host name.
(dolist (case '(:common :local))
(dolist (host '("MY-LISPM" "MY-VAX" "MY-UNIX"))
(print (make-pathname :host host :case case
:directory '(:absolute "PUBLIC" "GAMES")
:name "CHESS" :type "DB"))))
>> #P"MY-LISPM:>public>games>chess.db"
>> #P"MY-VAX:SYS$DISK:[PUBLIC.GAMES]CHESS.DB"
>> #P"MY-UNIX:/public/games/chess.db"
>> #P"MY-LISPM:>public>games>chess.db"
>> #P"MY-VAX:SYS$DISK:[PUBLIC.GAMES]CHESS.DB"
>> #P"MY-UNIX:/PUBLIC/GAMES/CHESS.DB"
=> NIL
; HyperSpec/Body/f_mach_t.htm
(machine-type)
=> "DEC PDP-10"
OR=> "Symbolics LM-2"
; HyperSpec/Body/f_ar_d_1.htm
(array-dimensions (make-array 4)) => (4)
(array-dimensions (make-array '(2 3))) => (2 3)
(array-dimensions (make-array 4 :fill-pointer 2)) => (4)
; HyperSpec/Body/f_substc.htm
(setq tree1 '(1 (1 2) (1 2 3) (1 2 3 4))) => (1 (1 2) (1 2 3) (1 2 3 4))
(subst "two" 2 tree1) => (1 (1 "two") (1 "two" 3) (1 "two" 3 4))
(subst "five" 5 tree1) => (1 (1 2) (1 2 3) (1 2 3 4))
(eq tree1 (subst "five" 5 tree1)) => implementation-dependent
(subst 'tempest 'hurricane
'(shakespeare wrote (the hurricane)))
=> (SHAKESPEARE WROTE (THE TEMPEST))
(subst 'foo 'nil '(shakespeare wrote (twelfth night)))
=> (SHAKESPEARE WROTE (TWELFTH NIGHT . FOO) . FOO)
(subst '(a . cons) '(old . pair)
'((old . spice) ((old . shoes) old . pair) (old . pair))
:test #'equal)
=> ((OLD . SPICE) ((OLD . SHOES) A . CONS) (A . CONS))
(subst-if 5 #'listp tree1) => 5
(subst-if-not '(x) #'consp tree1)
=> (1 X)
tree1 => (1 (1 2) (1 2 3) (1 2 3 4))
(nsubst 'x 3 tree1 :key #'(lambda (y) (and (listp y) (third y))))
=> (1 (1 2) X X)
tree1 => (1 (1 2) X X)
; HyperSpec/Body/f_dribbl.htm
; HyperSpec/Body/m_lambda.htm
(funcall (lambda (x) (+ x 3)) 4) => 7
; HyperSpec/Body/m_w_std_.htm
(with-open-file (file pathname :direction :output)
(with-standard-io-syntax
(print data file)))
;;; ... Later, in another Lisp:
(with-open-file (file pathname :direction :input)
(with-standard-io-syntax
(setq data (read file))))
; HyperSpec/Body/f_symb_4.htm
(setq sym (gensym)) => #:G9723
(symbol-plist sym) => ()
(setf (get sym 'prop1) 'val1) => VAL1
(symbol-plist sym) => (PROP1 VAL1)
(setf (get sym 'prop2) 'val2) => VAL2
(symbol-plist sym) => (PROP2 VAL2 PROP1 VAL1)
(setf (symbol-plist sym) (list 'prop3 'val3)) => (PROP3 VAL3)
(symbol-plist sym) => (PROP3 VAL3)
; HyperSpec/Body/f_add_me.htm
; HyperSpec/Body/s_multip.htm
(multiple-value-call #'list 1 '/ (values 2 3) '/ (values) '/ (floor 2.5))
=> (1 / 2 3 / / 2 0.5)
(+ (floor 5 3) (floor 19 4)) == (+ 1 4)
=> 5
(multiple-value-call #'+ (floor 5 3) (floor 19 4)) == (+ 1 2 4 3)
=> 10
; HyperSpec/Body/f_stg_tr.htm
(string-trim "abc" "abcaakaaakabcaaa") => "kaaak"
(string-trim '(#\Space #\Tab #\Newline) " garbanzo beans
") => "garbanzo beans"
(string-trim " (*)" " ( *three (silly) words* ) ")
=> "three (silly) words"
(string-left-trim "abc" "labcabcabc") => "labcabcabc"
(string-left-trim " (*)" " ( *three (silly) words* ) ")
=> "three (silly) words* ) "
(string-right-trim " (*)" " ( *three (silly) words* ) ")
=> " ( *three (silly) words"
; HyperSpec/Body/f_smp_st.htm
(simple-string-p "aaaaaa") => true
(simple-string-p (make-array 6
:element-type 'character
:fill-pointer t)) => false
; HyperSpec/Body/f_method.htm
(defmethod some-gf :before ((a integer)) a)
=> #<STANDARD-METHOD SOME-GF (:BEFORE) (INTEGER) 42736540>
(method-qualifiers *) => (:BEFORE)
; HyperSpec/Body/v_ar_ran.htm
; HyperSpec/Body/f_list_.htm
(list 1) => (1)
(list* 1) => 1
(setq a 1) => 1
(list a 2) => (1 2)
'(a 2) => (A 2)
(list 'a 2) => (A 2)
(list* a 2) => (1 . 2)
(list) => NIL ;i.e., ()
(setq a '(1 2)) => (1 2)
(eq a (list* a)) => true
(list 3 4 'a (car '(b . c)) (+ 6 -2)) => (3 4 A B 4)
(list* 'a 'b 'c 'd) == (cons 'a (cons 'b (cons 'c 'd))) => (A B C . D)
(list* 'a 'b 'c '(d e f)) => (A B C D E F)
; HyperSpec/Body/f_ar_dis.htm
(setq a1 (make-array 5)) => #<ARRAY 5 simple 46115576>
(setq a2 (make-array 4 :displaced-to a1
:displaced-index-offset 1))
=> #<ARRAY 4 indirect 46117134>
(array-displacement a2)
=> #<ARRAY 5 simple 46115576>, 1
(setq a3 (make-array 2 :displaced-to a2
:displaced-index-offset 2))
=> #<ARRAY 2 indirect 46122527>
(array-displacement a3)
=> #<ARRAY 4 indirect 46117134>, 2
; HyperSpec/Body/f_alphan.htm
(alphanumericp #\Z) => true
(alphanumericp #\9) => true
(alphanumericp #\Newline) => false
(alphanumericp #\#) => false
; HyperSpec/Body/f_merge_.htm
(merge-pathnames "CMUC::FORMAT"
"CMUC::PS:<LISPIO>.FASL")
=> #P"CMUC::PS:<LISPIO>FORMAT.FASL.0"
; HyperSpec/Body/f_shdw_i.htm
(in-package "COMMON-LISP-USER") => #<PACKAGE "COMMON-LISP-USER">
(setq sym (intern "CONFLICT")) => CONFLICT
(intern "CONFLICT" (make-package 'temp)) => TEMP::CONFLICT, NIL
(package-shadowing-symbols 'temp) => NIL
(shadowing-import sym 'temp) => T
(package-shadowing-symbols 'temp) => (CONFLICT)
; HyperSpec/Body/v_mexp_h.htm
(defun hook (expander form env)
(format t "Now expanding: ~S~%" form)
(funcall expander form env)) => HOOK
(defmacro machook (x y) `(/ (+ ,x ,y) 2)) => MACHOOK
(macroexpand '(machook 1 2)) => (/ (+ 1 2) 2), true
(let ((*macroexpand-hook* #'hook)) (macroexpand '(machook 1 2)))
>> Now expanding (MACHOOK 1 2)
=> (/ (+ 1 2) 2), true
; HyperSpec/Body/m_multip.htm
(multiple-value-bind (f r)
(floor 130 11)
(list f r)) => (11 9)
; HyperSpec/Body/f_rd_fro.htm
(read-from-string " 1 3 5" t nil :start 2) => 3, 5
(read-from-string "(a b c)") => (A B C), 7
; HyperSpec/Body/f_comp_1.htm
;; One possible way in which an interactive debugger might present
;; restarts to the user.
(defun invoke-a-restart ()
(let ((restarts (compute-restarts)))
(do ((i 0 (+ i 1)) (r restarts (cdr r))) ((null r))
(format t "~&~D: ~A~%" i (car r)))
(let ((n nil) (k (length restarts)))
(loop (when (and (typep n 'integer) (>= n 0) (< n k))
(return t))
(format t "~&Option: ")
(setq n (read))
(fresh-line))
(invoke-restart-interactively (nth n restarts)))))
(restart-case (invoke-a-restart)
(one () 1)
(two () 2)
(nil () :report "Who knows?" 'anonymous)
(one () 'I)
(two () 'II))
>> 0: ONE
>> 1: TWO
>> 2: Who knows?
>> 3: ONE
>> 4: TWO
>> 5: Return to Lisp Toplevel.
>> Option: 4
=> II
;; Note that in addition to user-defined restart points, COMPUTE-RESTARTS
;; also returns information about any system-supplied restarts, such as
;; the "Return to Lisp Toplevel" restart offered above.
; HyperSpec/Body/f_mk_sym.htm
(setq temp-string "temp") => "temp"
(setq temp-symbol (make-symbol temp-string)) => #:|temp|
(symbol-name temp-symbol) => "temp"
(eq (symbol-name temp-symbol) temp-string) => implementation-dependent
(find-symbol "temp") => NIL, NIL
(eq (make-symbol temp-string) (make-symbol temp-string)) => false
; HyperSpec/Body/f_stm_el.htm
;; Note that the stream must accomodate at least the specified type,
;; but might accomodate other types. Further note that even if it does
;; accomodate exactly the specified type, the type might be specified in
;; any of several ways.
(with-open-file (s "test" :element-type '(integer 0 1)
:if-exists :error
:direction :output)
(stream-element-type s))
=> INTEGER
OR=> (UNSIGNED-BYTE 16)
OR=> (UNSIGNED-BYTE 8)
OR=> BIT
OR=> (UNSIGNED-BYTE 1)
OR=> (INTEGER 0 1)
OR=> (INTEGER 0 (2))
; HyperSpec/Body/f_symb_5.htm
(setf (symbol-value 'a) 1) => 1
(symbol-value 'a) => 1
;; SYMBOL-VALUE cannot see lexical variables.
(let ((a 2)) (symbol-value 'a)) => 1
(let ((a 2)) (setq a 3) (symbol-value 'a)) => 1
;; SYMBOL-VALUE can see dynamic variables.
(let ((a 2))
(declare (special a))
(symbol-value 'a)) => 2
(let ((a 2))
(declare (special a))
(setq a 3)
(symbol-value 'a)) => 3
(let ((a 2))
(setf (symbol-value 'a) 3)
a) => 2
a => 3
(symbol-value 'a) => 3
(let ((a 4))
(declare (special a))
(let ((b (symbol-value 'a)))
(setf (symbol-value 'a) 5)
(values a b))) => 5, 4
a => 3
(symbol-value :any-keyword) => :ANY-KEYWORD
(symbol-value 'nil) => NIL
(symbol-value '()) => NIL
;; The precision of this next one is implementation-dependent.
(symbol-value 'pi) => 3.141592653589793d0
; HyperSpec/Body/v_break_.htm
*break-on-signals* => NIL
(ignore-errors (error 'simple-error :format-control "Fooey!"))
=> NIL, #<SIMPLE-ERROR 32207172>
(let ((*break-on-signals* 'error))
(ignore-errors (error 'simple-error :format-control "Fooey!")))
>> Break: Fooey!
>> BREAK entered because of *BREAK-ON-SIGNALS*.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Continue to signal.
>> 2: Top level.
>> Debug> :CONTINUE 1
>> Continue to signal.
=> NIL, #<SIMPLE-ERROR 32212257>
(let ((*break-on-signals* 'error))
(error 'simple-error :format-control "Fooey!"))
>> Break: Fooey!
>> BREAK entered because of *BREAK-ON-SIGNALS*.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Continue to signal.
>> 2: Top level.
>> Debug> :CONTINUE 1
>> Continue to signal.
>> Error: Fooey!
>> To continue, type :CONTINUE followed by an option number:
>> 1: Top level.
>> Debug> :CONTINUE 1
>> Top level.
; HyperSpec/Body/v_module.htm
; HyperSpec/Body/f_y_or_n.htm
(y-or-n-p "(t or nil) given by")
>> (t or nil) given by (Y or N) Y
=> true
(yes-or-no-p "a ~S message" 'frightening)
>> a FRIGHTENING message (Yes or No) no
=> false
(y-or-n-p "Produce listing file?")
>> Produce listing file?
>> Please respond with Y or N. n
=> false
; HyperSpec/Body/f_file_p.htm
(defun tester ()
(let ((noticed '()) file-written)
(flet ((notice (x) (push x noticed) x))
(with-open-file (s "test.bin"
:element-type '(unsigned-byte 8)
:direction :output
:if-exists :error)
(notice (file-position s)) ;1
(write-byte 5 s)
(write-byte 6 s)
(let ((p (file-position s)))
(notice p) ;2
(notice (when p (file-position s (1- p))))) ;3
(write-byte 7 s)
(notice (file-position s)) ;4
(setq file-written (truename s)))
(with-open-file (s file-written
:element-type '(unsigned-byte 8)
:direction :input)
(notice (file-position s)) ;5
(let ((length (file-length s)))
(notice length) ;6
(when length
(dotimes (i length)
(notice (read-byte s)))))) ;7,...
(nreverse noticed))))
=> tester
(tester)
=> (0 2 T 2 0 2 5 7)
OR=> (0 2 NIL 3 0 3 5 6 7)
OR=> (NIL NIL NIL NIL NIL NIL)
; HyperSpec/Body/m_mult_2.htm
(multiple-value-setq (quotient remainder) (truncate 3.2 2)) => 1
quotient => 1
remainder => 1.2
(multiple-value-setq (a b c) (values 1 2)) => 1
a => 1
b => 2
c => NIL
(multiple-value-setq (a b) (values 4 5 6)) => 4
a => 4
b => 5
; HyperSpec/Body/v_ld_pns.htm
; HyperSpec/Body/s_progv.htm
(setq *x* 1) => 1
(progv '(*x*) '(2) *x*) => 2
*x* => 1
Assuming *x* is not globally special,
(let ((*x* 3))
(progv '(*x*) '(4)
(list *x* (symbol-value '*x*)))) => (3 4)
; HyperSpec/Body/f_in_stm.htm
(input-stream-p *standard-input*) => true
(input-stream-p *terminal-io*) => true
(input-stream-p (make-string-output-stream)) => false
(output-stream-p *standard-output*) => true
(output-stream-p *terminal-io*) => true
(output-stream-p (make-string-input-stream "jr")) => false
; HyperSpec/Body/f_rd_lin.htm
(setq a "line 1
line2")
=> "line 1
line2"
(read-line (setq input-stream (make-string-input-stream a)))
=> "line 1", false
(read-line input-stream)
=> "line2", true
(read-line input-stream nil nil)
=> NIL, true
; HyperSpec/Body/m_psetq.htm
;; A simple use of PSETQ to establish values for variables.
;; As a matter of style, many programmers would prefer SETQ
;; in a simple situation like this where parallel assignment
;; is not needed, but the two have equivalent effect.
(psetq a 1 b 2 c 3) => NIL
a => 1
b => 2
c => 3
;; Use of PSETQ to update values by parallel assignment.
;; The effect here is very different than if SETQ had been used.
(psetq a (1+ b) b (1+ a) c (+ a b)) => NIL
a => 3
b => 2
c => 3
;; Use of PSETQ on a symbol macro.
(let ((x (list 10 20 30)))
(symbol-macrolet ((y (car x)) (z (cadr x)))
(psetq y (1+ z) z (1+ y))
(list x y z)))
=> ((21 11 30) 21 11)
;; Use of parallel assignment to swap values of A and B.
(let ((a 1) (b 2))
(psetq a b b a)
(values a b))
=> 2, 1
; HyperSpec/Body/v__.htm
(format t "~&Evaluating ~S~%" -)
>> Evaluating (FORMAT T "~&Evaluating ~S~%" -)
=> NIL
; HyperSpec/Body/m_defi_4.htm
;;; Examples of the short form of define-method-combination
(define-method-combination and :identity-with-one-argument t)
(defmethod func and ((x class1) y) ...)
;;; The equivalent of this example in the long form is:
(define-method-combination and
(&optional (order :most-specific-first))
((around (:around))
(primary (and) :order order :required t))
(let ((form (if (rest primary)
`(and ,@(mapcar #'(lambda (method)
`(call-method ,method))
primary))
`(call-method ,(first primary)))))
(if around
`(call-method ,(first around)
(,@(rest around)
(make-method ,form)))
form)))
;;; Examples of the long form of define-method-combination
;The default method-combination technique
(define-method-combination standard ()
((around (:around))
(before (:before))
(primary () :required t)
(after (:after)))
(flet ((call-methods (methods)
(mapcar #'(lambda (method)
`(call-method ,method))
methods)))
(let ((form (if (or before after (rest primary))
`(multiple-value-prog1
(progn ,@(call-methods before)
(call-method ,(first primary)
,(rest primary)))
,@(call-methods (reverse after)))
`(call-method ,(first primary)))))
(if around
`(call-method ,(first around)
(,@(rest around)
(make-method ,form)))
form))))
;A simple way to try several methods until one returns non-nil
(define-method-combination or ()
((methods (or)))
`(or ,@(mapcar #'(lambda (method)
`(call-method ,method))
methods)))
;A more complete version of the preceding
(define-method-combination or
(&optional (order ':most-specific-first))
((around (:around))
(primary (or)))
;; Process the order argument
(case order
(:most-specific-first)
(:most-specific-last (setq primary (reverse primary)))
(otherwise (method-combination-error "~S is an invalid order.~@
:most-specific-first and :most-specific-last are the possible values."
order)))
;; Must have a primary method
(unless primary
(method-combination-error "A primary method is required."))
;; Construct the form that calls the primary methods
(let ((form (if (rest primary)
`(or ,@(mapcar #'(lambda (method)
`(call-method ,method))
primary))
`(call-method ,(first primary)))))
;; Wrap the around methods around that form
(if around
`(call-method ,(first around)
(,@(rest around)
(make-method ,form)))
form)))
;The same thing, using the :order and :required keyword options
(define-method-combination or
(&optional (order ':most-specific-first))
((around (:around))
(primary (or) :order order :required t))
(let ((form (if (rest primary)
`(or ,@(mapcar #'(lambda (method)
`(call-method ,method))
primary))
`(call-method ,(first primary)))))
(if around
`(call-method ,(first around)
(,@(rest around)
(make-method ,form)))
form)))
;This short-form call is behaviorally identical to the preceding
(define-method-combination or :identity-with-one-argument t)
;Order methods by positive integer qualifiers
;:around methods are disallowed to keep the example small
(define-method-combination example-method-combination ()
((methods positive-integer-qualifier-p))
`(progn ,@(mapcar #'(lambda (method)
`(call-method ,method))
(stable-sort methods #'<
:key #'(lambda (method)
(first (method-qualifiers method)))))))
(defun positive-integer-qualifier-p (method-qualifiers)
(and (= (length method-qualifiers) 1)
(typep (first method-qualifiers) '(integer 0 *))))
;;; Example of the use of :arguments
(define-method-combination progn-with-lock ()
((methods ()))
(:arguments object)
`(unwind-protect
(progn (lock (object-lock ,object))
,@(mapcar #'(lambda (method)
`(call-method ,method))
methods))
(unlock (object-lock ,object))))
; HyperSpec/Body/f_invali.htm
; HyperSpec/Body/f_sw_tpc.htm
(software-type) => "Multics"
(software-version) => "1.3x"
; HyperSpec/Body/f_terpri.htm
(with-output-to-string (s)
(write-string "some text" s)
(terpri s)
(terpri s)
(write-string "more text" s))
=> "some text
more text"
(with-output-to-string (s)
(write-string "some text" s)
(fresh-line s)
(fresh-line s)
(write-string "more text" s))
=> "some text
more text"
; HyperSpec/Body/f_export.htm
(make-package 'temp :use nil) => #<PACKAGE "TEMP">
(use-package 'temp) => T
(intern "TEMP-SYM" 'temp) => TEMP::TEMP-SYM, NIL
(find-symbol "TEMP-SYM") => NIL, NIL
(export (find-symbol "TEMP-SYM" 'temp) 'temp) => T
(find-symbol "TEMP-SYM") => TEMP-SYM, :INHERITED
; HyperSpec/Body/f_rn_pkg.htm
(make-package 'temporary :nicknames '("TEMP")) => #<PACKAGE "TEMPORARY">
(rename-package 'temp 'ephemeral) => #<PACKAGE "EPHEMERAL">
(package-nicknames (find-package 'ephemeral)) => ()
(find-package 'temporary) => NIL
(rename-package 'ephemeral 'temporary '(temp fleeting))
=> #<PACKAGE "TEMPORARY">
(package-nicknames (find-package 'temp)) => ("TEMP" "FLEETING")
; HyperSpec/Body/v_multip.htm
; HyperSpec/Body/s_catch.htm
(catch 'dummy-tag 1 2 (throw 'dummy-tag 3) 4) => 3
(catch 'dummy-tag 1 2 3 4) => 4
(defun throw-back (tag) (throw tag t)) => THROW-BACK
(catch 'dummy-tag (throw-back 'dummy-tag) 2) => T
;; Contrast behavior of this example with corresponding example of BLOCK.
(catch 'c
(flet ((c1 () (throw 'c 1)))
(catch 'c (c1) (print 'unreachable))
2)) => 2
; HyperSpec/Body/v_ar_dim.htm
; HyperSpec/Body/f_sleep.htm
(sleep 1) => NIL
;; Actually, since SLEEP is permitted to use approximate timing,
;; this might not always yield true, but it will often enough that
;; we felt it to be a productive example of the intent.
(let ((then (get-universal-time))
(now (progn (sleep 10) (get-universal-time))))
(>= (- now then) 10))
=> true
; HyperSpec/Body/f_symb_1.htm
(symbol-function 'car) => #<FUNCTION CAR>
(symbol-function 'twice) is an error ;because TWICE isn't defined.
(defun twice (n) (* n 2)) => TWICE
(symbol-function 'twice) => #<FUNCTION TWICE>
(list (twice 3)
(funcall (function twice) 3)
(funcall (symbol-function 'twice) 3))
=> (6 6 6)
(flet ((twice (x) (list x x)))
(list (twice 3)
(funcall (function twice) 3)
(funcall (symbol-function 'twice) 3)))
=> ((3 3) (3 3) 6)
(setf (symbol-function 'twice) #'(lambda (x) (list x x)))
=> #<FUNCTION anonymous>
(list (twice 3)
(funcall (function twice) 3)
(funcall (symbol-function 'twice) 3))
=> ((3 3) (3 3) (3 3))
(fboundp 'defun) => true
(symbol-function 'defun)
=> implementation-dependent
(functionp (symbol-function 'defun))
=> implementation-dependent
(defun symbol-function-or-nil (symbol)
(if (and (fboundp symbol)
(not (macro-function symbol))
(not (special-operator-p symbol)))
(symbol-function symbol)
nil)) => SYMBOL-FUNCTION-OR-NIL
(symbol-function-or-nil 'car) => #<FUNCTION CAR>
(symbol-function-or-nil 'defun) => NIL
; HyperSpec/Body/f_coerce.htm
(coerce '(a b c) 'vector) => #(A B C)
(coerce 'a 'character) => #\A
(coerce 4.56 'complex) => #C(4.56 0.0)
(coerce 4.5s0 'complex) => #C(4.5s0 0.0s0)
(coerce 7/2 'complex) => 7/2
(coerce 0 'short-float) => 0.0s0
(coerce 3.5L0 'float) => 3.5L0
(coerce 7/2 'float) => 3.5
(coerce (cons 1 2) t) => (1 . 2)
; HyperSpec/Body/f_fbound.htm
(fboundp 'car) => true
(fboundp 'nth-value) => false
(fboundp 'with-open-file) => true
(fboundp 'unwind-protect) => true
(defun my-function (x) x) => MY-FUNCTION
(fboundp 'my-function) => true
(let ((saved-definition (symbol-function 'my-function)))
(unwind-protect (progn (fmakunbound 'my-function)
(fboundp 'my-function))
(setf (symbol-function 'my-function) saved-definition)))
=> false
(fboundp 'my-function) => true
(defmacro my-macro (x) `',x) => MY-MACRO
(fboundp 'my-macro) => true
(fmakunbound 'my-function) => MY-FUNCTION
(fboundp 'my-function) => false
(flet ((my-function (x) x))
(fboundp 'my-function)) => false
; HyperSpec/Body/f_mk_i_1.htm
; HyperSpec/Body/f_vector.htm
(arrayp (setq v (vector 1 2 'sirens))) => true
(vectorp v) => true
(simple-vector-p v) => true
(length v) => 3
; HyperSpec/Body/f_rest.htm
(rest '(1 2)) => (2)
(rest '(1 . 2)) => 2
(rest '(1)) => NIL
(setq *cons* '(1 . 2)) => (1 . 2)
(setf (rest *cons*) "two") => "two"
*cons* => (1 . "two")
; HyperSpec/Body/f_arrayp.htm
(arrayp (make-array '(2 3 4) :adjustable t)) => true
(arrayp (make-array 6)) => true
(arrayp #*1011) => true
(arrayp "hi") => true
(arrayp 'hi) => false
(arrayp 12) => false
; HyperSpec/Body/m_w_cnd_.htm
; HyperSpec/Body/f_slt_ma.htm
(slot-missing (class-of instance)
instance
slot-name
'slot-makunbound)
; HyperSpec/Body/f_arithm.htm
; HyperSpec/Body/f_ldb_te.htm
(ldb-test (byte 4 1) 16) => true
(ldb-test (byte 3 1) 16) => false
(ldb-test (byte 3 2) 16) => true
; HyperSpec/Body/f_slt_bo.htm
(slot-missing (class-of instance)
instance
slot-name
'slot-boundp)
; HyperSpec/Body/f_makunb.htm
(setf (symbol-value 'a) 1)
(boundp 'a) => true
a => 1
(makunbound 'a) => A
(boundp 'a) => false
; HyperSpec/Body/f_stmp.htm
(streamp *terminal-io*) => true
(streamp 1) => false
; HyperSpec/Body/f_eq.htm
(eq 'a 'b) => false
(eq 'a 'a) => true
(eq 3 3)
=> true
OR=> false
(eq 3 3.0) => false
(eq 3.0 3.0)
=> true
OR=> false
(eq #c(3 -4) #c(3 -4))
=> true
OR=> false
(eq #c(3 -4.0) #c(3 -4)) => false
(eq (cons 'a 'b) (cons 'a 'c)) => false
(eq (cons 'a 'b) (cons 'a 'b)) => false
(eq '(a . b) '(a . b))
=> true
OR=> false
(progn (setq x (cons 'a 'b)) (eq x x)) => true
(progn (setq x '(a . b)) (eq x x)) => true
(eq #\A #\A)
=> true
OR=> false
(let ((x "Foo")) (eq x x)) => true
(eq "Foo" "Foo")
=> true
OR=> false
(eq "Foo" (copy-seq "Foo")) => false
(eq "FOO" "foo") => false
(eq "string-seq" (copy-seq "string-seq")) => false
(let ((x 5)) (eq x x))
=> true
OR=> false
; HyperSpec/Body/v_lambda.htm
; HyperSpec/Body/f_graphi.htm
(graphic-char-p #\G) => true
(graphic-char-p #\#) => true
(graphic-char-p #\Space) => true
(graphic-char-p #\Newline) => false
; HyperSpec/Body/m_loop_f.htm
;; Terminate the loop, but return the accumulated count.
(loop for i in '(1 2 3 stop-here 4 5 6)
when (symbolp i) do (loop-finish)
count i)
=> 3
;; The preceding loop is equivalent to:
(loop for i in '(1 2 3 stop-here 4 5 6)
until (symbolp i)
count i)
=> 3
;; While LOOP-FINISH can be used can be used in a variety of
;; situations it is really most needed in a situation where a need
;; to exit is detected at other than the loop's `top level'
;; (where UNTIL or WHEN often work just as well), or where some
;; computation must occur between the point where a need to exit is
;; detected and the point where the exit actually occurs. For example:
(defun tokenize-sentence (string)
(macrolet ((add-word (wvar svar)
`(when ,wvar
(push (coerce (nreverse ,wvar) 'string) ,svar)
(setq ,wvar nil))))
(loop with word = '() and sentence = '() and endpos = nil
for i below (length string)
do (let ((char (aref string i)))
(case char
(#\Space (add-word word sentence))
(#\. (setq endpos (1+ i)) (loop-finish))
(otherwise (push char word))))
finally (add-word word sentence)
(return (values (nreverse sentence) endpos)))))
=> TOKENIZE-SENTENCE
(tokenize-sentence "this is a sentence. this is another sentence.")
=> ("this" "is" "a" "sentence"), 19
(tokenize-sentence "this is a sentence")
=> ("this" "is" "a" "sentence"), NIL
; HyperSpec/Body/f_vec_po.htm
(vector-push (setq fable (list 'fable))
(setq fa (make-array 8
:fill-pointer 2
:initial-element 'sisyphus))) => 2
(fill-pointer fa) => 3
(eq (vector-pop fa) fable) => true
(vector-pop fa) => SISYPHUS
(fill-pointer fa) => 1
; HyperSpec/Body/f_warn.htm
(defun foo (x)
(let ((result (* x 2)))
(if (not (typep result 'fixnum))
(warn "You're using very big numbers."))
result))
=> FOO
(foo 3)
=> 6
(foo most-positive-fixnum)
>> Warning: You're using very big numbers.
=> 4294967294
(setq *break-on-signals* t)
=> T
(foo most-positive-fixnum)
>> Break: Caveat emptor.
>> To continue, type :CONTINUE followed by an option number.
>> 1: Return from Break.
>> 2: Abort to Lisp Toplevel.
>> Debug> :continue 1
>> Warning: You're using very big numbers.
=> 4294967294
; HyperSpec/Body/f_log.htm
(log 100 10)
=> 2.0
=> 2
(log 100.0 10) => 2.0
(log #c(0 1) #c(0 -1))
=> #C(-1.0 0.0)
OR=> #C(-1 0)
(log 8.0 2) => 3.0
; HyperSpec/Body/m_defmet.htm
; HyperSpec/Body/m_defi_1.htm
(defvar *things* (list 'alpha 'beta 'gamma)) => *THINGS*
(define-symbol-macro thing1 (first *things*)) => THING1
(define-symbol-macro thing2 (second *things*)) => THING2
(define-symbol-macro thing3 (third *things*)) => THING3
thing1 => ALPHA
(setq thing1 'ONE) => ONE
*things* => (ONE BETA GAMMA)
(multiple-value-setq (thing2 thing3) (values 'two 'three)) => TWO
thing3 => THREE
*things* => (ONE TWO THREE)
(list thing2 (let ((thing2 2)) thing2)) => (TWO 2)
; HyperSpec/Body/f_cmp__1.htm
; HyperSpec/Body/m_pop.htm
(setq stack '(a b c)) => (A B C)
(pop stack) => A
stack => (B C)
(setq llst '((1 2 3 4))) => ((1 2 3 4))
(pop (car llst)) => 1
llst => ((2 3 4))
; HyperSpec/Body/m_defi_3.htm
(defun lastguy (x) (car (last x))) => LASTGUY
(define-setf-expander lastguy (x &environment env)
"Set the last element in a list to the given value."
(multiple-value-bind (dummies vals newval setter getter)
(get-setf-expansion x env)
(let ((store (gensym)))
(values dummies
vals
`(,store)
`(progn (rplaca (last ,getter) ,store) ,store)
`(lastguy ,getter))))) => LASTGUY
(setq a (list 'a 'b 'c 'd)
b (list 'x)
c (list 1 2 3 (list 4 5 6))) => (1 2 3 (4 5 6))
(setf (lastguy a) 3) => 3
(setf (lastguy b) 7) => 7
(setf (lastguy (lastguy c)) 'lastguy-symbol) => LASTGUY-SYMBOL
a => (A B C 3)
b => (7)
c => (1 2 3 (4 5 LASTGUY-SYMBOL))
; HyperSpec/Body/f_nconc.htm
(nconc) => NIL
(setq x '(a b c)) => (A B C)
(setq y '(d e f)) => (D E F)
(nconc x y) => (A B C D E F)
x => (A B C D E F)
; HyperSpec/Body/f_mexp_.htm
(defmacro alpha (x y) `(beta ,x ,y)) => ALPHA
(defmacro beta (x y) `(gamma ,x ,y)) => BETA
(defmacro delta (x y) `(gamma ,x ,y)) => EPSILON
(defmacro expand (form &environment env)
(multiple-value-bind (expansion expanded-p)
(macroexpand form env)
`(values ',expansion ',expanded-p))) => EXPAND
(defmacro expand-1 (form &environment env)
(multiple-value-bind (expansion expanded-p)
(macroexpand-1 form env)
`(values ',expansion ',expanded-p))) => EXPAND-1
;; Simple examples involving just the global environment
(macroexpand-1 '(alpha a b)) => (BETA A B), true
(expand-1 (alpha a b)) => (BETA A B), true
(macroexpand '(alpha a b)) => (GAMMA A B), true
(expand (alpha a b)) => (GAMMA A B), true
(macroexpand-1 'not-a-macro) => NOT-A-MACRO, false
(expand-1 not-a-macro) => NOT-A-MACRO, false
(macroexpand '(not-a-macro a b)) => (NOT-A-MACRO A B), false
(expand (not-a-macro a b)) => (NOT-A-MACRO A B), false
;; Examples involving lexical environments
(macrolet ((alpha (x y) `(delta ,x ,y)))
(macroexpand-1 '(alpha a b))) => (BETA A B), true
(macrolet ((alpha (x y) `(delta ,x ,y)))
(expand-1 (alpha a b))) => (DELTA A B), true
(macrolet ((alpha (x y) `(delta ,x ,y)))
(macroexpand '(alpha a b))) => (GAMMA A B), true
(macrolet ((alpha (x y) `(delta ,x ,y)))
(expand (alpha a b))) => (GAMMA A B), true
(macrolet ((beta (x y) `(epsilon ,x ,y)))
(expand (alpha a b))) => (EPSILON A B), true
(let ((x (list 1 2 3)))
(symbol-macrolet ((a (first x)))
(expand a))) => (FIRST X), true
(let ((x (list 1 2 3)))
(symbol-macrolet ((a (first x)))
(macroexpand 'a))) => A, false
(symbol-macrolet ((b (alpha x y)))
(expand-1 b)) => (ALPHA X Y), true
(symbol-macrolet ((b (alpha x y)))
(expand b)) => (GAMMA X Y), true
(symbol-macrolet ((b (alpha x y))
(a b))
(expand-1 a)) => B, true
(symbol-macrolet ((b (alpha x y))
(a b))
(expand a)) => (GAMMA X Y), true
;; Examples of shadowing behavior
(flet ((beta (x y) (+ x y)))
(expand (alpha a b))) => (BETA A B), true
(macrolet ((alpha (x y) `(delta ,x ,y)))
(flet ((alpha (x y) (+ x y)))
(expand (alpha a b)))) => (ALPHA A B), false
(let ((x (list 1 2 3)))
(symbol-macrolet ((a (first x)))
(let ((a x))
(expand a)))) => A, false
; HyperSpec/Body/f_logcou.htm
(logcount 0) => 0
(logcount -1) => 0
(logcount 7) => 3
(logcount 13) => 3 ;Two's-complement binary: ...0001101
(logcount -13) => 2 ;Two's-complement binary: ...1110011
(logcount 30) => 4 ;Two's-complement binary: ...0011110
(logcount -30) => 4 ;Two's-complement binary: ...1100010
(logcount (expt 2 100)) => 1
(logcount (- (expt 2 100))) => 100
(logcount (- (1+ (expt 2 100)))) => 1
; HyperSpec/Body/f_pkg_na.htm
(in-package "COMMON-LISP-USER") => #<PACKAGE "COMMON-LISP-USER">
(package-name *package*) => "COMMON-LISP-USER"
(package-name (symbol-package :test)) => "KEYWORD"
(package-name (find-package 'common-lisp)) => "COMMON-LISP"
; HyperSpec/Body/v_lamb_1.htm
; HyperSpec/Body/f_file_w.htm
(with-open-file (s "noel.text"
:direction :output :if-exists :error)
(format s "~&Dear Santa,~2%I was good this year. ~
Please leave lots of toys.~2%Love, Sue~
~2%attachments: milk, cookies~%")
(truename s))
=> #P"CUPID:/susan/noel.text"
(with-open-file (s "noel.text")
(file-write-date s))
=> 2902600800
; HyperSpec/Body/f_cp_seq.htm
(setq str "a string") => "a string"
(equalp str (copy-seq str)) => true
(eql str (copy-seq str)) => false
; HyperSpec/Body/f_revers.htm
(setq str "abc") => "abc"
(reverse str) => "cba"
str => "abc"
(setq str (copy-seq str)) => "abc"
(nreverse str) => "cba"
str => implementation-dependent
(setq l (list 1 2 3)) => (1 2 3)
(nreverse l) => (3 2 1)
l => implementation-dependent
; HyperSpec/Body/f_set_ma.htm
(get-macro-character #\{) => NIL, false
(not (get-macro-character #\;)) => false
; HyperSpec/Body/f_logand.htm
(logior 1 2 4 8) => 15
(logxor 1 3 7 15) => 10
(logeqv) => -1
(logand 16 31) => 16
(lognot 0) => -1
(lognot 1) => -2
(lognot -1) => 0
(lognot (1+ (lognot 1000))) => 999
;;; In the following example, m is a mask. For each bit in
;;; the mask that is a 1, the corresponding bits in x and y are
;;; exchanged. For each bit in the mask that is a 0, the
;;; corresponding bits of x and y are left unchanged.
(flet ((show (m x y)
(format t "~%m = #o~6,'0O~%x = #o~6,'0O~%y = #o~6,'0O~%"
m x y)))
(let ((m #o007750)
(x #o452576)
(y #o317407))
(show m x y)
(let ((z (logand (logxor x y) m)))
(setq x (logxor z x))
(setq y (logxor z y))
(show m x y))))
>> m = #o007750
>> x = #o452576
>> y = #o317407
>>
>> m = #o007750
>> x = #o457426
>> y = #o312557
=> NIL
; HyperSpec/Body/f_tree_e.htm
(setq tree1 '(1 (1 2))
tree2 '(1 (1 2))) => (1 (1 2))
(tree-equal tree1 tree2) => true
(eql tree1 tree2) => false
(setq tree1 '('a ('b 'c))
tree2 '('a ('b 'c))) => ('a ('b 'c))
=> ((QUOTE A) ((QUOTE B) (QUOTE C)))
(tree-equal tree1 tree2 :test 'eq) => true
; HyperSpec/Body/f_code_c.htm
(code-char 65.) => #\A ;in an implementation using ASCII codes
(code-char (char-code #\Space)) => #\Space ;in any implementation
; HyperSpec/Body/f_symb_2.htm
(symbol-name 'temp) => "TEMP"
(symbol-name :start) => "START"
(symbol-name (gensym)) => "G1234" ;for example
; HyperSpec/Body/f_boole.htm
(boole boole-ior 1 16) => 17
(boole boole-and -2 5) => 4
(boole boole-eqv 17 15) => -31
;;; These examples illustrate the result of applying BOOLE and each
;;; of the possible values of OP to each possible combination of bits.
(progn
(format t "~&Results of (BOOLE <op> #b0011 #b0101) ...~
~%---Op-------Decimal-----Binary----Bits---~%")
(dolist (symbol '(boole-1 boole-2 boole-and boole-andc1
boole-andc2 boole-c1 boole-c2 boole-clr
boole-eqv boole-ior boole-nand boole-nor
boole-orc1 boole-orc2 boole-set boole-xor))
(let ((result (boole (symbol-value symbol) #b0011 #b0101)))
(format t "~& ~A~13T~3,' D~23T~:*~5,' B~31T ...~4,'0B~%"
symbol result (logand result #b1111)))))
>> Results of (BOOLE <op> #b0011 #b0101) ...
>> ---Op-------Decimal-----Binary----Bits---
>> BOOLE-1 3 11 ...0011
>> BOOLE-2 5 101 ...0101
>> BOOLE-AND 1 1 ...0001
>> BOOLE-ANDC1 4 100 ...0100
>> BOOLE-ANDC2 2 10 ...0010
>> BOOLE-C1 -4 -100 ...1100
>> BOOLE-C2 -6 -110 ...1010
>> BOOLE-CLR 0 0 ...0000
>> BOOLE-EQV -7 -111 ...1001
>> BOOLE-IOR 7 111 ...0111
>> BOOLE-NAND -2 -10 ...1110
>> BOOLE-NOR -8 -1000 ...1000
>> BOOLE-ORC1 -3 -11 ...1101
>> BOOLE-ORC2 -5 -101 ...1011
>> BOOLE-SET -1 -1 ...1111
>> BOOLE-XOR 6 110 ...0110
=> NIL
; HyperSpec/Body/f_stg_up.htm
(string-upcase "abcde") => "ABCDE"
(string-upcase "Dr. Livingston, I presume?")
=> "DR. LIVINGSTON, I PRESUME?"
(string-upcase "Dr. Livingston, I presume?" :start 6 :end 10)
=> "Dr. LiVINGston, I presume?"
(string-downcase "Dr. Livingston, I presume?")
=> "dr. livingston, i presume?"
(string-capitalize "elm 13c arthur;fig don't") => "Elm 13c Arthur;Fig Don'T"
(string-capitalize " hello ") => " Hello "
(string-capitalize "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")
=> "Occluded Casements Forestall Inadvertent Defenestration"
(string-capitalize 'kludgy-hash-search) => "Kludgy-Hash-Search"
(string-capitalize "DON'T!") => "Don'T!" ;not "Don't!"
(string-capitalize "pipe 13a, foo16c") => "Pipe 13a, Foo16c"
(setq str (copy-seq "0123ABCD890a")) => "0123ABCD890a"
(nstring-downcase str :start 5 :end 7) => "0123AbcD890a"
str => "0123AbcD890a"
; HyperSpec/Body/f_cmp_fi.htm
; HyperSpec/Body/f_ed.htm
; HyperSpec/Body/m_pshnew.htm
(setq x '(a (b c) d)) => (A (B C) D)
(pushnew 5 (cadr x)) => (5 B C)
x => (A (5 B C) D)
(pushnew 'b (cadr x)) => (5 B C)
x => (A (5 B C) D)
(setq lst '((1) (1 2) (1 2 3))) => ((1) (1 2) (1 2 3))
(pushnew '(2) lst) => ((2) (1) (1 2) (1 2 3))
(pushnew '(1) lst) => ((1) (2) (1) (1 2) (1 2 3))
(pushnew '(1) lst :test 'equal) => ((1) (2) (1) (1 2) (1 2 3))
(pushnew '(1) lst :key #'car) => ((1) (2) (1) (1 2) (1 2 3))
; HyperSpec/Body/s_unwind.htm
(tagbody
(let ((x 3))
(unwind-protect
(if (numberp x) (go out))
(print x)))
out
...)
; HyperSpec/Body/f_specia.htm
(special-operator-p 'if) => true
(special-operator-p 'car) => false
(special-operator-p 'one) => false
; HyperSpec/Body/m_w_smp_.htm
(defun read-eval-print-loop (level)
(with-simple-restart (abort "Exit command level ~D." level)
(loop
(with-simple-restart (abort "Return to command level ~D." level)
(let ((form (prog2 (fresh-line) (read) (fresh-line))))
(prin1 (eval form)))))))
=> READ-EVAL-PRINT-LOOP
(read-eval-print-loop 1)
(+ 'a 3)
>> Error: The argument, A, to the function + was of the wrong type.
>> The function expected a number.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Specify a value to use this time.
>> 2: Return to command level 1.
>> 3: Exit command level 1.
>> 4: Return to Lisp Toplevel.
; HyperSpec/Body/f_name_c.htm
(name-char 'space) => #\Space
(name-char "space") => #\Space
(name-char "Space") => #\Space
(let ((x (char-name #\a)))
(or (not x) (eql (name-char x) #\a))) => true
; HyperSpec/Body/m_assert.htm
(setq x (make-array '(3 5) :initial-element 3))
=> #2A((3 3 3 3 3) (3 3 3 3 3) (3 3 3 3 3))
(setq y (make-array '(3 5) :initial-element 7))
=> #2A((7 7 7 7 7) (7 7 7 7 7) (7 7 7 7 7))
(defun matrix-multiply (a b)
(let ((*print-array* nil))
(assert (and (= (array-rank a) (array-rank b) 2)
(= (array-dimension a 1) (array-dimension b 0)))
(a b)
"Cannot multiply ~S by ~S." a b)
(really-matrix-multiply a b))) => MATRIX-MULTIPLY
(matrix-multiply x y)
>> Correctable error in MATRIX-MULTIPLY:
>> Cannot multiply #<ARRAY ...> by #<ARRAY ...>.
>> Restart options:
>> 1: You will be prompted for one or more new values.
>> 2: Top level.
>> Debug> :continue 1
>> Value for A: x
>> Value for B: (make-array '(5 3) :initial-element 6)
=> #2A((54 54 54 54 54)
(54 54 54 54 54)
(54 54 54 54 54)
(54 54 54 54 54)
(54 54 54 54 54))
; HyperSpec/Body/f_max_m.htm
(max 3) => 3
(min 3) => 3
(max 6 12) => 12
(min 6 12) => 6
(max -6 -12) => -6
(min -6 -12) => -12
(max 1 3 2 -7) => 3
(min 1 3 2 -7) => -7
(max -2 3 0 7) => 7
(min -2 3 0 7) => -2
(max 5.0 2) => 5.0
(min 5.0 2)
=> 2
OR=> 2.0
(max 3.0 7 1)
=> 7
OR=> 7.0
(min 3.0 7 1)
=> 1
OR=> 1.0
(max 1.0s0 7.0d0) => 7.0d0
(min 1.0s0 7.0d0)
=> 1.0s0
OR=> 1.0d0
(max 3 1 1.0s0 1.0d0)
=> 3
OR=> 3.0d0
(min 3 1 1.0s0 1.0d0)
=> 1
OR=> 1.0s0
OR=> 1.0d0
; HyperSpec/Body/f_symb_3.htm
(in-package "CL-USER") => #<PACKAGE "COMMON-LISP-USER">
(symbol-package 'car) => #<PACKAGE "COMMON-LISP">
(symbol-package 'bus) => #<PACKAGE "COMMON-LISP-USER">
(symbol-package :optional) => #<PACKAGE "KEYWORD">
;; Gensyms are uninterned, so have no home package.
(symbol-package (gensym)) => NIL
(make-package 'pk1) => #<PACKAGE "PK1">
(intern "SAMPLE1" "PK1") => PK1::SAMPLE1, NIL
(export (find-symbol "SAMPLE1" "PK1") "PK1") => T
(make-package 'pk2 :use '(pk1)) => #<PACKAGE "PK2">
(find-symbol "SAMPLE1" "PK2") => PK1:SAMPLE1, :INHERITED
(symbol-package 'pk1::sample1) => #<PACKAGE "PK1">
(symbol-package 'pk2::sample1) => #<PACKAGE "PK1">
(symbol-package 'pk1::sample2) => #<PACKAGE "PK1">
(symbol-package 'pk2::sample2) => #<PACKAGE "PK2">
;; The next several forms create a scenario in which a symbol
;; is not really uninterned, but is "apparently uninterned",
;; and so SYMBOL-PACKAGE still returns NIL.
(setq s3 'pk1::sample3) => PK1::SAMPLE3
(import s3 'pk2) => T
(unintern s3 'pk1) => T
(symbol-package s3) => NIL
(eq s3 'pk2::sample3) => T
; HyperSpec/Body/f_cmpd_f.htm
(defun f (x) x) => F
(compiled-function-p #'f)
=> false
OR=> true
(compiled-function-p 'f) => false
(compile 'f) => F
(compiled-function-p #'f) => true
(compiled-function-p 'f) => false
(compiled-function-p (compile nil '(lambda (x) x)))
=> true
(compiled-function-p #'(lambda (x) x))
=> false
OR=> true
(compiled-function-p '(lambda (x) x)) => false
; HyperSpec/Body/s_declar.htm
(defun nonsense (k x z)
(foo z x) ;First call to foo
(let ((j (foo k x)) ;Second call to foo
(x (* k k)))
(declare (inline foo) (special x z))
(foo x j z))) ;Third call to foo
; HyperSpec/Body/f_open.htm
(open filespec :direction :probe) => #<Closed Probe File Stream...>
(setq q (merge-pathnames (user-homedir-pathname) "test"))
=> #<PATHNAME :HOST NIL :DEVICE device-name :DIRECTORY directory-name
:NAME "test" :TYPE NIL :VERSION :NEWEST>
(open filespec :if-does-not-exist :create) => #<Input File Stream...>
(setq s (open filespec :direction :probe)) => #<Closed Probe File Stream...>
(truename s) => #<PATHNAME :HOST NIL :DEVICE device-name :DIRECTORY
directory-name :NAME filespec :TYPE extension :VERSION 1>
(open s :direction :output :if-exists nil) => NIL
; HyperSpec/Body/f_file_a.htm
(with-open-file (stream ">relativity>general.text")
(file-author s))
=> "albert"
; HyperSpec/Body/r_contin.htm
(let ((x 3))
(handler-bind ((error #'(lambda (c)
(let ((r (find-restart 'continue c)))
(when r (invoke-restart r))))))
(cond ((not (floatp x))
(cerror "Try floating it." "~D is not a float." x)
(float x))
(t x)))) => 3.0
; HyperSpec/Body/f_signal.htm
(defun handle-division-conditions (condition)
(format t "Considering condition for division condition handling~%")
(when (and (typep condition 'arithmetic-error)
(eq '/ (arithmetic-error-operation condition)))
(invoke-debugger condition)))
HANDLE-DIVISION-CONDITIONS
(defun handle-other-arithmetic-errors (condition)
(format t "Considering condition for arithmetic condition handling~%")
(when (typep condition 'arithmetic-error)
(abort)))
HANDLE-OTHER-ARITHMETIC-ERRORS
(define-condition a-condition-with-no-handler (condition) ())
A-CONDITION-WITH-NO-HANDLER
(signal 'a-condition-with-no-handler)
NIL
(handler-bind ((condition #'handle-division-conditions)
(condition #'handle-other-arithmetic-errors))
(signal 'a-condition-with-no-handler))
Considering condition for division condition handling
Considering condition for arithmetic condition handling
NIL
(handler-bind ((arithmetic-error #'handle-division-conditions)
(arithmetic-error #'handle-other-arithmetic-errors))
(signal 'arithmetic-error :operation '* :operands '(1.2 b)))
Considering condition for division condition handling
Considering condition for arithmetic condition handling
Back to Lisp Toplevel
; HyperSpec/Body/v_pkg.htm
(in-package "COMMON-LISP-USER") => #<PACKAGE "COMMON-LISP-USER">
*package* => #<PACKAGE "COMMON-LISP-USER">
(make-package "SAMPLE-PACKAGE" :use '("COMMON-LISP"))
=> #<PACKAGE "SAMPLE-PACKAGE">
(list
(symbol-package
(let ((*package* (find-package 'sample-package)))
(setq *some-symbol* (read-from-string "just-testing"))))
*package*)
=> (#<PACKAGE "SAMPLE-PACKAGE"> #<PACKAGE "COMMON-LISP-USER">)
(list (symbol-package (read-from-string "just-testing"))
*package*)
=> (#<PACKAGE "COMMON-LISP-USER"> #<PACKAGE "COMMON-LISP-USER">)
(eq 'foo (intern "FOO")) => true
(eq 'foo (let ((*package* (find-package 'sample-package)))
(intern "FOO")))
=> false
; HyperSpec/Body/f_list_a.htm
(let ((before (list-all-packages)))
(make-package 'temp)
(set-difference (list-all-packages) before)) => (#<PACKAGE "TEMP">)
; HyperSpec/Body/f_uninte.htm
(in-package "COMMON-LISP-USER") => #<PACKAGE "COMMON-LISP-USER">
(setq temps-unpack (intern "UNPACK" (make-package 'temp))) => TEMP::UNPACK
(unintern temps-unpack 'temp) => T
(find-symbol "UNPACK" 'temp) => NIL, NIL
temps-unpack => #:UNPACK
; HyperSpec/Body/f_open_s.htm
(open-stream-p *standard-input*) => true
; HyperSpec/Body/m_defi_2.htm
(define-modify-macro appendf (&rest args)
append "Append onto list") => APPENDF
(setq x '(a b c) y x) => (A B C)
(appendf x '(d e f) '(1 2 3)) => (A B C D E F 1 2 3)
x => (A B C D E F 1 2 3)
y => (A B C)
(define-modify-macro new-incf (&optional (delta 1)) +)
(define-modify-macro unionf (other-set &rest keywords) union)
; HyperSpec/Body/m_loop.htm
;; An example of the simple form of LOOP.
(defun sqrt-advisor ()
(loop (format t "~&Number: ")
(let ((n (parse-integer (read-line) :junk-allowed t)))
(when (not n) (return))
(format t "~&The square root of ~D is ~D.~%" n (sqrt n)))))
=> SQRT-ADVISOR
(sqrt-advisor)
>> Number: 5<NEWLINE>
>> The square root of 5 is 2.236068.
>> Number: 4<NEWLINE>
>> The square root of 4 is 2.
>> Number: done<NEWLINE>
=> NIL
;; An example of the extended form of LOOP.
(defun square-advisor ()
(loop as n = (progn (format t "~&Number: ")
(parse-integer (read-line) :junk-allowed t))
while n
do (format t "~&The square of ~D is ~D.~%" n (* n n))))
=> SQUARE-ADVISOR
(square-advisor)
>> Number: 4<NEWLINE>
>> The square of 4 is 16.
>> Number: 23<NEWLINE>
>> The square of 23 is 529.
>> Number: done<NEWLINE>
=> NIL
;; Another example of the extended form of LOOP.
(loop for n from 1 to 10
when (oddp n)
collect n)
=> (1 3 5 7 9)
; HyperSpec/Body/f_meth_1.htm
; HyperSpec/Body/f_clrhas.htm
(setq table (make-hash-table)) => #<HASH-TABLE EQL 0/120 32004073>
(dotimes (i 100) (setf (gethash i table) (format nil "~R" i))) => NIL
(hash-table-count table) => 100
(gethash 57 table) => "fifty-seven", true
(clrhash table) => #<HASH-TABLE EQL 0/120 32004073>
(hash-table-count table) => 0
(gethash 57 table) => NIL, false
; HyperSpec/Body/f_boundp.htm
(setq x 1) => 1
(boundp 'x) => true
(makunbound 'x) => X
(boundp 'x) => false
(let ((x 2)) (boundp 'x)) => false
(let ((x 2)) (declare (special x)) (boundp 'x)) => true
; HyperSpec/Body/f_peek_c.htm
(with-input-from-string (input-stream " 1 2 3 4 5")
(format t "~S ~S ~S"
(peek-char t input-stream)
(peek-char #\4 input-stream)
(peek-char nil input-stream)))
>> #\1 #\4 #\4
=> NIL
; HyperSpec/Body/m_defset.htm
(defsetf symbol-value set)
; HyperSpec/Body/f_find_c.htm
; HyperSpec/Body/v_nil.htm
nil => NIL
; HyperSpec/Body/f_class_.htm
; HyperSpec/Body/f_equal.htm
(equal 'a 'b) => false
(equal 'a 'a) => true
(equal 3 3) => true
(equal 3 3.0) => false
(equal 3.0 3.0) => true
(equal #c(3 -4) #c(3 -4)) => true
(equal #c(3 -4.0) #c(3 -4)) => false
(equal (cons 'a 'b) (cons 'a 'c)) => false
(equal (cons 'a 'b) (cons 'a 'b)) => true
(equal #\A #\A) => true
(equal #\A #\a) => false
(equal "Foo" "Foo") => true
(equal "Foo" (copy-seq "Foo")) => true
(equal "FOO" "foo") => false
(equal "This-string" "This-string") => true
(equal "This-string" "this-string") => false
; HyperSpec/Body/f_smp_cn.htm
(setq foo (make-condition 'simple-condition
:format-control "Hi ~S"
:format-arguments '(ho)))
=> #<SIMPLE-CONDITION 26223553>
(apply #'format nil (simple-condition-format-control foo)
(simple-condition-format-arguments foo))
=> "Hi HO"
; HyperSpec/Body/v_most_1.htm
; HyperSpec/Body/v_most_p.htm
; HyperSpec/Body/f_slt_ex.htm
; HyperSpec/Body/f_consta.htm
(constantp 1) => true
(constantp 'temp) => false
(constantp ''temp)) => true
(defconstant this-is-a-constant 'never-changing) => THIS-IS-A-CONSTANT
(constantp 'this-is-a-constant) => true
(constantp "temp") => true
(setq a 6) => 6
(constantp a) => true
(constantp '(sin pi)) => implementation-dependent
(constantp '(car '(x))) => implementation-dependent
(constantp '(eql x x)) => implementation-dependent
(constantp '(typep x 'nil)) => implementation-dependent
(constantp '(typep x 't)) => implementation-dependent
(constantp '(values this-is-a-constant)) => implementation-dependent
(constantp '(values 'x 'y)) => implementation-dependent
(constantp '(let ((a '(a b c))) (+ (length a) 6))) => implementation-dependent
; HyperSpec/Body/f_echo_s.htm
; HyperSpec/Body/f_inte_1.htm
(integerp 1) => true
(integerp (expt 2 130)) => true
(integerp 6/5) => false
(integerp nil) => false
; HyperSpec/Body/f_mk_l_1.htm
; HyperSpec/Body/s_throw.htm
(catch 'result
(setq i 0 j 0)
(loop (incf j 3) (incf i)
(if (= i 3) (throw 'result (values i j))))) => 3, 9
; HyperSpec/Body/f_rnd_st.htm
(random-state-p *random-state*) => true
(random-state-p (make-random-state)) => true
(random-state-p 'test-function) => false
; HyperSpec/Body/f_apply.htm
(setq f '+) => +
(apply f '(1 2)) => 3
(setq f #'-) => #<FUNCTION ->
(apply f '(1 2)) => -1
(apply #'max 3 5 '(2 7 3)) => 7
(apply 'cons '((+ 2 3) 4)) => ((+ 2 3) . 4)
(apply #'+ '()) => 0
(defparameter *some-list* '(a b c))
(defun strange-test (&rest x) (eq x *some-list*))
(apply #'strange-test *some-list*) => implementation-dependent
(defun bad-boy (&rest x) (rplacd x 'y))
(bad-boy 'a 'b 'c) has undefined consequences.
(apply #'bad-boy *some-list*) has undefined consequences.
; HyperSpec/Body/f_unuse_.htm
(in-package "COMMON-LISP-USER") => #<PACKAGE "COMMON-LISP-USER">
(export (intern "SHOES" (make-package 'temp)) 'temp) => T
(find-symbol "SHOES") => NIL, NIL
(use-package 'temp) => T
(find-symbol "SHOES") => SHOES, :INHERITED
(find (find-package 'temp) (package-use-list 'common-lisp-user)) => #<PACKAGE "TEMP">
(unuse-package 'temp) => T
(find-symbol "SHOES") => NIL, NIL
; HyperSpec/Body/f_conjug.htm
(conjugate #c(0 -1)) => #C(0 1)
(conjugate #c(1 1)) => #C(1 -1)
(conjugate 1.5) => 1.5
(conjugate #C(3/5 4/5)) => #C(3/5 -4/5)
(conjugate #C(0.0D0 -1.0D0)) => #C(0.0D0 1.0D0)
(conjugate 3.7) => 3.7
; HyperSpec/Body/m_format.htm
(funcall (formatter "~&~A~A") *standard-output* 'a 'b 'c)
>> AB
=> (C)
(format t (formatter "~&~A~A") 'a 'b 'c)
>> AB
=> NIL
; HyperSpec/Body/m_define.htm
(defun square (x) (expt x 2)) => SQUARE
(define-compiler-macro square (&whole form arg)
(if (atom arg)
`(expt ,arg 2)
(case (car arg)
(square (if (= (length arg) 2)
`(expt ,(nth 1 arg) 4)
form))
(expt (if (= (length arg) 3)
(if (numberp (nth 2 arg))
`(expt ,(nth 1 arg) ,(* 2 (nth 2 arg)))
`(expt ,(nth 1 arg) (* 2 ,(nth 2 arg))))
form))
(otherwise `(expt ,arg 2))))) => SQUARE
(square (square 3)) => 81
(macroexpand '(square x)) => (SQUARE X), false
(funcall (compiler-macro-function 'square) '(square x) nil)
=> (EXPT X 2)
(funcall (compiler-macro-function 'square) '(square (square x)) nil)
=> (EXPT X 4)
(funcall (compiler-macro-function 'square) '(funcall #'square x) nil)
=> (EXPT X 2)
(defun distance-positional (x1 y1 x2 y2)
(sqrt (+ (expt (- x2 x1) 2) (expt (- y2 y1) 2))))
=> DISTANCE-POSITIONAL
(defun distance (&key (x1 0) (y1 0) (x2 x1) (y2 y1))
(distance-positional x1 y1 x2 y2))
=> DISTANCE
(define-compiler-macro distance (&whole form
&rest key-value-pairs
&key (x1 0 x1-p)
(y1 0 y1-p)
(x2 x1 x2-p)
(y2 y1 y2-p)
&allow-other-keys
&environment env)
(flet ((key (n) (nth (* n 2) key-value-pairs))
(arg (n) (nth (1+ (* n 2)) key-value-pairs))
(simplep (x)
(let ((expanded-x (macroexpand x env)))
(or (constantp expanded-x env)
(symbolp expanded-x)))))
(let ((n (/ (length key-value-pairs) 2)))
(multiple-value-bind (x1s y1s x2s y2s others)
(loop for (key) on key-value-pairs by #'cddr
count (eq key ':x1) into x1s
count (eq key ':y1) into y1s
count (eq key ':x2) into x2s
count (eq key ':y1) into y2s
count (not (member key '(:x1 :x2 :y1 :y2)))
into others
finally (return (values x1s y1s x2s y2s others)))
(cond ((and (= n 4)
(eq (key 0) :x1)
(eq (key 1) :y1)
(eq (key 2) :x2)
(eq (key 3) :y2))
`(distance-positional ,x1 ,y1 ,x2 ,y2))
((and (if x1-p (and (= x1s 1) (simplep x1)) t)
(if y1-p (and (= y1s 1) (simplep y1)) t)
(if x2-p (and (= x2s 1) (simplep x2)) t)
(if y2-p (and (= y2s 1) (simplep y2)) t)
(zerop others))
`(distance-positional ,x1 ,y1 ,x2 ,y2))
((and (< x1s 2) (< y1s 2) (< x2s 2) (< y2s 2)
(zerop others))
(let ((temps (loop repeat n collect (gensym))))
`(let ,(loop for i below n
collect (list (nth i temps) (arg i)))
(distance
,@(loop for i below n
append (list (key i) (nth i temps)))))))
(t form))))))
=> DISTANCE
(dolist (form
'((distance :x1 (setq x 7) :x2 (decf x) :y1 (decf x) :y2 (decf x))
(distance :x1 (setq x 7) :y1 (decf x) :x2 (decf x) :y2 (decf x))
(distance :x1 (setq x 7) :y1 (incf x))
(distance :x1 (setq x 7) :y1 (incf x) :x1 (incf x))
(distance :x1 a1 :y1 b1 :x2 a2 :y2 b2)
(distance :x1 a1 :x2 a2 :y1 b1 :y2 b2)
(distance :x1 a1 :y1 b1 :z1 c1 :x2 a2 :y2 b2 :z2 c2)))
(print (funcall (compiler-macro-function 'distance) form nil)))
>> (LET ((#:G6558 (SETQ X 7))
>> (#:G6559 (DECF X))
>> (#:G6560 (DECF X))
>> (#:G6561 (DECF X)))
>> (DISTANCE :X1 #:G6558 :X2 #:G6559 :Y1 #:G6560 :Y2 #:G6561))
>> (DISTANCE-POSITIONAL (SETQ X 7) (DECF X) (DECF X) (DECF X))
>> (LET ((#:G6567 (SETQ X 7))
>> (#:G6568 (INCF X)))
>> (DISTANCE :X1 #:G6567 :Y1 #:G6568))
>> (DISTANCE :X1 (SETQ X 7) :Y1 (INCF X) :X1 (INCF X))
>> (DISTANCE-POSITIONAL A1 B1 A2 B2)
>> (DISTANCE-POSITIONAL A1 B1 A2 B2)
>> (DISTANCE :X1 A1 :Y1 B1 :Z1 C1 :X2 A2 :Y2 B2 :Z2 C2)
=> NIL
; HyperSpec/Body/f_firstc.htm
(setq lst '(1 2 3 (4 5 6) ((V)) vi 7 8 9 10))
=> (1 2 3 (4 5 6) ((V)) VI 7 8 9 10)
(first lst) => 1
(tenth lst) => 10
(fifth lst) => ((V))
(second (fourth lst)) => 5
(sixth '(1 2 3)) => NIL
(setf (fourth lst) "four") => "four"
lst => (1 2 3 "four" ((V)) VI 7 8 9 10)
; HyperSpec/Body/f_asin_.htm
(asin 0) => 0.0
(acos #c(0 1)) => #C(1.5707963267948966 -0.8813735870195432)
(/ (atan 1 (sqrt 3)) 6) => 0.087266
(atan #c(0 2)) => #C(-1.5707964 0.54930615)
; HyperSpec/Body/f_last.htm
(last nil) => NIL
(last '(1 2 3)) => (3)
(last '(1 2 . 3)) => (2 . 3)
(setq x (list 'a 'b 'c 'd)) => (A B C D)
(last x) => (D)
(rplacd (last x) (list 'e 'f)) x => (A B C D E F)
(last x) => (F)
(last '(a b c)) => (C)
(last '(a b c) 0) => ()
(last '(a b c) 1) => (C)
(last '(a b c) 2) => (B C)
(last '(a b c) 3) => (A B C)
(last '(a b c) 4) => (A B C)
(last '(a . b) 0) => B
(last '(a . b) 1) => (A . B)
(last '(a . b) 2) => (A . B)
; HyperSpec/Body/f_minusp.htm
(minusp -1) => true
(plusp 0) => false
(plusp least-positive-single-float) => true
; HyperSpec/Body/f_mk_rnd.htm
(let* ((rs1 (make-random-state nil))
(rs2 (make-random-state t))
(rs3 (make-random-state rs2))
(rs4 nil))
(list (loop for i from 1 to 10
collect (random 100)
when (= i 5)
do (setq rs4 (make-random-state)))
(loop for i from 1 to 10 collect (random 100 rs1))
(loop for i from 1 to 10 collect (random 100 rs2))
(loop for i from 1 to 10 collect (random 100 rs3))
(loop for i from 1 to 10 collect (random 100 rs4))))
=> ((29 25 72 57 55 68 24 35 54 65)
(29 25 72 57 55 68 24 35 54 65)
(93 85 53 99 58 62 2 23 23 59)
(93 85 53 99 58 62 2 23 23 59)
(68 24 35 54 65 54 55 50 59 49))
; HyperSpec/Body/f_mk_lis.htm
(make-list 5) => (NIL NIL NIL NIL NIL)
(make-list 3 :initial-element 'rah) => (RAH RAH RAH)
(make-list 2 :initial-element '(1 2 3)) => ((1 2 3) (1 2 3))
(make-list 0) => NIL ;i.e., ()
(make-list 0 :initial-element 'new-element) => NIL
; HyperSpec/Body/f_set_di.htm
(setq lst1 (list "A" "b" "C" "d")
lst2 (list "a" "B" "C" "d")) => ("a" "B" "C" "d")
(set-difference lst1 lst2) => ("d" "C" "b" "A")
(set-difference lst1 lst2 :test 'equal) => ("b" "A")
(set-difference lst1 lst2 :test #'equalp) => NIL
(nset-difference lst1 lst2 :test #'string=) => ("A" "b")
(setq lst1 '(("a" . "b") ("c" . "d") ("e" . "f")))
=> (("a" . "b") ("c" . "d") ("e" . "f"))
(setq lst2 '(("c" . "a") ("e" . "b") ("d" . "a")))
=> (("c" . "a") ("e" . "b") ("d" . "a"))
(nset-difference lst1 lst2 :test #'string= :key #'cdr)
=> (("c" . "d") ("e" . "f"))
lst1 => (("a" . "b") ("c" . "d") ("e" . "f"))
lst2 => (("c" . "a") ("e" . "b") ("d" . "a"))
; HyperSpec/Body/f_unboun.htm
; HyperSpec/Body/f_pr_not.htm
; HyperSpec/Body/f_intern.htm
(in-package "COMMON-LISP-USER") => #<PACKAGE "COMMON-LISP-USER">
(intern "Never-Before") => |Never-Before|, NIL
(intern "Never-Before") => |Never-Before|, :INTERNAL
(intern "NEVER-BEFORE" "KEYWORD") => :NEVER-BEFORE, NIL
(intern "NEVER-BEFORE" "KEYWORD") => :NEVER-BEFORE, :EXTERNAL
; HyperSpec/Body/m_hand_1.htm
(defun assess-condition (condition)
(handler-case (signal condition)
(warning () "Lots of smoke, but no fire.")
((or arithmetic-error control-error cell-error stream-error)
(condition)
(format nil "~S looks especially bad." condition))
(serious-condition (condition)
(format nil "~S looks serious." condition))
(condition () "Hardly worth mentioning.")))
=> ASSESS-CONDITION
(assess-condition (make-condition 'stream-error :stream *terminal-io*))
=> "#<STREAM-ERROR 12352256> looks especially bad."
(define-condition random-condition (condition) ()
(:report (lambda (condition stream)
(declare (ignore condition))
(princ "Yow" stream))))
=> RANDOM-CONDITION
(assess-condition (make-condition 'random-condition))
=> "Hardly worth mentioning."
; HyperSpec/Body/m_deftp.htm
(defun equidimensional (a)
(or (< (array-rank a) 2)
(apply #'= (array-dimensions a)))) => EQUIDIMENSIONAL
(deftype square-matrix (&optional type size)
`(and (array ,type (,size ,size))
(satisfies equidimensional))) => SQUARE-MATRIX
; HyperSpec/Body/f_get_se.htm
(get-setf-expansion 'x)
=> NIL, NIL, (#:G0001), (SETQ X #:G0001), X
; HyperSpec/Body/f_cp_sym.htm
(setq fred 'fred-smith) => FRED-SMITH
(setf (symbol-value fred) 3) => 3
(setq fred-clone-1a (copy-symbol fred nil)) => #:FRED-SMITH
(setq fred-clone-1b (copy-symbol fred nil)) => #:FRED-SMITH
(setq fred-clone-2a (copy-symbol fred t)) => #:FRED-SMITH
(setq fred-clone-2b (copy-symbol fred t)) => #:FRED-SMITH
(eq fred fred-clone-1a) => false
(eq fred-clone-1a fred-clone-1b) => false
(eq fred-clone-2a fred-clone-2b) => false
(eq fred-clone-1a fred-clone-2a) => false
(symbol-value fred) => 3
(boundp fred-clone-1a) => false
(symbol-value fred-clone-2a) => 3
(setf (symbol-value fred-clone-2a) 4) => 4
(symbol-value fred) => 3
(symbol-value fred-clone-2a) => 4
(symbol-value fred-clone-2b) => 3
(boundp fred-clone-1a) => false
(setf (symbol-function fred) #'(lambda (x) x)) => #<FUNCTION anonymous>
(fboundp fred) => true
(fboundp fred-clone-1a) => false
(fboundp fred-clone-2a) => false
; HyperSpec/Body/f_import.htm
(import 'common-lisp::car (make-package 'temp :use nil)) => T
(find-symbol "CAR" 'temp) => CAR, :INTERNAL
(find-symbol "CDR" 'temp) => NIL, NIL
; HyperSpec/Body/f_inspec.htm
; HyperSpec/Body/f_set_ex.htm
(setq lst1 (list 1 "a" "b")
lst2 (list 1 "A" "b")) => (1 "A" "b")
(set-exclusive-or lst1 lst2) => ("b" "A" "b" "a")
(set-exclusive-or lst1 lst2 :test #'equal) => ("A" "a")
(set-exclusive-or lst1 lst2 :test 'equalp) => NIL
(nset-exclusive-or lst1 lst2) => ("a" "b" "A" "b")
(setq lst1 (list (("a" . "b") ("c" . "d") ("e" . "f"))))
=> (("a" . "b") ("c" . "d") ("e" . "f"))
(setq lst2 (list (("c" . "a") ("e" . "b") ("d" . "a"))))
=> (("c" . "a") ("e" . "b") ("d" . "a"))
(nset-exclusive-or lst1 lst2 :test #'string= :key #'cdr)
=> (("c" . "d") ("e" . "f") ("c" . "a") ("d" . "a"))
lst1 => (("a" . "b") ("c" . "d") ("e" . "f"))
lst2 => (("c" . "a") ("d" . "a"))
; HyperSpec/Body/f_next_m.htm
; HyperSpec/Body/f_cmp.htm
(defun foo () "bar") => FOO
(compiled-function-p #'foo) => implementation-dependent
(compile 'foo) => FOO
(compiled-function-p #'foo) => true
(setf (symbol-function 'foo)
(compile nil '(lambda () "replaced"))) => #<Compiled-Function>
(foo) => "replaced"
; HyperSpec/Body/m_push.htm
(setq llst '(nil)) => (NIL)
(push 1 (car llst)) => (1)
llst => ((1))
(push 1 (car llst)) => (1 1)
llst => ((1 1))
(setq x '(a (b c) d)) => (A (B C) D)
(push 5 (cadr x)) => (5 B C)
x => (A (5 B C) D)
; HyperSpec/Body/v_rd_bas.htm
(dotimes (i 6)
(let ((*read-base* (+ 10. i)))
(let ((object (read-from-string "(\\DAD DAD |BEE| BEE 123. 123)")))
(print (list *read-base* object)))))
>> (10 (DAD DAD BEE BEE 123 123))
>> (11 (DAD DAD BEE BEE 123 146))
>> (12 (DAD DAD BEE BEE 123 171))
>> (13 (DAD DAD BEE BEE 123 198))
>> (14 (DAD 2701 BEE BEE 123 227))
>> (15 (DAD 3088 BEE 2699 123 258))
=> NIL
; HyperSpec/Body/f_pn_hos.htm
(setq q (make-pathname :host "KATHY"
:directory "CHAPMAN"
:name "LOGIN" :type "COM"))
=> #P"KATHY::[CHAPMAN]LOGIN.COM"
(pathname-host q) => "KATHY"
(pathname-name q) => "LOGIN"
(pathname-type q) => "COM"
;; Because namestrings are used, the results shown in the remaining
;; examples are not necessarily the only possible results. Mappings
;; from namestring representation to pathname representation are
;; dependent both on the file system involved and on the implementation
;; (since there may be several implementations which can manipulate the
;; the same file system, and those implementations are not constrained
;; to agree on all details). Consult the documentation for each
;; implementation for specific information on how namestrings are treated
;; that implementation.
;; VMS
(pathname-directory (parse-namestring "[FOO.*.BAR]BAZ.LSP"))
=> (:ABSOLUTE "FOO" "BAR")
(pathname-directory (parse-namestring "[FOO.*.BAR]BAZ.LSP") :case :common)
=> (:ABSOLUTE "FOO" "BAR")
;; Unix
(pathname-directory "foo.l") => NIL
(pathname-device "foo.l") => :UNSPECIFIC
(pathname-name "foo.l") => "foo"
(pathname-name "foo.l" :case :local) => "foo"
(pathname-name "foo.l" :case :common) => "FOO"
(pathname-type "foo.l") => "l"
(pathname-type "foo.l" :case :local) => "l"
(pathname-type "foo.l" :case :common) => "L"
(pathname-type "foo") => :UNSPECIFIC
(pathname-type "foo" :case :common) => :UNSPECIFIC
(pathname-type "foo.") => ""
(pathname-type "foo." :case :common) => ""
(pathname-directory (parse-namestring "/foo/bar/baz.lisp") :case :local)
=> (:ABSOLUTE "foo" "bar")
(pathname-directory (parse-namestring "/foo/bar/baz.lisp") :case :local)
=> (:ABSOLUTE "FOO" "BAR")
(pathname-directory (parse-namestring "../baz.lisp"))
=> (:RELATIVE :UP)
(PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/BAR/../Mum/baz"))
=> (:ABSOLUTE "foo" "BAR" :UP "Mum")
(PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/BAR/../Mum/baz") :case :common)
=> (:ABSOLUTE "FOO" "bar" :UP "Mum")
(PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/*/bar/baz.l"))
=> (:ABSOLUTE "foo" :WILD "bar")
(PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/*/bar/baz.l") :case :common)
=> (:ABSOLUTE "FOO" :WILD "BAR")
;; Symbolics LMFS
(pathname-directory (parse-namestring ">foo>**>bar>baz.lisp"))
=> (:ABSOLUTE "foo" :WILD-INFERIORS "bar")
(pathname-directory (parse-namestring ">foo>*>bar>baz.lisp"))
=> (:ABSOLUTE "foo" :WILD "bar")
(pathname-directory (parse-namestring ">foo>*>bar>baz.lisp") :case :common)
=> (:ABSOLUTE "FOO" :WILD "BAR")
(pathname-device (parse-namestring ">foo>baz.lisp")) => :UNSPECIFIC
; HyperSpec/Body/s_tagbod.htm
(let (val)
(tagbody
(setq val 1)
(go point-a)
(incf val 16)
point-c
(incf val 04)
(go point-b)
(incf val 32)
point-a
(incf val 02)
(go point-c)
(incf val 64)
point-b
(incf val 08))
val)
=> 15
(defun f1 (flag)
(let ((n 1))
(tagbody
(setq n (f2 flag #'(lambda () (go out))))
out
(prin1 n))))
=> F1
(defun f2 (flag escape)
(if flag (funcall escape) 2))
=> F2
(f1 nil)
>> 2
=> NIL
(f1 t)
>> 1
=> NIL
; HyperSpec/Body/f_funcal.htm
(funcall #'+ 1 2 3) => 6
(funcall 'car '(1 2 3)) => 1
(funcall 'position 1 '(1 2 3 2 1) :start 1) => 4
(cons 1 2) => (1 . 2)
(flet ((cons (x y) `(kons ,x ,y)))
(let ((cons (symbol-function '+)))
(funcall #'cons
(funcall 'cons 1 2)
(funcall cons 1 2))))
=> (KONS (1 . 2) 3)
; HyperSpec/Body/f_wr_by.htm
(with-open-file (s "temp-bytes"
:direction :output
:element-type 'unsigned-byte)
(write-byte 101 s)) => 101
; HyperSpec/Body/f_pars_1.htm
(setq q (parse-namestring "test"))
=> #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME "test"
:TYPE NIL :VERSION NIL)
(pathnamep q) => true
(parse-namestring "test")
=> #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME "test"
:TYPE NIL :VERSION NIL), 4
(setq s (open xxx)) => #<Input File Stream...>
(parse-namestring s)
=> #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME xxx
:TYPE NIL :VERSION NIL), 0
(parse-namestring "test" nil nil :start 2 :end 4 )
=> #S(PATHNAME ...), 15
(parse-namestring "foo.lisp")
=> #P"foo.lisp"
; HyperSpec/Body/f_float.htm
(float 0) => 0.0
(float 1 .5) => 1.0
(float 1.0) => 1.0
(float 1/2) => 0.5
=> 1.0d0
OR=> 1.0
(eql (float 1.0 1.0d0) 1.0d0) => true
; HyperSpec/Body/f_1pl_1_.htm
(1+ 99) => 100
(1- 100) => 99
(1+ (complex 0.0)) => #C(1.0 0.0)
(1- 5/3) => 2/3
; HyperSpec/Body/f_mk_ar.htm
(make-array 5) ;; Creates a one-dimensional array of five elements.
(make-array '(3 4) :element-type '(mod 16)) ;; Creates a
;;two-dimensional array, 3 by 4, with four-bit elements.
(make-array 5 :element-type 'single-float) ;; Creates an array of single-floats.
; HyperSpec/Body/f_sort_.htm
(setq tester (copy-seq "lkjashd")) => "lkjashd"
(sort tester #'char-lessp) => "adhjkls"
(setq tester (list '(1 2 3) '(4 5 6) '(7 8 9))) => ((1 2 3) (4 5 6) (7 8 9))
(sort tester #'> :key #'car) => ((7 8 9) (4 5 6) (1 2 3))
(setq tester (list 1 2 3 4 5 6 7 8 9 0)) => (1 2 3 4 5 6 7 8 9 0)
(stable-sort tester #'(lambda (x y) (and (oddp x) (evenp y))))
=> (1 3 5 7 9 2 4 6 8 0)
(sort (setq committee-data
(vector (list (list "JonL" "White") "Iteration")
(list (list "Dick" "Waters") "Iteration")
(list (list "Dick" "Gabriel") "Objects")
(list (list "Kent" "Pitman") "Conditions")
(list (list "Gregor" "Kiczales") "Objects")
(list (list "David" "Moon") "Objects")
(list (list "Kathy" "Chapman") "Editorial")
(list (list "Larry" "Masinter") "Cleanup")
(list (list "Sandra" "Loosemore") "Compiler")))
#'string-lessp :key #'cadar)
=> #((("Kathy" "Chapman") "Editorial")
(("Dick" "Gabriel") "Objects")
(("Gregor" "Kiczales") "Objects")
(("Sandra" "Loosemore") "Compiler")
(("Larry" "Masinter") "Cleanup")
(("David" "Moon") "Objects")
(("Kent" "Pitman") "Conditions")
(("Dick" "Waters") "Iteration")
(("JonL" "White") "Iteration"))
;; Note that individual alphabetical order within `committees'
;; is preserved.
(setq committee-data
(stable-sort committee-data #'string-lessp :key #'cadr))
=> #((("Larry" "Masinter") "Cleanup")
(("Sandra" "Loosemore") "Compiler")
(("Kent" "Pitman") "Conditions")
(("Kathy" "Chapman") "Editorial")
(("Dick" "Waters") "Iteration")
(("JonL" "White") "Iteration")
(("Dick" "Gabriel") "Objects")
(("Gregor" "Kiczales") "Objects")
(("David" "Moon") "Objects"))
; HyperSpec/Body/f_values.htm
(values) => <no values>
(values 1) => 1
(values 1 2) => 1, 2
(values 1 2 3) => 1, 2, 3
(values (values 1 2 3) 4 5) => 1, 4, 5
(defun polar (x y)
(values (sqrt (+ (* x x) (* y y))) (atan y x))) => POLAR
(multiple-value-bind (r theta) (polar 3.0 4.0)
(vector r theta))
=> #(5.0 0.927295)
; HyperSpec/Body/f_find_a.htm
(find-all-symbols 'car)
=> (CAR)
OR=> (CAR VEHICLES:CAR)
OR=> (VEHICLES:CAR CAR)
(intern "CAR" (make-package 'temp :use nil)) => TEMP::CAR, NIL
(find-all-symbols 'car)
=> (TEMP::CAR CAR)
OR=> (CAR TEMP::CAR)
OR=> (TEMP::CAR CAR VEHICLES:CAR)
OR=> (CAR TEMP::CAR VEHICLES:CAR)
; HyperSpec/Body/f_stgeq_.htm
(string= "foo" "foo") => true
(string= "foo" "Foo") => false
(string= "foo" "bar") => false
(string= "together" "frog" :start1 1 :end1 3 :start2 2) => true
(string-equal "foo" "Foo") => true
(string= "abcd" "01234abcd9012" :start2 5 :end2 9) => true
(string< "aaaa" "aaab") => 3
(string>= "aaaaa" "aaaa") => 4
(string-not-greaterp "Abcde" "abcdE") => 5
(string-lessp "012AAAA789" "01aaab6" :start1 3 :end1 7
:start2 2 :end2 6) => 6
(string-not-equal "AAAA" "aaaA") => false
; HyperSpec/Body/f_char_n.htm
(char-name #\ ) => "Space"
(char-name #\Space) => "Space"
(char-name #\Page) => "Page"
(char-name #\a)
=> NIL
OR=> "LOWERCASE-a"
OR=> "Small-A"
OR=> "LA01"
(char-name #\A)
=> NIL
OR=> "UPPERCASE-A"
OR=> "Capital-A"
OR=> "LA02"
;; Even though its CHAR-NAME can vary, #\A prints as #\A
(prin1-to-string (read-from-string (format nil "#\\~A" (or (char-name #\A) "A"))))
=> "#\\A"
; HyperSpec/Body/m_w_slts.htm
(defclass thing ()
((x :initarg :x :accessor thing-x)
(y :initarg :y :accessor thing-y)))
=> #<STANDARD-CLASS THING 250020173>
(defmethod (setf thing-x) :before (new-x (thing thing))
(format t "~&Changing X from ~D to ~D in ~S.~%"
(thing-x thing) new-x thing))
(setq thing (make-instance 'thing :x 0 :y 1)) => #<THING 62310540>
(with-slots (x y) thing (incf x) (incf y)) => 2
(values (thing-x thing) (thing-y thing)) => 1, 2
(setq thing1 (make-instance 'thing :x 1 :y 2)) => #<THING 43135676>
(setq thing2 (make-instance 'thing :x 7 :y 8)) => #<THING 43147374>
(with-slots ((x1 x) (y1 y))
thing1
(with-slots ((x2 x) (y2 y))
thing2
(list (list x1 (thing-x thing1) y1 (thing-y thing1)
x2 (thing-x thing2) y2 (thing-y thing2))
(setq x1 (+ y1 x2))
(list x1 (thing-x thing1) y1 (thing-y thing1)
x2 (thing-x thing2) y2 (thing-y thing2))
(setf (thing-x thing2) (list x1))
(list x1 (thing-x thing1) y1 (thing-y thing1)
x2 (thing-x thing2) y2 (thing-y thing2)))))
>> Changing X from 7 to (9) in #<THING 43147374>.
=> ((1 1 2 2 7 7 8 8)
9
(9 9 2 2 7 7 8 8)
(9)
(9 9 2 2 (9) (9) 8 8))
; HyperSpec/Body/f_mk_s_2.htm
(let ((s (make-string-output-stream)))
(write-string "testing... " s)
(prin1 1234 s)
(get-output-stream-string s))
=> "testing... 1234"
; HyperSpec/Body/m_defcla.htm
; HyperSpec/Body/f_pnp.htm
(setq q "test") => "test"
(pathnamep q) => false
(setq q (pathname "test"))
=> #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME "test" :TYPE NIL
:VERSION NIL)
(pathnamep q) => true
(setq q (logical-pathname "SYS:SITE;FOO.SYSTEM"))
=> #P"SYS:SITE;FOO.SYSTEM"
(pathnamep q) => true
; HyperSpec/Body/f_ration.htm
(rational 0) => 0
(rationalize -11/100) => -11/100
(rational .1) => 13421773/134217728 ;implementation-dependent
(rationalize .1) => 1/10
; HyperSpec/Body/f_invoke.htm
(ignore-errors ;Normally, this would suppress debugger entry
(handler-bind ((error #'invoke-debugger)) ;But this forces debugger entry
(error "Foo.")))
Debug: Foo.
To continue, type :CONTINUE followed by an option number:
1: Return to Lisp Toplevel.
Debug>
; HyperSpec/Body/f_update.htm
; HyperSpec/Body/f_find_r.htm
(restart-case
(let ((r (find-restart 'my-restart)))
(format t "~S is named ~S" r (restart-name r)))
(my-restart () nil))
>> #<RESTART 32307325> is named MY-RESTART
=> NIL
(find-restart 'my-restart)
=> NIL
; HyperSpec/Body/f_sin_c.htm
(sin 0) => 0.0
(cos 0.7853982) => 0.707107
(tan #c(0 1)) => #C(0.0 0.761594)
; HyperSpec/Body/f_get_in.htm
; HyperSpec/Body/f_ldb.htm
(ldb (byte 2 1) 10) => 1
(setq a (list 8)) => (8)
(setf (ldb (byte 2 1) (car a)) 1) => 1
a => (10)
; HyperSpec/Body/f_everyc.htm
(every #'characterp "abc") => true
(some #'= '(1 2 3 4 5) '(5 4 3 2 1)) => true
(notevery #'< '(1 2 3 4) '(5 6 7 8) '(9 10 11 12)) => false
(notany #'> '(1 2 3 4) '(5 6 7 8) '(9 10 11 12)) => true
; HyperSpec/Body/v_pr_cir.htm
(let ((a (list 1 2 3)))
(setf (cdddr a) a)
(let ((*print-circle* t))
(write a)
:done))
>> #1=(1 2 3 . #1#)
=> :DONE
; HyperSpec/Body/f_provid.htm
;;; This illustrates a nonportable use of REQUIRE, because it
;;; depends on the implementation-dependent file-loading mechanism.
(require "CALCULUS")
;;; This use of REQUIRE is nonportable because of the literal
;;; physical pathname.
(require "CALCULUS" "/usr/lib/lisp/calculus")
;;; One form of portable usage involves supplying a logical pathname,
;;; with appropriate translations defined elsewhere.
(require "CALCULUS" "lib:calculus")
;;; Another form of portable usage involves using a variable or
;;; table lookup function to determine the pathname, which again
;;; must be initialized elsewhere.
(require "CALCULUS" *calculus-module-pathname*)
; HyperSpec/Body/f_remhas.htm
(setq table (make-hash-table)) => #<HASH-TABLE EQL 0/120 32115666>
(setf (gethash 100 table) "C") => "C"
(gethash 100 table) => "C", true
(remhash 100 table) => true
(gethash 100 table) => NIL, false
(remhash 100 table) => false
; HyperSpec/Body/f_null.htm
(null '()) => T
(null nil) => T
(null t) => NIL
(null 1) => NIL
; HyperSpec/Body/f_encode.htm
(encode-universal-time 0 0 0 1 1 1900 0) => 0
(encode-universal-time 0 0 1 4 7 1976 5) => 2414296800
;; The next example assumes Eastern Daylight Time.
(encode-universal-time 0 0 1 4 7 1976) => 2414293200
; HyperSpec/Body/f_cp_ppr.htm
; HyperSpec/Body/f_ar_has.htm
(array-has-fill-pointer-p (make-array 4)) => implementation-dependent
(array-has-fill-pointer-p (make-array '(2 3))) => false
(array-has-fill-pointer-p
(make-array 8
:fill-pointer 2
:initial-element 'filler)) => true
; HyperSpec/Body/m_call_m.htm
; HyperSpec/Body/f_bt_sb.htm
(bit (setq ba (make-array 8
:element-type 'bit
:initial-element 1))
3) => 1
(setf (bit ba 3) 0) => 0
(bit ba 3) => 0
(sbit ba 5) => 1
(setf (sbit ba 5) 1) => 1
(sbit ba 5) => 1
; HyperSpec/Body/f_atom.htm
(atom 'sss) => true
(atom (cons 1 2)) => false
(atom nil) => true
(atom '()) => true
(atom 3) => true
; HyperSpec/Body/f_alpha_.htm
(alpha-char-p #\a) => true
(alpha-char-p #\5) => false
(alpha-char-p #\Newline) => false
;; This next example presupposes an implementation
;; in which #\<ALPHA> is a defined character.
(alpha-char-p #\<ALPHA>) => implementation-dependent
; HyperSpec/Body/f_stgp.htm
(stringp "aaaaaa") => true
(stringp #\a) => false
; HyperSpec/Body/f_probe_.htm
; HyperSpec/Body/f_pkg__1.htm
(package-used-by-list (make-package 'temp)) => ()
(make-package 'trash :use '(temp)) => #<PACKAGE "TRASH">
(package-used-by-list 'temp) => (#<PACKAGE "TRASH">)
; HyperSpec/Body/f_set.htm
(setf (symbol-value 'n) 1) => 1
(set 'n 2) => 2
(symbol-value 'n) => 2
(let ((n 3))
(declare (special n))
(setq n (+ n 1))
(setf (symbol-value 'n) (* n 10))
(set 'n (+ (symbol-value 'n) n))
n) => 80
n => 2
(let ((n 3))
(setq n (+ n 1))
(setf (symbol-value 'n) (* n 10))
(set 'n (+ (symbol-value 'n) n))
n) => 4
n => 44
(defvar *n* 2)
(let ((*n* 3))
(setq *n* (+ *n* 1))
(setf (symbol-value '*n*) (* *n* 10))
(set '*n* (+ (symbol-value '*n*) *n*))
*n*) => 80
*n* => 2
(defvar *even-count* 0) => *EVEN-COUNT*
(defvar *odd-count* 0) => *ODD-COUNT*
(defun tally-list (list)
(dolist (element list)
(set (if (evenp element) '*even-count* '*odd-count*)
(+ element (if (evenp element) *even-count* *odd-count*)))))
(tally-list '(1 9 4 3 2 7)) => NIL
*even-count* => 6
*odd-count* => 20
; HyperSpec/Body/f_floorc.htm
(floor 3/2) => 1, 1/2
(ceiling 3 2) => 2, -1
(ffloor 3 2) => 1.0, 1
(ffloor -4.7) => -5.0, 0.3
(ffloor 3.5d0) => 3.0d0, 0.5d0
(fceiling 3/2) => 2.0, -1/2
(truncate 1) => 1, 0
(truncate .5) => 0, 0.5
(round .5) => 0, 0.5
(ftruncate -7 2) => -3.0, -1
(fround -7 2) => -4.0, 1
(dolist (n '(2.6 2.5 2.4 0.7 0.3 -0.3 -0.7 -2.4 -2.5 -2.6))
(format t "~&~4,1@F ~2,' D ~2,' D ~2,' D ~2,' D"
n (floor n) (ceiling n) (truncate n) (round n)))
>> +2.6 2 3 2 3
>> +2.5 2 3 2 2
>> +2.4 2 3 2 2
>> +0.7 0 1 0 1
>> +0.3 0 1 0 0
>> -0.3 -1 0 0 0
>> -0.7 -1 0 0 -1
>> -2.4 -3 -2 -2 -2
>> -2.5 -3 -2 -2 -2
>> -2.6 -3 -2 -2 -3
=> NIL
; HyperSpec/Body/f_realp.htm
(realp 12) => true
(realp #c(5/3 7.2)) => false
(realp nil) => false
(realp (cons 1 2)) => false
; HyperSpec/Body/f_cp_rdt.htm
(setq zvar 123) => 123
(set-syntax-from-char #\z #\' (setq table2 (copy-readtable))) => T
zvar => 123
(copy-readtable table2 *readtable*) => #<READTABLE 614000277>
zvar => VAR
(setq *readtable* (copy-readtable)) => #<READTABLE 46210223>
zvar => VAR
(setq *readtable* (copy-readtable nil)) => #<READTABLE 46302670>
zvar => 123
; HyperSpec/Body/v_pl_plp.htm
(+ 0 1) => 1
(- 4 2) => 2
(/ 9 3) => 3
(list + ++ +++) => ((/ 9 3) (- 4 2) (+ 0 1))
(setq a 1 b 2 c 3 d (list a b c)) => (1 2 3)
(setq a 4 b 5 c 6 d (list a b c)) => (4 5 6)
(list a b c) => (4 5 6)
(eval +++) => (1 2 3)
#.`(,@++ d) => (1 2 3 (1 2 3))
; HyperSpec/Body/f_mk_ech.htm
(let ((out (make-string-output-stream)))
(with-open-stream
(s (make-echo-stream
(make-string-input-stream "this-is-read-and-echoed")
out))
(read s)
(format s " * this-is-direct-output")
(get-output-stream-string out)))
=> "this-is-read-and-echoed * this-is-direct-output"
; HyperSpec/Body/f_ppr_fi.htm
(progn (princ "Roads ")
(pprint-tabular *standard-output* '(elm main maple center) nil nil 8))
Roads ELM MAIN
MAPLE CENTER
; HyperSpec/Body/f_maphas.htm
(setq table (make-hash-table)) => #<HASH-TABLE EQL 0/120 32304110>
(dotimes (i 10) (setf (gethash i table) i)) => NIL
(let ((sum-of-squares 0))
(maphash #'(lambda (key val)
(let ((square (* val val)))
(incf sum-of-squares square)
(setf (gethash key table) square)))
table)
sum-of-squares) => 285
(hash-table-count table) => 10
(maphash #'(lambda (key val)
(when (oddp val) (remhash key table)))
table) => NIL
(hash-table-count table) => 5
(maphash #'(lambda (k v) (print (list k v))) table)
(0 0)
(8 64)
(2 4)
(6 36)
(4 16)
=> NIL
; HyperSpec/Body/m_destru.htm
(defun iota (n) (loop for i from 1 to n collect i)) ;helper
(destructuring-bind ((a &optional (b 'bee)) one two three)
`((alpha) ,@(iota 3))
(list a b three two one)) => (ALPHA BEE 3 2 1)
; HyperSpec/Body/f_find_s.htm
(find-symbol "NEVER-BEFORE-USED") => NIL, NIL
(find-symbol "NEVER-BEFORE-USED") => NIL, NIL
(intern "NEVER-BEFORE-USED") => NEVER-BEFORE-USED, NIL
(intern "NEVER-BEFORE-USED") => NEVER-BEFORE-USED, :INTERNAL
(find-symbol "NEVER-BEFORE-USED") => NEVER-BEFORE-USED, :INTERNAL
(find-symbol "never-before-used") => NIL, NIL
(find-symbol "CAR" 'common-lisp-user) => CAR, :INHERITED
(find-symbol "CAR" 'common-lisp) => CAR, :EXTERNAL
(find-symbol "NIL" 'common-lisp-user) => NIL, :INHERITED
(find-symbol "NIL" 'common-lisp) => NIL, :EXTERNAL
(find-symbol "NIL" (prog1 (make-package "JUST-TESTING" :use '())
(intern "NIL" "JUST-TESTING")))
=> JUST-TESTING::NIL, :INTERNAL
(export 'just-testing::nil 'just-testing)
(find-symbol "NIL" 'just-testing) => JUST-TESTING:NIL, :EXTERNAL
(find-symbol "NIL" "KEYWORD")
=> NIL, NIL
OR=> :NIL, :EXTERNAL
(find-symbol (symbol-name :nil) "KEYWORD") => :NIL, :EXTERNAL
; HyperSpec/Body/f_rdtabl.htm
; HyperSpec/Body/f_equalp.htm
(equalp 'a 'b) => false
(equalp 'a 'a) => true
(equalp 3 3) => true
(equalp 3 3.0) => true
(equalp 3.0 3.0) => true
(equalp #c(3 -4) #c(3 -4)) => true
(equalp #c(3 -4.0) #c(3 -4)) => true
(equalp (cons 'a 'b) (cons 'a 'c)) => false
(equalp (cons 'a 'b) (cons 'a 'b)) => true
(equalp #\A #\A) => true
(equalp #\A #\a) => true
(equalp "Foo" "Foo") => true
(equalp "Foo" (copy-seq "Foo")) => true
(equalp "FOO" "foo") => true
; HyperSpec/Body/m_case_.htm
(dolist (k '(1 2 3 :four #\v () t 'other))
(format t "~S "
(case k ((1 2) 'clause1)
(3 'clause2)
(nil 'no-keys-so-never-seen)
((nil) 'nilslot)
((:four #\v) 'clause4)
((t) 'tslot)
(otherwise 'others))))
>> CLAUSE1 CLAUSE1 CLAUSE2 CLAUSE4 CLAUSE4 NILSLOT TSLOT OTHERS
=> NIL
(defun add-em (x) (apply #'+ (mapcar #'decode x)))
=> ADD-EM
(defun decode (x)
(ccase x
((i uno) 1)
((ii dos) 2)
((iii tres) 3)
((iv cuatro) 4)))
=> DECODE
(add-em '(uno iii)) => 4
(add-em '(uno iiii))
>> Error: The value of X, IIII, is not I, UNO, II, DOS, III,
>> TRES, IV, or CUATRO.
>> 1: Supply a value to use instead.
>> 2: Return to Lisp Toplevel.
>> Debug> :CONTINUE 1
>> Value to evaluate and use for X: 'IV
=> 5
; HyperSpec/Body/f_tr_pn.htm
;; The results of the following five forms are all implementation-dependent.
;; The second item in particular is shown with multiple results just to
;; emphasize one of many particular variations which commonly occurs.
(pathname-name (translate-pathname "foobar" "foo*" "*baz")) => "barbaz"
(pathname-name (translate-pathname "foobar" "foo*" "*"))
=> "foobar"
OR=> "bar"
(pathname-name (translate-pathname "foobar" "*" "foo*")) => "foofoobar"
(pathname-name (translate-pathname "bar" "*" "foo*")) => "foobar"
(pathname-name (translate-pathname "foobar" "foo*" "baz*")) => "bazbar"
(defun translate-logical-pathname-1 (pathname rules)
(let ((rule (assoc pathname rules :test #'pathname-match-p)))
(unless rule (error "No translation rule for ~A" pathname))
(translate-pathname pathname (first rule) (second rule))))
(translate-logical-pathname-1 "FOO:CODE;BASIC.LISP"
'(("FOO:DOCUMENTATION;" "MY-UNIX:/doc/foo/")
("FOO:CODE;" "MY-UNIX:/lib/foo/")
("FOO:PATCHES;*;" "MY-UNIX:/lib/foo/patch/*/")))
=> #P"MY-UNIX:/lib/foo/basic.l"
;;;This example assumes one particular set of wildcard conventions
;;;Not all file systems will run this example exactly as written
(defun rename-files (from to)
(dolist (file (directory from))
(rename-file file (translate-pathname file from to))))
(rename-files "/usr/me/*.lisp" "/dev/her/*.l")
;Renames /usr/me/init.lisp to /dev/her/init.l
(rename-files "/usr/me/pcl*/*" "/sys/pcl/*/")
;Renames /usr/me/pcl-5-may/low.lisp to /sys/pcl/pcl-5-may/low.lisp
;In some file systems the result might be /sys/pcl/5-may/low.lisp
(rename-files "/usr/me/pcl*/*" "/sys/library/*/")
;Renames /usr/me/pcl-5-may/low.lisp to /sys/library/pcl-5-may/low.lisp
;In some file systems the result might be /sys/library/5-may/low.lisp
(rename-files "/usr/me/foo.bar" "/usr/me2/")
;Renames /usr/me/foo.bar to /usr/me2/foo.bar
(rename-files "/usr/joe/*-recipes.text" "/usr/jim/cookbook/joe's-*-rec.text")
;Renames /usr/joe/lamb-recipes.text to /usr/jim/cookbook/joe's-lamb-rec.text
;Renames /usr/joe/pork-recipes.text to /usr/jim/cookbook/joe's-pork-rec.text
;Renames /usr/joe/veg-recipes.text to /usr/jim/cookbook/joe's-veg-rec.text
; HyperSpec/Body/d_type.htm
(defun f (x y)
(declare (type fixnum x y))
(let ((z (+ x y)))
(declare (type fixnum z))
z)) => F
(f 1 2) => 3
;; The previous definition of F is equivalent to
(defun f (x y)
;; This declaration is a shorthand form of the TYPE declaration
(declare (fixnum x y))
;; To declare the type of a return value, it's not necessary to
;; create a named variable. A THE special form can be used instead.
(the fixnum (+ x y))) => F
(f 1 2) => 3
; HyperSpec/Body/m_do_do.htm
(do ((temp-one 1 (1+ temp-one))
(temp-two 0 (1- temp-two)))
((> (- temp-one temp-two) 5) temp-one)) => 4
(do ((temp-one 1 (1+ temp-one))
(temp-two 0 (1+ temp-one)))
((= 3 temp-two) temp-one)) => 3
(do* ((temp-one 1 (1+ temp-one))
(temp-two 0 (1+ temp-one)))
((= 3 temp-two) temp-one)) => 2
(do ((j 0 (+ j 1)))
(nil) ;Do forever.
(format t "~%Input ~D:" j)
(let ((item (read)))
(if (null item) (return) ;Process items until NIL seen.
(format t "~&Output ~D: ~S" j item))))
>> Input 0: banana
>> Output 0: BANANA
>> Input 1: (57 boxes)
>> Output 1: (57 BOXES)
>> Input 2: NIL
=> NIL
(setq a-vector (vector 1 nil 3 nil))
(do ((i 0 (+ i 1)) ;Sets every null element of a-vector to zero.
(n (array-dimension a-vector 0)))
((= i n))
(when (null (aref a-vector i))
(setf (aref a-vector i) 0))) => NIL
a-vector => #(1 0 3 0)
; HyperSpec/Body/f_conc_1.htm
; HyperSpec/Body/m_defcon.htm
(defconstant this-is-a-constant 'never-changing "for a test") => THIS-IS-A-CONSTANT
this-is-a-constant => NEVER-CHANGING
(documentation 'this-is-a-constant 'variable) => "for a test"
(constantp 'this-is-a-constant) => true
; HyperSpec/Body/m_rst_ca.htm
(restart-case
(handler-bind ((error #'(lambda (c)
(declare (ignore condition))
(invoke-restart 'my-restart 7))))
(error "Foo."))
(my-restart (&optional v) v))
=> 7
(define-condition food-error (error) ())
=> FOOD-ERROR
(define-condition bad-tasting-sundae (food-error)
((ice-cream :initarg :ice-cream :reader bad-tasting-sundae-ice-cream)
(sauce :initarg :sauce :reader bad-tasting-sundae-sauce)
(topping :initarg :topping :reader bad-tasting-sundae-topping))
(:report (lambda (condition stream)
(format stream "Bad tasting sundae with ~S, ~S, and ~S"
(bad-tasting-sundae-ice-cream condition)
(bad-tasting-sundae-sauce condition)
(bad-tasting-sundae-topping condition)))))
=> BAD-TASTING-SUNDAE
(defun all-start-with-same-letter (symbol1 symbol2 symbol3)
(let ((first-letter (char (symbol-name symbol1) 0)))
(and (eql first-letter (char (symbol-name symbol2) 0))
(eql first-letter (char (symbol-name symbol3) 0)))))
=> ALL-START-WITH-SAME-LETTER
(defun read-new-value ()
(format t "Enter a new value: ")
(multiple-value-list (eval (read))))
=> READ-NEW-VALUE
(defun verify-or-fix-perfect-sundae (ice-cream sauce topping)
(do ()
((all-start-with-same-letter ice-cream sauce topping))
(restart-case
(error 'bad-tasting-sundae
:ice-cream ice-cream
:sauce sauce
:topping topping)
(use-new-ice-cream (new-ice-cream)
:report "Use a new ice cream."
:interactive read-new-value
(setq ice-cream new-ice-cream))
(use-new-sauce (new-sauce)
:report "Use a new sauce."
:interactive read-new-value
(setq sauce new-sauce))
(use-new-topping (new-topping)
:report "Use a new topping."
:interactive read-new-value
(setq topping new-topping))))
(values ice-cream sauce topping))
=> VERIFY-OR-FIX-PERFECT-SUNDAE
(verify-or-fix-perfect-sundae 'vanilla 'caramel 'cherry)
>> Error: Bad tasting sundae with VANILLA, CARAMEL, and CHERRY.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Use a new ice cream.
>> 2: Use a new sauce.
>> 3: Use a new topping.
>> 4: Return to Lisp Toplevel.
>> Debug> :continue 1
>> Use a new ice cream.
>> Enter a new ice cream: 'chocolate
=> CHOCOLATE, CARAMEL, CHERRY
; HyperSpec/Body/f_mk_s_1.htm
(let ((string-stream (make-string-input-stream "1 one ")))
(list (read string-stream nil nil)
(read string-stream nil nil)
(read string-stream nil nil)))
=> (1 ONE NIL)
(read (make-string-input-stream "prefixtargetsuffix" 6 12)) => TARGET
; HyperSpec/Body/f_pkg_er.htm
(package-error-package
(make-condition 'package-error
:package (find-package "COMMON-LISP")))
=> #<Package "COMMON-LISP">
; HyperSpec/Body/d_specia.htm
(defun declare-eg (y) ;this y is special
(declare (special y))
(let ((y t)) ;this y is lexical
(list y
(locally (declare (special y)) y)))) ;this y refers to the
;special binding of y
=> DECLARE-EG
(declare-eg nil) => (T NIL)
; HyperSpec/Body/d_dynami.htm
(defun f ()
(let ((x (list 1 2 3)))
(declare (dynamic-extent x))
...))
; HyperSpec/Body/m_w_pkg_.htm
(defun test-package-iterator (package)
(unless (packagep package)
(setq package (find-package package)))
(let ((all-entries '())
(generated-entries '()))
(do-symbols (x package)
(multiple-value-bind (symbol accessibility)
(find-symbol (symbol-name x) package)
(push (list symbol accessibility) all-entries)))
(with-package-iterator (generator-fn package
:internal :external :inherited)
(loop
(multiple-value-bind (more? symbol accessibility pkg)
(generator-fn)
(unless more? (return))
(let ((l (multiple-value-list (find-symbol (symbol-name symbol)
package))))
(unless (equal l (list symbol accessibility))
(error "Symbol ~S not found as ~S in package ~A [~S]"
symbol accessibility (package-name package) l))
(push l generated-entries)))))
(unless (and (subsetp all-entries generated-entries :test #'equal)
(subsetp generated-entries all-entries :test #'equal))
(error "Generated entries and Do-Symbols entries don't correspond"))
t))
; HyperSpec/Body/f_char_i.htm
(char-int #\A) => 65 ; implementation A
(char-int #\A) => 577 ; implementation B
(char-int #\A) => 262145 ; implementation C
; HyperSpec/Body/f_reduce.htm
(reduce #'* '(1 2 3 4 5)) => 120
(reduce #'append '((1) (2)) :initial-value '(i n i t)) => (I N I T 1 2)
(reduce #'append '((1) (2)) :from-end t
:initial-value '(i n i t)) => (1 2 I N I T)
(reduce #'- '(1 2 3 4)) == (- (- (- 1 2) 3) 4) => -8
(reduce #'- '(1 2 3 4) :from-end t) ;Alternating sum.
== (- 1 (- 2 (- 3 4))) => -2
(reduce #'+ '()) => 0
(reduce #'+ '(3)) => 3
(reduce #'+ '(foo)) => FOO
(reduce #'list '(1 2 3 4)) => (((1 2) 3) 4)
(reduce #'list '(1 2 3 4) :from-end t) => (1 (2 (3 4)))
(reduce #'list '(1 2 3 4) :initial-value 'foo) => ((((foo 1) 2) 3) 4)
(reduce #'list '(1 2 3 4)
:from-end t :initial-value 'foo) => (1 (2 (3 (4 foo))))
; HyperSpec/Body/f_ensu_1.htm
; HyperSpec/Body/m_ppr_ex.htm
; HyperSpec/Body/f_pkg_sh.htm
(package-shadowing-symbols (make-package 'temp)) => ()
(shadow 'cdr 'temp) => T
(package-shadowing-symbols 'temp) => (TEMP::CDR)
(intern "PILL" 'temp) => TEMP::PILL, NIL
(shadowing-import 'pill 'temp) => T
(package-shadowing-symbols 'temp) => (PILL TEMP::CDR)
; HyperSpec/Body/f_elt.htm
(setq str (copy-seq "0123456789")) => "0123456789"
(elt str 6) => #\6
(setf (elt str 0) #\#) => #\#
str => "#123456789"
; HyperSpec/Body/m_remf.htm
(setq x (cons () ())) => (NIL)
(setf (getf (car x) 'prop1) 'val1) => VAL1
(remf (car x) 'prop1) => true
(remf (car x) 'prop1) => false
; HyperSpec/Body/f_syn_st.htm
; HyperSpec/Body/m_w_acce.htm
(defclass thing ()
((x :initarg :x :accessor thing-x)
(y :initarg :y :accessor thing-y)))
=> #<STANDARD-CLASS THING 250020173>
(defmethod (setf thing-x) :before (new-x (thing thing))
(format t "~&Changing X from ~D to ~D in ~S.~%"
(thing-x thing) new-x thing))
(setq thing1 (make-instance 'thing :x 1 :y 2)) => #<THING 43135676>
(setq thing2 (make-instance 'thing :x 7 :y 8)) => #<THING 43147374>
(with-accessors ((x1 thing-x) (y1 thing-y))
thing1
(with-accessors ((x2 thing-x) (y2 thing-y))
thing2
(list (list x1 (thing-x thing1) y1 (thing-y thing1)
x2 (thing-x thing2) y2 (thing-y thing2))
(setq x1 (+ y1 x2))
(list x1 (thing-x thing1) y1 (thing-y thing1)
x2 (thing-x thing2) y2 (thing-y thing2))
(setf (thing-x thing2) (list x1))
(list x1 (thing-x thing1) y1 (thing-y thing1)
x2 (thing-x thing2) y2 (thing-y thing2)))))
>> Changing X from 1 to 9 in #<THING 43135676>.
>> Changing X from 7 to (9) in #<THING 43147374>.
=> ((1 1 2 2 7 7 8 8)
9
(9 9 2 2 7 7 8 8)
(9)
(9 9 2 2 (9) (9) 8 8))
; HyperSpec/Body/f_pos_p.htm
(position #\a "baobab" :from-end t) => 4
(position-if #'oddp '((1) (2) (3) (4)) :start 1 :key #'car) => 2
(position 595 '()) => NIL
(position-if-not #'integerp '(1 2 3 4 5.0)) => 4
; HyperSpec/Body/f_adju_1.htm
(adjustable-array-p
(make-array 5
:element-type 'character
:adjustable t
:fill-pointer 3)) => true
(adjustable-array-p (make-array 4)) => implementation-dependent
; HyperSpec/Body/v_pr_pre.htm
(setq *print-pretty* 'nil) => NIL
(progn (write '(let ((a 1) (b 2) (c 3)) (+ a b c))) nil)
>> (LET ((A 1) (B 2) (C 3)) (+ A B C))
=> NIL
(let ((*print-pretty* t))
(progn (write '(let ((a 1) (b 2) (c 3)) (+ a b c))) nil))
>> (LET ((A 1)
>> (B 2)
>> (C 3))
>> (+ A B C))
=> NIL
;; Note that the first two expressions printed by this next form
;; differ from the second two only in whether escape characters are printed.
;; In all four cases, extra whitespace is inserted by the pretty printer.
(flet ((test (x)
(let ((*print-pretty* t))
(print x)
(format t "~%~S " x)
(terpri) (princ x) (princ " ")
(format t "~%~A " x))))
(test '#'(lambda () (list "a" #'c #'d))))
>> #'(LAMBDA ()
>> (LIST "a" #'C #'D))
>> #'(LAMBDA ()
>> (LIST "a" #'C #'D))
>> #'(LAMBDA ()
>> (LIST a b 'C #'D))
>> #'(LAMBDA ()
>> (LIST a b 'C #'D))
=> NIL
; HyperSpec/Body/f_rd_cha.htm
(with-input-from-string (is "0123")
(do ((c (read-char is) (read-char is nil 'the-end)))
((not (characterp c)))
(format t "~S " c)))
>> #\0 #\1 #\2 #\3
=> NIL
; HyperSpec/Body/f_tn.htm
;; An example involving version numbers. Note that the precise nature of
;; the truename is implementation-dependent while the file is still open.
(with-open-file (stream ">vistor>test.text.newest")
(values (pathname stream)
(truename stream)))
=> #P"S:>vistor>test.text.newest", #P"S:>vistor>test.text.1"
OR=> #P"S:>vistor>test.text.newest", #P"S:>vistor>test.text.newest"
OR=> #P"S:>vistor>test.text.newest", #P"S:>vistor>_temp_._temp_.1"
;; In this case, the file is closed when the truename is tried, so the
;; truename information is reliable.
(with-open-file (stream ">vistor>test.text.newest")
(close stream)
(values (pathname stream)
(truename stream)))
=> #P"S:>vistor>test.text.newest", #P"S:>vistor>test.text.1"
;; An example involving TOP-20's implementation-dependent concept
;; of logical devices -- in this case, "DOC:" is shorthand for
;; "PS:<DOCUMENTATION>" ...
(with-open-file (stream "CMUC::DOC:DUMPER.HLP")
(values (pathname stream)
(truename stream)))
=> #P"CMUC::DOC:DUMPER.HLP", #P"CMUC::PS:<DOCUMENTATION>DUMPER.HLP.13"
; HyperSpec/Body/f_shared.htm
; HyperSpec/Body/f_zerop.htm
(zerop 0) => true
(zerop 1) => false
(zerop -0.0) => true
(zerop 0/100) => true
(zerop #c(0 0.0)) => true
; HyperSpec/Body/f_wr_seq.htm
(write-sequence "bookworms" *standard-output* :end 4)
>> book
=> "bookworms"
; HyperSpec/Body/f_mk_con.htm
(read (make-concatenated-stream
(make-string-input-stream "1")
(make-string-input-stream "2"))) => 12
; HyperSpec/Body/f_mk_seq.htm
(make-sequence 'list 0) => ()
(make-sequence 'string 26 :initial-element #\.)
=> ".........................."
(make-sequence '(vector double-float) 2
:initial-element 1d0)
=> #(1.0d0 1.0d0)
; HyperSpec/Body/f_short_.htm
(short-site-name)
=> "MIT AI Lab"
OR=> "CMU-CSD"
(long-site-name)
=> "MIT Artificial Intelligence Laboratory"
OR=> "CMU Computer Science Department"
; HyperSpec/Body/f_fill.htm
(fill (list 0 1 2 3 4 5) '(444)) => ((444) (444) (444) (444) (444) (444))
(fill (copy-seq "01234") #\e :start 3) => "012ee"
(setq x (vector 'a 'b 'c 'd 'e)) => #(A B C D E)
(fill x 'z :start 1 :end 3) => #(A Z Z D E)
x => #(A Z Z D E)
(fill x 'p) => #(P P P P P)
x => #(P P P P P)
; HyperSpec/Body/v_debug_.htm
(with-output-to-string (*error-output*)
(warn "this string is sent to *error-output*"))
=> "Warning: this string is sent to *error-output*
" ;The exact format of this string is implementation-dependent.
(with-input-from-string (*standard-input* "1001")
(+ 990 (read))) => 1991
(progn (setq out (with-output-to-string (*standard-output*)
(print "print and format t send things to")
(format t "*standard-output* now going to a string")))
:done)
=> :DONE
out
=> "
\"print and format t send things to\" *standard-output* now going to a string"
(defun fact (n) (if (< n 2) 1 (* n (fact (- n 1)))))
=> FACT
(trace fact)
=> (FACT)
;; Of course, the format of traced output is implementation-dependent.
(with-output-to-string (*trace-output*)
(fact 3))
=> "
1 Enter FACT 3
| 2 Enter FACT 2
| 3 Enter FACT 1
| 3 Exit FACT 1
| 2 Exit FACT 2
1 Exit FACT 6"
; HyperSpec/Body/f_rd_c_1.htm
;; This code assumes an implementation in which a newline is not
;; required to terminate input from the console.
(defun test-it ()
(unread-char (read-char))
(list (read-char-no-hang)
(read-char-no-hang)
(read-char-no-hang)))
=> TEST-IT
;; Implementation A, where a Newline is not required to terminate
;; interactive input on the console.
(test-it)
>> a
=> (#\a NIL NIL)
;; Implementation B, where a Newline is required to terminate
;; interactive input on the console, and where that Newline remains
;; on the input stream.
(test-it)
>> a<NEWLINE>
=> (#\a #\Newline NIL)
; HyperSpec/Body/s_symbol.htm
;;; The following is equivalent to
;;; (list 'foo (let ((x 'bar)) x)),
;;; not
;;; (list 'foo (let (('foo 'bar)) 'foo))
(symbol-macrolet ((x 'foo))
(list x (let ((x 'bar)) x)))
=> (foo bar)
NOT=> (foo foo)
(symbol-macrolet ((x '(foo x)))
(list x))
=> ((FOO X))
; HyperSpec/Body/f_find_p.htm
(find-package 'common-lisp) => #<PACKAGE "COMMON-LISP">
(find-package "COMMON-LISP-USER") => #<PACKAGE "COMMON-LISP-USER">
(find-package 'not-there) => NIL
; HyperSpec/Body/f_ar_in_.htm
(setq a (make-array '(7 11) :element-type 'string-char))
(array-in-bounds-p a 0 0) => true
(array-in-bounds-p a 6 10) => true
(array-in-bounds-p a 0 -1) => false
(array-in-bounds-p a 0 11) => false
(array-in-bounds-p a 7 0) => false
; HyperSpec/Body/m_setf_.htm
(setq x (cons 'a 'b) y (list 1 2 3)) => (1 2 3)
(setf (car x) 'x (cadr y) (car x) (cdr x) y) => (1 X 3)
x => (X 1 X 3)
y => (1 X 3)
(setq x (cons 'a 'b) y (list 1 2 3)) => (1 2 3)
(psetf (car x) 'x (cadr y) (car x) (cdr x) y) => NIL
x => (X 1 A 3)
y => (1 A 3)
; HyperSpec/Body/m_ppr_po.htm
; HyperSpec/Body/m_when_.htm
(when t 'hello) => HELLO
(unless t 'hello) => NIL
(when nil 'hello) => NIL
(unless nil 'hello) => HELLO
(when t) => NIL
(unless nil) => NIL
(when t (prin1 1) (prin1 2) (prin1 3))
>> 123
=> 3
(unless t (prin1 1) (prin1 2) (prin1 3)) => NIL
(when nil (prin1 1) (prin1 2) (prin1 3)) => NIL
(unless nil (prin1 1) (prin1 2) (prin1 3))
>> 123
=> 3
(let ((x 3))
(list (when (oddp x) (incf x) (list x))
(when (oddp x) (incf x) (list x))
(unless (oddp x) (incf x) (list x))
(unless (oddp x) (incf x) (list x))
(if (oddp x) (incf x) (list x))
(if (oddp x) (incf x) (list x))
(if (not (oddp x)) (incf x) (list x))
(if (not (oddp x)) (incf x) (list x))))
=> ((4) NIL (5) NIL 6 (6) 7 (7))
; HyperSpec/Body/m_w_comp.htm
(defun compile-files (&rest files)
(with-compilation-unit ()
(mapcar #'(lambda (file) (compile-file file)) files)))
(compile-files "A" "B" "C")
; HyperSpec/Body/f_subset.htm
(setq cosmos '(1 "a" (1 2))) => (1 "a" (1 2))
(subsetp '(1) cosmos) => true
(subsetp '((1 2)) cosmos) => false
(subsetp '((1 2)) cosmos :test 'equal) => true
(subsetp '(1 "A") cosmos :test #'equalp) => true
(subsetp '((1) (2)) '((1) (2))) => false
(subsetp '((1) (2)) '((1) (2)) :key #'car) => true
; HyperSpec/Body/f_upgr_1.htm
(defun upgraded-array-element-type (type &optional environment)
(array-element-type (make-array 0 :element-type type)))
; HyperSpec/Body/m_check_.htm
(setq aardvarks '(sam harry fred))
=> (SAM HARRY FRED)
(check-type aardvarks (array * (3)))
>> Error: The value of AARDVARKS, (SAM HARRY FRED),
>> is not a 3-long array.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Specify a value to use instead.
>> 2: Return to Lisp Toplevel.
>> Debug> :CONTINUE 1
>> Use Value: #(SAM FRED HARRY)
=> NIL
aardvarks
=> #<ARRAY-T-3 13571>
(map 'list #'identity aardvarks)
=> (SAM FRED HARRY)
(setq aardvark-count 'foo)
=> FOO
(check-type aardvark-count (integer 0 *) "A positive integer")
>> Error: The value of AARDVARK-COUNT, FOO, is not a positive integer.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Specify a value to use instead.
>> 2: Top level.
>> Debug> :CONTINUE 2
; HyperSpec/Body/f_macro_.htm
(defmacro macfun (x) '(macro-function 'macfun)) => MACFUN
(not (macro-function 'macfun)) => false
; HyperSpec/Body/f_descri.htm
; HyperSpec/Body/f_exp_e.htm
(exp 0) => 1.0
(exp 1) => 2.718282
(exp (log 5)) => 5.0
(expt 2 8) => 256
(expt 4 .5) => 2.0
(expt #c(0 1) 2) => -1
(expt #c(2 2) 3) => #C(-16 16)
(expt #c(2 2) 4) => -64
; HyperSpec/Body/f_clear_.htm
;; The exact I/O behavior of this example might vary from implementation
;; to implementation depending on the kind of interactive buffering that
;; occurs. (The call to SLEEP here is intended to help even out the
;; differences in implementations which do not do line-at-a-time buffering.)
(defun read-sleepily (&optional (clear-p nil) (zzz 0))
(list (progn (print '>) (read))
;; Note that input typed within the first ZZZ seconds
;; will be discarded.
(progn (print '>)
(if zzz (sleep zzz))
(print '>>)
(if clear-p (clear-input))
(read))))
(read-sleepily)
>> > 10
>> >
>> >> 20
=> (10 20)
(read-sleepily t)
>> > 10
>> >
>> >> 20
=> (10 20)
(read-sleepily t 10)
>> > 10
>> > 20 ; Some implementations won't echo typeahead here.
>> >> 30
=> (10 30)
; HyperSpec/Body/f_nump.htm
(numberp 12) => true
(numberp (expt 2 130)) => true
(numberp #c(5/3 7.2)) => true
(numberp nil) => false
(numberp (cons 1 2)) => false
; HyperSpec/Body/f_logbtp.htm
(logbitp 1 1) => false
(logbitp 0 1) => true
(logbitp 3 10) => true
(logbitp 1000000 -1) => true
(logbitp 2 6) => true
(logbitp 0 6) => false
; HyperSpec/Body/f_two_wa.htm
; HyperSpec/Body/s_fn.htm
(defun adder (x) (function (lambda (y) (+ x y))))
; HyperSpec/Body/f_init_i.htm
; HyperSpec/Body/f_std_ch.htm
(standard-char-p #\Space) => true
(standard-char-p #\~) => true
;; This next example presupposes an implementation
;; in which #\Bell is a defined character.
(standard-char-p #\Bell) => false
; HyperSpec/Body/f_cmp_ma.htm
; HyperSpec/Body/f_error.htm
(defun factorial (x)
(cond ((or (not (typep x 'integer)) (minusp x))
(error "~S is not a valid argument to FACTORIAL." x))
((zerop x) 1)
(t (* x (factorial (- x 1))))))
=> FACTORIAL
(factorial 20)
=> 2432902008176640000
(factorial -1)
>> Error: -1 is not a valid argument to FACTORIAL.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Return to Lisp Toplevel.
>> Debug>
; HyperSpec/Body/v_sl_sls.htm
(floor 22 7) => 3, 1
(+ (* (car /) 7) (cadr /)) => 22
; HyperSpec/Body/f_smp_bt.htm
(simple-bit-vector-p (make-array 6)) => false
(simple-bit-vector-p #*) => true
; HyperSpec/Body/f_car_c.htm
(car nil) => NIL
(cdr '(1 . 2)) => 2
(cdr '(1 2)) => (2)
(cadr '(1 2)) => 2
(car '(a b c)) => A
(cdr '(a b c)) => (B C)
; HyperSpec/Body/f_format.htm
; HyperSpec/Body/f_sublis.htm
(sublis '((x . 100) (z . zprime))
'(plus x (minus g z x p) 4 . x))
=> (PLUS 100 (MINUS G ZPRIME 100 P) 4 . 100)
(sublis '(((+ x y) . (- x y)) ((- x y) . (+ x y)))
'(* (/ (+ x y) (+ x p)) (- x y))
:test #'equal)
=> (* (/ (- X Y) (+ X P)) (+ X Y))
(setq tree1 '(1 (1 2) ((1 2 3)) (((1 2 3 4)))))
=> (1 (1 2) ((1 2 3)) (((1 2 3 4))))
(sublis '((3 . "three")) tree1)
=> (1 (1 2) ((1 2 "three")) (((1 2 "three" 4))))
(sublis '((t . "string"))
(sublis '((1 . "") (4 . 44)) tree1)
:key #'stringp)
=> ("string" ("string" 2) (("string" 2 3)) ((("string" 2 3 44))))
tree1 => (1 (1 2) ((1 2 3)) (((1 2 3 4))))
(setq tree2 '("one" ("one" "two") (("one" "Two" "three"))))
=> ("one" ("one" "two") (("one" "Two" "three")))
(sublis '(("two" . 2)) tree2)
=> ("one" ("one" "two") (("one" "Two" "three")))
tree2 => ("one" ("one" "two") (("one" "Two" "three")))
(sublis '(("two" . 2)) tree2 :test 'equal)
=> ("one" ("one" 2) (("one" "Two" "three")))
(nsublis '((t . 'temp))
tree1
:key #'(lambda (x) (or (atom x) (< (list-length x) 3))))
=> ((QUOTE TEMP) (QUOTE TEMP) QUOTE TEMP)
; HyperSpec/Body/f_hash_3.htm
(setq table (make-hash-table :size 100 :rehash-threshold 0.5))
=> #<HASH-TABLE EQL 0/100 2562446>
(hash-table-rehash-threshold table) => 0.5
; HyperSpec/Body/f_merge.htm
(setq test1 (list 1 3 4 6 7))
(setq test2 (list 2 5 8))
(merge 'list test1 test2 #'<) => (1 2 3 4 5 6 7 8)
(setq test1 (copy-seq "BOY"))
(setq test2 (copy-seq :nosy"))
(merge 'string test1 test2 #'char-lessp) => "BnOosYy"
(setq test1 (vector ((red . 1) (blue . 4))))
(setq test2 (vector ((yellow . 2) (green . 7))))
(merge 'vector test1 test2 #'< :key #'cdr)
=> #((RED . 1) (YELLOW . 2) (BLUE . 4) (GREEN . 7))
; HyperSpec/Body/f_hash_2.htm
(setq table (make-hash-table :size 100 :rehash-size 1.4))
=> #<HASH-TABLE EQL 0/100 2556371>
(hash-table-rehash-size table) => 1.4
; HyperSpec/Body/v_pr_esc.htm
(let ((*print-escape* t)) (write #\a))
>> #\a
=> #\a
(let ((*print-escape* nil)) (write #\a))
>> a
=> #\a
; HyperSpec/Body/f_mk_dis.htm
(get-macro-character #\{) => NIL, false
(make-dispatch-macro-character #\{) => T
(not (get-macro-character #\{)) => false
; HyperSpec/Body/f_dec_fl.htm
;; Note that since the purpose of this functionality is to expose
;; details of the implementation, all of these examples are necessarily
;; very implementation-dependent. Results may vary widely.
;; Values shown here are chosen consistently from one particular implementation.
(decode-float .5) => 0.5, 0, 1.0
(decode-float 1.0) => 0.5, 1, 1.0
(scale-float 1.0 1) => 2.0
(scale-float 10.01 -2) => 2.5025
(scale-float 23.0 0) => 23.0
(float-radix 1.0) => 2
(float-sign 5.0) => 1.0
(float-sign -5.0) => -1.0
(float-sign 0.0) => 1.0
(float-sign 1.0 0.0) => 0.0
(float-sign 1.0 -10.0) => 10.0
(float-sign -1.0 10.0) => -10.0
(float-digits 1.0) => 24
(float-precision 1.0) => 24
(float-precision least-positive-single-float) => 1
(integer-decode-float 1.0) => 8388608, -23, 1
; HyperSpec/Body/f_replac.htm
(replace "abcdefghij" "0123456789" :start1 4 :end1 7 :start2 4)
=> "abcd456hij"
(setq lst "012345678") => "012345678"
(replace lst lst :start1 2 :start2 0) => "010123456"
lst => "010123456"
; HyperSpec/Body/s_quote.htm
(setq a 1) => 1
(quote (setq a 3)) => (SETQ A 3)
a => 1
'a => A
''a => (QUOTE A)
'''a => (QUOTE (QUOTE A))
(setq a 43) => 43
(list a (cons a 3)) => (43 (43 . 3))
(list (quote a) (quote (cons a 3))) => (A (CONS A 3))
1 => 1
'1 => 1
"foo" => "foo"
'"foo" => "foo"
(car '(a b)) => A
'(car '(a b)) => (CAR (QUOTE (A B)))
#(car '(a b)) => #(CAR (QUOTE (A B)))
'#(car '(a b)) => #(CAR (QUOTE (A B)))
; HyperSpec/Body/f_fill_p.htm
(setq a (make-array 8 :fill-pointer 4)) => #(NIL NIL NIL NIL)
(fill-pointer a) => 4
(dotimes (i (length a)) (setf (aref a i) (* i i))) => NIL
a => #(0 1 4 9)
(setf (fill-pointer a) 3) => 3
(fill-pointer a) => 3
a => #(0 1 4)
(setf (fill-pointer a) 8) => 8
a => #(0 1 4 9 NIL NIL NIL NIL)
; HyperSpec/Body/v_short_.htm
; HyperSpec/Body/v_pr_mis.htm
; HyperSpec/Body/m_w_out_.htm
(setq fstr (make-array '(0) :element-type 'base-char
:fill-pointer 0 :adjustable t)) => ""
(with-output-to-string (s fstr)
(format s "here's some output")
(input-stream-p s)) => false
fstr => "here's some output"
; HyperSpec/Body/f_reinit.htm
; HyperSpec/Body/d_optimi.htm
(defun often-used-subroutine (x y)
(declare (optimize (safety 2)))
(error-check x y)
(hairy-setup x)
(do ((i 0 (+ i 1))
(z x (cdr z)))
((null z))
;; This inner loop really needs to burn.
(declare (optimize speed))
(declare (fixnum i))
))
; HyperSpec/Body/f_no_app.htm
; HyperSpec/Body/f__.htm
(- 55.55) => -55.55
(- #c(3 -5)) => #C(-3 5)
(- 0) => 0
(eql (- 0.0) -0.0) => true
(- #c(100 45) #c(0 45)) => 100
(- 10 1 2 3 4) => 0
; HyperSpec/Body/f_set_pp.htm
(cons car-type cdr-type)
; HyperSpec/Body/f_rst_na.htm
(restart-case
(loop for restart in (compute-restarts)
collect (restart-name restart))
(case1 () :report "Return 1." 1)
(nil () :report "Return 2." 2)
(case3 () :report "Return 3." 3)
(case1 () :report "Return 4." 4))
=> (CASE1 NIL CASE3 CASE1 ABORT)
;; In the example above the restart named ABORT was not created
;; explicitly, but was implicitly supplied by the system.
; HyperSpec/Body/f_cp_tre.htm
(setq object (list (cons 1 "one")
(cons 2 (list 'a 'b 'c))))
=> ((1 . "one") (2 A B C))
(setq object-too object) => ((1 . "one") (2 A B C))
(setq copy-as-list (copy-list object))
(setq copy-as-alist (copy-alist object))
(setq copy-as-tree (copy-tree object))
(eq object object-too) => true
(eq copy-as-tree object) => false
(eql copy-as-tree object) => false
(equal copy-as-tree object) => true
(setf (first (cdr (second object))) "a"
(car (second object)) "two"
(car object) '(one . 1)) => (ONE . 1)
object => ((ONE . 1) ("two" "a" B C))
object-too => ((ONE . 1) ("two" "a" B C))
copy-as-list => ((1 . "one") ("two" "a" B C))
copy-as-alist => ((1 . "one") (2 "a" B C))
copy-as-tree => ((1 . "one") (2 A B C))
; HyperSpec/Body/m_tracec.htm
(defun fact (n) (if (zerop n) 1 (* n (fact (- n 1)))))
=> FACT
(trace fact)
=> (FACT)
;; Of course, the format of traced output is implementation-dependent.
(fact 3)
>> 1 Enter FACT 3
>> | 2 Enter FACT 2
>> | 3 Enter FACT 1
>> | | 4 Enter FACT 0
>> | | 4 Exit FACT 1
>> | 3 Exit FACT 1
>> | 2 Exit FACT 2
>> 1 Exit FACT 6
=> 6
; HyperSpec/Body/d_inline.htm
;; The globally defined function DISPATCH should be open-coded,
;; if the implementation supports inlining, unless a NOTINLINE
;; declaration overrides this effect.
(declaim (inline dispatch))
(defun dispatch (x) (funcall (get (car x) 'dispatch) x))
;; Here is an example where inlining would be encouraged.
(defun top-level-1 () (dispatch (read-command)))
;; Here is an example where inlining would be prohibited.
(defun top-level-2 ()
(declare (notinline dispatch))
(dispatch (read-command)))
;; Here is an example where inlining would be prohibited.
(declaim (notinline dispatch))
(defun top-level-3 () (dispatch (read-command)))
;; Here is an example where inlining would be encouraged.
(defun top-level-4 ()
(declare (inline dispatch))
(dispatch (read-command)))
; HyperSpec/Body/f_rplaca.htm
(defparameter *some-list* (list* 'one 'two 'three 'four)) => *some-list*
*some-list* => (ONE TWO THREE . FOUR)
(rplaca *some-list* 'uno) => (UNO TWO THREE . FOUR)
*some-list* => (UNO TWO THREE . FOUR)
(rplacd (last *some-list*) (list 'IV)) => (THREE IV)
*some-list* => (UNO TWO THREE IV)
; HyperSpec/Body/m_return.htm
(block nil (return) 1) => NIL
(block nil (return 1) 2) => 1
(block nil (return (values 1 2)) 3) => 1, 2
(block nil (block alpha (return 1) 2)) => 1
(block alpha (block nil (return 1)) 2) => 2
(block nil (block nil (return 1) 2)) => 1
; HyperSpec/Body/f_ch.htm
(character #\a) => #\a
(character "a") => #\a
(character 'a) => #\A
(character '\a) => #\a
(character 65.) is an error.
(character 'apple) is an error.
; HyperSpec/Body/f_chareq.htm
(char= #\d #\d) => true
(char= #\A #\a) => false
(char= #\d #\x) => false
(char= #\d #\D) => false
(char/= #\d #\d) => false
(char/= #\d #\x) => true
(char/= #\d #\D) => true
(char= #\d #\d #\d #\d) => true
(char/= #\d #\d #\d #\d) => false
(char= #\d #\d #\x #\d) => false
(char/= #\d #\d #\x #\d) => false
(char= #\d #\y #\x #\c) => false
(char/= #\d #\y #\x #\c) => true
(char= #\d #\c #\d) => false
(char/= #\d #\c #\d) => false
(char< #\d #\x) => true
(char<= #\d #\x) => true
(char< #\d #\d) => false
(char<= #\d #\d) => true
(char< #\a #\e #\y #\z) => true
(char<= #\a #\e #\y #\z) => true
(char< #\a #\e #\e #\y) => false
(char<= #\a #\e #\e #\y) => true
(char> #\e #\d) => true
(char>= #\e #\d) => true
(char> #\d #\c #\b #\a) => true
(char>= #\d #\c #\b #\a) => true
(char> #\d #\d #\c #\a) => false
(char>= #\d #\d #\c #\a) => true
(char> #\e #\d #\b #\c #\a) => false
(char>= #\e #\d #\b #\c #\a) => false
(char> #\z #\A) => implementation-dependent
(char> #\Z #\a) => implementation-dependent
(char-equal #\A #\a) => true
(stable-sort (list #\b #\A #\B #\a #\c #\C) #'char-lessp)
=> (#\A #\a #\b #\B #\c #\C)
(stable-sort (list #\b #\A #\B #\a #\c #\C) #'char<)
=> (#\A #\B #\C #\a #\b #\c) ;Implementation A
=> (#\a #\b #\c #\A #\B #\C) ;Implementation B
=> (#\a #\A #\b #\B #\c #\C) ;Implementation C
=> (#\A #\a #\B #\b #\C #\c) ;Implementation D
=> (#\A #\B #\a #\b #\C #\c) ;Implementation E
; HyperSpec/Body/f_mk_cnd.htm
(defvar *oops-count* 0)
(setq a (make-condition 'simple-error
:format-control "This is your ~:R error."
:format-arguments (list (incf *oops-count*))))
=> #<SIMPLE-ERROR 32245104>
(format t "~&~A~%" a)
>> This is your first error.
=> NIL
(error a)
>> Error: This is your first error.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Return to Lisp Toplevel.
>> Debug>
; HyperSpec/Body/f_smp_ve.htm
(simple-vector-p (make-array 6)) => true
(simple-vector-p "aaaaaa") => false
(simple-vector-p (make-array 6 :fill-pointer t)) => false
; HyperSpec/Body/v_pr_gen.htm
(let ((*print-gensym* nil))
(print (gensym)))
>> G6040
=> #:G6040
; HyperSpec/Body/f_digi_1.htm
(digit-char-p #\5) => 5
(digit-char-p #\5 2) => false
(digit-char-p #\A) => false
(digit-char-p #\a) => false
(digit-char-p #\A 11) => 10
(digit-char-p #\a 11) => 10
(mapcar #'(lambda (radix)
(map 'list #'(lambda (x) (digit-char-p x radix))
"059AaFGZ"))
'(2 8 10 16 36))
=> ((0 NIL NIL NIL NIL NIL NIL NIL)
(0 5 NIL NIL NIL NIL NIL NIL)
(0 5 9 NIL NIL NIL NIL NIL)
(0 5 9 10 10 15 NIL NIL)
(0 5 9 10 10 15 16 35))
; HyperSpec/Body/f_dpb.htm
(dpb 1 (byte 1 10) 0) => 1024
(dpb -2 (byte 2 10) 0) => 2048
(dpb 1 (byte 2 10) 2048) => 1024
; HyperSpec/Body/f_by_by.htm
(setq b (byte 100 200)) => #<BYTE-SPECIFIER size 100 position 200>
(byte-size b) => 100
(byte-position b) => 200
; HyperSpec/Body/f_hash_1.htm
(setq table (make-hash-table)) => #<HASH-TABLE EQL 0/120 32115135>
(hash-table-count table) => 0
(setf (gethash 57 table) "fifty-seven") => "fifty-seven"
(hash-table-count table) => 1
(dotimes (i 100) (setf (gethash i table) i)) => NIL
(hash-table-count table) => 100
; HyperSpec/Body/f_rn_fil.htm
;; An example involving logical pathnames.
(with-open-file (stream "sys:chemistry;lead.text"
:direction :output :if-exists :error)
(princ "eureka" stream)
(values (pathname stream) (truename stream)))
=> #P"SYS:CHEMISTRY;LEAD.TEXT.NEWEST", #P"Q:>sys>chem>lead.text.1"
(rename-file "sys:chemistry;lead.text" "gold.text")
=> #P"SYS:CHEMISTRY;GOLD.TEXT.NEWEST",
#P"Q:>sys>chem>lead.text.1",
#P"Q:>sys>chem>gold.text.1"
; HyperSpec/Body/v_rdtabl.htm
(readtablep *readtable*) => true
(setq zvar 123) => 123
(set-syntax-from-char #\z #\' (setq table2 (copy-readtable))) => T
zvar => 123
(setq *readtable* table2) => #<READTABLE>
zvar => VAR
(setq *readtable* (copy-readtable nil)) => #<READTABLE>
zvar => 123
; HyperSpec/Body/f_set__1.htm
(get-dispatch-macro-character #\# #\{) => NIL
(set-dispatch-macro-character #\# #\{ ;dispatch on #{
#'(lambda(s c n)
(let ((list (read s nil (values) t))) ;list is object after #n{
(when (consp list) ;return nth element of list
(unless (and n (< 0 n (length list))) (setq n 0))
(setq list (nth n list)))
list))) => T
#{(1 2 3 4) => 1
#3{(0 1 2 3) => 3
#{123 => 123
; HyperSpec/Body/m_pr_unr.htm
(defmethod print-object ((obj airplane) stream)
(print-unreadable-object (obj stream :type t :identity t)
(princ (tail-number obj) stream)))
(prin1-to-string my-airplane)
=> "#<Airplane NW0773 36000123135>"
OR=> "#<FAA:AIRPLANE NW0773 17>"
; HyperSpec/Body/f_intege.htm
(integer-length 0) => 0
(integer-length 1) => 1
(integer-length 3) => 2
(integer-length 4) => 3
(integer-length 7) => 3
(integer-length -1) => 0
(integer-length -4) => 2
(integer-length -7) => 3
(integer-length -8) => 3
(integer-length (expt 2 9)) => 10
(integer-length (1- (expt 2 9))) => 9
(integer-length (- (expt 2 9))) => 9
(integer-length (- (1+ (expt 2 9)))) => 10
; HyperSpec/Body/s_let_l.htm
(setq a 'top) => TOP
(defun dummy-function () a) => DUMMY-FUNCTION
(let ((a 'inside) (b a))
(format nil "~S ~S ~S" a b (dummy-function))) => "INSIDE TOP TOP"
(let* ((a 'inside) (b a))
(format nil "~S ~S ~S" a b (dummy-function))) => "INSIDE INSIDE TOP"
(let ((a 'inside) (b a))
(declare (special a))
(format nil "~S ~S ~S" a b (dummy-function))) => "INSIDE TOP INSIDE"
; HyperSpec/Body/s_block.htm
(block empty) => NIL
(block whocares (values 1 2) (values 3 4)) => 3, 4
(let ((x 1))
(block stop (setq x 2) (return-from stop) (setq x 3))
x) => 2
(block early (return-from early (values 1 2)) (values 3 4)) => 1, 2
(block outer (block inner (return-from outer 1)) 2) => 1
(block twin (block twin (return-from twin 1)) 2) => 2
;; Contrast behavior of this example with corresponding example of CATCH.
(block b
(flet ((b1 () (return-from b 1)))
(block b (b1) (print 'unreachable))
2)) => 1
; HyperSpec/Body/f_append.htm
(append '(a b c) '(d e f) '() '(g)) => (A B C D E F G)
(append '(a b c) 'd) => (A B C . D)
(setq lst '(a b c)) => (A B C)
(append lst '(d)) => (A B C D)
lst => (A B C)
(append) => NIL
(append 'a) => A
; HyperSpec/Body/s_locall.htm
(defun sample-function (y) ;this y is regarded as special
(declare (special y))
(let ((y t)) ;this y is regarded as lexical
(list y
(locally (declare (special y))
;; this next y is regarded as special
y))))
=> SAMPLE-FUNCTION
(sample-function nil) => (T NIL)
(setq x '(1 2 3) y '(4 . 5)) => (4 . 5)
;;; The following declarations are not notably useful in specific.
;;; They just offer a sample of valid declaration syntax using LOCALLY.
(locally (declare (inline floor) (notinline car cdr))
(declare (optimize space))
(floor (car x) (cdr y))) => 0, 1
; HyperSpec/Body/f_cp_stu.htm
; HyperSpec/Body/r_store_.htm
(defun type-error-auto-coerce (c)
(when (typep c 'type-error)
(let ((r (find-restart 'store-value c)))
(handler-case (let ((v (coerce (type-error-datum c)
(type-error-expected-type c))))
(invoke-restart r v))
(error ()))))) => TYPE-ERROR-AUTO-COERCE
(let ((x 3))
(handler-bind ((type-error #'type-error-auto-coerce))
(check-type x float)
x)) => 3.0
; HyperSpec/Body/f_logi_1.htm
; HyperSpec/Body/v_t.htm
t => T
(eq t 't) => true
(find-class 't) => #<CLASS T 610703333>
(case 'a (a 1) (t 2)) => 1
(case 'b (a 1) (t 2)) => 2
(prin1 'hello t)
>> HELLO
=> HELLO
; HyperSpec/Body/f_rd_by.htm
(with-open-file (s "temp-bytes"
:direction :output
:element-type 'unsigned-byte)
(write-byte 101 s)) => 101
(with-open-file (s "temp-bytes" :element-type 'unsigned-byte)
(format t "~S ~S" (read-byte s) (read-byte s nil 'eof)))
>> 101 EOF
=> NIL
; HyperSpec/Body/v_pi.htm
;; In each of the following computations, the precision depends
;; on the implementation. Also, if `long float' is treated by
;; the implementation as equivalent to some other float format
;; (e.g., `double float') the exponent marker might be the marker
;; for that equivalent (e.g., `D' instead of `L').
pi => 3.141592653589793L0
(cos pi) => -1.0L0
(defun sin-of-degrees (degrees)
(let ((x (if (floatp degrees) degrees (float degrees pi))))
(sin (* x (/ (float pi x) 180)))))
; HyperSpec/Body/f_get_pr.htm
(setq x '()) => NIL
(setq *indicator-list* '(prop1 prop2)) => (PROP1 PROP2)
(getf x 'prop1) => NIL
(setf (getf x 'prop1) 'val1) => VAL1
(eq (getf x 'prop1) 'val1) => true
(get-properties x *indicator-list*) => PROP1, VAL1, (PROP1 VAL1)
x => (PROP1 VAL1)
; HyperSpec/Body/f_gcd.htm
(gcd) => 0
(gcd 60 42) => 6
(gcd 3333 -33 101) => 1
(gcd 3333 -33 1002001) => 11
(gcd 91 -49) => 7
(gcd 63 -42 35) => 7
(gcd 5) => 5
(gcd -4) => 4
; HyperSpec/Body/v_ld_prs.htm
; HyperSpec/Body/f_shadow.htm
(package-shadowing-symbols (make-package 'temp)) => NIL
(find-symbol 'car 'temp) => CAR, :INHERITED
(shadow 'car 'temp) => T
(find-symbol 'car 'temp) => TEMP::CAR, :INTERNAL
(package-shadowing-symbols 'temp) => (TEMP::CAR)
; HyperSpec/Body/f_set_sy.htm
(set-syntax-from-char #\7 #\;) => T
123579 => 1235
; HyperSpec/Body/f_fn_kwd.htm
(defmethod gf1 ((a integer) &optional (b 2)
&key (c 3) ((:dee d) 4) e ((eff f)))
(list a b c d e f))
=> #<STANDARD-METHOD GF1 (INTEGER) 36324653>
(find-method #'gf1 '() (list (find-class 'integer)))
=> #<STANDARD-METHOD GF1 (INTEGER) 36324653>
(function-keywords *)
=> (:C :DEE :E EFF), false
(defmethod gf2 ((a integer))
(list a b c d e f))
=> #<STANDARD-METHOD GF2 (INTEGER) 42701775>
(function-keywords (find-method #'gf1 '() (list (find-class 'integer))))
=> (), false
(defmethod gf3 ((a integer) &key b c d &allow-other-keys)
(list a b c d e f))
(function-keywords *)
=> (:B :C :D), true
; HyperSpec/Body/f_evenpc.htm
(evenp 0) => true
(oddp 10000000000000000000000) => false
(oddp -1) => true
; HyperSpec/Body/f_char_c.htm
;; An implementation using ASCII character encoding
;; might return these values:
(char-code #\$) => 36
(char-code #\a) => 97
; HyperSpec/Body/f_mk_bro.htm
(setq a-stream (make-string-output-stream)
b-stream (make-string-output-stream)) => #<String Output Stream>
(format (make-broadcast-stream a-stream b-stream)
"this will go to both streams") => NIL
(get-output-stream-string a-stream) => "this will go to both streams"
(get-output-stream-string b-stream) => "this will go to both streams"
; HyperSpec/Body/f_upper_.htm
(upper-case-p #\A) => true
(upper-case-p #\a) => false
(both-case-p #\a) => true
(both-case-p #\5) => false
(lower-case-p #\5) => false
(upper-case-p #\5) => false
;; This next example presupposes an implementation
;; in which #\Bell is an implementation-defined character.
(lower-case-p #\Bell) => false
; HyperSpec/Body/f_ppr_di.htm
(let ((*print-pretty* t))
(write object :stream s))
== (funcall (pprint-dispatch object) s object)
; HyperSpec/Body/f_ppr_in.htm
; HyperSpec/Body/f_ldiffc.htm
(let ((lists '#((a b c) (a b c . d))))
(dotimes (i (length lists)) ()
(let ((list (aref lists i)))
(format t "~2&list=~S ~21T(tailp object list)~
~44T(ldiff list object)~%" list)
(let ((objects (vector list (cddr list) (copy-list (cddr list))
'(f g h) '() 'd 'x)))
(dotimes (j (length objects)) ()
(let ((object (aref objects j)))
(format t "~& object=~S ~21T~S ~44T~S"
object (tailp object list) (ldiff list object))))))))
>>
>> list=(A B C) (tailp object list) (ldiff list object)
>> object=(A B C) T NIL
>> object=(C) T (A B)
>> object=(C) NIL (A B C)
>> object=(F G H) NIL (A B C)
>> object=NIL T (A B C)
>> object=D NIL (A B C)
>> object=X NIL (A B C)
>>
>> list=(A B C . D) (tailp object list) (ldiff list object)
>> object=(A B C . D) T NIL
>> object=(C . D) T (A B)
>> object=(C . D) NIL (A B C . D)
>> object=(F G H) NIL (A B C . D)
>> object=NIL NIL (A B C . D)
>> object=D T (A B C)
>> object=X NIL (A B C . D)
=> NIL
; HyperSpec/Body/f_unionc.htm
(union '(a b c) '(f a d))
=> (A B C F D)
OR=> (B C F A D)
OR=> (D F A B C)
(union '((x 5) (y 6)) '((z 2) (x 4)) :key #'car)
=> ((X 5) (Y 6) (Z 2))
OR=> ((X 4) (Y 6) (Z 2))
(setq lst1 (list 1 2 '(1 2) "a" "b")
lst2 (list 2 3 '(2 3) "B" "C"))
=> (2 3 (2 3) "B" "C")
(nunion lst1 lst2)
=> (1 (1 2) "a" "b" 2 3 (2 3) "B" "C")
OR=> (1 2 (1 2) "a" "b" "C" "B" (2 3) 3)
; HyperSpec/Body/f_bt_vec.htm
(bit-vector-p (make-array 6
:element-type 'bit
:fill-pointer t)) => true
(bit-vector-p #*) => true
(bit-vector-p (make-array 6)) => false
; HyperSpec/Body/f_invo_1.htm
(defun add3 (x) (check-type x number) (+ x 3))
(foo 'seven)
>> Error: The value SEVEN was not of type NUMBER.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Specify a different value to use.
>> 2: Return to Lisp Toplevel.
>> Debug> (invoke-restart 'store-value 7)
=> 10
; HyperSpec/Body/f_mismat.htm
(mismatch "abcd" "ABCDE" :test #'char-equal) => 4
(mismatch '(3 2 1 1 2 3) '(1 2 3) :from-end t) => 3
(mismatch '(1 2 3) '(2 3 4) :test-not #'eq :key #'oddp) => NIL
(mismatch '(1 2 3 4 5 6) '(3 4 5 6 7) :start1 2 :end2 4) => NIL
; HyperSpec/Body/f_dir.htm
; HyperSpec/Body/f_acons.htm
(setq alist '()) => NIL
(acons 1 "one" alist) => ((1 . "one"))
alist => NIL
(setq alist (acons 1 "one" (acons 2 "two" alist))) => ((1 . "one") (2 . "two"))
(assoc 1 alist) => (1 . "one")
(setq alist (acons 1 "uno" alist)) => ((1 . "uno") (1 . "one") (2 . "two"))
(assoc 1 alist) => (1 . "uno")
; HyperSpec/Body/v_pr_rig.htm
; HyperSpec/Body/f_map.htm
(map 'string #'(lambda (x y)
(char "01234567890ABCDEF" (mod (+ x y) 16)))
'(1 2 3 4)
'(10 9 8 7)) => "AAAA"
(setq seq '("lower" "UPPER" "" "123")) => ("lower" "UPPER" "" "123")
(map nil #'nstring-upcase seq) => NIL
seq => ("LOWER" "UPPER" "" "123")
(map 'list #'- '(1 2 3 4)) => (-1 -2 -3 -4)
(map 'string
#'(lambda (x) (if (oddp x) #\1 #\0))
'(1 2 3 4)) => "1010"
; HyperSpec/Body/v_defaul.htm
;; This example illustrates a possible usage for a hypothetical Lisp running on a
;; DEC TOPS-20 file system. Since pathname conventions vary between Lisp
;; implementations and host file system types, it is not possible to provide a
;; general-purpose, conforming example.
*default-pathname-defaults* => #P"PS:<FRED>"
(merge-pathnames (make-pathname :name "CALENDAR"))
=> #P"PS:<FRED>CALENDAR"
(let ((*default-pathname-defaults* (pathname "<MARY>")))
(merge-pathnames (make-pathname :name "CALENDAR")))
=> #P"<MARY>CALENDAR"
; HyperSpec/Body/f_hash_5.htm
; HyperSpec/Body/f_hash_t.htm
(setq table (make-hash-table)) => #<HASH-TABLE EQL 0/120 32511220>
(hash-table-p table) => true
(hash-table-p 37) => false
(hash-table-p '((a . 1) (b . 2))) => false
; HyperSpec/Body/f_mk_two.htm
(with-output-to-string (out)
(with-input-from-string (in "input...")
(let ((two (make-two-way-stream in out)))
(format two "output...")
(setq what-is-read (read two))))) => "output..."
what-is-read => INPUT...
; HyperSpec/Body/f_hash_4.htm
; HyperSpec/Body/m_dotime.htm
(dotimes (temp-one 10 temp-one)) => 10
(setq temp-two 0) => 0
(dotimes (temp-one 10 t) (incf temp-two)) => T
temp-two => 10
; HyperSpec/Body/f_listp.htm
(listp nil) => true
(listp (cons 1 2)) => true
(listp (make-array 6)) => false
(listp t) => false
; HyperSpec/Body/f_desc_1.htm
(defclass spaceship ()
((captain :initarg :captain :accessor spaceship-captain)
(serial# :initarg :serial-number :accessor spaceship-serial-number)))
(defclass federation-starship (spaceship) ())
(defmethod describe-object ((s spaceship) stream)
(with-slots (captain serial#) s
(format stream "~&~S is a spaceship of type ~S,~
~%with ~A at the helm ~
and with serial number ~D.~%"
s (type-of s) captain serial#)))
(make-instance 'federation-starship
:captain "Rachel Garrett"
:serial-number "NCC-1701-C")
=> #<FEDERATION-STARSHIP 26312465>
(describe *)
>> #<FEDERATION-STARSHIP 26312465> is a spaceship of type FEDERATION-STARSHIP,
>> with Rachel Garrett at the helm and with serial number NCC-1701-C.
=> <no values>
; HyperSpec/Body/m_ignore.htm
(defun load-init-file (program)
(let ((win nil))
(ignore-errors ;if this fails, don't enter debugger
(load (merge-pathnames (make-pathname :name program :type :lisp)
(user-homedir-pathname)))
(setq win t))
(unless win (format t "~&Init file failed to load.~%"))
win))
(load-init-file "no-such-program")
>> Init file failed to load.
NIL
; HyperSpec/Body/f_ensure.htm
; HyperSpec/Body/m_prog1c.htm
(setq temp 1) => 1
(prog1 temp (print temp) (incf temp) (print temp))
>> 1
>> 2
=> 1
(prog1 temp (setq temp nil)) => 2
temp => NIL
(prog1 (values 1 2 3) 4) => 1
(setq temp (list 'a 'b 'c))
(prog1 (car temp) (setf (car temp) 'alpha)) => A
temp => (ALPHA B C)
(flet ((swap-symbol-values (x y)
(setf (symbol-value x)
(prog1 (symbol-value y)
(setf (symbol-value y) (symbol-value x))))))
(let ((*foo* 1) (*bar* 2))
(declare (special *foo* *bar*))
(swap-symbol-values '*foo* '*bar*)
(values *foo* *bar*)))
=> 2, 1
(setq temp 1) => 1
(prog2 (incf temp) (incf temp) (incf temp)) => 3
temp => 4
(prog2 1 (values 2 3 4) 5) => 2
; HyperSpec/Body/v_pr_rda.htm
(let ((x (list "a" '\a (gensym) '((a (b (c))) d e f g)))
(*print-escape* nil)
(*print-gensym* nil)
(*print-level* 3)
(*print-length* 3))
(write x)
(let ((*print-readably* t))
(terpri)
(write x)
:done))
>> (a a G4581 ((A #) D E ...))
>> ("a" |a| #:G4581 ((A (B (C))) D E F G))
=> :DONE
;; This is setup code is shared between the examples
;; of three hypothetical implementations which follow.
(setq table (make-hash-table)) => #<HASH-TABLE EQL 0/120 32005763>
(setf (gethash table 1) 'one) => ONE
(setf (gethash table 2) 'two) => TWO
;; Implementation A
(let ((*print-readably* t)) (print table))
Error: Can't print #<HASH-TABLE EQL 0/120 32005763> readably.
;; Implementation B
;; No standardized #S notation for hash tables is defined,
;; but there might be an implementation-defined notation.
(let ((*print-readably* t)) (print table))
>> #S(HASH-TABLE :TEST EQL :SIZE 120 :CONTENTS (1 ONE 2 TWO))
=> #<HASH-TABLE EQL 0/120 32005763>
;; Implementation C
;; Note that #. notation can only be used if *READ-EVAL* is true.
;; If *READ-EVAL* were false, this same implementation might have to
;; signal an error unless it had yet another printing strategy to fall
;; back on.
(let ((*print-readably* t)) (print table))
>> #.(LET ((HASH-TABLE (MAKE-HASH-TABLE)))
>> (SETF (GETHASH 1 HASH-TABLE) ONE)
>> (SETF (GETHASH 2 HASH-TABLE) TWO)
>> HASH-TABLE)
=> #<HASH-TABLE EQL 0/120 32005763>
; HyperSpec/Body/s_if.htm
(if t 1) => 1
(if nil 1 2) => 2
(defun test ()
(dolist (truth-value '(t nil 1 (a b c)))
(if truth-value (print 'true) (print 'false))
(prin1 truth-value))) => TEST
(test)
>> TRUE T
>> FALSE NIL
>> TRUE 1
>> TRUE (A B C)
=> NIL
; HyperSpec/Body/f_fdefin.htm
; HyperSpec/Body/f_use_pk.htm
(export (intern "LAND-FILL" (make-package 'trash)) 'trash) => T
(find-symbol "LAND-FILL" (make-package 'temp)) => NIL, NIL
(package-use-list 'temp) => (#<PACKAGE "TEMP">)
(use-package 'trash 'temp) => T
(package-use-list 'temp) => (#<PACKAGE "TEMP"> #<PACKAGE "TRASH">)
(find-symbol "LAND-FILL" 'temp) => TRASH:LAND-FILL, :INHERITED
; HyperSpec/Body/f_cons.htm
(cons 1 2) => (1 . 2)
(cons 1 nil) => (1)
(cons nil 2) => (NIL . 2)
(cons nil nil) => (NIL)
(cons 1 (cons 2 (cons 3 (cons 4 nil)))) => (1 2 3 4)
(cons 'a 'b) => (A . B)
(cons 'a (cons 'b (cons 'c '<TT>()</TT>))) => (A B C)
(cons 'a '(b c d)) => (A B C D)
; HyperSpec/Body/v_rd_sup.htm
(let ((*read-suppress* t))
(mapcar #'read-from-string
'("#(foo bar baz)" "#P(:type :lisp)" "#c1.2"
"#.(PRINT 'FOO)" "#3AHELLO" "#S(INTEGER)"
"#*ABC" "#\GARBAGE" "#RALPHA" "#3R444")))
=> (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
; HyperSpec/Body/f_cell_e.htm
; HyperSpec/Body/f_find_m.htm
(defmethod some-operation ((a integer) (b float)) (list a b))
=> #&lt;STANDARD-METHOD SOME-OPERATION (INTEGER FLOAT) 26723357>
(find-method #'some-operation '() (mapcar #'find-class '(integer float)))
=> #&lt;STANDARD-METHOD SOME-OPERATION (INTEGER FLOAT) 26723357>
(find-method #'some-operation '() (mapcar #'find-class '(integer integer)))
>> Error: No matching method
(find-method #'some-operation '() (mapcar #'find-class '(integer integer)) nil)
=> NIL
; HyperSpec/Body/f_sbs_s.htm
(substitute #\. #\SPACE "0 2 4 6") => "0.2.4.6"
(substitute 9 4 '(1 2 4 1 3 4 5)) => (1 2 9 1 3 9 5)
(substitute 9 4 '(1 2 4 1 3 4 5) :count 1) => (1 2 9 1 3 4 5)
(substitute 9 4 '(1 2 4 1 3 4 5) :count 1 :from-end t)
=> (1 2 4 1 3 9 5)
(substitute 9 3 '(1 2 4 1 3 4 5) :test #'>) => (9 9 4 9 3 4 5)
(substitute-if 0 #'evenp '((1) (2) (3) (4)) :start 2 :key #'car)
=> ((1) (2) (3) 0)
(substitute-if 9 #'oddp '(1 2 4 1 3 4 5)) => (9 2 4 9 9 4 9)
(substitute-if 9 #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t)
=> (1 2 4 1 3 9 5)
(setq some-things (list 'a 'car 'b 'cdr 'c)) => (A CAR B CDR C)
(nsubstitute-if "function was here" #'fboundp some-things
:count 1 :from-end t) => (A CAR B "function was here" C)
some-things => (A CAR B "function was here" C)
(setq alpha-tester (copy-seq "ab ")) => "ab "
(nsubstitute-if-not #\z #'alpha-char-p alpha-tester) => "abz"
alpha-tester => "abz"
; HyperSpec/Body/f_char_u.htm
(char-upcase #\a) => #\A
(char-upcase #\A) => #\A
(char-downcase #\a) => #\a
(char-downcase #\A) => #\a
(char-upcase #\9) => #\9
(char-downcase #\9) => #\9
(char-upcase #\@) => #\@
(char-downcase #\@) => #\@
;; Note that this next example might run for a very long time in
;; some implementations if CHAR-CODE-LIMIT happens to be very large
;; for that implementation.
(dotimes (code char-code-limit)
(let ((char (code-char code)))
(when char
(unless (cond ((upper-case-p char) (char= (char-upcase (char-downcase char)) char))
((lower-case-p char) (char= (char-downcase (char-upcase char)) char))
(t (and (char= (char-upcase (char-downcase char)) char)
(char= (char-downcase (char-upcase char)) char))))
(return char)))))
=> NIL
; HyperSpec/Body/f_room.htm
; HyperSpec/Body/f_logtes.htm
(logtest 1 7) => true
(logtest 1 2) => false
(logtest -2 -1) => true
(logtest 0 -1) => false
; HyperSpec/Body/m_defun.htm
(defun recur (x)
(when (> x 0)
(recur (1- x)))) => RECUR
(defun ex (a b &amp;optional c (d 66) &amp;rest keys &amp;key test (start 0))
(list a b c d keys test start)) => EX
(ex 1 2) => (1 2 NIL 66 NIL NIL 0)
(ex 1 2 3 4 :test 'equal :start 50)
=> (1 2 3 4 (:TEST EQUAL :START 50) EQUAL 50)
(ex :test 1 :start 2) => (:TEST 1 :START 2 NIL NIL 0)
;; This function assumes its callers have checked the types of the
;; arguments, and authorizes the compiler to build in that assumption.
(defun discriminant (a b c)
(declare (number a b c))
"Compute the discriminant for a quadratic equation."
(- (* b b) (* 4 a c))) => DISCRIMINANT
(discriminant 1 2/3 -2) => 76/9
;; This function assumes its callers have not checked the types of the
;; arguments, and performs explicit type checks before making any assumptions.
(defun careful-discriminant (a b c)
"Compute the discriminant for a quadratic equation."
(check-type a number)
(check-type b number)
(check-type c number)
(locally (declare (number a b c))
(- (* b b) (* 4 a c)))) => CAREFUL-DISCRIMINANT
(careful-discriminant 1 2/3 -2) => 76/9
; HyperSpec/Body/f_intera.htm
(when (> measured limit)
(let ((error (round (* (- measured limit) 100)
limit)))
(unless (if (interactive-stream-p *query-io*)
(yes-or-no-p "The frammis is out of tolerance by ~D%.~@
Is it safe to proceed? " error)
(&lt; error 15)) ;15% is acceptable
(error "The frammis is out of tolerance by ~D%." error))))
; HyperSpec/Body/v_call_a.htm
; HyperSpec/Body/f_rempro.htm
(setq test (make-symbol "PSEUDO-PI")) => #:PSEUDO-PI
(symbol-plist test) => ()
(setf (get test 'constant) t) => T
(setf (get test 'approximation) 3.14) => 3.14
(setf (get test 'error-range) 'noticeable) => NOTICEABLE
(symbol-plist test)
=> (ERROR-RANGE NOTICEABLE APPROXIMATION 3.14 CONSTANT T)
(setf (get test 'approximation) nil) => NIL
(symbol-plist test)
=> (ERROR-RANGE NOTICEABLE APPROXIMATION NIL CONSTANT T)
(get test 'approximation) => NIL
(remprop test 'approximation) => true
(get test 'approximation) => NIL
(symbol-plist test)
=> (ERROR-RANGE NOTICEABLE CONSTANT T)
(remprop test 'approximation) => NIL
(symbol-plist test)
=> (ERROR-RANGE NOTICEABLE CONSTANT T)
(remprop test 'error-range) => true
(setf (get test 'approximation) 3) => 3
(symbol-plist test)
=> (APPROXIMATION 3 CONSTANT T)
; HyperSpec/Body/m_step.htm
; HyperSpec/Body/m_defmac.htm
(defmacro mac1 (a b) "Mac1 multiplies and adds"
`(+ ,a (* ,b 3))) => MAC1
(mac1 4 5) => 19
(documentation 'mac1 'function) => "Mac1 multiplies and adds"
(defmacro mac2 (&amp;optional (a 2 b) (c 3 d) &amp;rest x) `'(,a ,b ,c ,d ,x)) => MAC2
(mac2 6) => (6 T 3 NIL NIL)
(mac2 6 3 8) => (6 T 3 T (8))
(defmacro mac3 (&amp;whole r a &amp;optional (b 3) &amp;rest x &amp;key c (d a))
`'(,r ,a ,b ,c ,d ,x)) => MAC3
(mac3 1 6 :d 8 :c 9 :d 10) => ((MAC3 1 6 :D 8 :C 9 :D 10) 1 6 9 8 (:D 8 :C 9 :D 10))
; HyperSpec/Body/f_vals_l.htm
(values-list nil) => &lt;no values>
(values-list '(1)) => 1
(values-list '(1 2)) => 1, 2
(values-list '(1 2 3)) => 1, 2, 3
; HyperSpec/Body/f_rm_dup.htm
(remove-duplicates "aBcDAbCd" :test #'char-equal :from-end t) => "aBcD"
(remove-duplicates '(a b c b d d e)) => (A C B D E)
(remove-duplicates '(a b c b d d e) :from-end t) => (A B C D E)
(remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
:test #'char-equal :key #'cadr) => ((BAR #\%) (BAZ #\A))
(remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
:test #'char-equal :key #'cadr :from-end t) => ((FOO #\a) (BAR #\%))
(setq tester (list 0 1 2 3 4 5 6))
(delete-duplicates tester :key #'oddp :start 1 :end 6) => (0 4 5 6)
; HyperSpec/Body/f_subseq.htm
(setq str "012345") => "012345"
(subseq str 2) => "2345"
(subseq str 3 5) => "34"
(setf (subseq str 4) "abc") => "abc"
str => "0123ab"
(setf (subseq str 0 2) "A") => "A"
str => "A123ab"
; HyperSpec/Body/s_ret_fr.htm
(block alpha (return-from alpha) 1) => NIL
(block alpha (return-from alpha 1) 2) => 1
(block alpha (return-from alpha (values 1 2)) 3) => 1, 2
(let ((a 0))
(dotimes (i 10) (incf a) (when (oddp i) (return)))
a) => 2
(defun temp (x)
(if x (return-from temp 'dummy))
44) => TEMP
(temp nil) => 44
(temp t) => DUMMY
(block out
(flet ((exit (n) (return-from out n)))
(block out (exit 1)))
2) => 1
(block nil
(unwind-protect (return-from nil 1)
(return-from nil 2)))
=> 2
(dolist (flag '(nil t))
(block nil
(let ((x 5))
(declare (special x))
(unwind-protect (return-from nil)
(print x))))
(print 'here))
>> 5
>> HERE
>> 5
>> HERE
=> NIL
(dolist (flag '(nil t))
(block nil
(let ((x 5))
(declare (special x))
(unwind-protect
(if flag (return-from nil))
(print x))))
(print 'here))
>> 5
>> HERE
>> 5
>> HERE
=> NIL
; HyperSpec/Body/f_rm_met.htm
; HyperSpec/Body/f_disass.htm
(defun f (a) (1+ a)) => F
(eq (symbol-function 'f)
(progn (disassemble 'f)
(symbol-function 'f))) => true
; HyperSpec/Body/f_sxhash.htm
(= (sxhash (list 'list "ab")) (sxhash (list 'list "ab"))) => true
(= (sxhash "a") (sxhash (make-string 1 :initial-element #\a))) => true
(let ((r (make-random-state)))
(= (sxhash r) (sxhash (make-random-state r))))
=> implementation-dependent
; HyperSpec/Body/f_adjust.htm
(adjustable-array-p
(setq ada (adjust-array
(make-array '(2 3)
:adjustable t
:initial-contents '((a b c) (1 2 3)))
'(4 6)))) => T
(array-dimensions ada) => (4 6)
(aref ada 1 1) => 2
(setq beta (make-array '(2 3) :adjustable t))
=> #2A((NIL NIL NIL) (NIL NIL NIL))
(adjust-array beta '(4 6) :displaced-to ada)
=> #2A((A B C NIL NIL NIL)
(1 2 3 NIL NIL NIL)
(NIL NIL NIL NIL NIL NIL)
(NIL NIL NIL NIL NIL NIL))
(array-dimensions beta) => (4 6)
(aref beta 1 1) => 2
; HyperSpec/Body/m_prog_.htm
(prog* ((y z) (x (car y)))
(return x))
; HyperSpec/Body/f_docume.htm
; HyperSpec/Body/f_comple.htm
(funcall (complement #'zerop) 1) => true
(funcall (complement #'characterp) #\A) => false
(funcall (complement #'member) 'a '(a b c)) => false
(funcall (complement #'member) 'd '(a b c)) => true
; HyperSpec/Body/v_pr_bas.htm
(let ((*print-base* 24.) (*print-radix* t))
(print 23.))
>> #24rN
=> 23
(setq *print-base* 10) => 10
(setq *print-radix* nil) => NIL
(dotimes (i 35)
(let ((*print-base* (+ i 2))) ;print the decimal number 40
(write 40) ;in each base from 2 to 36
(if (zerop (mod i 10)) (terpri) (format t " "))))
>> 101000
>> 1111 220 130 104 55 50 44 40 37 34
>> 31 2C 2A 28 26 24 22 20 1J 1I
>> 1H 1G 1F 1E 1D 1C 1B 1A 19 18
>> 17 16 15 14
=> NIL
(dolist (pb '(2 3 8 10 16))
(let ((*print-radix* t) ;print the integer 10 and
(*print-base* pb)) ;the ratio 1/10 in bases 2,
(format t "~&amp;~S ~S~%" 10 1/10))) ;3, 8, 10, 16
>> #b1010 #b1/1010
>> #3r101 #3r1/101
>> #o12 #o1/12
>> 10. #10r1/10
>> #xA #x1/A
=> NIL
; HyperSpec/Body/f_mem_m.htm
(member 2 '(1 2 3)) => (2 3)
(member 2 '((1 . 2) (3 . 4)) :test-not #'= :key #'cdr) => ((3 . 4))
(member 'e '(a b c d)) => NIL
; HyperSpec/Body/f_invo_2.htm
(defun add3 (x) (check-type x number) (+ x 3))
(add3 'seven)
>> Error: The value SEVEN was not of type NUMBER.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Specify a different value to use.
>> 2: Return to Lisp Toplevel.
>> Debug> (invoke-restart-interactively 'store-value)
>> Type a form to evaluate and use: 7
=> 10
; HyperSpec/Body/m_defpar.htm
(defparameter *p* 1) => *P*
*p* => 1
(constantp '*p*) => false
(setq *p* 2) => 2
(defparameter *p* 3) => *P*
*p* => 3
(defvar *v* 1) => *V*
*v* => 1
(constantp '*v*) => false
(setq *v* 2) => 2
(defvar *v* 3) => *V*
*v* => 2
(defun foo ()
(let ((*p* 'p) (*v* 'v))
(bar))) => FOO
(defun bar () (list *p* *v*)) => BAR
(foo) => (P V)
; HyperSpec/Body/s_go.htm
(tagbody
(setq val 2)
(go lp)
(incf val 3)
lp (incf val 4)) => NIL
val => 6
; HyperSpec/Body/f_wild_p.htm
;;;The following examples are not portable. They are written to run
;;;with particular file systems and particular wildcard conventions.
;;;Other implementations will behave differently. These examples are
;;;intended to be illustrative, not to be prescriptive.
(wild-pathname-p (make-pathname :name :wild)) => true
(wild-pathname-p (make-pathname :name :wild) :name) => true
(wild-pathname-p (make-pathname :name :wild) :type) => false
(wild-pathname-p (pathname "s:>foo>**>")) => true ;Lispm
(wild-pathname-p (pathname :name "F*O")) => true ;Most places
; HyperSpec/Body/f_get__1.htm
; HyperSpec/Body/f_ld_log.htm
(translate-logical-pathname "hacks:weather;barometer.lisp.newest")
>> Error: The logical host HACKS is not defined.
(load-logical-pathname-translations "HACKS")
>> ;; Loading SYS:SITE;HACKS.TRANSLATIONS
>> ;; Loading done.
=> true
(translate-logical-pathname "hacks:weather;barometer.lisp.newest")
=> #P"HELIUM:[SHARED.HACKS.WEATHER]BAROMETER.LSP;0"
(load-logical-pathname-translations "HACKS")
=> false
; HyperSpec/Body/d_declar.htm
(declaim (declaration author target-language target-machine))
(declaim (target-language ada))
(declaim (target-machine IBM-650))
(defun strangep (x)
(declare (author "Harry Tweeker"))
(member x '(strange weird odd peculiar)))
; HyperSpec/Body/f_mod_r.htm
(rem -1 5) => -1
(mod -1 5) => 4
(mod 13 4) => 1
(rem 13 4) => 1
(mod -13 4) => 3
(rem -13 4) => -1
(mod 13 -4) => -3
(rem 13 -4) => 1
(mod -13 -4) => -1
(rem -13 -4) => -1
(mod 13.4 1) => 0.4
(rem 13.4 1) => 0.4
(mod -13.4 1) => 0.6
(rem -13.4 1) => -0.4
; HyperSpec/Body/v_intern.htm
; HyperSpec/Body/f_call_n.htm
; HyperSpec/Body/f_abs.htm
(abs 0) => 0
(abs 12/13) => 12/13
(abs -1.09) => 1.09
(abs #c(5.0 -5.0)) => 7.071068
(abs #c(5 5)) => 7.071068
(abs #c(3/5 4/5)) => 1 or approximately 1.0
(eql (abs -0.0) -0.0) => true
; HyperSpec/Body/v_pr_ppr.htm
; HyperSpec/Body/m_do_sym.htm
(make-package 'temp :use nil) => #&lt;PACKAGE "TEMP">
(intern "SHY" 'temp) => TEMP::SHY, NIL ;SHY will be an internal symbol
;in the package TEMP
(export (intern "BOLD" 'temp) 'temp) => T ;BOLD will be external
(let ((lst ()))
(do-symbols (s (find-package 'temp)) (push s lst))
lst)
=> (TEMP::SHY TEMP:BOLD)
OR=> (TEMP:BOLD TEMP::SHY)
(let ((lst ()))
(do-external-symbols (s (find-package 'temp) lst) (push s lst))
lst)
=> (TEMP:BOLD)
(let ((lst ()))
(do-all-symbols (s lst)
(when (eq (find-package 'temp) (symbol-package s)) (push s lst)))
lst)
=> (TEMP::SHY TEMP:BOLD)
OR=> (TEMP:BOLD TEMP::SHY)
; HyperSpec/Body/m_cond.htm
(defun select-options ()
(cond ((= a 1) (setq a 2))
((= a 2) (setq a 3))
((and (= a 3) (floor a 2)))
(t (floor a 3)))) => SELECT-OPTIONS
(setq a 1) => 1
(select-options) => 2
a => 2
(select-options) => 3
a => 3
(select-options) => 1
(setq a 5) => 5
(select-options) => 1, 2
; HyperSpec/Body/f_length.htm
(length "abc") => 3
(setq str (make-array '(3) :element-type 'character
:initial-contents "abc"
:fill-pointer t)) => "abc"
(length str) => 3
(setf (fill-pointer str) 2) => 2
(length str) => 2
; HyperSpec/Body/s_ld_tim.htm
;;; The function INCR1 always returns the same value, even in different images.
;;; The function INCR2 always returns the same value in a given image,
;;; but the value it returns might vary from image to image.
(defun incr1 (x) (+ x #.(random 17)))
(defun incr2 (x) (+ x (load-time-value (random 17))))
;;; The function FOO1-REF references the nth element of the first of
;;; the *FOO-ARRAYS* that is available at load time. It is permissible for
;;; that array to be modified (e.g., by SET-FOO1-REF); FOO1-REF will see the
;;; updated values.
(defvar *foo-arrays* (list (make-array 7) (make-array 8)))
(defun foo1-ref (n) (aref (load-time-value (first *my-arrays*) nil) n))
(defun set-foo1-ref (n val)
(setf (aref (load-time-value (first *my-arrays*) nil) n) val))
;;; The function BAR1-REF references the nth element of the first of
;;; the *BAR-ARRAYS* that is available at load time. The programmer has
;;; promised that the array will be treated as read-only, so the system
;;; can copy or coalesce the array.
(defvar *bar-arrays* (list (make-array 7) (make-array 8)))
(defun bar1-ref (n) (aref (load-time-value (first *my-arrays*) t) n))
;;; This use of LOAD-TIME-VALUE permits the indicated vector to be coalesced
;;; even though NIL was specified, because the object was already read-only
;;; when it was written as a literal vector rather than created by a constructor.
;;; User programs must treat the vector v as read-only.
(defun baz-ref (n)
(let ((v (load-time-value #(A B C) nil)))
(values (svref v n) v)))
;;; This use of LOAD-TIME-VALUE permits the indicated vector to be coalesced
;;; even though NIL was specified in the outer situation because T was specified
;;; in the inner situation. User programs must treat the vector v as read-only.
(defun baz-ref (n)
(let ((v (load-time-value (load-time-value (vector 1 2 3) t) nil)))
(values (svref v n) v)))
; HyperSpec/Body/f_assocc.htm
(setq values '((x . 100) (y . 200) (z . 50))) => ((X . 100) (Y . 200) (Z . 50))
(assoc 'y values) => (Y . 200)
(rplacd (assoc 'y values) 201) => (Y . 201)
(assoc 'y values) => (Y . 201)
(setq alist '((1 . "one")(2 . "two")(3 . "three")))
=> ((1 . "one") (2 . "two") (3 . "three"))
(assoc 2 alist) => (2 . "two")
(assoc-if #'evenp alist) => (2 . "two")
(assoc-if-not #'(lambda(x) (&lt; x 3)) alist) => (3 . "three")
(setq alist '(("one" . 1)("two" . 2))) => (("one" . 1) ("two" . 2))
(assoc "one" alist) => NIL
(assoc "one" alist :test #'equalp) => ("one" . 1)
(assoc "two" alist :key #'(lambda(x) (char x 2))) => NIL
(assoc #\o alist :key #'(lambda(x) (char x 2))) => ("two" . 2)
(assoc 'r '((a . b) (c . d) (r . x) (s . y) (r . z))) => (R . X)
(assoc 'goo '((foo . bar) (zoo . goo))) => NIL
(assoc '2 '((1 a b c) (2 b c d) (-7 x y z))) => (2 B C D)
(setq alist '(("one" . 1) ("2" . 2) ("three" . 3)))
=> (("one" . 1) ("2" . 2) ("three" . 3))
(assoc-if-not #'alpha-char-p alist
:key #'(lambda (x) (char x 0))) => ("2" . 2)
; HyperSpec/Body/m_or.htm
(or) => NIL
(setq temp0 nil temp1 10 temp2 20 temp3 30) => 30
(or temp0 temp1 (setq temp2 37)) => 10
temp2 => 20
(or (incf temp1) (incf temp2) (incf temp3)) => 11
temp1 => 11
temp2 => 20
temp3 => 30
(or (values) temp1) => 11
(or (values temp1 temp2) temp3) => 11
(or temp0 (values temp1 temp2)) => 11, 20
(or (values temp0 temp1) (values temp2 temp3)) => 20, 30
; HyperSpec/Body/f_symbol.htm
(symbolp 'elephant) => true
(symbolp 12) => false
(symbolp nil) => true
(symbolp '()) => true
(symbolp :test) => true
(symbolp "hello") => false
; HyperSpec/Body/f_tr_log.htm
; HyperSpec/Body/f_digit_.htm
(digit-char 0) => #\0
(digit-char 10 11) => #\A
(digit-char 10 10) => false
(digit-char 7) => #\7
(digit-char 12) => false
(digit-char 12 16) => #\C ;not #\c
(digit-char 6 2) => false
(digit-char 1 2) => #\1
; HyperSpec/Body/f_isec_.htm
(setq list1 (list 1 1 2 3 4 a b c "A" "B" "C" "d")
list2 (list 1 4 5 b c d "a" "B" "c" "D"))
=> (1 4 5 B C D "a" "B" "c" "D")
(intersection list1 list2) => (C B 4 1 1)
(intersection list1 list2 :test 'equal) => ("B" C B 4 1 1)
(intersection list1 list2 :test #'equalp) => ("d" "C" "B" "A" C B 4 1 1)
(nintersection list1 list2) => (1 1 4 B C)
list1 => implementation-dependent ;e.g., (1 1 4 B C)
list2 => implementation-dependent ;e.g., (1 4 5 B C D "a" "B" "c" "D")
(setq list1 (copy-list '((1 . 2) (2 . 3) (3 . 4) (4 . 5))))
=> ((1 . 2) (2 . 3) (3 . 4) (4 . 5))
(setq list2 (copy-list '((1 . 3) (2 . 4) (3 . 6) (4 . 8))))
=> ((1 . 3) (2 . 4) (3 . 6) (4 . 8))
(nintersection list1 list2 :key #'cdr) => ((2 . 3) (3 . 4))
list1 => implementation-dependent ;e.g., ((1 . 2) (2 . 3) (3 . 4))
list2 => implementation-dependent ;e.g., ((1 . 3) (2 . 4) (3 . 6) (4 . 8))
; HyperSpec/Body/v_rnd_st.htm
(random-state-p *random-state*) => true
(setq snap-shot (make-random-state))
;; The series from any given point is random,
;; but if you backtrack to that point, you get the same series.
(list (loop for i from 1 to 10 collect (random))
(let ((*random-state* snap-shot))
(loop for i from 1 to 10 collect (random)))
(loop for i from 1 to 10 collect (random))
(let ((*random-state* snap-shot))
(loop for i from 1 to 10 collect (random))))
=> ((19 16 44 19 96 15 76 96 13 61)
(19 16 44 19 96 15 76 96 13 61)
(16 67 0 43 70 79 58 5 63 50)
(16 67 0 43 70 79 58 5 63 50))
; HyperSpec/Body/r_muffle.htm
(defvar *all-quiet* nil) => *ALL-QUIET*
(defvar *saved-warnings* '()) => *SAVED-WARNINGS*
(defun quiet-warning-handler (c)
(when *all-quiet*
(let ((r (find-restart 'muffle-warning c)))
(when r
(push c *saved-warnings*)
(invoke-restart r)))))
=> CUSTOM-WARNING-HANDLER
(defmacro with-quiet-warnings (&amp;body forms)
`(let ((*all-quiet* t)
(*saved-warnings* '()))
(handler-bind ((warning #'quiet-warning-handler))
,@forms
*saved-warnings*)))
=> WITH-QUIET-WARNINGS
(setq saved
(with-quiet-warnings
(warn "Situation #1.")
(let ((*all-quiet* nil))
(warn "Situation #2."))
(warn "Situation #3.")))
>> Warning: Situation #2.
=> (#&lt;SIMPLE-WARNING 42744421> #&lt;SIMPLE-WARNING 42744365>)
(dolist (s saved) (format t "~&amp;~A~%" s))
>> Situation #3.
>> Situation #1.
=> NIL
; HyperSpec/Body/m_declai.htm
; HyperSpec/Body/f_string.htm
(string "already a string") => "already a string"
(string 'elm) => "ELM"
(string #\c) => "c"
; HyperSpec/Body/f_list_l.htm
(list-length '(a b c d)) => 4
(list-length '(a (b c) d)) => 3
(list-length '()) => 0
(list-length nil) => 0
(defun circular-list (&amp;rest elements)
(let ((cycle (copy-list elements)))
(nconc cycle cycle)))
(list-length (circular-list 'a 'b)) => NIL
(list-length (circular-list 'a)) => NIL
(list-length (circular-list)) => 0
; HyperSpec/Body/f_phase.htm
(phase 1) => 0.0s0
(phase 0) => 0.0s0
(phase (cis 30)) => -1.4159266
(phase #c(0 1)) => 1.5707964
; HyperSpec/Body/f_namest.htm
(namestring "getty")
=> "getty"
(setq q (make-pathname :host "kathy"
:directory
(pathname-directory *default-pathname-defaults*)
:name "getty"))
=> #S(PATHNAME :HOST "kathy" :DEVICE NIL :DIRECTORY directory-name
:NAME "getty" :TYPE NIL :VERSION NIL)
(file-namestring q) => "getty"
(directory-namestring q) => directory-name
(host-namestring q) => "kathy"
; HyperSpec/Body/f_ppr_ta.htm
; HyperSpec/Body/v_cmp_fi.htm
; HyperSpec/Body/f_get_ou.htm
(setq a-stream (make-string-output-stream)
a-string "abcdefghijklm") => "abcdefghijklm"
(write-string a-string a-stream) => "abcdefghijklm"
(get-output-stream-string a-stream) => "abcdefghijklm"
(get-output-stream-string a-stream) => ""
; HyperSpec/Body/f_mach_i.htm
(machine-instance)
=> "ACME.COM"
OR=> "S/N 123231"
OR=> "18.26.0.179"
OR=> "AA-00-04-00-A7-A4"
; HyperSpec/Body/f_file_l.htm
(with-open-file (s "decimal-digits.text"
:direction :output :if-exists :error)
(princ "0123456789" s)
(truename s))
=> #P"A:>Joe>decimal-digits.text.1"
(with-open-file (s "decimal-digits.text")
(file-length s))
=> 10
; HyperSpec/Body/f_fmakun.htm
(defun add-some (x) (+ x 19)) => ADD-SOME
(fboundp 'add-some) => true
(flet ((add-some (x) (+ x 37)))
(fmakunbound 'add-some)
(add-some 1)) => 38
(fboundp 'add-some) => false
; HyperSpec/Body/f_subtpp.htm
(subtypep 'compiled-function 'function) => true, true
(subtypep 'null 'list) => true, true
(subtypep 'null 'symbol) => true, true
(subtypep 'integer 'string) => false, true
(subtypep '(satisfies dummy) nil) => false, implementation-dependent
(subtypep '(integer 1 3) '(integer 1 4)) => true, true
(subtypep '(integer (0) (0)) 'nil) => true, true
(subtypep 'nil '(integer (0) (0))) => true, true
(subtypep '(integer (0) (0)) '(member)) => true, true ;or false, false
(subtypep '(member) 'nil) => true, true ;or false, false
(subtypep 'nil '(member)) => true, true ;or false, false
; HyperSpec/Body/v_debugg.htm
(defun one-of (choices &amp;optional (prompt "Choice"))
(let ((n (length choices)) (i))
(do ((c choices (cdr c)) (i 1 (+ i 1)))
((null c))
(format t "~&amp;[~D] ~A~%" i (car c)))
(do () ((typep i `(integer 1 ,n)))
(format t "~&amp;~A: " prompt)
(setq i (read))
(fresh-line))
(nth (- i 1) choices)))
(defun my-debugger (condition me-or-my-encapsulation)
(format t "~&amp;Fooey: ~A" condition)
(let ((restart (one-of (compute-restarts))))
(if (not restart) (error "My debugger got an error."))
(let ((*debugger-hook* me-or-my-encapsulation))
(invoke-restart-interactively restart))))
(let ((*debugger-hook* #'my-debugger))
(+ 3 'a))
>> Fooey: The argument to +, A, is not a number.
>> [1] Supply a replacement for A.
>> [2] Return to Cloe Toplevel.
>> Choice: 1
>> Form to evaluate and use: (+ 5 'b)
>> Fooey: The argument to +, B, is not a number.
>> [1] Supply a replacement for B.
>> [2] Supply a replacement for A.
>> [3] Return to Cloe Toplevel.
>> Choice: 1
>> Form to evaluate and use: 1
=> 9
; HyperSpec/Body/m_ppr_lo.htm
; HyperSpec/Body/f_eq_sle.htm
(= 3 3) is true. (/= 3 3) is false.
(= 3 5) is false. (/= 3 5) is true.
(= 3 3 3 3) is true. (/= 3 3 3 3) is false.
(= 3 3 5 3) is false. (/= 3 3 5 3) is false.
(= 3 6 5 2) is false. (/= 3 6 5 2) is true.
(= 3 2 3) is false. (/= 3 2 3) is false.
(&lt; 3 5) is true. (&lt;= 3 5) is true.
(&lt; 3 -5) is false. (&lt;= 3 -5) is false.
(&lt; 3 3) is false. (&lt;= 3 3) is true.
(&lt; 0 3 4 6 7) is true. (&lt;= 0 3 4 6 7) is true.
(&lt; 0 3 4 4 6) is false. (&lt;= 0 3 4 4 6) is true.
(> 4 3) is true. (>= 4 3) is true.
(> 4 3 2 1 0) is true. (>= 4 3 2 1 0) is true.
(> 4 3 3 2 0) is false. (>= 4 3 3 2 0) is true.
(> 4 3 1 2 0) is false. (>= 4 3 1 2 0) is false.
(= 3) is true. (/= 3) is true.
(&lt; 3) is true. (&lt;= 3) is true.
(= 3.0 #c(3.0 0.0)) is true. (/= 3.0 #c(3.0 1.0)) is true.
(= 3 3.0) is true. (= 3.0s0 3.0d0) is true.
(= 0.0 -0.0) is true. (= 5/2 2.5) is true.
(> 0.0 -0.0) is false. (= 0 -0.0) is true.
(&lt;= 0 x 9) is true if x is between 0 and 9, inclusive
(&lt; 0.0 x 1.0) is true if x is between 0.0 and 1.0, exclusive
(&lt; -1 j (length v)) is true if j is a valid array index for a vector v
; HyperSpec/Body/m_time.htm
; HyperSpec/Body/f_mapc_.htm
(mapcar #'car '((1 a) (2 b) (3 c))) => (1 2 3)
(mapcar #'abs '(3 -4 2 -5 -6)) => (3 4 2 5 6)
(mapcar #'cons '(a b c) '(1 2 3)) => ((A . 1) (B . 2) (C . 3))
(maplist #'append '(1 2 3 4) '(1 2) '(1 2 3))
=> ((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3))
(maplist #'(lambda (x) (cons 'foo x)) '(a b c d))
=> ((FOO A B C D) (FOO B C D) (FOO C D) (FOO D))
(maplist #'(lambda (x) (if (member (car x) (cdr x)) 0 1)) '(a b a c d b c))
=> (0 0 1 0 1 1 1)
;An entry is 1 if the corresponding element of the input
; list was the last instance of that element in the input list.
(setq dummy nil) => NIL
(mapc #'(lambda (&amp;rest x) (setq dummy (append dummy x)))
'(1 2 3 4)
'(a b c d e)
'(x y z)) => (1 2 3 4)
dummy => (1 A X 2 B Y 3 C Z)
(setq dummy nil) => NIL
(mapl #'(lambda (x) (push x dummy)) '(1 2 3 4)) => (1 2 3 4)
dummy => ((4) (3 4) (2 3 4) (1 2 3 4))
(mapcan #'(lambda (x y) (if (null x) nil (list x y)))
'(nil nil nil d e)
'(1 2 3 4 5 6)) => (D 4 E 5)
(mapcan #'(lambda (x) (and (numberp x) (list x)))
'(a 1 b c 3 4 d 5))
=> (1 3 4 5)
; HyperSpec/Body/f_eval.htm
(setq form '(1+ a) a 999) => 999
(eval form) => 1000
(eval 'form) => (1+ A)
(let ((a '(this would break if eval used local value))) (eval form))
=> 1000
; HyperSpec/Body/f_sinh_.htm
(sinh 0) => 0.0
(cosh (complex 0 -1)) => #C(0.540302 -0.0)
; HyperSpec/Body/f_fnp.htm
(functionp 'append) => false
(functionp #'append) => true
(functionp (symbol-function 'append)) => true
(flet ((f () 1)) (functionp #'f)) => true
(functionp (compile nil '(lambda () 259))) => true
(functionp nil) => false
(functionp 12) => false
(functionp '(lambda (x) (* x x))) => false
(functionp #'(lambda (x) (* x x))) => true
; HyperSpec/Body/f_dec_un.htm
(decode-universal-time 0 0) => 0, 0, 0, 1, 1, 1900, 0, false, 0
;; The next two examples assume Eastern Daylight Time.
(decode-universal-time 2414296800 5) => 0, 0, 1, 4, 7, 1976, 6, false, 5
(decode-universal-time 2414293200) => 0, 0, 1, 4, 7, 1976, 6, true, 5
;; This example assumes that the time zone is Eastern Daylight Time
;; (and that the time zone is constant throughout the example).
(let* ((here (nth 8 (multiple-value-list (get-decoded-time)))) ;Time zone
(recently (get-universal-time))
(a (nthcdr 7 (multiple-value-list (decode-universal-time recently))))
(b (nthcdr 7 (multiple-value-list (decode-universal-time recently here)))))
(list a b (equal a b))) => ((T 5) (NIL 5) NIL)
; HyperSpec/Body/v__stst_.htm
(values 'a1 'a2) => A1, A2
'b => B
(values 'c1 'c2 'c3) => C1, C2, C3
(list * ** ***) => (C1 B A1)
(defun cube-root (x) (expt x 1/3)) => CUBE-ROOT
(compile *) => CUBE-ROOT
(setq a (cube-root 27.0)) => 3.0
(* * 9.0) => 27.0
; HyperSpec/Body/f_butlas.htm
(setq lst '(1 2 3 4 5 6 7 8 9)) => (1 2 3 4 5 6 7 8 9)
(butlast lst) => (1 2 3 4 5 6 7 8)
(butlast lst 5) => (1 2 3 4)
(butlast lst (+ 5 5)) => NIL
lst => (1 2 3 4 5 6 7 8 9)
(nbutlast lst 3) => (1 2 3 4 5 6)
lst => (1 2 3 4 5 6)
(nbutlast lst 99) => NIL
lst => (1 2 3 4 5 6)
(butlast '(a b c d)) => (A B C)
(butlast '((a b) (c d))) => ((A B))
(butlast '(a)) => NIL
(butlast nil) => NIL
(setq foo (list 'a 'b 'c 'd)) => (A B C D)
(nbutlast foo) => (A B C)
foo => (A B C)
(nbutlast (list 'a)) => NIL
(nbutlast '()) => NIL
; HyperSpec/Body/m_w_hash.htm
(defun test-hash-table-iterator (hash-table)
(let ((all-entries '())
(generated-entries '())
(unique (list nil)))
(maphash #'(lambda (key value) (push (list key value) all-entries))
hash-table)
(with-hash-table-iterator (generator-fn hash-table)
(loop
(multiple-value-bind (more? key value) (generator-fn)
(unless more? (return))
(unless (eql value (gethash key hash-table unique))
(error "Key ~S not found for value ~S" key value))
(push (list key value) generated-entries))))
(unless (= (length all-entries)
(length generated-entries)
(length (union all-entries generated-entries
:key #'car :test (hash-table-test hash-table))))
(error "Generated entries and Maphash entries don't correspond"))
t))
; HyperSpec/Body/f_lisp_i.htm
(lisp-implementation-type)
=> "ACME Lisp"
OR=> "Joe's Common Lisp"
(lisp-implementation-version)
=> "1.3a"
=> "V2"
OR=> "Release 17.3, ECO #6"
; HyperSpec/Body/f_gentem.htm
(gentemp) => T1298
(gentemp "FOO") => FOO1299
(find-symbol "FOO1300") => NIL, NIL
(gentemp "FOO") => FOO1300
(find-symbol "FOO1300") => FOO1300, :INTERNAL
(intern "FOO1301") => FOO1301, :INTERNAL
(gentemp "FOO") => FOO1302
(gentemp) => T1303
; HyperSpec/Body/f_pn_mat.htm
; HyperSpec/Body/m_w_op_1.htm
(with-open-stream (s (make-string-input-stream "1 2 3 4"))
(+ (read s) (read s) (read s))) => 6
; HyperSpec/Body/s_setq.htm
;; A simple use of SETQ to establish values for variables.
(setq a 1 b 2 c 3) => 3
a => 1
b => 2
c => 3
;; Use of SETQ to update values by sequential assignment.
(setq a (1+ b) b (1+ a) c (+ a b)) => 7
a => 3
b => 4
c => 7
;; This illustrates the use of SETQ on a symbol macro.
(let ((x (list 10 20 30)))
(symbol-macrolet ((y (car x)) (z (cadr x)))
(setq y (1+ z) z (1+ y))
(list x y z)))
=> ((21 22 30) 21 22)
; HyperSpec/Body/f_mk_ld_.htm
(defclass obj ()
((x :initarg :x :reader obj-x)
(y :initarg :y :reader obj-y)
(dist :accessor obj-dist)))
=> #&lt;STANDARD-CLASS OBJ 250020030>
(defmethod shared-initialize :after ((self obj) slot-names &amp;rest keys)
(declare (ignore slot-names keys))
(unless (slot-boundp self 'dist)
(setf (obj-dist self)
(sqrt (+ (expt (obj-x self) 2) (expt (obj-y self) 2))))))
=> #&lt;STANDARD-METHOD SHARED-INITIALIZE (:AFTER) (OBJ T) 26266714>
(defmethod make-load-form ((self obj) &amp;optional environment)
(declare (ignore environment))
;; Note that this definition only works because X and Y do not
;; contain information which refers back to the object itself.
;; For a more general solution to this problem, see revised example below.
`(make-instance ',(class-of self)
:x ',(obj-x self) :y ',(obj-y self)))
=> #&lt;STANDARD-METHOD MAKE-LOAD-FORM (OBJ) 26267532>
(setq obj1 (make-instance 'obj :x 3.0 :y 4.0)) => #&lt;OBJ 26274136>
(obj-dist obj1) => 5.0
(make-load-form obj1) => (MAKE-INSTANCE 'OBJ :X '3.0 :Y '4.0)
; HyperSpec/Body/f_typep.htm
(typep 12 'integer) => true
(typep (1+ most-positive-fixnum) 'fixnum) => false
(typep nil t) => true
(typep nil nil) => false
(typep 1 '(mod 2)) => true
(typep #c(1 1) '(complex (eql 1))) => true
;; To understand this next example, you might need to refer to
;; Section 12.1.5.3 (Rule of Canonical Representation for Complex Rationals).
(typep #c(0 0) '(complex (eql 0))) => false
; HyperSpec/Body/v_cmp_pr.htm
; HyperSpec/Body/f_finish.htm
;; Implementation A
(progn (princ "am i seen?") (clear-output))
=> NIL
;; Implementation B
(progn (princ "am i seen?") (clear-output))
>> am i seen?
=> NIL
; HyperSpec/Body/f_cerror.htm
(defun real-sqrt (n)
(when (minusp n)
(setq n (- n))
(cerror "Return sqrt(~D) instead." "Tried to take sqrt(-~D)." n))
(sqrt n))
(real-sqrt 4)
=> 2.0
(real-sqrt -9)
>> Correctable error in REAL-SQRT: Tried to take sqrt(-9).
>> Restart options:
>> 1: Return sqrt(9) instead.
>> 2: Top level.
>> Debug> :continue 1
=> 3.0
(define-condition not-a-number (error)
((argument :reader not-a-number-argument :initarg :argument))
(:report (lambda (condition stream)
(format stream "~S is not a number."
(not-a-number-argument condition)))))
(defun assure-number (n)
(loop (when (numberp n) (return n))
(cerror "Enter a number."
'not-a-number :argument n)
(format t "~&amp;Type a number: ")
(setq n (read))
(fresh-line)))
(assure-number 'a)
>> Correctable error in ASSURE-NUMBER: A is not a number.
>> Restart options:
>> 1: Enter a number.
>> 2: Top level.
>> Debug> :continue 1
>> Type a number: 1/2
=> 1/2
(defun assure-large-number (n)
(loop (when (and (numberp n) (> n 73)) (return n))
(cerror "Enter a number~:[~; a bit larger than ~D~]."
"~*~A is not a large number."
(numberp n) n)
(format t "~&amp;Type a large number: ")
(setq n (read))
(fresh-line)))
(assure-large-number 10000)
=> 10000
(assure-large-number 'a)
>> Correctable error in ASSURE-LARGE-NUMBER: A is not a large number.
>> Restart options:
>> 1: Enter a number.
>> 2: Top level.
>> Debug> :continue 1
>> Type a large number: 88
=> 88
(assure-large-number 37)
>> Correctable error in ASSURE-LARGE-NUMBER: 37 is not a large number.
>> Restart options:
>> 1: Enter a number a bit larger than 37.
>> 2: Top level.
>> Debug> :continue 1
>> Type a large number: 259
=> 259
(define-condition not-a-large-number (error)
((argument :reader not-a-large-number-argument :initarg :argument))
(:report (lambda (condition stream)
(format stream "~S is not a large number."
(not-a-large-number-argument condition)))))
(defun assure-large-number (n)
(loop (when (and (numberp n) (> n 73)) (return n))
(cerror "Enter a number~3*~:[~; a bit larger than ~*~D~]."
'not-a-large-number
:argument n
:ignore (numberp n)
:ignore n
:allow-other-keys t)
(format t "~&amp;Type a large number: ")
(setq n (read))
(fresh-line)))
(assure-large-number 'a)
>> Correctable error in ASSURE-LARGE-NUMBER: A is not a large number.
>> Restart options:
>> 1: Enter a number.
>> 2: Top level.
>> Debug> :continue 1
>> Type a large number: 88
=> 88
(assure-large-number 37)
>> Correctable error in ASSURE-LARGE-NUMBER: A is not a large number.
>> Restart options:
>> 1: Enter a number a bit larger than 37.
>> 2: Top level.
>> Debug> :continue 1
>> Type a large number: 259
=> 259
; HyperSpec/Body/f_ar_row.htm
(setq a (make-array '(4 7) :element-type '(unsigned-byte 8)))
(array-row-major-index a 1 2) => 9
(array-row-major-index
(make-array '(2 3 4)
:element-type '(unsigned-byte 8)
:displaced-to a
:displaced-index-offset 4)
0 2 1) => 9
; HyperSpec/Body/f_broadc.htm
; HyperSpec/Body/f_countc.htm
(count #\a "how many A's are there in here?") => 2
(count-if-not #'oddp '((1) (2) (3) (4)) :key #'car) => 2
(count-if #'upper-case-p "The Crying of Lot 49" :start 4) => 2
; HyperSpec/Body/f_map_in.htm
(setq a (list 1 2 3 4) b (list 10 10 10 10)) => (10 10 10 10)
(map-into a #'+ a b) => (11 12 13 14)
a => (11 12 13 14)
b => (10 10 10 10)
(setq k '(one two three)) => (ONE TWO THREE)
(map-into a #'cons k a) => ((ONE . 11) (TWO . 12) (THREE . 13) 14)
(map-into a #'gensym) => (#:G9090 #:G9091 #:G9092 #:G9093)
a => (#:G9090 #:G9091 #:G9092 #:G9093)
; HyperSpec/Body/f_ppr_nl.htm
; HyperSpec/Body/f_rm_rm.htm
(remove 4 '(1 3 4 5 9)) => (1 3 5 9)
(remove 4 '(1 2 4 1 3 4 5)) => (1 2 1 3 5)
(remove 4 '(1 2 4 1 3 4 5) :count 1) => (1 2 1 3 4 5)
(remove 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) => (1 2 4 1 3 5)
(remove 3 '(1 2 4 1 3 4 5) :test #'>) => (4 3 4 5)
(setq lst '(list of four elements)) => (LIST OF FOUR ELEMENTS)
(setq lst2 (copy-seq lst)) => (LIST OF FOUR ELEMENTS)
(setq lst3 (delete 'four lst)) => (LIST OF ELEMENTS)
(equal lst lst2) => false
(remove-if #'oddp '(1 2 4 1 3 4 5)) => (2 4 4)
(remove-if #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t)
=> (1 2 4 1 3 5)
(remove-if-not #'evenp '(1 2 3 4 5 6 7 8 9) :count 2 :from-end t)
=> (1 2 3 4 5 6 8)
(setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5)
(delete 4 tester) => (1 2 1 3 5)
(setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5)
(delete 4 tester :count 1) => (1 2 1 3 4 5)
(setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5)
(delete 4 tester :count 1 :from-end t) => (1 2 4 1 3 5)
(setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5)
(delete 3 tester :test #'>) => (4 3 4 5)
(setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5)
(delete-if #'oddp tester) => (2 4 4)
(setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5)
(delete-if #'evenp tester :count 1 :from-end t) => (1 2 4 1 3 5)
(setq tester (list 1 2 3 4 5 6)) => (1 2 3 4 5 6)
(delete-if #'evenp tester) => (1 3 5)
tester => implementation-dependent
; HyperSpec/Body/f_pkg_us.htm
(package-use-list (make-package 'temp)) => (#&lt;PACKAGE "COMMON-LISP">)
(use-package 'common-lisp-user 'temp) => T
(package-use-list 'temp) => (#&lt;PACKAGE "COMMON-LISP"> #&lt;PACKAGE "COMMON-LISP-USER">)
; HyperSpec/Body/f_concat.htm
(concatenate 'string "all" " " "together" " " "now") => "all together now"
(concatenate 'list "ABC" '(d e f) #(1 2 3) #*1011)
=> (#\A #\B #\C D E F 1 2 3 1 0 1 1)
(concatenate 'list) => NIL
; HyperSpec/Body/f_break.htm
(break "You got here with arguments: ~:S." '(FOO 37 A))
>> BREAK: You got here with these arguments: FOO, 37, A.
>> To continue, type :CONTINUE followed by an option number:
>> 1: Return from BREAK.
>> 2: Top level.
>> Debug> :CONTINUE 1
>> Return from BREAK.
=> NIL
; HyperSpec/Body/v_rd_eva.htm
; HyperSpec/Body/f_revapp.htm
(let ((list-1 (list 1 2 3))
(list-2 (list 'a 'b 'c)))
(print (revappend list-1 list-2))
(print (equal list-1 '(1 2 3)))
(print (equal list-2 '(a b c))))
>> (3 2 1 A B C)
>> T
>> T
=> T
(revappend '(1 2 3) '()) => (3 2 1)
(revappend '(1 2 3) '(a . b)) => (3 2 1 A . B)
(revappend '() '(a b c)) => (A B C)
(revappend '(1 2 3) 'a) => (3 2 1 . A)
(revappend '() 'a) => A ;degenerate case
(let ((list-1 '(1 2 3))
(list-2 '(a b c)))
(print (nreconc list-1 list-2))
(print (equal list-1 '(1 2 3)))
(print (equal list-2 '(a b c))))
>> (3 2 1 A B C)
>> NIL
>> T
=> T
; HyperSpec/Body/f_numera.htm
(numerator 1/2) => 1
(denominator 12/36) => 3
(numerator -1) => -1
(denominator (/ -33)) => 33
(numerator (/ 8 -6)) => -4
(denominator (/ 8 -6)) => 3
; HyperSpec/Body/f_rd_del.htm
(read-delimited-list #\]) 1 2 3 4 5 6 ]
=> (1 2 3 4 5 6)
; HyperSpec/Body/f_tp_err.htm
(defun fix-digits (condition)
(check-type condition type-error)
(let* ((digits '(zero one two three four
five six seven eight nine))
(val (position (type-error-datum condition) digits)))
(if (and val (subtypep 'fixnum (type-error-expected-type condition)))
(store-value 7))))
(defun foo (x)
(handler-bind ((type-error #'fix-digits))
(check-type x number)
(+ x 3)))
(foo 'seven)
=> 10
; HyperSpec/Body/f_ar_dim.htm
(array-dimension (make-array 4) 0) => 4
(array-dimension (make-array '(2 3)) 1) => 3
; HyperSpec/Body/f_vecp.htm
(vectorp "aaaaaa") => true
(vectorp (make-array 6 :fill-pointer t)) => true
(vectorp (make-array '(2 3 4))) => false
(vectorp #*11) => true
(vectorp #b11) => false
; HyperSpec/Body/m_and.htm
(if (and (>= n 0)
(&lt; n (length a-simple-vector))
(eq (elt a-simple-vector n) 'foo))
(princ "Foo!"))
; HyperSpec/Body/f_ash.htm
(ash 16 1) => 32
(ash 16 0) => 16
(ash 16 -1) => 8
(ash -100000000000000000000000000000000 -100) => -79
; HyperSpec/Body/f_cis.htm
(cis 0) => #C(1.0 0.0)
; HyperSpec/Body/f_rdta_1.htm
(readtablep *readtable*) => true
(readtablep (copy-readtable)) => true
(readtablep '*readtable*) => false
; HyperSpec/Body/f_listen.htm
(progn (unread-char (read-char)) (list (listen) (read-char)))
>> 1
=> (T #\1)
(progn (clear-input) (listen))
=> NIL ;Unless you're a very fast typist!
; HyperSpec/Body/f_stm_er.htm
(with-input-from-string (s "(FOO")
(handler-case (read s)
(end-of-file (c)
(format nil "~&amp;End of file on ~S." (stream-error-stream c)))))
"End of file on #&lt;String Stream>."
; HyperSpec/Body/f_tp_of.htm
; HyperSpec/Body/f_gethas.htm
(setq table (make-hash-table)) => #&lt;HASH-TABLE EQL 0/120 32206334>
(gethash 1 table) => NIL, false
(gethash 1 table 2) => 2, false
(setf (gethash 1 table) "one") => "one"
(setf (gethash 2 table "two") "two") => "two"
(gethash 1 table) => "one", true
(gethash 2 table) => "two", true
(gethash nil table) => NIL, false
(setf (gethash nil table) nil) => NIL
(gethash nil table) => NIL, true
(defvar *counters* (make-hash-table)) => *COUNTERS*
(gethash 'foo *counters*) => NIL, false
(gethash 'foo *counters* 0) => 0, false
(defmacro how-many (obj) `(values (gethash ,obj *counters* 0))) => HOW-MANY
(defun count-it (obj) (incf (how-many obj))) => COUNT-IT
(dolist (x '(bar foo foo bar bar baz)) (count-it x))
(how-many 'foo) => 2
(how-many 'bar) => 3
(how-many 'quux) => 0
; HyperSpec/Body/f_apropo.htm
; HyperSpec/Body/f_find_.htm
(find #\d "here are some letters that can be looked at" :test #'char>)
=> #\Space
(find-if #'oddp '(1 2 3 4 5) :end 3 :from-end t) => 3
(find-if-not #'complexp
'#(3.5 2 #C(1.0 0.0) #C(0.0 1.0))
:start 2) => NIL
; HyperSpec/Body/f_row_ma.htm
(row-major-aref array index) ==
(aref (make-array (array-total-size array)
:displaced-to array
:element-type (array-element-type array))
index)
(aref array i1 i2 ...) ==
(row-major-aref array (array-row-major-index array i1 i2))
; HyperSpec/Body/f_aref.htm
(aref (setq alpha (make-array 4)) 3) => implementation-dependent
(setf (aref alpha 3) 'sirens) => SIRENS
(aref alpha 3) => SIRENS
(aref (setq beta (make-array '(2 4)
:element-type '(unsigned-byte 2)
:initial-contents '((0 1 2 3) (3 2 1 0))))
1 2) => 1
(setq gamma '(0 2))
(apply #'aref beta gamma) => 2
(setf (apply #'aref beta gamma) 3) => 3
(apply #'aref beta gamma) => 3
(aref beta 0 2) => 3
; HyperSpec/Body/f_kwdp.htm
(keywordp 'elephant) => false
(keywordp 12) => false
(keywordp :test) => true
(keywordp ':test) => true
(keywordp nil) => false
(keywordp :nil) => true
(keywordp '(:test)) => false
(keywordp "hello") => false
(keywordp ":hello") => false
(keywordp '&amp;optional) => false
; HyperSpec/Body/f_get.htm
(defun make-person (first-name last-name)
(let ((person (gensym "PERSON")))
(setf (get person 'first-name) first-name)
(setf (get person 'last-name) last-name)
person)) => MAKE-PERSON
(defvar *john* (make-person "John" "Dow")) => *JOHN*
*john* => #:PERSON4603
(defvar *sally* (make-person "Sally" "Jones")) => *SALLY*
(get *john* 'first-name) => "John"
(get *sally* 'last-name) => "Jones"
(defun marry (man woman married-name)
(setf (get man 'wife) woman)
(setf (get woman 'husband) man)
(setf (get man 'last-name) married-name)
(setf (get woman 'last-name) married-name)
married-name) => MARRY
(marry *john* *sally* "Dow-Jones") => "Dow-Jones"
(get *john* 'last-name) => "Dow-Jones"
(get (get *john* 'wife) 'first-name) => "Sally"
(symbol-plist *john*)
=> (WIFE #:PERSON4604 LAST-NAME "Dow-Jones" FIRST-NAME "John")
(defmacro age (person &amp;optional (default ''thirty-something))
`(get ,person 'age ,default)) => AGE
(age *john*) => THIRTY-SOMETHING
(age *john* 20) => 20
(setf (age *john*) 25) => 25
(age *john*) => 25
(age *john* 20) => 25
; HyperSpec/Body/f_unexpo.htm
(in-package "COMMON-LISP-USER") => #&lt;PACKAGE "COMMON-LISP-USER">
(export (intern "CONTRABAND" (make-package 'temp)) 'temp) => T
(find-symbol "CONTRABAND") => NIL, NIL
(use-package 'temp) => T
(find-symbol "CONTRABAND") => CONTRABAND, :INHERITED
(unexport 'contraband 'temp) => T
(find-symbol "CONTRABAND") => NIL, NIL
; HyperSpec/Body/f_get_un.htm
;; At noon on July 4, 1976 in Eastern Daylight Time.
(get-decoded-time) => 0, 0, 12, 4, 7, 1976, 6, true, 5
;; At exactly the same instant.
(get-universal-time) => 2414332800
;; Exactly five minutes later.
(get-universal-time) => 2414333100
;; The difference is 300 seconds (five minutes)
(- * **) => 300
; HyperSpec/Body/f_parse_.htm
(parse-integer "123") => 123, 3
(parse-integer "123" :start 1 :radix 5) => 13, 3
(parse-integer "no-integer" :junk-allowed t) => NIL, 0
; HyperSpec/Body/f_ar_ran.htm
(array-rank (make-array '())) => 0
(array-rank (make-array 4)) => 1
(array-rank (make-array '(4))) => 1
(array-rank (make-array '(2 3))) => 2
; HyperSpec/Body/f_random.htm
(&lt;= 0 (random 1000) 1000) => true
(let ((state1 (make-random-state))
(state2 (make-random-state)))
(= (random 1000 state1) (random 1000 state2))) => true
; HyperSpec/Body/f_mk_pkg.htm
(make-package 'temporary :nicknames '("TEMP" "temp")) => #&lt;PACKAGE "TEMPORARY">
(make-package "OWNER" :use '("temp")) => #&lt;PACKAGE "OWNER">
(package-used-by-list 'temp) => (#&lt;PACKAGE "OWNER">)
(package-use-list 'owner) => (#&lt;PACKAGE "TEMPORARY">)
; HyperSpec/Body/v_pr_cas.htm
(defun test-print-case ()
(dolist (*print-case* '(:upcase :downcase :capitalize))
(format t "~&amp;~S ~S~%" 'this-and-that '|And-something-elSE|)))
=> TEST-PC
;; Although the choice of which characters to escape is specified by
;; *PRINT-CASE*, the choice of how to escape those characters
;; (i.e., whether single escapes or multiple escapes are used)
;; is implementation-dependent. The examples here show two of the
;; many valid ways in which escaping might appear.
(test-print-case) ;Implementation A
>> THIS-AND-THAT |And-something-elSE|
>> this-and-that a\n\d-\s\o\m\e\t\h\i\n\g-\e\lse
>> This-And-That A\n\d-\s\o\m\e\t\h\i\n\g-\e\lse
=> NIL
(test-print-case) ;Implementation B
>> THIS-AND-THAT |And-something-elSE|
>> this-and-that a|nd-something-el|se
>> This-And-That A|nd-something-el|se
=> NIL
; HyperSpec/Body/f_rd_rd.htm
(read)
>> 'a
=> (QUOTE A)
(with-input-from-string (is " ") (read is nil 'the-end)) => THE-END
(defun skip-then-read-char (s c n)
(if (char= c #\{) (read s t nil t) (read-preserving-whitespace s))
(read-char-no-hang s)) => SKIP-THEN-READ-CHAR
(let ((*readtable* (copy-readtable nil)))
(set-dispatch-macro-character #\# #\{ #'skip-then-read-char)
(set-dispatch-macro-character #\# #\} #'skip-then-read-char)
(with-input-from-string (is "#{123 x #}123 y")
(format t "~S ~S" (read is) (read is)))) => #\x, #\Space, NIL
; HyperSpec/Body/f_no_nex.htm
; HyperSpec/Body/f_rati_1.htm
(rationalp 12) => true
(rationalp 6/5) => true
(rationalp 1.212) => false
; HyperSpec/Body/f_floatp.htm
(floatp 1.2d2) => true
(floatp 1.212) => true
(floatp 1.2s2) => true
(floatp (expt 2 130)) => false
; HyperSpec/Body/f_slt_un.htm
; HyperSpec/Body/f_wr_stg.htm
(prog1 (write-string "books" nil :end 4) (write-string "worms"))
>> bookworms
=> "books"
(progn (write-char #\*)
(write-line "test12" *standard-output* :end 5)
(write-line "*test2")
(write-char #\*)
nil)
>> *test1
>> *test2
>> *
=> NIL
; HyperSpec/Body/f_load.htm
;Establish a data file...
(with-open-file (str "data.in" :direction :output :if-exists :error)
(print 1 str) (print '(setq a 888) str) t)
=> T
(load "data.in") => true
a => 888
(load (setq p (merge-pathnames "data.in")) :verbose t)
; Loading contents of file /fred/data.in
; Finished loading /fred/data.in
=> true
(load p :print t)
; Loading contents of file /fred/data.in
; 1
; 888
; Finished loading /fred/data.in
=> true
; HyperSpec/Body/f_close.htm
(setq s (make-broadcast-stream)) => #&lt;BROADCAST-STREAM>
(close s) => T
(output-stream-p s) => true
; HyperSpec/Body/f_st.htm
(*) => 1
(* 3 5) => 15
(* 1.0 #c(22 33) 55/98) => #C(12.346938775510203 18.520408163265305)
; HyperSpec/Body/f_mk_stg.htm
(make-string 10 :initial-element #\5) => "5555555555"
(length (make-string 10)) => 10
; HyperSpec/Body/f_ar_tot.htm
(array-total-size (make-array 4)) => 4
(array-total-size (make-array 4 :fill-pointer 2)) => 4
(array-total-size (make-array 0)) => 0
(array-total-size (make-array '(4 2))) => 8
(array-total-size (make-array '(4 0))) => 0
(array-total-size (make-array '())) => 1
; HyperSpec/Body/f_svref.htm
(simple-vector-p (setq v (vector 1 2 'sirens))) => true
(svref v 0) => 1
(svref v 2) => SIRENS
(setf (svref v 1) 'newcomer) => NEWCOMER
v => #(1 NEWCOMER SIRENS)
; HyperSpec/Body/f_slt_mi.htm
; HyperSpec/Body/f_pn.htm
;; There is a great degree of variability permitted here. The next
;; several examples are intended to illustrate just a few of the many
;; possibilities. Whether the name is canonicalized to a particular
;; case (either upper or lower) depends on both the file system and the
;; implementation since two different implementations using the same
;; file system might differ on many issues. How information is stored
;; internally (and possibly presented in #S notation) might vary,
;; possibly requiring `accessors' such as PATHNAME-NAME to perform case
;; conversion upon access. The format of a namestring is dependent both
;; on the file system and the implementation since, for example, one
;; implementation might include the host name in a namestring, and
;; another might not. #S notation would generally only be used in a
;; situation where no appropriate namestring could be constructed for use
;; with #P.
(setq p1 (pathname "test"))
=> #P"CHOCOLATE:TEST" ; with case canonicalization (e.g., VMS)
OR=> #P"VANILLA:test" ; without case canonicalization (e.g., Unix)
OR=> #P"test"
OR=> #S(PATHNAME :HOST "STRAWBERRY" :NAME "TEST")
OR=> #S(PATHNAME :HOST "BELGIAN-CHOCOLATE" :NAME "test")
(setq p2 (pathname "test"))
=> #P"CHOCOLATE:TEST"
OR=> #P"VANILLA:test"
OR=> #P"test"
OR=> #S(PATHNAME :HOST "STRAWBERRY" :NAME "TEST")
OR=> #S(PATHNAME :HOST "BELGIAN-CHOCOLATE" :NAME "test")
(pathnamep p1) => true
(eq p1 (pathname p1)) => true
(eq p1 p2)
=> true
OR=> false
(with-open-file (stream "test" :direction :output)
(pathname stream))
=> #P"ORANGE-CHOCOLATE:>Gus>test.lisp.newest"
; HyperSpec/Body/f_upda_1.htm
(defclass position () ())
(defclass x-y-position (position)
((x :initform 0 :accessor position-x)
(y :initform 0 :accessor position-y)))
;;; It turns out polar coordinates are used more than Cartesian
;;; coordinates, so the representation is altered and some new
;;; accessor methods are added.
(defmethod update-instance-for-redefined-class :before
((pos x-y-position) added deleted plist &amp;key)
;; Transform the x-y coordinates to polar coordinates
;; and store into the new slots.
(let ((x (getf plist 'x))
(y (getf plist 'y)))
(setf (position-rho pos) (sqrt (+ (* x x) (* y y)))
(position-theta pos) (atan y x))))
(defclass x-y-position (position)
((rho :initform 0 :accessor position-rho)
(theta :initform 0 :accessor position-theta)))
;;; All instances of the old x-y-position class will be updated
;;; automatically.
;;; The new representation is given the look and feel of the old one.
(defmethod position-x ((pos x-y-position))
(with-slots (rho theta) pos (* rho (cos theta))))
(defmethod (setf position-x) (new-x (pos x-y-position))
(with-slots (rho theta) pos
(let ((y (position-y pos)))
(setq rho (sqrt (+ (* new-x new-x) (* y y)))
theta (atan y new-x))
new-x)))
(defmethod position-y ((pos x-y-position))
(with-slots (rho theta) pos (* rho (sin theta))))
(defmethod (setf position-y) (new-y (pos x-y-position))
(with-slots (rho theta) pos
(let ((x (position-x pos)))
(setq rho (sqrt (+ (* x x) (* new-y new-y)))
theta (atan new-y x))
new-y)))
; HyperSpec/Body/f_getf.htm
(setq x '()) => NIL
(getf x 'prop1) => NIL
(getf x 'prop1 7) => 7
(getf x 'prop1) => NIL
(setf (getf x 'prop1) 'val1) => VAL1
(eq (getf x 'prop1) 'val1) => true
(getf x 'prop1) => VAL1
(getf x 'prop1 7) => VAL1
x => (PROP1 VAL1)
;; Examples of implementation variation permitted.
(setq foo (list 'a 'b 'c 'd 'e 'f)) => (A B C D E F)
(setq bar (cddr foo)) => (C D E F)
(remf foo 'c) => true
foo => (A B E F)
bar
=> (C D E F)
OR=> (C)
OR=> (NIL)
OR=> (C NIL)
OR=> (C D)
; HyperSpec/Body/f_logica.htm
;;;A very simple example of setting up a logical pathname host. No
;;;translations are necessary to get around file system restrictions, so
;;;all that is necessary is to specify the root of the physical directory
;;;tree that contains the logical file system.
;;;The namestring syntax on the right-hand side is implementation-dependent.
(setf (logical-pathname-translations "foo")
'(("**;*.*.*" "MY-LISPM:>library>foo>**>")))
;;;Sample use of that logical pathname. The return value
;;;is implementation-dependent.
(translate-logical-pathname "foo:bar;baz;mum.quux.3")
=> #P"MY-LISPM:>library>foo>bar>baz>mum.quux.3"
;;;A more complex example, dividing the files among two file servers
;;;and several different directories. This Unix doesn't support
;;;:WILD-INFERIORS in the directory, so each directory level must
;;;be translated individually. No file name or type translations
;;;are required except for .MAIL to .MBX.
;;;The namestring syntax on the right-hand side is implementation-dependent.
(setf (logical-pathname-translations "prog")
'(("RELEASED;*.*.*" "MY-UNIX:/sys/bin/my-prog/")
("RELEASED;*;*.*.*" "MY-UNIX:/sys/bin/my-prog/*/")
("EXPERIMENTAL;*.*.*" "MY-UNIX:/usr/Joe/development/prog/")
("EXPERIMENTAL;DOCUMENTATION;*.*.*"
"MY-VAX:SYS$DISK:[JOE.DOC]")
("EXPERIMENTAL;*;*.*.*" "MY-UNIX:/usr/Joe/development/prog/*/")
("MAIL;**;*.MAIL" "MY-VAX:SYS$DISK:[JOE.MAIL.PROG...]*.MBX")))
;;;Sample use of that logical pathname. The return value
;;;is implementation-dependent.
(translate-logical-pathname "prog:mail;save;ideas.mail.3")
=> #P"MY-VAX:SYS$DISK:[JOE.MAIL.PROG.SAVE]IDEAS.MBX.3"
;;;Example translations for a program that uses three files main.lisp,
;;;auxiliary.lisp, and documentation.lisp. These translations might be
;;;supplied by a software supplier as examples.
;;;For Unix with long file names
(setf (logical-pathname-translations "prog")
'(("CODE;*.*.*" "/lib/prog/")))
;;;Sample use of that logical pathname. The return value
;;;is implementation-dependent.
(translate-logical-pathname "prog:code;documentation.lisp")
=> #P"/lib/prog/documentation.lisp"
;;;For Unix with 14-character file names, using .lisp as the type
(setf (logical-pathname-translations "prog")
'(("CODE;DOCUMENTATION.*.*" "/lib/prog/docum.*")
("CODE;*.*.*" "/lib/prog/")))
;;;Sample use of that logical pathname. The return value
;;;is implementation-dependent.
(translate-logical-pathname "prog:code;documentation.lisp")
=> #P"/lib/prog/docum.lisp"
;;;For Unix with 14-character file names, using .l as the type
;;;The second translation shortens the compiled file type to .b
(setf (logical-pathname-translations "prog")
`(("**;*.LISP.*" ,(logical-pathname "PROG:**;*.L.*"))
(,(compile-file-pathname (logical-pathname "PROG:**;*.LISP.*"))
,(logical-pathname "PROG:**;*.B.*"))
("CODE;DOCUMENTATION.*.*" "/lib/prog/documentatio.*")
("CODE;*.*.*" "/lib/prog/")))
;;;Sample use of that logical pathname. The return value
;;;is implementation-dependent.
(translate-logical-pathname "prog:code;documentation.lisp")
=> #P"/lib/prog/documentatio.l"
;;;For a Cray with 6 character names and no directories, types, or versions.
(setf (logical-pathname-translations "prog")
(let ((l '(("MAIN" "PGMN")
("AUXILIARY" "PGAUX")
("DOCUMENTATION" "PGDOC")))
(logpath (logical-pathname "prog:code;"))
(phypath (pathname "XXX")))
(append
;; Translations for source files
(mapcar #'(lambda (x)
(let ((log (first x))
(phy (second x)))
(list (make-pathname :name log
:type "LISP"
:version :wild
:defaults logpath)
(make-pathname :name phy
:defaults phypath))))
l)
;; Translations for compiled files
(mapcar #'(lambda (x)
(let* ((log (first x))
(phy (second x))
(com (compile-file-pathname
(make-pathname :name log
:type "LISP"
:version :wild
:defaults logpath))))
(setq phy (concatenate 'string phy "B"))
(list com
(make-pathname :name phy
:defaults phypath))))
l))))
;;;Sample use of that logical pathname. The return value
;;;is implementation-dependent.
(translate-logical-pathname "prog:code;documentation.lisp")
=> #P"PGDOC"
; HyperSpec/Body/m_defpkg.htm
(defpackage "MY-PACKAGE"
(:nicknames "MYPKG" "MY-PKG")
(:use "COMMON-LISP")
(:shadow "CAR" "CDR")
(:shadowing-import-from "VENDOR-COMMON-LISP" "CONS")
(:import-from "VENDOR-COMMON-LISP" "GC")
(:export "EQ" "CONS" "FROBOLA")
)
(defpackage my-package
(:nicknames mypkg :MY-PKG) ; remember Common Lisp conventions for case
(:use common-lisp) ; conversion on symbols
(:shadow CAR :cdr #:cons)
(:export "CONS") ; this is the shadowed one.
)
; HyperSpec/Body/m_shiftf.htm
(setq x (list 1 2 3) y 'trash) => TRASH
(shiftf y x (cdr x) '(hi there)) => TRASH
x => (2 3)
y => (1 HI THERE)
(setq x (list 'a 'b 'c)) => (A B C)
(shiftf (cadr x) 'z) => B
x => (A Z C)
(shiftf (cadr x) (cddr x) 'q) => Z
x => (A (C) . Q)
(setq n 0) => 0
(setq x (list 'a 'b 'c 'd)) => (A B C D)
(shiftf (nth (setq n (+ n 1)) x) 'z) => B
x => (A Z C D)
; HyperSpec/Body/m_rotate.htm
(let ((n 0)
(x (list 'a 'b 'c 'd 'e 'f 'g)))
(rotatef (nth (incf n) x)
(nth (incf n) x)
(nth (incf n) x))
x) => (A C D B E F G)
; HyperSpec/Body/f_deposi.htm
(deposit-field 7 (byte 2 1) 0) => 6
(deposit-field -1 (byte 4 0) 0) => 15
(deposit-field 0 (byte 2 1) -3) => -7
; HyperSpec/Body/f_lcm.htm
(lcm 10) => 10
(lcm 25 30) => 150
(lcm -24 18 10) => 360
(lcm 14 35) => 70
(lcm 0 5) => 0
(lcm 1 2 3 4 5 6) => 60
; HyperSpec/Body/f_fn_lam.htm
(function-lambda-expression #'(lambda (x) x))
=> NIL, false, NIL
OR=> NIL, true, NIL
OR=> (LAMBDA (X) X), true, NIL
OR=> (LAMBDA (X) X), false, NIL
(function-lambda-expression
(funcall #'(lambda () #'(lambda (x) x))))
=> NIL, false, NIL
OR=> NIL, true, NIL
OR=> (LAMBDA (X) X), true, NIL
OR=> (LAMBDA (X) X), false, NIL
(function-lambda-expression
(funcall #'(lambda (x) #'(lambda () x)) nil))
=> NIL, true, NIL
OR=> (LAMBDA () X), true, NIL
NOT=> NIL, false, NIL
NOT=> (LAMBDA () X), false, NIL
(flet ((foo (x) x))
(setf (symbol-function 'bar) #'foo)
(function-lambda-expression #'bar))
=> NIL, false, NIL
OR=> NIL, true, NIL
OR=> (LAMBDA (X) (BLOCK FOO X)), true, NIL
OR=> (LAMBDA (X) (BLOCK FOO X)), false, FOO
OR=> (SI::BLOCK-LAMBDA FOO (X) X), false, FOO
(defun foo ()
(flet ((bar (x) x))
#'bar))
(function-lambda-expression (foo))
=> NIL, false, NIL
OR=> NIL, true, NIL
OR=> (LAMBDA (X) (BLOCK BAR X)), true, NIL
OR=> (LAMBDA (X) (BLOCK BAR X)), true, (:INTERNAL FOO 0 BAR)
OR=> (LAMBDA (X) (BLOCK BAR X)), false, "BAR in FOO"
; HyperSpec/Body/f_ar_ele.htm
(array-element-type (make-array 4)) => T
(array-element-type (make-array 12 :element-type '(unsigned-byte 8)))
=> implementation-dependent
(array-element-type (make-array 12 :element-type '(unsigned-byte 5)))
=> implementation-dependent
; HyperSpec/Body/f_endp.htm
(endp nil) => true
(endp '(1 2)) => false
(endp (cddr '(1 2))) => true
; HyperSpec/Body/v_gensym.htm
; HyperSpec/Body/f_cp_ali.htm
(defparameter *alist* (acons 1 "one" (acons 2 "two" '())))
*alist* => ((1 . "one") (2 . "two"))
(defparameter *list-copy* (copy-list *alist*))
*list-copy* => ((1 . "one") (2 . "two"))
(defparameter *alist-copy* (copy-alist *alist*))
*alist-copy* => ((1 . "one") (2 . "two"))
(setf (cdr (assoc 2 *alist-copy*)) "deux") => "deux"
*alist-copy* => ((1 . "one") (2 . "deux"))
*alist* => ((1 . "one") (2 . "two"))
(setf (cdr (assoc 1 *list-copy*)) "uno") => "uno"
*list-copy* => ((1 . "uno") (2 . "two"))
*alist* => ((1 . "uno") (2 . "two"))
; HyperSpec/Body/v_rd_def.htm
(let ((*read-default-float-format* 'double-float))
(read-from-string "(1.0 1.0e0 1.0s0 1.0f0 1.0d0 1.0L0)"))
=> (1.0 1.0 1.0 1.0 1.0 1.0) ;Implementation has float format F.
=> (1.0 1.0 1.0s0 1.0 1.0 1.0) ;Implementation has float formats S and F.
=> (1.0d0 1.0d0 1.0 1.0 1.0d0 1.0d0) ;Implementation has float formats F and D.
=> (1.0d0 1.0d0 1.0s0 1.0 1.0d0 1.0d0) ;Implementation has float formats S, F, D.
=> (1.0d0 1.0d0 1.0 1.0 1.0d0 1.0L0) ;Implementation has float formats F, D, L.
=> (1.0d0 1.0d0 1.0s0 1.0 1.0d0 1.0L0) ;Implementation has formats S, F, D, L.
; HyperSpec/Body/m_w_in_f.htm
(with-input-from-string (s "XXX1 2 3 4xxx"
:index ind
:start 3 :end 10)
(+ (read s) (read s) (read s))) => 6
ind => 9
(with-input-from-string (s "Animal Crackers" :index j :start 6)
(read s)) => CRACKERS
; HyperSpec/Body/f_unrd_c.htm
(with-input-from-string (is "0123")
(dotimes (i 6)
(let ((c (read-char is)))
(if (evenp i) (format t "~&amp;~S ~S~%" i c) (unread-char c is)))))
>> 0 #\0
>> 2 #\1
>> 4 #\2
=> NIL
; HyperSpec/Body/m_defstr.htm
(defstruct ship
x-position
y-position
x-velocity
y-velocity
mass)
; HyperSpec/Body/f_del_pk.htm
(setq *foo-package* (make-package "FOO" :use nil))
(setq *foo-symbol* (intern "FOO" *foo-package*))
(export *foo-symbol* *foo-package*)
(setq *bar-package* (make-package "BAR" :use '("FOO")))
(setq *bar-symbol* (intern "BAR" *bar-package*))
(export *foo-symbol* *bar-package*)
(export *bar-symbol* *bar-package*)
(setq *baz-package* (make-package "BAZ" :use '("BAR")))
(symbol-package *foo-symbol*) => #&lt;PACKAGE "FOO">
(symbol-package *bar-symbol*) => #&lt;PACKAGE "BAR">
(prin1-to-string *foo-symbol*) => "FOO:FOO"
(prin1-to-string *bar-symbol*) => "BAR:BAR"
(find-symbol "FOO" *bar-package*) => FOO:FOO, :EXTERNAL
(find-symbol "FOO" *baz-package*) => FOO:FOO, :INHERITED
(find-symbol "BAR" *baz-package*) => BAR:BAR, :INHERITED
(packagep *foo-package*) => true
(packagep *bar-package*) => true
(packagep *baz-package*) => true
(package-name *foo-package*) => "FOO"
(package-name *bar-package*) => "BAR"
(package-name *baz-package*) => "BAZ"
(package-use-list *foo-package*) => ()
(package-use-list *bar-package*) => (#&lt;PACKAGE "FOO">)
(package-use-list *baz-package*) => (#&lt;PACKAGE "BAR">)
(package-used-by-list *foo-package*) => (#&lt;PACKAGE "BAR">)
(package-used-by-list *bar-package*) => (#&lt;PACKAGE "BAZ">)
(package-used-by-list *baz-package*) => ()
(delete-package *bar-package*)
>> Error: Package BAZ uses package BAR.
>> If continued, BAZ will be made to unuse-package BAR,
>> and then BAR will be deleted.
>> Type :CONTINUE to continue.
>> Debug> :CONTINUE
=> T
(symbol-package *foo-symbol*) => #&lt;PACKAGE "FOO">
(symbol-package *bar-symbol*) is unspecified
(prin1-to-string *foo-symbol*) => "FOO:FOO"
(prin1-to-string *bar-symbol*) is unspecified
(find-symbol "FOO" *bar-package*) is unspecified
(find-symbol "FOO" *baz-package*) => NIL, NIL
(find-symbol "BAR" *baz-package*) => NIL, NIL
(packagep *foo-package*) => T
(packagep *bar-package*) => T
(packagep *baz-package*) => T
(package-name *foo-package*) => "FOO"
(package-name *bar-package*) => NIL
(package-name *baz-package*) => "BAZ"
(package-use-list *foo-package*) => ()
(package-use-list *bar-package*) is unspecified
(package-use-list *baz-package*) => ()
(package-used-by-list *foo-package*) => ()
(package-used-by-list *bar-package*) is unspecified
(package-used-by-list *baz-package*) => ()
; HyperSpec/Body/f_abortc.htm
;;; Example of the ABORT retart
(defmacro abort-on-error (&amp;body forms)
`(handler-bind ((error #'abort))
,@forms)) => ABORT-ON-ERROR
(abort-on-error (+ 3 5)) => 8
(abort-on-error (error "You lose."))
>> Returned to Lisp Top Level.
;;; Example of the CONTINUE restart
(defun real-sqrt (n)
(when (minusp n)
(setq n (- n))
(cerror "Return sqrt(~D) instead." "Tried to take sqrt(-~D)." n))
(sqrt n))
(real-sqrt 4) => 2
(real-sqrt -9)
>> Error: Tried to take sqrt(-9).
>> To continue, type :CONTINUE followed by an option number:
>> 1: Return sqrt(9) instead.
>> 2: Return to Lisp Toplevel.
>> Debug> (continue)
>> Return sqrt(9) instead.
=> 3
(handler-bind ((error #'(lambda (c) (continue))))
(real-sqrt -9)) => 3
;;; Example of the MUFFLE-WARNING restart
(defun count-down (x)
(do ((counter x (1- counter)))
((= counter 0) 'done)
(when (= counter 1)
(warn "Almost done"))
(format t "~&amp;~D~%" counter)))
=> COUNT-DOWN
(count-down 3)
>> 3
>> 2
>> Warning: Almost done
>> 1
=> DONE
(defun ignore-warnings-while-counting (x)
(handler-bind ((warning #'ignore-warning))
(count-down x)))
=> IGNORE-WARNINGS-WHILE-COUNTING
(defun ignore-warning (condition)
(declare (ignore condition))
(muffle-warning))
=> IGNORE-WARNING
(ignore-warnings-while-counting 3)
>> 3
>> 2
>> 1
=> DONE
;;; Example of the STORE-VALUE and USE-VALUE restarts
(defun careful-symbol-value (symbol)
(check-type symbol symbol)
(restart-case (if (boundp symbol)
(return-from careful-symbol-value
(symbol-value symbol))
(error 'unbound-variable
:name symbol))
(use-value (value)
:report "Specify a value to use this time."
value)
(store-value (value)
:report "Specify a value to store and use in the future."
(setf (symbol-value symbol) value))))
(setq a 1234) => 1234
(careful-symbol-value 'a) => 1234
(makunbound 'a) => A
(careful-symbol-value 'a)
>> Error: A is not bound.
>> To continue, type :CONTINUE followed by an option number.
>> 1: Specify a value to use this time.
>> 2: Specify a value to store and use in the future.
>> 3: Return to Lisp Toplevel.
>> Debug> (use-value 12)
=> 12
(careful-symbol-value 'a)
>> Error: A is not bound.
>> To continue, type :CONTINUE followed by an option number.
>> 1: Specify a value to use this time.
>> 2: Specify a value to store and use in the future.
>> 3: Return to Lisp Toplevel.
>> Debug> (store-value 24)
=> 24
(careful-symbol-value 'a)
=> 24
;;; Example of the USE-VALUE restart
(defun add-symbols-with-default (default &amp;rest symbols)
(handler-bind ((sys:unbound-symbol
#'(lambda (c)
(declare (ignore c))
(use-value default))))
(apply #'+ (mapcar #'careful-symbol-value symbols))))
=> ADD-SYMBOLS-WITH-DEFAULT
(setq x 1 y 2) => 2
(add-symbols-with-default 3 'x 'y 'z) => 6
; HyperSpec/Body/f_vec_ps.htm
(vector-push (setq fable (list 'fable))
(setq fa (make-array 8
:fill-pointer 2
:initial-element 'first-one))) => 2
(fill-pointer fa) => 3
(eq (aref fa 2) fable) => true
(vector-push-extend #\X
(setq aa
(make-array 5
:element-type 'character
:adjustable t
:fill-pointer 3))) => 3
(fill-pointer aa) => 4
(vector-push-extend #\Y aa 4) => 4
(array-total-size aa) => at least 5
(vector-push-extend #\Z aa 4) => 5
(array-total-size aa) => 9 ;(or more)
; HyperSpec/Body/f_adjoin.htm
(setq slist '()) => NIL
(adjoin 'a slist) => (A)
slist => NIL
(setq slist (adjoin '(test-item 1) slist)) => ((TEST-ITEM 1))
(adjoin '(test-item 1) slist) => ((TEST-ITEM 1) (TEST-ITEM 1))
(adjoin '(test-item 1) slist :test 'equal) => ((TEST-ITEM 1))
(adjoin '(new-test-item 1) slist :key #'cadr) => ((TEST-ITEM 1))
(adjoin '(new-test-item 1) slist) => ((NEW-TEST-ITEM 1) (TEST-ITEM 1))
; HyperSpec/Body/f_chp.htm
(characterp #\a) => true
(characterp 'a) => false
(characterp "a") => false
(characterp 65.) => false
(characterp #\Newline) => true
;; This next example presupposes an implementation
;; in which #\Rubout is an implementation-defined character.
(characterp #\Rubout) => true
; HyperSpec/Body/f_slt_va.htm
(defclass foo ()
((a :accessor foo-a :initarg :a :initform 1)
(b :accessor foo-b :initarg :b)
(c :accessor foo-c :initform 3)))
=> #&lt;STANDARD-CLASS FOO 244020371>
(setq foo1 (make-instance 'foo :a 'one :b 'two))
=> #&lt;FOO 36325624>
(slot-value foo1 'a) => ONE
(slot-value foo1 'b) => TWO
(slot-value foo1 'c) => 3
(setf (slot-value foo1 'a) 'uno) => UNO
(slot-value foo1 'a) => UNO
(defmethod foo-method ((x foo))
(slot-value x 'a))
=> #&lt;STANDARD-METHOD FOO-METHOD (FOO) 42720573>
(foo-method foo1) => UNO
; HyperSpec/Body/f_char_.htm
(setq my-simple-string (make-string 6 :initial-element #\A)) => "AAAAAA"
(schar my-simple-string 4) => #\A
(setf (schar my-simple-string 4) #\B) => #\B
my-simple-string => "AAAABA"
(setq my-filled-string
(make-array 6 :element-type 'character
:fill-pointer 5
:initial-contents my-simple-string))
=> "AAAAB"
(char my-filled-string 4) => #\B
(char my-filled-string 5) => #\A
(setf (char my-filled-string 3) #\C) => #\C
(setf (char my-filled-string 5) #\D) => #\D
(setf (fill-pointer my-filled-string) 6) => 6
my-filled-string => "AAACBD"
; HyperSpec/Body/v_featur.htm
; HyperSpec/Body/m_dolist.htm
(setq temp-two '()) => NIL
(dolist (temp-one '(1 2 3 4) temp-two) (push temp-one temp-two)) => (4 3 2 1)
(setq temp-two 0) => 0
(dolist (temp-one '(1 2 3 4)) (incf temp-two)) => NIL
temp-two => 4
(dolist (x '(a b c d)) (prin1 x) (princ " "))
>> A B C D
=> NIL
; HyperSpec/Body/f_pl.htm
(+) => 0
(+ 1) => 1
(+ 31/100 69/100) => 1
(+ 1/5 0.8) => 1.0
; HyperSpec/Body/f_pr_obj.htm
; HyperSpec/Body/f_pairli.htm
(setq keys '(1 2 3)
data '("one" "two" "three")
alist '((4 . "four"))) => ((4 . "four"))
(pairlis keys data) => ((3 . "three") (2 . "two") (1 . "one"))
(pairlis keys data alist)
=> ((3 . "three") (2 . "two") (1 . "one") (4 . "four"))
alist => ((4 . "four"))
; HyperSpec/Body/f_wr_cha.htm
(write-char #\a)
>> a
=> #\a
(with-output-to-string (s)
(write-char #\a s)
(write-char #\Space s)
(write-char #\b s))
=> "a b"
; HyperSpec/Body/f_nthcdr.htm
(nthcdr 0 '()) => NIL
(nthcdr 3 '()) => NIL
(nthcdr 0 '(a b c)) => (A B C)
(nthcdr 2 '(a b c)) => (C)
(nthcdr 4 '(a b c)) => ()
(nthcdr 1 '(0 . 1)) => 1
(locally (declare (optimize (safety 3)))
(nthcdr 3 '(0 . 1)))
Error: Attempted to take CDR of 1.
; HyperSpec/Body/f_rd_seq.htm
(defvar *data* (make-array 15 :initial-element nil))
(values (read-sequence *data* (make-string-input-stream "test string")) *data*)
=> 11, #(#\t #\e #\s #\t #\Space #\s #\t #\r #\i #\n #\g NIL NIL NIL NIL)
; HyperSpec/Body/m_incf_.htm
(setq n 0)
(incf n) => 1
n => 1
(decf n 3) => -2
n => -2
(decf n -5) => 3
(decf n) => 2
(incf n 0.5) => 2.5
(decf n) => 1.5
n => 1.5
; HyperSpec/Body/f_mk_has.htm
(setq table (make-hash-table)) => #&lt;HASH-TABLE EQL 0/120 46142754>
(setf (gethash "one" table) 1) => 1
(gethash "one" table) => NIL, false
(setq table (make-hash-table :test 'equal)) => #&lt;HASH-TABLE EQUAL 0/139 46145547>
(setf (gethash "one" table) 1) => 1
(gethash "one" table) => 1, T
(make-hash-table :rehash-size 1.5 :rehash-threshold 0.7)
=> #&lt;HASH-TABLE EQL 0/120 46156620>
; HyperSpec/Body/f_wr_to_.htm
(prin1-to-string "abc") => "\"abc\""
(princ-to-string "abc") => "abc"
; HyperSpec/Body/m_handle.htm
(handler-bind ((unbound-variable #'(lambda ...))
(error #'(lambda ...)))
...)
; HyperSpec/Body/f_realpa.htm
(realpart #c(23 41)) => 23
(imagpart #c(23 41.0)) => 41.0
(realpart #c(23 41.0)) => 23.0
(imagpart 23.0) => 0.0
; HyperSpec/Body/v_pr_lev.htm
(setq a '(1 (2 (3 (4 (5 (6))))))) => (1 (2 (3 (4 (5 (6))))))
(dotimes (i 8)
(let ((*print-level* i))
(format t "~&amp;~D -- ~S~%" i a)))
>> 0 -- #
>> 1 -- (1 #)
>> 2 -- (1 (2 #))
>> 3 -- (1 (2 (3 #)))
>> 4 -- (1 (2 (3 (4 #))))
>> 5 -- (1 (2 (3 (4 (5 #)))))
>> 6 -- (1 (2 (3 (4 (5 (6))))))
>> 7 -- (1 (2 (3 (4 (5 (6))))))
=> NIL
(setq a '(1 2 3 4 5 6)) => (1 2 3 4 5 6)
(dotimes (i 7)
(let ((*print-length* i))
(format t "~&amp;~D -- ~S~%" i a)))
>> 0 -- (...)
>> 1 -- (1 ...)
>> 2 -- (1 2 ...)
>> 3 -- (1 2 3 ...)
>> 4 -- (1 2 3 4 ...)
>> 5 -- (1 2 3 4 5 6)
>> 6 -- (1 2 3 4 5 6)
=> NIL
(dolist (level-length '((0 1) (1 1) (1 2) (1 3) (1 4)
(2 1) (2 2) (2 3) (3 2) (3 3) (3 4)))
(let ((*print-level* (first level-length))
(*print-length* (second level-length)))
(format t "~&amp;~D ~D -- ~S~%"
*print-level* *print-length*
'(if (member x y) (+ (car x) 3) '(foo . #(a b c d "Baz"))))))
>> 0 1 -- #
>> 1 1 -- (IF ...)
>> 1 2 -- (IF # ...)
>> 1 3 -- (IF # # ...)
>> 1 4 -- (IF # # #)
>> 2 1 -- (IF ...)
>> 2 2 -- (IF (MEMBER X ...) ...)
>> 2 3 -- (IF (MEMBER X Y) (+ # 3) ...)
>> 3 2 -- (IF (MEMBER X ...) ...)
>> 3 3 -- (IF (MEMBER X Y) (+ (CAR X) 3) ...)
>> 3 4 -- (IF (MEMBER X Y) (+ (CAR X) 3) '(FOO . #(A B C D ...)))
=> NIL
; HyperSpec/Body/f_chg_cl.htm
(defclass position () ())
(defclass x-y-position (position)
((x :initform 0 :initarg :x)
(y :initform 0 :initarg :y)))
(defclass rho-theta-position (position)
((rho :initform 0)
(theta :initform 0)))
(defmethod update-instance-for-different-class :before ((old x-y-position)
(new rho-theta-position)
&amp;key)
;; Copy the position information from old to new to make new
;; be a rho-theta-position at the same position as old.
(let ((x (slot-value old 'x))
(y (slot-value old 'y)))
(setf (slot-value new 'rho) (sqrt (+ (* x x) (* y y)))
(slot-value new 'theta) (atan y x))))
;;; At this point an instance of the class x-y-position can be
;;; changed to be an instance of the class rho-theta-position using
;;; change-class:
(setq p1 (make-instance 'x-y-position :x 2 :y 0))
(change-class p1 'rho-theta-position)
;;; The result is that the instance bound to p1 is now an instance of
;;; the class rho-theta-position. The update-instance-for-different-class
;;; method performed the initialization of the rho and theta slots based
;;; on the value of the x and y slots, which were maintained by
;;; the old instance.
; HyperSpec/Body/s_progn.htm
(progn) => NIL
(progn 1 2 3) => 3
(progn (values 1 2 3)) => 1, 2, 3
(setq a 1) => 1
(if a
(progn (setq a nil) 'here)
(progn (setq a t) 'there)) => HERE
a => NIL
; HyperSpec/Body/f_pkgp.htm
(packagep *package*) => true
(packagep 'common-lisp) => false
(packagep (find-package 'common-lisp)) => true
; HyperSpec/Body/f_pkg_ni.htm
(package-nicknames (make-package 'temporary
:nicknames '("TEMP" "temp")))
=> ("temp" "TEMP")
; HyperSpec/Body/f_cons_1.htm
(mapcar (constantly 3) '(a b c d)) => (3 3 3 3)
(defmacro with-vars (vars &amp;body forms)
`((lambda ,vars ,@forms) ,@(mapcar (constantly nil) vars)))
=> WITH-VARS
(macroexpand '(with-vars (a b) (setq a 3 b (* a a)) (list a b)))
=> ((LAMBDA (A B) (SETQ A 3 B (* A A)) (LIST A B)) NIL NIL), true
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment