diff options
| author | Matthias Andreas Benkard <matthias@benkard.de> | 2008-07-31 09:33:25 +0200 |
|---|---|---|
| committer | Matthias Andreas Benkard <matthias@benkard.de> | 2008-07-31 09:33:25 +0200 |
| commit | 0f383318a079bd0c7bb23c909f30771b1c20b29c (patch) | |
| tree | bc4e2e9a4d5670c4d2dd3886637d11f7f4d5581c /Sacla/tests/must-reader.lisp | |
| parent | 563dd3a5963fb34903e2e209833d66a19e691d96 (diff) | |
Add Sacla to the repository.
Diffstat (limited to 'Sacla/tests/must-reader.lisp')
| -rw-r--r-- | Sacla/tests/must-reader.lisp | 3052 |
1 files changed, 3052 insertions, 0 deletions
diff --git a/Sacla/tests/must-reader.lisp b/Sacla/tests/must-reader.lisp new file mode 100644 index 0000000..d491390 --- /dev/null +++ b/Sacla/tests/must-reader.lisp @@ -0,0 +1,3052 @@ +;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp> +;; ALL RIGHTS RESERVED. +;; +;; $Id: must-reader.lisp,v 1.11 2004/08/09 02:49:54 yuji Exp $ +;; +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions +;; are met: +;; +;; * Redistributions of source code must retain the above copyright +;; notice, this list of conditions and the following disclaimer. +;; * Redistributions in binary form must reproduce the above copyright +;; notice, this list of conditions and the following disclaimer in +;; the documentation and/or other materials provided with the +;; distribution. +;; +;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + +(symbolp (read-from-string"|ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{\|}`^~|")) +(eq (read-from-string "this") 'this) +(eq (read-from-string "cl:car") 'cl:car) +(eq (read-from-string ":ok") :ok) +(eq (read-from-string "ok#") 'ok\#) +(eq (read-from-string "x#x") 'x\#x) +(eq (read-from-string "abc(x y z)") 'abc) +(multiple-value-bind (obj pos) (read-from-string "abc(x y z)") + (and (eq obj 'abc) + (equal (read-from-string "abc(x y z)" t nil :start pos) '(x y z)))) +(eq (read-from-string "abc") (read-from-string "ABC")) +(eq (read-from-string "abc") (read-from-string "|ABC|")) +(eq (read-from-string "abc") (read-from-string "a|B|c")) +(not (eq (read-from-string "abc") (read-from-string "|abc|"))) +(eq (read-from-string "abc") (read-from-string "\\A\\B\\C")) +(eq (read-from-string "abc") (read-from-string "a\\Bc")) +(eq (read-from-string "abc") (read-from-string "\\ABC")) +(not (eq (read-from-string "abc") (read-from-string "\\abc"))) + +(= 1 (eval (read-from-string "(length '(this-that))"))) +(= 3 (eval (read-from-string "(length '(this - that))"))) +(= 2 (eval (read-from-string "(length '(a + b))"))) +(= 34 (eval (read-from-string "(+ 34)"))) +(= 7 (eval (read-from-string "(+ 3 4)"))) + + +(eq :key (let ((*package* (find-package "KEYWORD"))) (read-from-string "key"))) +(progn + (when (find-package 'test-foo) (delete-package 'test-foo)) + (let ((*package* (make-package 'test-foo :use nil))) + (and (not (find-symbol "BAR")) + (eq (read-from-string "bar") (find-symbol "BAR"))))) + + + + +(= (read-from-string "1.0") 1.0) +(= (read-from-string "2/3") 2/3) +(zerop (read-from-string "0")) +(zerop (read-from-string "0.0")) +(zerop (read-from-string "0/3")) + +(null (read-from-string "()")) +(equal (read-from-string "(a)") '(a)) +(equal (read-from-string "(a b)") '(a b)) +(equal (read-from-string "(a b c)") '(a b c)) +(equal (read-from-string "(a b c d)") '(a b c d)) +(equal (read-from-string "(a b c d e)") '(a b c d e)) +(equal (read-from-string "(a b c d e f)") '(a b c d e f)) +(equal (read-from-string "(a b c d e f g)") '(a b c d e f g)) +(equal (read-from-string "(a b c d e f g h)") '(a b c d e f g h)) +(handler-case (read-from-string ".") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) +(handler-case (read-from-string "...") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(let ((*read-base* 8)) (= (read-from-string "0") 0)) +(let ((*read-base* 8)) (= (read-from-string "1") 1)) +(let ((*read-base* 8)) (= (read-from-string "2") 2)) +(let ((*read-base* 8)) (= (read-from-string "3") 3)) +(let ((*read-base* 8)) (= (read-from-string "4") 4)) +(let ((*read-base* 8)) (= (read-from-string "5") 5)) +(let ((*read-base* 8)) (= (read-from-string "6") 6)) +(let ((*read-base* 8)) (= (read-from-string "7") 7)) +(let ((*read-base* 8)) (= (read-from-string "8.") 8)) +(let ((*read-base* 8)) (= (read-from-string "10") 8)) +(let ((*read-base* 8)) (= (read-from-string "11") 9)) +(let ((*read-base* 8)) (= (read-from-string "12") 10)) +(let ((*read-base* 8)) (= (read-from-string "13") 11)) +(let ((*read-base* 8)) (= (read-from-string "14") 12)) +(let ((*read-base* 8)) (= (read-from-string "15") 13)) +(let ((*read-base* 8)) (= (read-from-string "16") 14)) +(let ((*read-base* 8)) (= (read-from-string "17") 15)) +(let ((*read-base* 8)) (= (read-from-string "20") 16)) +(let ((*read-base* 8)) (= (read-from-string "21") 17)) + +(let ((*read-base* 16)) (= (read-from-string "0") 0)) +(let ((*read-base* 16)) (= (read-from-string "1") 1)) +(let ((*read-base* 16)) (= (read-from-string "2") 2)) +(let ((*read-base* 16)) (= (read-from-string "3") 3)) +(let ((*read-base* 16)) (= (read-from-string "4") 4)) +(let ((*read-base* 16)) (= (read-from-string "5") 5)) +(let ((*read-base* 16)) (= (read-from-string "6") 6)) +(let ((*read-base* 16)) (= (read-from-string "7") 7)) +(let ((*read-base* 16)) (= (read-from-string "8") 8)) +(let ((*read-base* 16)) (= (read-from-string "9") 9)) +(let ((*read-base* 16)) (= (read-from-string "A") 10)) +(let ((*read-base* 16)) (= (read-from-string "a") 10)) +(let ((*read-base* 16)) (= (read-from-string "B") 11)) +(let ((*read-base* 16)) (= (read-from-string "b") 11)) +(let ((*read-base* 16)) (= (read-from-string "C") 12)) +(let ((*read-base* 16)) (= (read-from-string "c") 12)) +(let ((*read-base* 16)) (= (read-from-string "D") 13)) +(let ((*read-base* 16)) (= (read-from-string "d") 13)) +(let ((*read-base* 16)) (= (read-from-string "E") 14)) +(let ((*read-base* 16)) (= (read-from-string "e") 14)) +(let ((*read-base* 16)) (= (read-from-string "F") 15)) +(let ((*read-base* 16)) (= (read-from-string "f") 15)) +(let ((*read-base* 16)) (= (read-from-string "10") 16)) +(let ((*read-base* 16)) (= (read-from-string "11") 17)) +(let ((*read-base* 16)) (= (read-from-string "12") 18)) +(let ((*read-base* 16)) (= (read-from-string "13") 19)) +(let ((*read-base* 16)) (= (read-from-string "14") 20)) +(let ((*read-base* 16)) (= (read-from-string "15") 21)) +(let ((*read-base* 16)) (= (read-from-string "16") 22)) +(let ((*read-base* 16)) (= (read-from-string "17") 23)) +(let ((*read-base* 16)) (= (read-from-string "18") 24)) +(let ((*read-base* 16)) (= (read-from-string "19") 25)) +(let ((*read-base* 16)) (= (read-from-string "1A") 26)) +(let ((*read-base* 16)) (= (read-from-string "1a") 26)) +(let ((*read-base* 16)) (= (read-from-string "1B") 27)) +(let ((*read-base* 16)) (= (read-from-string "1b") 27)) +(let ((*read-base* 16)) (= (read-from-string "1C") 28)) +(let ((*read-base* 16)) (= (read-from-string "1c") 28)) +(let ((*read-base* 16)) (= (read-from-string "1D") 29)) +(let ((*read-base* 16)) (= (read-from-string "1d") 29)) +(let ((*read-base* 16)) (= (read-from-string "1E") 30)) +(let ((*read-base* 16)) (= (read-from-string "1e") 30)) +(let ((*read-base* 16)) (= (read-from-string "1F") 31)) +(let ((*read-base* 16)) (= (read-from-string "1f") 31)) +(let ((*read-base* 16)) (= (read-from-string "20") 32)) + + +(= (read-from-string "0") 0) +(= (read-from-string "+0") 0) +(= (read-from-string "-0") 0) +(integerp (read-from-string "0")) +(integerp (read-from-string "+0")) +(integerp (read-from-string "-0")) +(= (read-from-string "1") 1) +(= (read-from-string "+1") 1) +(= (read-from-string "-1") -1) +(integerp (read-from-string "1")) +(integerp (read-from-string "+1")) +(integerp (read-from-string "-1")) +(= (read-from-string "12") 12) +(= (read-from-string "+12") 12) +(= (read-from-string "-12") -12) +(integerp (read-from-string "12")) +(integerp (read-from-string "+12")) +(integerp (read-from-string "-12")) +(= (read-from-string "123") 123) +(= (read-from-string "+123") 123) +(= (read-from-string "-123") -123) +(integerp (read-from-string "123")) +(integerp (read-from-string "+123")) +(integerp (read-from-string "-123")) +(= (read-from-string "1234") 1234) +(= (read-from-string "+1234") 1234) +(= (read-from-string "-1234") -1234) +(integerp (read-from-string "1234")) +(integerp (read-from-string "+1234")) +(integerp (read-from-string "-1234")) +(= (read-from-string "12345") 12345) +(= (read-from-string "+12345") 12345) +(= (read-from-string "-12345") -12345) +(integerp (read-from-string "12345")) +(integerp (read-from-string "+12345")) +(integerp (read-from-string "-12345")) +(integerp (read-from-string "48148148031244413808971345")) +(integerp (read-from-string "+48148148031244413808971345")) +(integerp (read-from-string "-48148148031244413808971345")) + +(= (read-from-string "0.") 0) +(= (read-from-string "+0.") 0) +(= (read-from-string "-0.") 0) +(integerp (read-from-string "0.")) +(integerp (read-from-string "+0.")) +(integerp (read-from-string "-0.")) +(= (read-from-string "1.") 1) +(= (read-from-string "+1.") 1) +(= (read-from-string "-1.") -1) +(integerp (read-from-string "1.")) +(integerp (read-from-string "+1.")) +(integerp (read-from-string "-1.")) +(= (read-from-string "12.") 12) +(= (read-from-string "+12.") 12) +(= (read-from-string "-12.") -12) +(integerp (read-from-string "12.")) +(integerp (read-from-string "+12.")) +(integerp (read-from-string "-12.")) +(= (read-from-string "123.") 123) +(= (read-from-string "+123.") 123) +(= (read-from-string "-123.") -123) +(integerp (read-from-string "123.")) +(integerp (read-from-string "+123.")) +(integerp (read-from-string "-123.")) +(= (read-from-string "1234.") 1234) +(= (read-from-string "+1234.") 1234) +(= (read-from-string "-1234.") -1234) +(integerp (read-from-string "1234.")) +(integerp (read-from-string "+1234.")) +(integerp (read-from-string "-1234.")) +(= (read-from-string "12345.") 12345) +(= (read-from-string "+12345.") 12345) +(= (read-from-string "-12345.") -12345) +(integerp (read-from-string "12345.")) +(integerp (read-from-string "+12345.")) +(integerp (read-from-string "-12345.")) +(integerp (read-from-string "48148148031244413808971345.")) +(integerp (read-from-string "+48148148031244413808971345.")) +(integerp (read-from-string "-48148148031244413808971345.")) + +(zerop (let ((*read-base* 2)) (read-from-string "0"))) +(zerop (let ((*read-base* 2)) (read-from-string "+0"))) +(zerop (let ((*read-base* 2)) (read-from-string "-0"))) +(= 1 (let ((*read-base* 2)) (read-from-string "1"))) +(= 1 (let ((*read-base* 2)) (read-from-string "+1"))) +(= -1 (let ((*read-base* 2)) (read-from-string "-1"))) +(= 2 (let ((*read-base* 2)) (read-from-string "10"))) +(= 2 (let ((*read-base* 2)) (read-from-string "+10"))) +(= -2 (let ((*read-base* 2)) (read-from-string "-10"))) +(= 3 (let ((*read-base* 2)) (read-from-string "11"))) +(= 3 (let ((*read-base* 2)) (read-from-string "+11"))) +(= -3 (let ((*read-base* 2)) (read-from-string "-11"))) +(= -11 (let ((*read-base* 2)) (read-from-string "-11."))) +(integerp (let ((*read-base* 2)) (read-from-string "-11."))) +(= 21 (let ((*read-base* 2)) (read-from-string "10101"))) +(= 21 (let ((*read-base* 2)) (read-from-string "+10101"))) +(= -21 (let ((*read-base* 2)) (read-from-string "-10101"))) +(= -1.0101 (let ((*read-base* 2)) (read-from-string "-1.0101"))) +(= 1.0101 (let ((*read-base* 2)) (read-from-string "1.0101"))) +(= 123 (let ((*read-base* 2)) (read-from-string "123."))) + +(zerop (let ((*read-base* 3)) (read-from-string "0"))) +(zerop (let ((*read-base* 3)) (read-from-string "+0"))) +(zerop (let ((*read-base* 3)) (read-from-string "-0"))) +(= 1 (let ((*read-base* 3)) (read-from-string "1"))) +(= 1 (let ((*read-base* 3)) (read-from-string "+1"))) +(= -1 (let ((*read-base* 3)) (read-from-string "-1"))) +(= 2 (let ((*read-base* 3)) (read-from-string "2"))) +(= 2 (let ((*read-base* 3)) (read-from-string "+2"))) +(= -2 (let ((*read-base* 3)) (read-from-string "-2"))) +(= 3 (let ((*read-base* 3)) (read-from-string "10"))) +(= 3 (let ((*read-base* 3)) (read-from-string "+10"))) +(= -3 (let ((*read-base* 3)) (read-from-string "-10"))) +(= 4 (let ((*read-base* 3)) (read-from-string "11"))) +(= 4 (let ((*read-base* 3)) (read-from-string "+11"))) +(= -4 (let ((*read-base* 3)) (read-from-string "-11"))) +(= 5 (let ((*read-base* 3)) (read-from-string "12"))) +(= 5 (let ((*read-base* 3)) (read-from-string "+12"))) +(= -5 (let ((*read-base* 3)) (read-from-string "-12"))) +(= 6 (let ((*read-base* 3)) (read-from-string "20"))) +(= 6 (let ((*read-base* 3)) (read-from-string "+20"))) +(= -6 (let ((*read-base* 3)) (read-from-string "-20"))) +(= 7 (let ((*read-base* 3)) (read-from-string "21"))) +(= 7 (let ((*read-base* 3)) (read-from-string "+21"))) +(= -7 (let ((*read-base* 3)) (read-from-string "-21"))) +(= 8 (let ((*read-base* 3)) (read-from-string "22"))) +(= 8 (let ((*read-base* 3)) (read-from-string "+22"))) +(= -8 (let ((*read-base* 3)) (read-from-string "-22"))) + +(= 391514 (let ((*read-base* 3)) (read-from-string "201220001112"))) +(= 391514 (let ((*read-base* 3)) (read-from-string "+201220001112"))) +(= -391514 (let ((*read-base* 3)) (read-from-string "-201220001112"))) + +(zerop (let ((*read-base* 8)) (read-from-string "0"))) +(zerop (let ((*read-base* 8)) (read-from-string "+0"))) +(zerop (let ((*read-base* 8)) (read-from-string "-0"))) +(= 1 (let ((*read-base* 8)) (read-from-string "1"))) +(= 1 (let ((*read-base* 8)) (read-from-string "+1"))) +(= -1 (let ((*read-base* 8)) (read-from-string "-1"))) +(= 7 (let ((*read-base* 8)) (read-from-string "7"))) +(= 7 (let ((*read-base* 8)) (read-from-string "+7"))) +(= -7 (let ((*read-base* 8)) (read-from-string "-7"))) + + +(zerop (let ((*read-base* 16)) (read-from-string "0"))) +(zerop (let ((*read-base* 16)) (read-from-string "+0"))) +(zerop (let ((*read-base* 16)) (read-from-string "-0"))) +(= 1 (let ((*read-base* 16)) (read-from-string "1"))) +(= 1 (let ((*read-base* 16)) (read-from-string "+1"))) +(= -1 (let ((*read-base* 16)) (read-from-string "-1"))) +(= 9 (let ((*read-base* 16)) (read-from-string "9"))) +(= 9 (let ((*read-base* 16)) (read-from-string "+9"))) +(= -9 (let ((*read-base* 16)) (read-from-string "-9"))) +(= 15 (let ((*read-base* 16)) (read-from-string "F"))) +(= -15 (let ((*read-base* 16)) (read-from-string "-F"))) +(= 15 (let ((*read-base* 16)) (read-from-string "F"))) +(= 15 (let ((*read-base* 16)) (read-from-string "f"))) +(= -15 (let ((*read-base* 16)) (read-from-string "-f"))) +(= 15 (let ((*read-base* 16)) (read-from-string "f"))) +(= 31 (let ((*read-base* 16)) (read-from-string "1F"))) +(= 31 (let ((*read-base* 16)) (read-from-string "+1F"))) +(= -31 (let ((*read-base* 16)) (read-from-string "-1F"))) +(= #x3F (let ((*read-base* 16)) (read-from-string "3F"))) +(= #x3F (let ((*read-base* 16)) (read-from-string "+3F"))) +(= #x-3F (let ((*read-base* 16)) (read-from-string "-3F"))) +(= 9 (let ((*read-base* 16)) (read-from-string "9."))) +(integerp (let ((*read-base* 16)) (read-from-string "9."))) +(= 10 (let ((*read-base* 16)) (read-from-string "10."))) +(integerp (let ((*read-base* 16)) (read-from-string "10."))) + +(equal (let (stack) + (dotimes (i 6 stack) + (let ((*read-base* (+ 10. i))) + (let ((object (read-from-string "(\\DAD DAD |BEE| BEE 123. 123)"))) + (push (list *read-base* object) stack))))) + '((15 (DAD 3088 BEE 2699 123 258)) + (14 (DAD 2701 BEE BEE 123 227)) + (13 (DAD DAD BEE BEE 123 198)) + (12 (DAD DAD BEE BEE 123 171)) + (11 (DAD DAD BEE BEE 123 146)) + (10 (DAD DAD BEE BEE 123 123)))) + +(loop for i from 2 upto 32 + always (zerop (let ((*read-base* i)) (read-from-string "0")))) +(loop for i from 2 upto 32 + always (zerop (let ((*read-base* i)) (read-from-string "+0")))) +(loop for i from 2 upto 32 + always (zerop (let ((*read-base* i)) (read-from-string "-0")))) +(loop for i from 2 upto 32 + always (= 1 (let ((*read-base* i)) (read-from-string "1")))) +(loop for i from 2 upto 32 + always (= 1 (let ((*read-base* i)) (read-from-string "+1")))) +(loop for i from 2 upto 32 + always (= -1 (let ((*read-base* i)) (read-from-string "-1")))) +(loop for i from 2 upto 32 + for n = (let ((*read-base* i)) (read-from-string "10.")) + always (and (integerp n) (= 10 n))) +(loop for i from 2 upto 32 + for n = (let ((*read-base* i)) (read-from-string "+10.")) + always (and (integerp n) (= 10 n))) +(loop for i from 2 upto 32 + for n = (let ((*read-base* i)) (read-from-string "-10.")) + always (and (integerp n) (= -10 n))) +(loop for i from 2 upto 32 + for n = (let ((*read-base* i)) (read-from-string "1.1")) + always (= 1.1 n)) +(loop for i from 2 upto 32 + for n = (let ((*read-base* i)) (read-from-string "+1.1")) + always (= 1.1 n)) +(loop for i from 2 upto 32 + for n = (let ((*read-base* i)) (read-from-string "-1.1")) + always (= -1.1 n)) + +(zerop (read-from-string "0/2")) +(zerop (read-from-string "0/3")) +(zerop (read-from-string "0/4")) +(zerop (read-from-string "0/5")) +(zerop (read-from-string "0/6")) +(zerop (read-from-string "0/7")) +(zerop (read-from-string "0/8")) +(zerop (read-from-string "0/9")) +(zerop (read-from-string "0/10")) +(zerop (read-from-string "0/11")) +(zerop (read-from-string "0/12")) +(zerop (read-from-string "0/13")) +(zerop (read-from-string "0/14")) +(zerop (read-from-string "0/15")) +(zerop (read-from-string "0/16")) +(zerop (read-from-string "0/17")) +(zerop (read-from-string "0/18")) +(zerop (read-from-string "0/19")) +(zerop (read-from-string "0/20")) + +(= 1/2 (read-from-string "1/2")) +(= 1/3 (read-from-string "1/3")) +(= 1/4 (read-from-string "1/4")) +(= 1/5 (read-from-string "1/5")) +(= 1/6 (read-from-string "1/6")) +(= 1/7 (read-from-string "1/7")) +(= 1/8 (read-from-string "1/8")) +(= 1/9 (read-from-string "1/9")) +(= 1/10 (read-from-string "1/10")) +(= 1/11 (read-from-string "1/11")) +(= 1/12 (read-from-string "1/12")) +(= 1/13 (read-from-string "1/13")) +(= 1/14 (read-from-string "1/14")) +(= 1/15 (read-from-string "1/15")) +(= 1/16 (read-from-string "1/16")) +(= 1/17 (read-from-string "1/17")) +(= 1/18 (read-from-string "1/18")) +(= 1/19 (read-from-string "1/19")) +(= 1/20 (read-from-string "1/20")) + +(= 2/2 (read-from-string "2/2")) +(= 2/3 (read-from-string "2/3")) +(= 2/4 (read-from-string "2/4")) +(= 2/5 (read-from-string "2/5")) +(= 2/6 (read-from-string "2/6")) +(= 2/7 (read-from-string "2/7")) +(= 2/8 (read-from-string "2/8")) +(= 2/9 (read-from-string "2/9")) +(= 2/10 (read-from-string "2/10")) +(= 2/11 (read-from-string "2/11")) +(= 2/12 (read-from-string "2/12")) +(= 2/13 (read-from-string "2/13")) +(= 2/14 (read-from-string "2/14")) +(= 2/15 (read-from-string "2/15")) +(= 2/16 (read-from-string "2/16")) +(= 2/17 (read-from-string "2/17")) +(= 2/18 (read-from-string "2/18")) +(= 2/19 (read-from-string "2/19")) +(= 2/20 (read-from-string "2/20")) + +(= 17/2 (read-from-string "17/2")) +(= 17/3 (read-from-string "17/3")) +(= 17/4 (read-from-string "17/4")) +(= 17/5 (read-from-string "17/5")) +(= 17/6 (read-from-string "17/6")) +(= 17/7 (read-from-string "17/7")) +(= 17/8 (read-from-string "17/8")) +(= 17/9 (read-from-string "17/9")) +(= 17/10 (read-from-string "17/10")) +(= 17/11 (read-from-string "17/11")) +(= 17/12 (read-from-string "17/12")) +(= 17/13 (read-from-string "17/13")) +(= 17/14 (read-from-string "17/14")) +(= 17/15 (read-from-string "17/15")) +(= 17/16 (read-from-string "17/16")) +(= 17/17 (read-from-string "17/17")) +(= 17/18 (read-from-string "17/18")) +(= 17/19 (read-from-string "17/19")) +(= 17/20 (read-from-string "17/20")) + +(= 0 (let ((*read-base* 2)) (read-from-string "0/1"))) +(= 1 (let ((*read-base* 2)) (read-from-string "1/1"))) +(= 1/2 (let ((*read-base* 2)) (read-from-string "1/10"))) +(= 1/3 (let ((*read-base* 2)) (read-from-string "1/11"))) +(= 1/4 (let ((*read-base* 2)) (read-from-string "1/100"))) +(= 1/5 (let ((*read-base* 2)) (read-from-string "1/101"))) +(= 1/6 (let ((*read-base* 2)) (read-from-string "1/110"))) +(= 1/7 (let ((*read-base* 2)) (read-from-string "1/111"))) +(= 1/8 (let ((*read-base* 2)) (read-from-string "1/1000"))) +(= 1/9 (let ((*read-base* 2)) (read-from-string "1/1001"))) +(= 1/10 (let ((*read-base* 2)) (read-from-string "1/1010"))) +(= 1/11 (let ((*read-base* 2)) (read-from-string "1/1011"))) +(= 1/12 (let ((*read-base* 2)) (read-from-string "1/1100"))) +(= 1/13 (let ((*read-base* 2)) (read-from-string "1/1101"))) +(= 1/14 (let ((*read-base* 2)) (read-from-string "1/1110"))) +(= 1/15 (let ((*read-base* 2)) (read-from-string "1/1111"))) +(= 1/16 (let ((*read-base* 2)) (read-from-string "1/10000"))) +(= 1/17 (let ((*read-base* 2)) (read-from-string "1/10001"))) +(= 1/18 (let ((*read-base* 2)) (read-from-string "1/10010"))) +(= 1/19 (let ((*read-base* 2)) (read-from-string "1/10011"))) +(= 1/20 (let ((*read-base* 2)) (read-from-string "1/10100"))) +(= 1/21 (let ((*read-base* 2)) (read-from-string "1/10101"))) +(= 1/22 (let ((*read-base* 2)) (read-from-string "1/10110"))) +(= 1/23 (let ((*read-base* 2)) (read-from-string "1/10111"))) + +(= 2 (let ((*read-base* 2)) (read-from-string "10/1"))) +(= 2/2 (let ((*read-base* 2)) (read-from-string "10/10"))) +(= 2/3 (let ((*read-base* 2)) (read-from-string "10/11"))) +(= 2/4 (let ((*read-base* 2)) (read-from-string "10/100"))) +(= 2/5 (let ((*read-base* 2)) (read-from-string "10/101"))) +(= 2/6 (let ((*read-base* 2)) (read-from-string "10/110"))) +(= 2/7 (let ((*read-base* 2)) (read-from-string "10/111"))) +(= 2/8 (let ((*read-base* 2)) (read-from-string "10/1000"))) +(= 2/9 (let ((*read-base* 2)) (read-from-string "10/1001"))) +(= 2/10 (let ((*read-base* 2)) (read-from-string "10/1010"))) +(= 2/11 (let ((*read-base* 2)) (read-from-string "10/1011"))) +(= 2/12 (let ((*read-base* 2)) (read-from-string "10/1100"))) +(= 2/13 (let ((*read-base* 2)) (read-from-string "10/1101"))) +(= 2/14 (let ((*read-base* 2)) (read-from-string "10/1110"))) +(= 2/15 (let ((*read-base* 2)) (read-from-string "10/1111"))) +(= 2/16 (let ((*read-base* 2)) (read-from-string "10/10000"))) +(= 2/17 (let ((*read-base* 2)) (read-from-string "10/10001"))) +(= 2/18 (let ((*read-base* 2)) (read-from-string "10/10010"))) +(= 2/19 (let ((*read-base* 2)) (read-from-string "10/10011"))) +(= 2/20 (let ((*read-base* 2)) (read-from-string "10/10100"))) +(= 2/21 (let ((*read-base* 2)) (read-from-string "10/10101"))) +(= 2/22 (let ((*read-base* 2)) (read-from-string "10/10110"))) +(= 2/23 (let ((*read-base* 2)) (read-from-string "10/10111"))) + +(= 3 (let ((*read-base* 2)) (read-from-string "11/1"))) +(= 3/2 (let ((*read-base* 2)) (read-from-string "11/10"))) +(= 3/3 (let ((*read-base* 2)) (read-from-string "11/11"))) +(= 3/4 (let ((*read-base* 2)) (read-from-string "11/100"))) +(= 3/5 (let ((*read-base* 2)) (read-from-string "11/101"))) +(= 3/6 (let ((*read-base* 2)) (read-from-string "11/110"))) +(= 3/7 (let ((*read-base* 2)) (read-from-string "11/111"))) +(= 3/8 (let ((*read-base* 2)) (read-from-string "11/1000"))) +(= 3/9 (let ((*read-base* 2)) (read-from-string "11/1001"))) +(= 3/10 (let ((*read-base* 2)) (read-from-string "11/1010"))) +(= 3/11 (let ((*read-base* 2)) (read-from-string "11/1011"))) +(= 3/12 (let ((*read-base* 2)) (read-from-string "11/1100"))) +(= 3/13 (let ((*read-base* 2)) (read-from-string "11/1101"))) +(= 3/14 (let ((*read-base* 2)) (read-from-string "11/1110"))) +(= 3/15 (let ((*read-base* 2)) (read-from-string "11/1111"))) +(= 3/16 (let ((*read-base* 2)) (read-from-string "11/10000"))) +(= 3/17 (let ((*read-base* 2)) (read-from-string "11/10001"))) +(= 3/18 (let ((*read-base* 2)) (read-from-string "11/10010"))) +(= 3/19 (let ((*read-base* 2)) (read-from-string "11/10011"))) +(= 3/20 (let ((*read-base* 2)) (read-from-string "11/10100"))) +(= 3/21 (let ((*read-base* 2)) (read-from-string "11/10101"))) +(= 3/22 (let ((*read-base* 2)) (read-from-string "11/10110"))) +(= 3/23 (let ((*read-base* 2)) (read-from-string "11/10111"))) + +(= 0 (let ((*read-base* 8)) (read-from-string "0/1"))) +(= 1/2 (let ((*read-base* 8)) (read-from-string "1/2"))) +(= 1/3 (let ((*read-base* 8)) (read-from-string "1/3"))) +(= 1/4 (let ((*read-base* 8)) (read-from-string "1/4"))) +(= 1/5 (let ((*read-base* 8)) (read-from-string "1/5"))) +(= 1/6 (let ((*read-base* 8)) (read-from-string "1/6"))) +(= 1/7 (let ((*read-base* 8)) (read-from-string "1/7"))) +(= 1/8 (let ((*read-base* 8)) (read-from-string "1/10"))) +(= 1/9 (let ((*read-base* 8)) (read-from-string "1/11"))) +(= 1/10 (let ((*read-base* 8)) (read-from-string "1/12"))) +(= 1/11 (let ((*read-base* 8)) (read-from-string "1/13"))) +(= 1/12 (let ((*read-base* 8)) (read-from-string "1/14"))) +(= 1/13 (let ((*read-base* 8)) (read-from-string "1/15"))) +(= 1/14 (let ((*read-base* 8)) (read-from-string "1/16"))) +(= 1/15 (let ((*read-base* 8)) (read-from-string "1/17"))) +(= 1/16 (let ((*read-base* 8)) (read-from-string "1/20"))) +(= 1/17 (let ((*read-base* 8)) (read-from-string "1/21"))) +(= 1/18 (let ((*read-base* 8)) (read-from-string "1/22"))) +(= 1/19 (let ((*read-base* 8)) (read-from-string "1/23"))) +(= 1/20 (let ((*read-base* 8)) (read-from-string "1/24"))) + +(= 3/2 (let ((*read-base* 8)) (read-from-string "3/2"))) +(= 3/3 (let ((*read-base* 8)) (read-from-string "3/3"))) +(= 3/4 (let ((*read-base* 8)) (read-from-string "3/4"))) +(= 3/5 (let ((*read-base* 8)) (read-from-string "3/5"))) +(= 3/6 (let ((*read-base* 8)) (read-from-string "3/6"))) +(= 3/7 (let ((*read-base* 8)) (read-from-string "3/7"))) +(= 3/8 (let ((*read-base* 8)) (read-from-string "3/10"))) +(= 3/9 (let ((*read-base* 8)) (read-from-string "3/11"))) +(= 3/10 (let ((*read-base* 8)) (read-from-string "3/12"))) +(= 3/11 (let ((*read-base* 8)) (read-from-string "3/13"))) +(= 3/12 (let ((*read-base* 8)) (read-from-string "3/14"))) +(= 3/13 (let ((*read-base* 8)) (read-from-string "3/15"))) +(= 3/14 (let ((*read-base* 8)) (read-from-string "3/16"))) +(= 3/15 (let ((*read-base* 8)) (read-from-string "3/17"))) +(= 3/16 (let ((*read-base* 8)) (read-from-string "3/20"))) +(= 3/17 (let ((*read-base* 8)) (read-from-string "3/21"))) +(= 3/18 (let ((*read-base* 8)) (read-from-string "3/22"))) +(= 3/19 (let ((*read-base* 8)) (read-from-string "3/23"))) +(= 3/20 (let ((*read-base* 8)) (read-from-string "3/24"))) + +(= 13/2 (let ((*read-base* 8)) (read-from-string "15/2"))) +(= 13/3 (let ((*read-base* 8)) (read-from-string "15/3"))) +(= 13/4 (let ((*read-base* 8)) (read-from-string "15/4"))) +(= 13/5 (let ((*read-base* 8)) (read-from-string "15/5"))) +(= 13/6 (let ((*read-base* 8)) (read-from-string "15/6"))) +(= 13/7 (let ((*read-base* 8)) (read-from-string "15/7"))) +(= 13/8 (let ((*read-base* 8)) (read-from-string "15/10"))) +(= 13/9 (let ((*read-base* 8)) (read-from-string "15/11"))) +(= 13/10 (let ((*read-base* 8)) (read-from-string "15/12"))) +(= 13/11 (let ((*read-base* 8)) (read-from-string "15/13"))) +(= 13/12 (let ((*read-base* 8)) (read-from-string "15/14"))) +(= 13/13 (let ((*read-base* 8)) (read-from-string "15/15"))) +(= 13/14 (let ((*read-base* 8)) (read-from-string "15/16"))) +(= 13/15 (let ((*read-base* 8)) (read-from-string "15/17"))) +(= 13/16 (let ((*read-base* 8)) (read-from-string "15/20"))) +(= 13/17 (let ((*read-base* 8)) (read-from-string "15/21"))) +(= 13/18 (let ((*read-base* 8)) (read-from-string "15/22"))) +(= 13/19 (let ((*read-base* 8)) (read-from-string "15/23"))) +(= 13/20 (let ((*read-base* 8)) (read-from-string "15/24"))) + + +(= 0 (let ((*read-base* 16)) (read-from-string "0/1"))) +(= 1/2 (let ((*read-base* 16)) (read-from-string "1/2"))) +(= 1/3 (let ((*read-base* 16)) (read-from-string "1/3"))) +(= 1/4 (let ((*read-base* 16)) (read-from-string "1/4"))) +(= 1/5 (let ((*read-base* 16)) (read-from-string "1/5"))) +(= 1/6 (let ((*read-base* 16)) (read-from-string "1/6"))) +(= 1/7 (let ((*read-base* 16)) (read-from-string "1/7"))) +(= 1/8 (let ((*read-base* 16)) (read-from-string "1/8"))) +(= 1/9 (let ((*read-base* 16)) (read-from-string "1/9"))) +(= 1/10 (let ((*read-base* 16)) (read-from-string "1/A"))) +(= 1/11 (let ((*read-base* 16)) (read-from-string "1/B"))) +(= 1/12 (let ((*read-base* 16)) (read-from-string "1/C"))) +(= 1/13 (let ((*read-base* 16)) (read-from-string "1/D"))) +(= 1/14 (let ((*read-base* 16)) (read-from-string "1/E"))) +(= 1/15 (let ((*read-base* 16)) (read-from-string "1/F"))) +(= 1/10 (let ((*read-base* 16)) (read-from-string "1/a"))) +(= 1/11 (let ((*read-base* 16)) (read-from-string "1/b"))) +(= 1/12 (let ((*read-base* 16)) (read-from-string "1/c"))) +(= 1/13 (let ((*read-base* 16)) (read-from-string "1/d"))) +(= 1/14 (let ((*read-base* 16)) (read-from-string "1/e"))) +(= 1/15 (let ((*read-base* 16)) (read-from-string "1/f"))) +(= 1/16 (let ((*read-base* 16)) (read-from-string "1/10"))) +(= 1/17 (let ((*read-base* 16)) (read-from-string "1/11"))) +(= 1/18 (let ((*read-base* 16)) (read-from-string "1/12"))) +(= 1/19 (let ((*read-base* 16)) (read-from-string "1/13"))) +(= 1/20 (let ((*read-base* 16)) (read-from-string "1/14"))) +(= 1/21 (let ((*read-base* 16)) (read-from-string "1/15"))) +(= 1/22 (let ((*read-base* 16)) (read-from-string "1/16"))) +(= 1/23 (let ((*read-base* 16)) (read-from-string "1/17"))) +(= 1/24 (let ((*read-base* 16)) (read-from-string "1/18"))) +(= 1/25 (let ((*read-base* 16)) (read-from-string "1/19"))) +(= 1/26 (let ((*read-base* 16)) (read-from-string "1/1A"))) +(= 1/27 (let ((*read-base* 16)) (read-from-string "1/1B"))) +(= 1/28 (let ((*read-base* 16)) (read-from-string "1/1C"))) +(= 1/29 (let ((*read-base* 16)) (read-from-string "1/1D"))) +(= 1/30 (let ((*read-base* 16)) (read-from-string "1/1E"))) +(= 1/31 (let ((*read-base* 16)) (read-from-string "1/1F"))) +(= 1/32 (let ((*read-base* 16)) (read-from-string "1/20"))) +(= 1/33 (let ((*read-base* 16)) (read-from-string "1/21"))) +(= 1/34 (let ((*read-base* 16)) (read-from-string "1/22"))) +(= 1/35 (let ((*read-base* 16)) (read-from-string "1/23"))) +(= 1/36 (let ((*read-base* 16)) (read-from-string "1/24"))) + +(= 2/2 (let ((*read-base* 16)) (read-from-string "2/2"))) +(= 2/3 (let ((*read-base* 16)) (read-from-string "2/3"))) +(= 2/4 (let ((*read-base* 16)) (read-from-string "2/4"))) +(= 2/5 (let ((*read-base* 16)) (read-from-string "2/5"))) +(= 2/6 (let ((*read-base* 16)) (read-from-string "2/6"))) +(= 2/7 (let ((*read-base* 16)) (read-from-string "2/7"))) +(= 2/8 (let ((*read-base* 16)) (read-from-string "2/8"))) +(= 2/9 (let ((*read-base* 16)) (read-from-string "2/9"))) +(= 2/10 (let ((*read-base* 16)) (read-from-string "2/A"))) +(= 2/11 (let ((*read-base* 16)) (read-from-string "2/B"))) +(= 2/12 (let ((*read-base* 16)) (read-from-string "2/C"))) +(= 2/13 (let ((*read-base* 16)) (read-from-string "2/D"))) +(= 2/14 (let ((*read-base* 16)) (read-from-string "2/E"))) +(= 2/15 (let ((*read-base* 16)) (read-from-string "2/F"))) +(= 2/10 (let ((*read-base* 16)) (read-from-string "2/a"))) +(= 2/11 (let ((*read-base* 16)) (read-from-string "2/b"))) +(= 2/12 (let ((*read-base* 16)) (read-from-string "2/c"))) +(= 2/13 (let ((*read-base* 16)) (read-from-string "2/d"))) +(= 2/14 (let ((*read-base* 16)) (read-from-string "2/e"))) +(= 2/15 (let ((*read-base* 16)) (read-from-string "2/f"))) +(= 2/16 (let ((*read-base* 16)) (read-from-string "2/10"))) +(= 2/17 (let ((*read-base* 16)) (read-from-string "2/11"))) +(= 2/18 (let ((*read-base* 16)) (read-from-string "2/12"))) +(= 2/19 (let ((*read-base* 16)) (read-from-string "2/13"))) +(= 2/20 (let ((*read-base* 16)) (read-from-string "2/14"))) +(= 2/21 (let ((*read-base* 16)) (read-from-string "2/15"))) +(= 2/22 (let ((*read-base* 16)) (read-from-string "2/16"))) +(= 2/23 (let ((*read-base* 16)) (read-from-string "2/17"))) +(= 2/24 (let ((*read-base* 16)) (read-from-string "2/18"))) +(= 2/25 (let ((*read-base* 16)) (read-from-string "2/19"))) +(= 2/26 (let ((*read-base* 16)) (read-from-string "2/1A"))) +(= 2/27 (let ((*read-base* 16)) (read-from-string "2/1B"))) +(= 2/28 (let ((*read-base* 16)) (read-from-string "2/1C"))) +(= 2/29 (let ((*read-base* 16)) (read-from-string "2/1D"))) +(= 2/30 (let ((*read-base* 16)) (read-from-string "2/1E"))) +(= 2/31 (let ((*read-base* 16)) (read-from-string "2/1F"))) +(= 2/32 (let ((*read-base* 16)) (read-from-string "2/20"))) +(= 2/33 (let ((*read-base* 16)) (read-from-string "2/21"))) +(= 2/34 (let ((*read-base* 16)) (read-from-string "2/22"))) +(= 2/35 (let ((*read-base* 16)) (read-from-string "2/23"))) +(= 2/36 (let ((*read-base* 16)) (read-from-string "2/24"))) + + +(= 10/2 (let ((*read-base* 16)) (read-from-string "a/2"))) +(= 10/3 (let ((*read-base* 16)) (read-from-string "a/3"))) +(= 10/4 (let ((*read-base* 16)) (read-from-string "a/4"))) +(= 10/5 (let ((*read-base* 16)) (read-from-string "a/5"))) +(= 10/6 (let ((*read-base* 16)) (read-from-string "a/6"))) +(= 10/7 (let ((*read-base* 16)) (read-from-string "a/7"))) +(= 10/8 (let ((*read-base* 16)) (read-from-string "a/8"))) +(= 10/9 (let ((*read-base* 16)) (read-from-string "a/9"))) +(= 10/10 (let ((*read-base* 16)) (read-from-string "a/A"))) +(= 10/11 (let ((*read-base* 16)) (read-from-string "a/B"))) +(= 10/12 (let ((*read-base* 16)) (read-from-string "a/C"))) +(= 10/13 (let ((*read-base* 16)) (read-from-string "a/D"))) +(= 10/14 (let ((*read-base* 16)) (read-from-string "a/E"))) +(= 10/15 (let ((*read-base* 16)) (read-from-string "a/F"))) +(= 10/10 (let ((*read-base* 16)) (read-from-string "a/a"))) +(= 10/11 (let ((*read-base* 16)) (read-from-string "a/b"))) +(= 10/12 (let ((*read-base* 16)) (read-from-string "a/c"))) +(= 10/13 (let ((*read-base* 16)) (read-from-string "a/d"))) +(= 10/14 (let ((*read-base* 16)) (read-from-string "a/e"))) +(= 10/15 (let ((*read-base* 16)) (read-from-string "a/f"))) +(= 10/16 (let ((*read-base* 16)) (read-from-string "a/10"))) +(= 10/17 (let ((*read-base* 16)) (read-from-string "a/11"))) +(= 10/18 (let ((*read-base* 16)) (read-from-string "a/12"))) +(= 10/19 (let ((*read-base* 16)) (read-from-string "a/13"))) +(= 10/20 (let ((*read-base* 16)) (read-from-string "a/14"))) +(= 10/21 (let ((*read-base* 16)) (read-from-string "a/15"))) +(= 10/22 (let ((*read-base* 16)) (read-from-string "a/16"))) +(= 10/23 (let ((*read-base* 16)) (read-from-string "a/17"))) +(= 10/24 (let ((*read-base* 16)) (read-from-string "a/18"))) +(= 10/25 (let ((*read-base* 16)) (read-from-string "a/19"))) +(= 10/26 (let ((*read-base* 16)) (read-from-string "a/1A"))) +(= 10/27 (let ((*read-base* 16)) (read-from-string "a/1B"))) +(= 10/28 (let ((*read-base* 16)) (read-from-string "a/1C"))) +(= 10/29 (let ((*read-base* 16)) (read-from-string "a/1D"))) +(= 10/30 (let ((*read-base* 16)) (read-from-string "a/1E"))) +(= 10/31 (let ((*read-base* 16)) (read-from-string "a/1F"))) +(= 10/32 (let ((*read-base* 16)) (read-from-string "a/20"))) +(= 10/33 (let ((*read-base* 16)) (read-from-string "a/21"))) +(= 10/34 (let ((*read-base* 16)) (read-from-string "a/22"))) +(= 10/35 (let ((*read-base* 16)) (read-from-string "a/23"))) +(= 10/36 (let ((*read-base* 16)) (read-from-string "a/24"))) + + +(= 35/2 (let ((*read-base* 16)) (read-from-string "23/2"))) +(= 35/3 (let ((*read-base* 16)) (read-from-string "23/3"))) +(= 35/4 (let ((*read-base* 16)) (read-from-string "23/4"))) +(= 35/5 (let ((*read-base* 16)) (read-from-string "23/5"))) +(= 35/6 (let ((*read-base* 16)) (read-from-string "23/6"))) +(= 35/7 (let ((*read-base* 16)) (read-from-string "23/7"))) +(= 35/8 (let ((*read-base* 16)) (read-from-string "23/8"))) +(= 35/9 (let ((*read-base* 16)) (read-from-string "23/9"))) +(= 35/10 (let ((*read-base* 16)) (read-from-string "23/A"))) +(= 35/11 (let ((*read-base* 16)) (read-from-string "23/B"))) +(= 35/12 (let ((*read-base* 16)) (read-from-string "23/C"))) +(= 35/13 (let ((*read-base* 16)) (read-from-string "23/D"))) +(= 35/14 (let ((*read-base* 16)) (read-from-string "23/E"))) +(= 35/15 (let ((*read-base* 16)) (read-from-string "23/F"))) +(= 35/10 (let ((*read-base* 16)) (read-from-string "23/a"))) +(= 35/11 (let ((*read-base* 16)) (read-from-string "23/b"))) +(= 35/12 (let ((*read-base* 16)) (read-from-string "23/c"))) +(= 35/13 (let ((*read-base* 16)) (read-from-string "23/d"))) +(= 35/14 (let ((*read-base* 16)) (read-from-string "23/e"))) +(= 35/15 (let ((*read-base* 16)) (read-from-string "23/f"))) +(= 35/16 (let ((*read-base* 16)) (read-from-string "23/10"))) +(= 35/17 (let ((*read-base* 16)) (read-from-string "23/11"))) +(= 35/18 (let ((*read-base* 16)) (read-from-string "23/12"))) +(= 35/19 (let ((*read-base* 16)) (read-from-string "23/13"))) +(= 35/20 (let ((*read-base* 16)) (read-from-string "23/14"))) +(= 35/21 (let ((*read-base* 16)) (read-from-string "23/15"))) +(= 35/22 (let ((*read-base* 16)) (read-from-string "23/16"))) +(= 35/23 (let ((*read-base* 16)) (read-from-string "23/17"))) +(= 35/24 (let ((*read-base* 16)) (read-from-string "23/18"))) +(= 35/25 (let ((*read-base* 16)) (read-from-string "23/19"))) +(= 35/26 (let ((*read-base* 16)) (read-from-string "23/1A"))) +(= 35/27 (let ((*read-base* 16)) (read-from-string "23/1B"))) +(= 35/28 (let ((*read-base* 16)) (read-from-string "23/1C"))) +(= 35/29 (let ((*read-base* 16)) (read-from-string "23/1D"))) +(= 35/30 (let ((*read-base* 16)) (read-from-string "23/1E"))) +(= 35/31 (let ((*read-base* 16)) (read-from-string "23/1F"))) +(= 35/32 (let ((*read-base* 16)) (read-from-string "23/20"))) +(= 35/33 (let ((*read-base* 16)) (read-from-string "23/21"))) +(= 35/34 (let ((*read-base* 16)) (read-from-string "23/22"))) +(= 35/35 (let ((*read-base* 16)) (read-from-string "23/23"))) +(= 35/36 (let ((*read-base* 16)) (read-from-string "23/24"))) + +(= 110/2 (let ((*read-base* 16)) (read-from-string "6E/2"))) +(= 110/3 (let ((*read-base* 16)) (read-from-string "6E/3"))) +(= 110/4 (let ((*read-base* 16)) (read-from-string "6E/4"))) +(= 110/5 (let ((*read-base* 16)) (read-from-string "6E/5"))) +(= 110/6 (let ((*read-base* 16)) (read-from-string "6E/6"))) +(= 110/7 (let ((*read-base* 16)) (read-from-string "6E/7"))) +(= 110/8 (let ((*read-base* 16)) (read-from-string "6E/8"))) +(= 110/9 (let ((*read-base* 16)) (read-from-string "6E/9"))) +(= 110/10 (let ((*read-base* 16)) (read-from-string "6E/A"))) +(= 110/11 (let ((*read-base* 16)) (read-from-string "6E/B"))) +(= 110/12 (let ((*read-base* 16)) (read-from-string "6E/C"))) +(= 110/13 (let ((*read-base* 16)) (read-from-string "6E/D"))) +(= 110/14 (let ((*read-base* 16)) (read-from-string "6E/E"))) +(= 110/15 (let ((*read-base* 16)) (read-from-string "6E/F"))) +(= 110/10 (let ((*read-base* 16)) (read-from-string "6E/a"))) +(= 110/11 (let ((*read-base* 16)) (read-from-string "6E/b"))) +(= 110/12 (let ((*read-base* 16)) (read-from-string "6E/c"))) +(= 110/13 (let ((*read-base* 16)) (read-from-string "6E/d"))) +(= 110/14 (let ((*read-base* 16)) (read-from-string "6E/e"))) +(= 110/15 (let ((*read-base* 16)) (read-from-string "6E/f"))) +(= 110/16 (let ((*read-base* 16)) (read-from-string "6E/10"))) +(= 110/17 (let ((*read-base* 16)) (read-from-string "6E/11"))) +(= 110/18 (let ((*read-base* 16)) (read-from-string "6E/12"))) +(= 110/19 (let ((*read-base* 16)) (read-from-string "6E/13"))) +(= 110/20 (let ((*read-base* 16)) (read-from-string "6E/14"))) +(= 110/21 (let ((*read-base* 16)) (read-from-string "6E/15"))) +(= 110/22 (let ((*read-base* 16)) (read-from-string "6E/16"))) +(= 110/23 (let ((*read-base* 16)) (read-from-string "6E/17"))) +(= 110/24 (let ((*read-base* 16)) (read-from-string "6E/18"))) +(= 110/25 (let ((*read-base* 16)) (read-from-string "6E/19"))) +(= 110/26 (let ((*read-base* 16)) (read-from-string "6E/1A"))) +(= 110/27 (let ((*read-base* 16)) (read-from-string "6E/1B"))) +(= 110/28 (let ((*read-base* 16)) (read-from-string "6E/1C"))) +(= 110/29 (let ((*read-base* 16)) (read-from-string "6E/1D"))) +(= 110/30 (let ((*read-base* 16)) (read-from-string "6E/1E"))) +(= 110/31 (let ((*read-base* 16)) (read-from-string "6E/1F"))) +(= 110/32 (let ((*read-base* 16)) (read-from-string "6E/20"))) +(= 110/33 (let ((*read-base* 16)) (read-from-string "6E/21"))) +(= 110/34 (let ((*read-base* 16)) (read-from-string "6E/22"))) +(= 110/35 (let ((*read-base* 16)) (read-from-string "6E/23"))) +(= 110/36 (let ((*read-base* 16)) (read-from-string "6E/24"))) + +(= 11/1111111111111111111111111111111111 + (read-from-string "11/1111111111111111111111111111111111")) + + +;; float ::= [sign] {decimal-digit}* decimal-point {decimal-digit}+ [exponent] +;; | [sign] {decimal-digit}+ [decimal-point {decimal-digit}*] exponent +(let ((f (read-from-string "0.0"))) (and (floatp f) (zerop f))) +(let ((f (read-from-string "+0.0"))) (and (floatp f) (zerop f))) +(let ((f (read-from-string "-0.0"))) (and (floatp f) (zerop f))) + +(let ((f (read-from-string ".0"))) (and (floatp f) (zerop f))) +(let ((f (read-from-string "+.0"))) (and (floatp f) (zerop f))) +(let ((f (read-from-string "-.0"))) (and (floatp f) (zerop f))) + +(let ((f (read-from-string "1.0"))) (and (floatp f) (= 1.0 f))) +(let ((f (read-from-string "+1.0"))) (and (floatp f) (= 1.0 f))) +(let ((f (read-from-string "-1.0"))) (and (floatp f) (= -1.0 f))) + +(let ((f (read-from-string "1d1"))) (and (floatp f) (= 1d1 f))) +(let ((f (read-from-string "1e1"))) (and (floatp f) (= 1e1 f))) +(let ((f (read-from-string "1f1"))) (and (floatp f) (= 1f1 f))) +(let ((f (read-from-string "1l1"))) (and (floatp f) (= 1l1 f))) +(let ((f (read-from-string "1s1"))) (and (floatp f) (= 1s1 f))) +(LET ((F (READ-FROM-STRING "1D1"))) (AND (FLOATP F) (= 1D1 F))) +(LET ((F (READ-FROM-STRING "1E1"))) (AND (FLOATP F) (= 1E1 F))) +(LET ((F (READ-FROM-STRING "1F1"))) (AND (FLOATP F) (= 1F1 F))) +(LET ((F (READ-FROM-STRING "1L1"))) (AND (FLOATP F) (= 1L1 F))) +(LET ((F (READ-FROM-STRING "1S1"))) (AND (FLOATP F) (= 1S1 F))) + +(let ((f (read-from-string "1d+1"))) (and (floatp f) (= 1d1 f))) +(let ((f (read-from-string "1e+1"))) (and (floatp f) (= 1e1 f))) +(let ((f (read-from-string "1f+1"))) (and (floatp f) (= 1f1 f))) +(let ((f (read-from-string "1l+1"))) (and (floatp f) (= 1l1 f))) +(let ((f (read-from-string "1s+1"))) (and (floatp f) (= 1s1 f))) +(LET ((F (READ-FROM-STRING "1D+1"))) (AND (FLOATP F) (= 1D1 F))) +(LET ((F (READ-FROM-STRING "1E+1"))) (AND (FLOATP F) (= 1E1 F))) +(LET ((F (READ-FROM-STRING "1F+1"))) (AND (FLOATP F) (= 1F1 F))) +(LET ((F (READ-FROM-STRING "1L+1"))) (AND (FLOATP F) (= 1L1 F))) +(LET ((F (READ-FROM-STRING "1S+1"))) (AND (FLOATP F) (= 1S1 F))) + +(let ((f (read-from-string "1d-1"))) (and (floatp f) (= 1d-1 f))) +(let ((f (read-from-string "1e-1"))) (and (floatp f) (= 1e-1 f))) +(let ((f (read-from-string "1f-1"))) (and (floatp f) (= 1f-1 f))) +(let ((f (read-from-string "1l-1"))) (and (floatp f) (= 1l-1 f))) +(let ((f (read-from-string "1s-1"))) (and (floatp f) (= 1s-1 f))) +(LET ((F (READ-FROM-STRING "1D-1"))) (AND (FLOATP F) (= 1D-1 F))) +(LET ((F (READ-FROM-STRING "1E-1"))) (AND (FLOATP F) (= 1E-1 F))) +(LET ((F (READ-FROM-STRING "1F-1"))) (AND (FLOATP F) (= 1F-1 F))) +(LET ((F (READ-FROM-STRING "1L-1"))) (AND (FLOATP F) (= 1L-1 F))) +(LET ((F (READ-FROM-STRING "1S-1"))) (AND (FLOATP F) (= 1S-1 F))) + + +(let ((f (read-from-string "+1d1"))) (and (floatp f) (= 1d1 f))) +(let ((f (read-from-string "+1e1"))) (and (floatp f) (= 1e1 f))) +(let ((f (read-from-string "+1f1"))) (and (floatp f) (= 1f1 f))) +(let ((f (read-from-string "+1l1"))) (and (floatp f) (= 1l1 f))) +(let ((f (read-from-string "+1s1"))) (and (floatp f) (= 1s1 f))) +(LET ((F (READ-FROM-STRING "+1D1"))) (AND (FLOATP F) (= 1D1 F))) +(LET ((F (READ-FROM-STRING "+1E1"))) (AND (FLOATP F) (= 1E1 F))) +(LET ((F (READ-FROM-STRING "+1F1"))) (AND (FLOATP F) (= 1F1 F))) +(LET ((F (READ-FROM-STRING "+1L1"))) (AND (FLOATP F) (= 1L1 F))) +(LET ((F (READ-FROM-STRING "+1S1"))) (AND (FLOATP F) (= 1S1 F))) + +(let ((f (read-from-string "+1d+1"))) (and (floatp f) (= 1d1 f))) +(let ((f (read-from-string "+1e+1"))) (and (floatp f) (= 1e1 f))) +(let ((f (read-from-string "+1f+1"))) (and (floatp f) (= 1f1 f))) +(let ((f (read-from-string "+1l+1"))) (and (floatp f) (= 1l1 f))) +(let ((f (read-from-string "+1s+1"))) (and (floatp f) (= 1s1 f))) +(LET ((F (READ-FROM-STRING "+1D+1"))) (AND (FLOATP F) (= 1D1 F))) +(LET ((F (READ-FROM-STRING "+1E+1"))) (AND (FLOATP F) (= 1E1 F))) +(LET ((F (READ-FROM-STRING "+1F+1"))) (AND (FLOATP F) (= 1F1 F))) +(LET ((F (READ-FROM-STRING "+1L+1"))) (AND (FLOATP F) (= 1L1 F))) +(LET ((F (READ-FROM-STRING "+1S+1"))) (AND (FLOATP F) (= 1S1 F))) + +(let ((f (read-from-string "+1d-1"))) (and (floatp f) (= 1d-1 f))) +(let ((f (read-from-string "+1e-1"))) (and (floatp f) (= 1e-1 f))) +(let ((f (read-from-string "+1f-1"))) (and (floatp f) (= 1f-1 f))) +(let ((f (read-from-string "+1l-1"))) (and (floatp f) (= 1l-1 f))) +(let ((f (read-from-string "+1s-1"))) (and (floatp f) (= 1s-1 f))) +(LET ((F (READ-FROM-STRING "+1D-1"))) (AND (FLOATP F) (= 1D-1 F))) +(LET ((F (READ-FROM-STRING "+1E-1"))) (AND (FLOATP F) (= 1E-1 F))) +(LET ((F (READ-FROM-STRING "+1F-1"))) (AND (FLOATP F) (= 1F-1 F))) +(LET ((F (READ-FROM-STRING "+1L-1"))) (AND (FLOATP F) (= 1L-1 F))) +(LET ((F (READ-FROM-STRING "+1S-1"))) (AND (FLOATP F) (= 1S-1 F))) + + +(let ((f (read-from-string "-1d1"))) (and (floatp f) (= -1d1 f))) +(let ((f (read-from-string "-1e1"))) (and (floatp f) (= -1e1 f))) +(let ((f (read-from-string "-1f1"))) (and (floatp f) (= -1f1 f))) +(let ((f (read-from-string "-1l1"))) (and (floatp f) (= -1l1 f))) +(let ((f (read-from-string "-1s1"))) (and (floatp f) (= -1s1 f))) +(LET ((F (READ-FROM-STRING "-1D1"))) (AND (FLOATP F) (= -1D1 F))) +(LET ((F (READ-FROM-STRING "-1E1"))) (AND (FLOATP F) (= -1E1 F))) +(LET ((F (READ-FROM-STRING "-1F1"))) (AND (FLOATP F) (= -1F1 F))) +(LET ((F (READ-FROM-STRING "-1L1"))) (AND (FLOATP F) (= -1L1 F))) +(LET ((F (READ-FROM-STRING "-1S1"))) (AND (FLOATP F) (= -1S1 F))) + +(let ((f (read-from-string "-1d+1"))) (and (floatp f) (= -1d1 f))) +(let ((f (read-from-string "-1e+1"))) (and (floatp f) (= -1e1 f))) +(let ((f (read-from-string "-1f+1"))) (and (floatp f) (= -1f1 f))) +(let ((f (read-from-string "-1l+1"))) (and (floatp f) (= -1l1 f))) +(let ((f (read-from-string "-1s+1"))) (and (floatp f) (= -1s1 f))) +(LET ((F (READ-FROM-STRING "-1D+1"))) (AND (FLOATP F) (= -1D1 F))) +(LET ((F (READ-FROM-STRING "-1E+1"))) (AND (FLOATP F) (= -1E1 F))) +(LET ((F (READ-FROM-STRING "-1F+1"))) (AND (FLOATP F) (= -1F1 F))) +(LET ((F (READ-FROM-STRING "-1L+1"))) (AND (FLOATP F) (= -1L1 F))) +(LET ((F (READ-FROM-STRING "-1S+1"))) (AND (FLOATP F) (= -1S1 F))) + +(let ((f (read-from-string "-1d-1"))) (and (floatp f) (= -1d-1 f))) +(let ((f (read-from-string "-1e-1"))) (and (floatp f) (= -1e-1 f))) +(let ((f (read-from-string "-1f-1"))) (and (floatp f) (= -1f-1 f))) +(let ((f (read-from-string "-1l-1"))) (and (floatp f) (= -1l-1 f))) +(let ((f (read-from-string "-1s-1"))) (and (floatp f) (= -1s-1 f))) +(LET ((F (READ-FROM-STRING "-1D-1"))) (AND (FLOATP F) (= -1D-1 F))) +(LET ((F (READ-FROM-STRING "-1E-1"))) (AND (FLOATP F) (= -1E-1 F))) +(LET ((F (READ-FROM-STRING "-1F-1"))) (AND (FLOATP F) (= -1F-1 F))) +(LET ((F (READ-FROM-STRING "-1L-1"))) (AND (FLOATP F) (= -1L-1 F))) +(LET ((F (READ-FROM-STRING "-1S-1"))) (AND (FLOATP F) (= -1S-1 F))) + + +(let ((f (read-from-string "1d10"))) (and (floatp f) (= 1d10 f))) +(let ((f (read-from-string "1e10"))) (and (floatp f) (= 1e10 f))) +(let ((f (read-from-string "1f10"))) (and (floatp f) (= 1f10 f))) +(let ((f (read-from-string "1l10"))) (and (floatp f) (= 1l10 f))) +(let ((f (read-from-string "1s10"))) (and (floatp f) (= 1s10 f))) +(LET ((F (READ-FROM-STRING "1D10"))) (AND (FLOATP F) (= 1D10 F))) +(LET ((F (READ-FROM-STRING "1E10"))) (AND (FLOATP F) (= 1E10 F))) +(LET ((F (READ-FROM-STRING "1F10"))) (AND (FLOATP F) (= 1F10 F))) +(LET ((F (READ-FROM-STRING "1L10"))) (AND (FLOATP F) (= 1L10 F))) +(LET ((F (READ-FROM-STRING "1S10"))) (AND (FLOATP F) (= 1S10 F))) + +(let ((f (read-from-string "1d+10"))) (and (floatp f) (= 1d10 f))) +(let ((f (read-from-string "1e+10"))) (and (floatp f) (= 1e10 f))) +(let ((f (read-from-string "1f+10"))) (and (floatp f) (= 1f10 f))) +(let ((f (read-from-string "1l+10"))) (and (floatp f) (= 1l10 f))) +(let ((f (read-from-string "1s+10"))) (and (floatp f) (= 1s10 f))) +(LET ((F (READ-FROM-STRING "1D+10"))) (AND (FLOATP F) (= 1D10 F))) +(LET ((F (READ-FROM-STRING "1E+10"))) (AND (FLOATP F) (= 1E10 F))) +(LET ((F (READ-FROM-STRING "1F+10"))) (AND (FLOATP F) (= 1F10 F))) +(LET ((F (READ-FROM-STRING "1L+10"))) (AND (FLOATP F) (= 1L10 F))) +(LET ((F (READ-FROM-STRING "1S+10"))) (AND (FLOATP F) (= 1S10 F))) + +(let ((f (read-from-string "1d-10"))) (and (floatp f) (= 1d-10 f))) +(let ((f (read-from-string "1e-10"))) (and (floatp f) (= 1e-10 f))) +(let ((f (read-from-string "1f-10"))) (and (floatp f) (= 1f-10 f))) +(let ((f (read-from-string "1l-10"))) (and (floatp f) (= 1l-10 f))) +(let ((f (read-from-string "1s-10"))) (and (floatp f) (= 1s-10 f))) +(LET ((F (READ-FROM-STRING "1D-10"))) (AND (FLOATP F) (= 1D-10 F))) +(LET ((F (READ-FROM-STRING "1E-10"))) (AND (FLOATP F) (= 1E-10 F))) +(LET ((F (READ-FROM-STRING "1F-10"))) (AND (FLOATP F) (= 1F-10 F))) +(LET ((F (READ-FROM-STRING "1L-10"))) (AND (FLOATP F) (= 1L-10 F))) +(LET ((F (READ-FROM-STRING "1S-10"))) (AND (FLOATP F) (= 1S-10 F))) + + +(let ((f (read-from-string "+1d10"))) (and (floatp f) (= 1d10 f))) +(let ((f (read-from-string "+1e10"))) (and (floatp f) (= 1e10 f))) +(let ((f (read-from-string "+1f10"))) (and (floatp f) (= 1f10 f))) +(let ((f (read-from-string "+1l10"))) (and (floatp f) (= 1l10 f))) +(let ((f (read-from-string "+1s10"))) (and (floatp f) (= 1s10 f))) +(LET ((F (READ-FROM-STRING "+1D10"))) (AND (FLOATP F) (= 1D10 F))) +(LET ((F (READ-FROM-STRING "+1E10"))) (AND (FLOATP F) (= 1E10 F))) +(LET ((F (READ-FROM-STRING "+1F10"))) (AND (FLOATP F) (= 1F10 F))) +(LET ((F (READ-FROM-STRING "+1L10"))) (AND (FLOATP F) (= 1L10 F))) +(LET ((F (READ-FROM-STRING "+1S10"))) (AND (FLOATP F) (= 1S10 F))) + +(let ((f (read-from-string "+1d+10"))) (and (floatp f) (= 1d10 f))) +(let ((f (read-from-string "+1e+10"))) (and (floatp f) (= 1e10 f))) +(let ((f (read-from-string "+1f+10"))) (and (floatp f) (= 1f10 f))) +(let ((f (read-from-string "+1l+10"))) (and (floatp f) (= 1l10 f))) +(let ((f (read-from-string "+1s+10"))) (and (floatp f) (= 1s10 f))) +(LET ((F (READ-FROM-STRING "+1D+10"))) (AND (FLOATP F) (= 1D10 F))) +(LET ((F (READ-FROM-STRING "+1E+10"))) (AND (FLOATP F) (= 1E10 F))) +(LET ((F (READ-FROM-STRING "+1F+10"))) (AND (FLOATP F) (= 1F10 F))) +(LET ((F (READ-FROM-STRING "+1L+10"))) (AND (FLOATP F) (= 1L10 F))) +(LET ((F (READ-FROM-STRING "+1S+10"))) (AND (FLOATP F) (= 1S10 F))) + +(let ((f (read-from-string "+1d-10"))) (and (floatp f) (= 1d-10 f))) +(let ((f (read-from-string "+1e-10"))) (and (floatp f) (= 1e-10 f))) +(let ((f (read-from-string "+1f-10"))) (and (floatp f) (= 1f-10 f))) +(let ((f (read-from-string "+1l-10"))) (and (floatp f) (= 1l-10 f))) +(let ((f (read-from-string "+1s-10"))) (and (floatp f) (= 1s-10 f))) +(LET ((F (READ-FROM-STRING "+1D-10"))) (AND (FLOATP F) (= 1D-10 F))) +(LET ((F (READ-FROM-STRING "+1E-10"))) (AND (FLOATP F) (= 1E-10 F))) +(LET ((F (READ-FROM-STRING "+1F-10"))) (AND (FLOATP F) (= 1F-10 F))) +(LET ((F (READ-FROM-STRING "+1L-10"))) (AND (FLOATP F) (= 1L-10 F))) +(LET ((F (READ-FROM-STRING "+1S-10"))) (AND (FLOATP F) (= 1S-10 F))) + + +(let ((f (read-from-string "-1d10"))) (and (floatp f) (= -1d10 f))) +(let ((f (read-from-string "-1e10"))) (and (floatp f) (= -1e10 f))) +(let ((f (read-from-string "-1f10"))) (and (floatp f) (= -1f10 f))) +(let ((f (read-from-string "-1l10"))) (and (floatp f) (= -1l10 f))) +(let ((f (read-from-string "-1s10"))) (and (floatp f) (= -1s10 f))) +(LET ((F (READ-FROM-STRING "-1D10"))) (AND (FLOATP F) (= -1D10 F))) +(LET ((F (READ-FROM-STRING "-1E10"))) (AND (FLOATP F) (= -1E10 F))) +(LET ((F (READ-FROM-STRING "-1F10"))) (AND (FLOATP F) (= -1F10 F))) +(LET ((F (READ-FROM-STRING "-1L10"))) (AND (FLOATP F) (= -1L10 F))) +(LET ((F (READ-FROM-STRING "-1S10"))) (AND (FLOATP F) (= -1S10 F))) + +(let ((f (read-from-string "-1d+10"))) (and (floatp f) (= -1d10 f))) +(let ((f (read-from-string "-1e+10"))) (and (floatp f) (= -1e10 f))) +(let ((f (read-from-string "-1f+10"))) (and (floatp f) (= -1f10 f))) +(let ((f (read-from-string "-1l+10"))) (and (floatp f) (= -1l10 f))) +(let ((f (read-from-string "-1s+10"))) (and (floatp f) (= -1s10 f))) +(LET ((F (READ-FROM-STRING "-1D+10"))) (AND (FLOATP F) (= -1D10 F))) +(LET ((F (READ-FROM-STRING "-1E+10"))) (AND (FLOATP F) (= -1E10 F))) +(LET ((F (READ-FROM-STRING "-1F+10"))) (AND (FLOATP F) (= -1F10 F))) +(LET ((F (READ-FROM-STRING "-1L+10"))) (AND (FLOATP F) (= -1L10 F))) +(LET ((F (READ-FROM-STRING "-1S+10"))) (AND (FLOATP F) (= -1S10 F))) + +(let ((f (read-from-string "-1d-10"))) (and (floatp f) (= -1d-10 f))) +(let ((f (read-from-string "-1e-10"))) (and (floatp f) (= -1e-10 f))) +(let ((f (read-from-string "-1f-10"))) (and (floatp f) (= -1f-10 f))) +(let ((f (read-from-string "-1l-10"))) (and (floatp f) (= -1l-10 f))) +(let ((f (read-from-string "-1s-10"))) (and (floatp f) (= -1s-10 f))) +(LET ((F (READ-FROM-STRING "-1D-10"))) (AND (FLOATP F) (= -1D-10 F))) +(LET ((F (READ-FROM-STRING "-1E-10"))) (AND (FLOATP F) (= -1E-10 F))) +(LET ((F (READ-FROM-STRING "-1F-10"))) (AND (FLOATP F) (= -1F-10 F))) +(LET ((F (READ-FROM-STRING "-1L-10"))) (AND (FLOATP F) (= -1L-10 F))) +(LET ((F (READ-FROM-STRING "-1S-10"))) (AND (FLOATP F) (= -1S-10 F))) + +(floatp (read-from-string "-1.23")) +(floatp (read-from-string "-823.0023D10")) +(floatp (read-from-string "-324.0293E10")) +(floatp (read-from-string "-12.0023F10")) +(floatp (read-from-string "-911.823L10")) +(floatp (read-from-string "-788.823S10")) + +(eq '|\256| (read-from-string "\\256")) +(eq '|25\64| (read-from-string "25\\64")) +(eq '|1.0\E6| (read-from-string "1.0\\E6")) +(eq '|100| (read-from-string "|100|")) +(eq '|3.14159| (read-from-string "3\\.14159")) +(eq '|3/4| (read-from-string "|3/4|")) +(eq '|3/4| (read-from-string "3\\/4")) +(eq '|5| (read-from-string "5||")) +(eq '|5| (read-from-string "||5")) +(eq '|567| (read-from-string "||567")) +(eq '|567| (read-from-string "5||67")) +(eq '|567| (read-from-string "56||7")) +(eq '|567| (read-from-string "567||")) +(eq '|567| (read-from-string "||5||6||7||")) +(eq '|567| (read-from-string "||||5||||6||||7||||")) +(eq '|567| (read-from-string "567||||||")) + + +(eq '|/| (read-from-string "/")) +(eq '|/5| (read-from-string "/5")) +(eq '|+| (read-from-string "+")) +(eq '|1+| (read-from-string "1+")) +(eq '|1-| (read-from-string "1-")) +(eq '|FOO+| (read-from-string "foo+")) +(eq '|AB.CD| (read-from-string "ab.cd")) +(eq '|_| (read-from-string "_")) +(eq '|^| (read-from-string "^")) +(eq '|^/-| (read-from-string "^/-")) + +(eq :a (read-from-string ":a")) +(eq :b (read-from-string ":b")) +(eq :c (read-from-string ":c")) +(eq :d (read-from-string ":d")) +(eq :keyword-symbol (read-from-string ":keyword-symbol")) +(eq 'cl::cdr (read-from-string "cl::cdr")) +(eq 'cl:append (read-from-string "cl:append")) +(eq 'cl-user::append (read-from-string "cl-user::append")) +(progn + (when (find-package 'test-foo) (delete-package 'test-foo)) + (make-package 'test-foo :use nil) + (handler-case (read-from-string "test-foo:no-such-symbol") + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil))) +(progn + (when (find-package 'test-foo) (delete-package 'test-foo)) + (make-package 'test-foo :use nil) + (and (not (find-symbol "NEW-ONE" "TEST-FOO")) + (read-from-string "test-foo::new-one") + (find-symbol "NEW-ONE" "TEST-FOO"))) +(progn + (when (find-package 'test-foo) (delete-package 'test-foo)) + (let ((*package* (make-package 'test-foo :use nil))) + (read-from-string "my-symbol"))) +(string= " " (symbol-name (read-from-string "cl-user::\\ "))) +(progn + (when (find-package 'no-such-package) (delete-package 'no-such-package)) + (handler-case (read-from-string "no-such-package::bar") + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil))) +(progn + (when (find-package 'no-such-package) (delete-package 'no-such-package)) + (handler-case (read-from-string "no-such-package::no-such-symbol") + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + + +(string= "FROBBOZ" (symbol-name (read-from-string "FROBBOZ"))) +(string= "FROBBOZ" (symbol-name (read-from-string "frobboz"))) +(string= "FROBBOZ" (symbol-name (read-from-string "fRObBoz"))) +(string= "UNWIND-PROTECT" (symbol-name (read-from-string "unwind-protect"))) +(string= "+$" (symbol-name (read-from-string "+$"))) +(string= "1+" (symbol-name (read-from-string "1+"))) +(= 1 (read-from-string "+1")) +(string= "PASCAL_STYLE" (symbol-name (read-from-string "pascal_style"))) +(string= "FILE.REL.43" (symbol-name (read-from-string "file.rel.43"))) +(string= "\(" (symbol-name (read-from-string "\\("))) +(string= "\+1" (symbol-name (read-from-string "\\+1"))) +(string= "+\1" (symbol-name (read-from-string "+\\1"))) +(string= "fROBBOZ" (symbol-name (read-from-string "\\frobboz"))) +(string= "3.14159265s0" (symbol-name (read-from-string "3.14159265\\s0"))) +(string= "3.14159265S0" (symbol-name (read-from-string "3.14159265\\S0"))) +(string= "FOo" (symbol-name (read-from-string "fo\\o"))) + +(string= "APL\\360" (symbol-name (read-from-string "APL\\\\360"))) +(string= "APL\\360" (symbol-name (read-from-string "apl\\\\360"))) +(string= "(B^2)-4*A*C" (symbol-name (read-from-string "\\(b^2\\)\\-\\4*a*c"))) +(string= "(b^2)-4*a*c" + (symbol-name (read-from-string "\\(\\b^2\\)\\-\\4*\\a*\\c"))) +(string= "\"" (symbol-name (read-from-string "|\"|"))) +(string= "(b^2) - 4*a*c" (symbol-name (read-from-string "|(b^2) - 4*a*c|"))) +(string= "frobboz" (symbol-name (read-from-string "|frobboz|"))) +(string= "APL360" (symbol-name (read-from-string "|APL\\360|"))) +(string= "APL\\360" (symbol-name (read-from-string "|APL\\\\360|"))) +(string= "apl\\360" (symbol-name (read-from-string "|apl\\\\360|"))) +(string= "||" (symbol-name (read-from-string "|\\|\\||"))) +(string= "(B^2) - 4*A*C" (symbol-name (read-from-string "|(B^2) - 4*A*C|"))) +(string= "(b^2) - 4*a*c" (symbol-name (read-from-string "|(b^2) - 4*a*c|"))) +(string= "." (symbol-name (read-from-string "\\."))) +(string= ".." (symbol-name (read-from-string "|..|"))) + + +(null (read-from-string "()")) +(null (read-from-string "( )")) +(null (read-from-string "( )")) +(equal (read-from-string "(a)") '(a)) +(equal (read-from-string "( a)") '(a)) +(equal (read-from-string "(a )") '(a)) +(equal (read-from-string "( a )") '(a)) +(equal (read-from-string "(a b)") '(a b)) +(equal (read-from-string "( a b)") '(a b)) +(equal (read-from-string "( a b )") '(a b)) +(equal (read-from-string "( a b )") '(a b)) +(equal (read-from-string "( a b )") '(a b)) +(equal (read-from-string "(a #| |# b)") '(a b)) +(equal (read-from-string "(a #| |# b #| |# )") '(a b)) +(equal (read-from-string "(a #| |# b +)") '(a b)) +(equal (read-from-string "( +a +b +)") '(a b)) +(equal (read-from-string "(a . b)") '(a . b)) +(equal (read-from-string "(a . nil)") '(a)) +(equal (read-from-string "(a . (b))") '(a b)) +(equal (read-from-string "(a . (b . (c . (d))))") '(a b c d)) +(let ((x (read-from-string "(a .$b)"))) + (and (= 2 (length x)) + (eq (first x) 'a) + (eq (second x) '|.$B|))) +(equal (read-from-string "(a b c . d)") + (cons 'a (cons 'b (cons 'c 'd)))) +(equal (read-from-string "(this-one . that-one)") + (cons 'this-one 'that-one)) +(equal (read-from-string "(a b c d . (e f . (g)))") '(a b c d e f g)) +(equal (read-from-string "(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30)") + '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30)) +(handler-case (read-from-string ")") + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(equal (read-from-string "(a (b (c d)))") '(a (b (c d)))) +(equal (read-from-string "'a") '(quote a)) +(equal (read-from-string "'(a b c)") '(quote (a b c))) +(equal (read-from-string "'''(a b c)") '(quote (quote (quote (a b c))))) +(equal (read-from-string "'(a 'b '('c))") + '(quote (a (quote b) (quote ((quote c)))))) +(equal (read-from-string "'('('a '('b 'c)))") + '(quote ((quote ((quote a) (quote ((quote b) (quote c)))))))) +(equal (read-from-string "''''''a") + '(quote (quote (quote (quote (quote (quote a))))))) +(equal (read-from-string "' a") '(quote a)) +(eq 'quote (eval (read-from-string "(car ''foo)"))) + + + +(eq (read-from-string "; comment +a") 'a) +(= 7 (eval (read-from-string "(+ 3 ; three +4)"))) +(eq 'a (read-from-string ";;;;;;; +a")) +(equal (read-from-string "(a ;;;;;;; +b ;; +;; +c;;;;;;;;;;;;;;;;;;;;;;;;;;; +d)") '(a b c d)) +(equal (read-from-string "(a ; comment + ; + ; +; +b)") '(a b)) +(equal (read-from-string "(a\\;b c)") '(|A;B| c)) + +(string= (read-from-string "\"hello\"") "hello") +(string= (read-from-string "\"\\\"hello\\\"\"") "\"hello\"") +(string= (read-from-string "\"|hello|\"") "|hello|") +(string= "string" (read-from-string " \"string\"")) +(let ((x (read-from-string "\"\\\\\""))) + (and (= 1 (length x)) (char= #\\ (char x 0)))) +(string= " This is a sentence. " (read-from-string "\" This is a sentence. \"")) +(simple-string-p (read-from-string "\"a simple string\"")) +(let ((x (read-from-string "\"\\\"\""))) + (and (= 1 (length x)) (char= #\" (char x 0)))) +(let ((x (read-from-string "\"|\""))) + (and (= 1 (length x)) (char= #\| (char x 0)))) + + +(eq (eval (read-from-string "`a")) 'a) +(equal (eval (read-from-string "(let ((x 1)) `(a ,x))")) '(a 1)) +(equal (eval (read-from-string "(let ((x 1)) `(a ,`(,x)))")) '(a (1))) +(equal (eval (read-from-string "(let ((a 0) (c 2) (d '(3))) `((,a b) ,c ,@d))")) + '((0 b) 2 3)) +(equal + (eval (read-from-string "(let ((a 0) (c 2) (d '(3 4 5))) `((,a b) ,c ,@d))")) + '((0 b) 2 3 4 5)) +(equal + (eval (read-from-string "(let ((a '(0 1)) (c 2) (d '(3 4 5))) + `((,a b) ,c ,@d))")) + '(((0 1) b) 2 3 4 5)) +(equal + (eval (read-from-string "(let ((a '(0 1)) (c 2) (d '(3 4 5))) + `((,@a b) ,c ,@d))")) + '((0 1 b) 2 3 4 5)) +(equal (eval (read-from-string "`(a b ,`c)")) '(a b c)) +(equal (eval (read-from-string "`(a ,@(map 'list #'char-upcase \"bcd\") e f)")) + '(a #\B #\C #\D E F)) +(equal (eval (read-from-string "(let ((x 1)) `(a . ,x))")) '(a . 1)) +(equal (eval (read-from-string "(let ((x '(b c))) `(a . ,x))")) '(a b c)) +(equalp (eval (read-from-string "(let ((x #(b c))) `(a . ,x))")) '(a . #(b c))) +(equalp (eval (read-from-string "(let ((x '(b c))) `#(a ,x))")) #(a (b c))) +(equalp (eval (read-from-string "(let ((x 'b ) (y 'c)) `#(a ,x ,y))")) + #(a b c)) +(equalp (eval (read-from-string "(let ((x '(b c))) `#(a ,@x))")) #(a b c)) +(equalp (eval (read-from-string "`\"abc\"")) "abc") +(equalp (eval (read-from-string "(let ((x '(b c)) (y '(d e)) (z '(f g))) `(a ,@x ,@y ,@z))")) '(a b c d e f g)) +(equalp (eval (read-from-string "(let ((x '(b c)) (y 'd) (z '(e f g h))) `(a ,@x ,y ,@z))")) '(a b c d e f g h)) +(equal (eval (read-from-string "`(a ,@(mapcar #'char-downcase `(,(char-upcase #\\b) ,(char-upcase #\\c) ,(char-upcase #\\d))) e f)")) + '(a #\b #\c #\d e f)) +(equal (eval (read-from-string "`(a ,@(map 'list #'char-downcase `#(,(char-upcase #\\b) ,(char-upcase #\\c) ,(char-upcase #\\d))) e f)")) + '(a #\b #\c #\d e f)) +(equal (eval (read-from-string "(let ((x 1)) `(a (,x)))")) '(a (1))) +(equal (eval (read-from-string "(let ((x 1)) `(a ((,x))))")) '(a ((1)))) +(equal (eval (read-from-string "(let ((x 1)) `(a (((,x)))))")) '(a (((1))))) +(equalp (eval (read-from-string "(let ((x 1)) `(a ((#(,x)))))")) '(a ((#(1))))) +(equalp (eval (read-from-string "(let ((x 1)) `(a #((#(,x)))))")) '(a #((#(1))))) +(equalp (eval (read-from-string "(let ((x 1)) `#(a #((#(,x)))))")) + '#(a #((#(1))))) +(equal (eval (read-from-string "(let ((x 1) (y 2) (z 3)) `(,x (,y) ((,z))))")) + '(1 (2) ((3)))) +(equal (eval (read-from-string + "(let ((x 1) (y 2) (z 3)) `((,x) ((,y)) (((,z)))))")) + '((1) ((2)) (((3))))) +(equal (eval (read-from-string + "(let ((x 1) (y 2) (z 3)) `(((,x)) (((,y))) ((((,z))))))")) + '(((1)) (((2))) ((((3)))))) +(equal (eval (read-from-string + "(let ((x 1) (y 2) (z 3)) `((((,x))) ((((,y)))) (((((,z)))))))")) + '((((1))) ((((2)))) (((((3))))))) +(equalp (eval (read-from-string "(let ((x 1) (y 2) (z 3)) `#(,x (,y) ((,z))))")) + '#(1 (2) ((3)))) +(equalp (eval (read-from-string + "(let ((x 1) (y 2) (z 3)) `#((,x) ((,y)) (((,z)))))")) + '#((1) ((2)) (((3))))) +(equalp (eval (read-from-string + "(let ((x 1) (y 2) (z 3)) `#(((,x)) (((,y))) ((((,z))))))")) + '#(((1)) (((2))) ((((3)))))) +(equalp (eval (read-from-string + "(let ((x 1) (y 2) (z 3)) `#((((,x))) ((((,y)))) (((((,z)))))))")) + '#((((1))) ((((2)))) (((((3))))))) +(equal (eval (read-from-string "(let ((x 1)) `'(,x))")) ''(1)) +(equal (eval (read-from-string "(let ((x 1)) `'(',x))")) ''('1)) +(equal (eval (read-from-string "`'(','x))")) ''('x)) +(equal (eval (read-from-string "`(a . b)")) '(a . b)) +(equal (eval (read-from-string "(let ((x 1)) `(a . ,x))")) '(a . 1)) +(equal (eval (read-from-string "(let ((x 1)) `(a . (b . (,x))))")) '(a b 1)) +(equal (eval (read-from-string "(let ((x 1)) `(a ,x . z))")) '(a 1 . z)) +(equalp (eval (read-from-string "(let ((x 1)) `(a #(#(#(,x))) . z))")) + '(a #(#(#(1))) . z)) + +(handler-case (read-from-string ",") + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(handler-case (read-from-string "'(,x)") + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(handler-case (read-from-string "`(,(append ,x y))") + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(char= (read-from-string "#\\a") #\a) +(char= (read-from-string "#\\b") #\b) +(char= (read-from-string "#\\c") #\c) +(char= (read-from-string "#\\d") #\d) +(char= (read-from-string "#\\e") #\e) +(char= (read-from-string "#\\f") #\f) +(char= (read-from-string "#\\g") #\g) +(char= (read-from-string "#\\h") #\h) +(char= (read-from-string "#\\i") #\i) +(char= (read-from-string "#\\j") #\j) +(char= (read-from-string "#\\k") #\k) +(char= (read-from-string "#\\l") #\l) +(char= (read-from-string "#\\m") #\m) +(char= (read-from-string "#\\n") #\n) +(char= (read-from-string "#\\o") #\o) +(char= (read-from-string "#\\p") #\p) +(char= (read-from-string "#\\q") #\q) +(char= (read-from-string "#\\r") #\r) +(char= (read-from-string "#\\s") #\s) +(char= (read-from-string "#\\t") #\t) +(char= (read-from-string "#\\u") #\u) +(char= (read-from-string "#\\v") #\v) +(char= (read-from-string "#\\w") #\w) +(char= (read-from-string "#\\x") #\x) +(char= (read-from-string "#\\y") #\y) +(char= (read-from-string "#\\z") #\z) +(CHAR= (READ-FROM-STRING "#\\A") #\A) +(CHAR= (READ-FROM-STRING "#\\B") #\B) +(CHAR= (READ-FROM-STRING "#\\C") #\C) +(CHAR= (READ-FROM-STRING "#\\D") #\D) +(CHAR= (READ-FROM-STRING "#\\E") #\E) +(CHAR= (READ-FROM-STRING "#\\F") #\F) +(CHAR= (READ-FROM-STRING "#\\G") #\G) +(CHAR= (READ-FROM-STRING "#\\H") #\H) +(CHAR= (READ-FROM-STRING "#\\I") #\I) +(CHAR= (READ-FROM-STRING "#\\J") #\J) +(CHAR= (READ-FROM-STRING "#\\K") #\K) +(CHAR= (READ-FROM-STRING "#\\L") #\L) +(CHAR= (READ-FROM-STRING "#\\M") #\M) +(CHAR= (READ-FROM-STRING "#\\N") #\N) +(CHAR= (READ-FROM-STRING "#\\O") #\O) +(CHAR= (READ-FROM-STRING "#\\P") #\P) +(CHAR= (READ-FROM-STRING "#\\Q") #\Q) +(CHAR= (READ-FROM-STRING "#\\R") #\R) +(CHAR= (READ-FROM-STRING "#\\S") #\S) +(CHAR= (READ-FROM-STRING "#\\T") #\T) +(CHAR= (READ-FROM-STRING "#\\U") #\U) +(CHAR= (READ-FROM-STRING "#\\V") #\V) +(CHAR= (READ-FROM-STRING "#\\W") #\W) +(CHAR= (READ-FROM-STRING "#\\X") #\X) +(CHAR= (READ-FROM-STRING "#\\Y") #\Y) +(CHAR= (READ-FROM-STRING "#\\Z") #\Z) +(not (char= (read-from-string "#\\Z") (read-from-string "#\\z"))) + +(char= (read-from-string "#\\0") #\0) +(char= (read-from-string "#\\1") #\1) +(char= (read-from-string "#\\2") #\2) +(char= (read-from-string "#\\3") #\3) +(char= (read-from-string "#\\4") #\4) +(char= (read-from-string "#\\5") #\5) +(char= (read-from-string "#\\6") #\6) +(char= (read-from-string "#\\7") #\7) +(char= (read-from-string "#\\8") #\8) +(char= (read-from-string "#\\9") #\9) + +(char= (read-from-string "#\\!") #\!) +(char= (read-from-string "#\\$") #\$) +(char= (read-from-string "#\\\"") #\") +(char= (read-from-string "#\\'") #\') +(char= (read-from-string "#\\(") #\() +(char= (read-from-string "#\\)") #\)) +(char= (read-from-string "#\\,") #\,) +(char= (read-from-string "#\\_") #\_) +(char= (read-from-string "#\\-") #\-) +(char= (read-from-string "#\\.") #\.) +(char= (read-from-string "#\\/") #\/) +(char= (read-from-string "#\\:") #\:) +(char= (read-from-string "#\\;") #\;) +(char= (read-from-string "#\\?") #\?) +(char= (read-from-string "#\\+") #\+) +(char= (read-from-string "#\\<") #\<) +(char= (read-from-string "#\\=") #\=) +(char= (read-from-string "#\\>") #\>) +(char= (read-from-string "#\\#") #\#) +(char= (read-from-string "#\\%") #\%) +(char= (read-from-string "#\\&") #\&) +(char= (read-from-string "#\\*") #\*) +(char= (read-from-string "#\\@") #\@) +(char= (read-from-string "#\\[") #\[) +(char= (read-from-string "#\\\\") #\\) +(char= (read-from-string "#\\]") #\]) +(char= (read-from-string "#\\{") #\{) +(char= (read-from-string "#\\|") #\|) +(char= (read-from-string "#\\}") #\}) +(char= (read-from-string "#\\`") #\`) +(char= (read-from-string "#\\^") #\^) +(char= (read-from-string "#\\~") #\~) + +(char= (read-from-string "#\\newline") #\newline) +(char= (read-from-string "#\\space") #\space) +(char= (read-from-string "#\\Newline") #\newline) +(char= (read-from-string "#\\Space") #\space) +(char= (read-from-string "#\\NeWlInE") #\newline) +(char= (read-from-string "#\\SpAcE") #\space) +(char= (read-from-string "#\\NEWLINE") #\newline) +(char= (read-from-string "#\\SPACE") #\space) + + +(equal (read-from-string "#'car") '(function car)) +(eq (eval (read-from-string "#'car")) #'car) + +(simple-vector-p (read-from-string "#(a)")) +(equalp (read-from-string "#(a)") #(a)) +(equalp (read-from-string "#()") #()) +(equalp (read-from-string "#(a b)") #(a b)) +(equalp (read-from-string "#(a b c)") #(a b c)) +(equalp (read-from-string "#(a b c d)") #(a b c d)) +(equalp (read-from-string "#(a b c d e)") #(a b c d e)) +(equalp (read-from-string "#(a b c d e f)") #(a b c d e f)) +(equalp (read-from-string "#(a b c d e f g)") #(a b c d e f g)) +(equalp (read-from-string "#(a b c c c c)") #(a b c c c c)) +(equalp (read-from-string "#6(a b c c c c)") #(a b c c c c)) +(equalp (read-from-string "#6(a b c)") #(a b c c c c)) +(equalp (read-from-string "#6(a b c c)") #(a b c c c c)) +(let ((x (read-from-string "#(a b c)"))) (= 3 (length x))) +(let ((x (read-from-string "#()"))) + (and (simple-vector-p x) + (zerop (length x)) + (equalp x #0()))) +(let ((x (read-from-string "#0()"))) + (and (simple-vector-p x) + (zerop (length x)) + (equalp x #()))) +(equalp (read-from-string "#1(a)") #(a)) +(equalp (read-from-string "#2(a b)") #(a b)) +(equalp (read-from-string "#3(a b c)") #(a b c)) +(equalp (read-from-string "#4(a b c d)") #(a b c d)) +(equalp (read-from-string "#5(a b c d e)") #(a b c d e)) +(equalp (read-from-string "#6(a b c d e f)") #(a b c d e f)) +(equalp (read-from-string "#2(a)") #(a a)) +(equalp (read-from-string "#3(a)") #(a a a)) +(equalp (read-from-string "#4(a)") #(a a a a)) +(equalp (read-from-string "#5(a)") #(a a a a a)) +(equalp (read-from-string "#6(a)") #(a a a a a a)) +(equalp (read-from-string "#7(a)") #(a a a a a a a)) +(equalp (read-from-string "#8(a)") #(a a a a a a a a)) +(equalp (read-from-string "#9(a)") #(a a a a a a a a a)) +(equalp (read-from-string "#10(a)") #(a a a a a a a a a a)) +(let ((x (read-from-string "#100(a)"))) + (and (simple-vector-p x) + (= 100 (length x)) + (every #'symbolp x) + (every #'(lambda (s) (eq s 'a)) x))) +(let ((x (read-from-string "#100(#\\z)"))) + (and (simple-vector-p x) + (= 100 (length x)) + (every #'characterp x) + (every #'(lambda (c) (char= c #\z)) x))) +(let ((x (read-from-string "#100(#())"))) + (and (simple-vector-p x) + (= 100 (length x)) + (every #'simple-vector-p x) + (every #'(lambda (v) (zerop (length v))) x))) + + +(equalp (read-from-string "#*0") #*0) +(equalp (read-from-string "#*1") #*1) +(equalp (read-from-string "#*01") #*01) +(equalp (read-from-string "#*10") #*10) +(equalp (read-from-string "#*11") #*11) +(equalp (read-from-string "#0*") #*) +(equalp (read-from-string "#*") #*) +(equalp (read-from-string "#3*1") #*111) +(equalp (read-from-string "#3*10") #*100) +(equalp (read-from-string "#*101111") #*101111) +(equalp (read-from-string "#6*101111") #*101111) +(equalp (read-from-string "#6*101") #*101111) +(equalp (read-from-string "#6*1011") #*101111) +(let ((x (read-from-string "#*10"))) + (and (simple-bit-vector-p x) + (= 2 (length x)) + (= 1 (bit x 0)) + (= 0 (bit x 1)))) +(let ((x (read-from-string "#*"))) + (and (simple-bit-vector-p x) + (zerop (length x)))) +(let ((x (read-from-string "#100*0"))) + (and (simple-bit-vector-p x) + (= 100 (length x)) + (every #'zerop x))) +(let ((x (read-from-string "#100*1"))) + (and (simple-bit-vector-p x) + (= 100 (length x)) + (every #'(lambda (n) (= 1 n)) x))) +(handler-case (read-from-string "#3*1110") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) +(handler-case (read-from-string "#3*") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) +(handler-case (read-from-string "#3*abc") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(let ((symbol (read-from-string "#:ok"))) + (and (null (symbol-package symbol)) (string= (symbol-name symbol) "OK"))) +(let ((symbol (read-from-string "#:g10"))) + (and (null (symbol-package symbol)) (string= (symbol-name symbol) "G10"))) +(let ((symbol (read-from-string "#:10"))) + (and (null (symbol-package symbol)) (string= (symbol-name symbol) "10"))) +(let ((symbol (read-from-string "#:0"))) + (and (null (symbol-package symbol)) (string= (symbol-name symbol) "0"))) +(let ((symbol (read-from-string "#:-"))) + (and (null (symbol-package symbol)) (string= (symbol-name symbol) "-"))) +(let ((symbol (read-from-string "#:\\-"))) + (and (null (symbol-package symbol)) (string= (symbol-name symbol) "-"))) +(let ((symbol (read-from-string "#:$$-$$"))) + (and (null (symbol-package symbol)) (string= (symbol-name symbol) "$$-$$"))) + +(eq 'a (read-from-string "#.'a")) +(packagep (read-from-string "#.*package*")) +(= 11 (read-from-string "#.(let ((x 10)) (1+ x))")) +(= 4 (read-from-string "#.(1+ 3)")) +(handler-case (let ((*read-eval* nil)) (read-from-string "#.(1+ 3)")) + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) +(equal '(a b . 3) (read-from-string "#.(let ((x 3)) `(a b . ,x))")) + + +(= (read-from-string "#b0") 0) +(= (read-from-string "#B0") 0) +(= (read-from-string "#b01") 1) +(= (read-from-string "#B01") 1) +(= (read-from-string "#B1101") 13) +(= (read-from-string "#b101/11") 5/3) +(= 172236929 (read-from-string "#b1010010001000010000010000001")) + +(= (read-from-string "#o0") 0) +(= (read-from-string "#O0") 0) +(= (read-from-string "#o37/15") 31/13) +(= (read-from-string "#o777") 511) +(= (read-from-string "#o105") 69) +(= (read-from-string "#O37/15") 31/13) +(= (read-from-string "#O777") 511) +(= (read-from-string "#O105") 69) +(= 342391 (read-from-string "#o1234567")) + +(= (read-from-string "#x0") 0) +(= (read-from-string "#xF00") 3840) +(= (read-from-string "#x105") 261) +(= (read-from-string "#X0") 0) +(= (read-from-string "#XF00") 3840) +(= (read-from-string "#Xf00") 3840) +(= (read-from-string "#X105") 261) +(= 81985529216486895 (read-from-string "#X0123456789ABCDEF")) + +(= (read-from-string "#3r0") 0) +(= (read-from-string "#2r11010101") 213) +(= (read-from-string "#b11010101") 213) +(= (read-from-string "#b+11010101") 213) +(= (read-from-string "#o325") 213) +(= (read-from-string "#xD5") 213) +(= (read-from-string "#16r+D5") 213) +(= (read-from-string "#o-300") -192) +(= (read-from-string "#3r-21010") -192) +(= (read-from-string "#25R-7H") -192) +(= (read-from-string "#xACCEDED") 181202413) + + + + + +(zerop (read-from-string "#c(0 0)")) +(= (read-from-string "#c(1 0)") #c(1 0)) +(complexp (read-from-string "#c(1 10)")) +(= (read-from-string "#c(1 0)") 1) +(= (read-from-string "#c(0 1)") #c(0 1)) +(= (read-from-string "#c(1 1)") #c(1 1)) +(= (read-from-string "#C(3.0s1 2.0s-1)") #C(3.0s1 2.0s-1)) +(= (read-from-string "#C(5 -3)") #c(5 -3)) +(= (read-from-string "#C(5/3 7.0)") #c(5/3 7.0)) +(let ((x (read-from-string "#C(5/3 7.0)"))) + (and (floatp (realpart x)) (floatp (imagpart x)))) + +(= (read-from-string "#C(0 1)") #C(0 1)) + +;; array +(equalp (read-from-string "#1A(0 1)") #(0 1)) +(let ((x (read-from-string "#1A(0 1)"))) + (and (vectorp x) + (= 2 (length x)) + (= 0 (aref x 0)) + (= 1 (aref x 1)))) +(equalp (read-from-string "#2A((0 1 5) (foo 2 (hot dog)))") + #2A((0 1 5) (foo 2 (hot dog)))) +(let ((x (read-from-string "#2A((0 1 5) (foo 2 (hot dog)))"))) + (and (arrayp x) + (equal (array-dimensions x) '(2 3)) + (zerop (aref x 0 0)) + (= (aref x 0 1) 1) + (= (aref x 0 2) 5) + (eq (aref x 1 0) 'foo) + (= (aref x 1 1) 2) + (equal (aref x 1 2) '(hot dog)))) +(equal (aref (read-from-string "#0A((0 1 5) (foo 2 (hot dog)))")) + '((0 1 5) (foo 2 (hot dog)))) +(let ((x (read-from-string "#0A((0 1 5) (foo 2 (hot dog)))"))) + (and (arrayp x) + (null (array-dimensions x)) + (equal (aref x) '((0 1 5) (foo 2 (hot dog)))))) +(equalp (read-from-string "#0A foo") #0Afoo) +(let ((x (read-from-string "#0A foo"))) + (and (arrayp x) + (null (array-dimensions x)) + (eq (aref x) 'foo))) + +(equal (array-dimensions (read-from-string "#3A((() ()) (() ()) (() ()))")) + '(3 2 0)) +(equal (array-dimensions (read-from-string "#10A(() ())")) + '(2 0 0 0 0 0 0 0 0 0)) +(let ((x (read-from-string " +#4A((((0 1 2 3) (4 5 6 7) (8 9 10 11)) + ((12 13 14 15) (16 17 18 19) (20 21 22 23))))"))) + (and (arrayp x) + (equal (array-dimensions x) '(1 2 3 4)) + (loop for i below 24 always (= i (row-major-aref x i))))) + +;; label +(eq (read-from-string "#1=a") 'a) +(equal (read-from-string "(#1=a #1#)") '(a a)) +(let ((x (read-from-string "#1=(a . #1#)"))) (eq x (cdr x))) +(let ((x (read-from-string "((a b) . #1=(#2=(p q) foo #2# . #1#))"))) + (and (eq (nthcdr 1 x) (nthcdr 4 x)) + (eq (nthcdr 4 x) (nthcdr 7 x)) + (eq (nthcdr 7 x) (nthcdr 10 x)) + (eq (nth 1 x) (nth 3 x)) + (eq (nth 3 x) (nth 6 x)) + (eq (nth 6 x) (nth 9 x)) + (eq (nth 9 x) (nth 12 x)))) +(let ((x (read-from-string "(#1=(a . #1#) #2=(#1# . #2#))"))) + (and (eq (car x) (caadr x)) + (eq (car x) (cdar x)) + (eq (cadr x) (cdadr x)))) +(let ((x (read-from-string "#1=#2=#3=(0 . #1#)"))) + (and (eq x (cdr x)) (zerop (car x)))) +(let ((x (read-from-string "#1=#2=#3=(0 . #2#)"))) + (and (eq x (cdr x)) (zerop (car x)))) +(let ((x (read-from-string "#1=#2=#3=(0 . #3#)"))) + (and (eq x (cdr x)) (zerop (car x)))) +(let ((x (read-from-string "#1=#2=#3=(0 #1# #2# #3#)"))) + (and (= 4 (length x)) + (zerop (first x)) + (eq x (second x)) + (eq x (third x)) + (eq x (fourth x)))) +(equal (read-from-string "(#1000=a #1000#)") '(a a)) +(let ((x (read-from-string "(#1=#:g10 #1#)"))) + (and (= 2 (length x)) + (string= (symbol-name (first x)) "G10") + (eq (first x) (second x)))) +(let ((x (read-from-string "#1=(a (b #2=(x y z) . #1#) . #2#)"))) + (and (eq (first x) 'a) + (eq x (cddr (second x))) + (eq (second (second x)) (cddr x)))) +(let ((x (read-from-string "(#1=(a (b #2=(x y z) . #1#) . #2#))"))) + (and (eq (caar x) 'a) + (eq (car x) (cddr (second (first x)))) + (eq (second (second (first x))) (cddr (first x))))) +(let ((x (read-from-string "#1=(a #2=(b #3=(c . #3#) . #2#) . #1#)"))) + (and (eq (first x) 'a) + (eq (first (second x)) 'b) + (eq (first (second (second x))) 'c) + (eq x (cddr x)) + (eq (second x) (cddr (second x))) + (eq (second (second x)) (cdr (second (second x)))))) +(let ((x (read-from-string "#1=(a #2=(b #3=(c . #1#) . #2#) . #3#)"))) + (and (eq (first x) 'a) + (eq (first (second x)) 'b) + (eq (first (second (second x))) 'c) + (eq x (cdr (second (second x)))) + (eq (second x) (cddr (second x))) + (eq (second (second x)) (cddr x)))) +(let ((x (read-from-string "(#1=#(0 1 2) #1#)"))) + (and (= 2 (length x)) + (eq (first x) (second x)) + (equalp (first x) #(0 1 2)))) + +(let ((x (read-from-string "#1=#(#1# 1 2)"))) + (and (= 3 (length x)) + (eq (aref x 0) x) + (= (aref x 1) 1) + (= (aref x 2) 2))) +(let ((x (read-from-string "#(#1=#:g00 a b #1#)"))) + (and (= 4 (length x)) + (string= (symbol-name (aref x 0)) "G00") + (eq (aref x 0) (aref x 3)) + (eq (aref x 1) 'a) + (eq (aref x 2) 'b))) +(let ((x (read-from-string "#1=#(#2=#:g00 a #2# #1#)"))) + (and (= 4 (length x)) + (string= (symbol-name (aref x 0)) "G00") + (eq x (aref x 3)) + (eq (aref x 0) (aref x 2)) + (eq (aref x 1) 'a))) +(let ((x (read-from-string "#1=#(#1# #1# #1#)"))) + (and (= 3 (length x)) + (eq x (aref x 0)) + (eq (aref x 0) (aref x 1)) + (eq (aref x 1) (aref x 2)))) +(let ((x (read-from-string "#1=#(#(#1#))"))) + (and (= 1 (length x)) + (= 1 (length (aref x 0))) + (eq x (aref (aref x 0) 0)))) +(let ((x (read-from-string "#1=#(#2=#(#3=#(#3# #2# #1#))))"))) + (and (= 1 (length x)) + (= 1 (length (aref x 0))) + (= 3 (length (aref (aref x 0) 0))) + (eq x (aref (aref (aref x 0) 0) 2)) + (eq (aref x 0) (aref (aref (aref x 0) 0) 1)) + (eq (aref (aref x 0) 0) (aref (aref (aref x 0) 0) 0)))) +(let ((x (read-from-string "#1=#(#2=#(#3=#(#1# #2# #3#))))"))) + (and (= 1 (length x)) + (= 1 (length (aref x 0))) + (= 3 (length (aref (aref x 0) 0))) + (eq x (aref (aref (aref x 0) 0) 0)) + (eq (aref x 0) (aref (aref (aref x 0) 0) 1)) + (eq (aref (aref x 0) 0) (aref (aref (aref x 0) 0) 2)))) +(let ((x (read-from-string "(#1=#(0 #2=#:g100 2) #2# #1#)"))) + (and (= 3 (length x)) + (eq (first x) (third x)) + (string= (symbol-name (aref (first x) 1)) "G100") + (null (symbol-package (aref (first x) 1))) + (eq (aref (first x) 1) (second x)))) +(let ((x (read-from-string "(a #1=#(0 (#1#) 2) c)"))) + (and (= 3 (length x)) + (eq (first x) 'a) + (eq (second x) (first (aref (second x) 1))) + (eq (third x) 'c) + (= 0 (aref (second x) 0)) + (= 2 (aref (second x) 2)))) +(let ((x (read-from-string "#1=#2A((a b) (c #1#))"))) + (and (= 4 (array-total-size x)) + (eq (aref x 0 0) 'a) + (eq (aref x 0 1) 'b) + (eq (aref x 1 0) 'c) + (eq (aref x 1 1) x))) +(let ((x (read-from-string "#2A((#1=#:G10 b) (#1# d))"))) + (and (= 4 (array-total-size x)) + (eq (aref x 0 0) (aref x 1 0)) + (null (symbol-package (aref x 0 0))) + (string= (symbol-name (aref x 0 0)) "G10") + (eq (aref x 0 1) 'b) + (eq (aref x 1 1) 'd))) +(let ((x (read-from-string "#1=#2A((#2=#:GG #1#) (#2# #1#))"))) + (and (= 4 (array-total-size x)) + (eq (aref x 0 0) (aref x 1 0)) + (null (symbol-package (aref x 0 0))) + (string= "GG" (symbol-name (aref x 0 0))) + (eq x (aref x 0 1)) + (eq x (aref x 1 1)))) +(let ((x (read-from-string "#1=#0A#1#"))) + (and (arrayp x) + (eq x (aref x)))) +(let ((x (read-from-string "#1=#0A(#1#)"))) + (and (arrayp x) + (consp (aref x)) + (= 1 (length (aref x))) + (eq x (first (aref x))))) +(let ((x (read-from-string "#1=#1A(#1#)"))) + (and (vectorp x) + (= 1 (length x)) + (eq x (aref x 0)))) +(let ((x (read-from-string "#1=#1A(#2=(a b c) #1# #2#)"))) + (and (vectorp x) + (= 3 (length x)) + (equal (aref x 0) '(a b c)) + (eq (aref x 0) (aref x 2)) + (eq x (aref x 1)))) +(let ((x (read-from-string + "#1=#3A(((0 a) (1 b) (2 c)) + ((3 d) (4 #2A((41 #2=#(x y z)) (43 #1#))) (5 f)) + ((6 g) (((#2#)) h) (9 i)))"))) + (and (= 18 (array-total-size x)) + (= 0 (aref x 0 0 0)) + (eq 'a (aref x 0 0 1)) + (= 1 (aref x 0 1 0)) + (eq 'b (aref x 0 1 1)) + (= 2 (aref x 0 2 0)) + (eq 'c (aref x 0 2 1)) + (= 3 (aref x 1 0 0)) + (eq 'd (aref x 1 0 1)) + (= 4 (aref x 1 1 0)) + (= (array-total-size (aref x 1 1 1)) 4) + (= 41 (aref (aref x 1 1 1) 0 0)) + (equalp (aref (aref x 1 1 1) 0 1) #(x y z)) + (= 43 (aref (aref x 1 1 1) 1 0)) + (eq x (aref (aref x 1 1 1) 1 1)) + (= 5 (aref x 1 2 0)) + (eq 'f (aref x 1 2 1)) + (= 6 (aref x 2 0 0)) + (eq 'g (aref x 2 0 1)) + (eq (caar (aref x 2 1 0)) (aref (aref x 1 1 1) 0 1)) + (eq 'h (aref x 2 1 1)) + (= 9 (aref x 2 2 0)) + (eq 'i (aref x 2 2 1)))) + + +(progn + #-CLISP ;Bruno: ANSI CL 2.2. refers to the spec of READ, which says that + ; an error of type end-of-file is signalled. + (handler-case (null (let ((*features* '())) (read-from-string "#+test1 a"))) + (error () nil)) + #+CLISP 'skipped) + +(let ((*features* '())) + (equal (with-input-from-string (stream "#+test1 a #-test1 b") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(b))) +(let ((*features* '(:test1))) + (equal (with-input-from-string (stream "#+test1 a #-test1 b") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(a))) +(let ((*features* '())) + (equal (with-input-from-string (stream "#+(not test1) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test1))) + (equal (with-input-from-string (stream "#+(not test1) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1))) + (equal (with-input-from-string (stream "#-(not test1) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '())) + (equal (with-input-from-string (stream "#-(not test1) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) + +(let ((*features* '(:test1 :test2))) + (equal (with-input-from-string (stream "#+(and test1 test2) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test1))) + (equal (with-input-from-string (stream "#+(and test1 test2) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '())) + (equal (with-input-from-string (stream "#+(and test1 test2) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '())) + (equal (with-input-from-string (stream "#+(or test1 test2) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1))) + (equal (with-input-from-string (stream "#+(or test1 test2) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test2))) + (equal (with-input-from-string (stream "#+(or test1 test2) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test1 :test2))) + (equal (with-input-from-string (stream "#+(or test1 test2) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test1 :test2 :test3))) + (equal (with-input-from-string (stream "#+(or test1 test2) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) + +(let ((*features* '(:test1 :test2))) + (equal (with-input-from-string (stream "#+(and test1 (not test2)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '())) + (equal (with-input-from-string (stream "#+(and test1 (not test2)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1))) + (equal (with-input-from-string (stream "#+(and test1 (not test2)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '())) + (equal (with-input-from-string + (stream "#+(or (and test1 (not test2)) test3) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1))) + (equal (with-input-from-string + (stream "#+(or (and test1 (not test2)) test3) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test1 :test2))) + (equal (with-input-from-string + (stream "#+(or (and test1 (not test2)) test3) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1 :test2 :test3))) + (equal (with-input-from-string + (stream "#+(or (and test1 (not test2)) test3) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test1 :test3))) + (equal (with-input-from-string + (stream "#+(or (and test1 (not test2)) test3) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test2 :test3))) + (equal (with-input-from-string + (stream "#+(or (and test1 (not test2)) test3) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) + +(let ((*features* '())) + (equal (with-input-from-string + (stream "#+(and test1 (not test2) (or test3 test4)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1))) + (equal (with-input-from-string + (stream "#+(and test1 (not test2) (or test3 test4)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1 :test3))) + (equal (with-input-from-string + (stream "#+(and test1 (not test2) (or test3 test4)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test1 :test4))) + (equal (with-input-from-string + (stream "#+(and test1 (not test2) (or test3 test4)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test1 :test2))) + (equal (with-input-from-string + (stream "#+(and test1 (not test2) (or test3 test4)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1 :test2 :test3))) + (equal (with-input-from-string + (stream "#+(and test1 (not test2) (or test3 test4)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1 :test2 :test3 :test4))) + (equal (with-input-from-string + (stream "#+(and test1 (not test2) (or test3 test4)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1 :test3 :test4))) + (equal (with-input-from-string + (stream "#+(and test1 (not test2) (or test3 test4)) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) + +(let ((*features* '())) + (equal (with-input-from-string + (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1))) + (equal (with-input-from-string + (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1 :test3))) + (equal (with-input-from-string + (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test1 :test4))) + (equal (with-input-from-string + (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) +(let ((*features* '(:test1 :test2))) + (equal (with-input-from-string + (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1 :test2 :test3))) + (equal (with-input-from-string + (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1 :test2 :test3 :test4))) + (equal (with-input-from-string + (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '())) +(let ((*features* '(:test1 :test3 :test4))) + (equal (with-input-from-string + (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this") + (loop + for x = (read stream nil 'end) + until (eq x 'end) + collecting x)) + '(eat-this))) + + +(eq (read-from-string "#| comment |# a") 'a) +(eq (read-from-string "#| #| nested comment |# |# a") 'a) +(eq (read-from-string "#| comment +comment + still comment +|# a") 'a) + +(handler-case (read-from-string "#<invalid-token>") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) +(handler-case (read-from-string "# ") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) +(handler-case (read-from-string "# +") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) +(handler-case (read-from-string "#)") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :upcase) + (string= "ZEBRA" (symbol-name (read-from-string "ZEBRA")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :upcase) + (string= "ZEBRA" (symbol-name (read-from-string "Zebra")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :upcase) + (string= "ZEBRA" (symbol-name (read-from-string "zebra")))) + +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :downcase) + (string= "zebra" (symbol-name (read-from-string "ZEBRA")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :downcase) + (string= "zebra" (symbol-name (read-from-string "Zebra")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :downcase) + (string= "zebra" (symbol-name (read-from-string "zebra")))) + +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :preserve) + (string= "ZEBRA" (symbol-name (read-from-string "ZEBRA")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :preserve) + (string= "Zebra" (symbol-name (read-from-string "Zebra")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :preserve) + (string= "zebra" (symbol-name (read-from-string "zebra")))) + +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :invert) + (string= "zebra" (symbol-name (read-from-string "ZEBRA")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :invert) + (string= "Zebra" (symbol-name (read-from-string "Zebra")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :invert) + (string= "ZEBRA" (symbol-name (read-from-string "zebra")))) + +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :upcase) + (string= "CAT-AND-MOUSE" (symbol-name (read-from-string "cat-and-mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :upcase) + (string= "CAT-AND-MOUSE" (symbol-name (read-from-string "Cat-And-Mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :upcase) + (string= "CAT-AND-MOUSE" (symbol-name (read-from-string "CAT-AND-MOUSE")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :downcase) + (string= "cat-and-mouse" (symbol-name (read-from-string "cat-and-mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :downcase) + (string= "cat-and-mouse" (symbol-name (read-from-string "Cat-And-Mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :downcase) + (string= "cat-and-mouse" (symbol-name (read-from-string "CAT-AND-MOUSE")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :preserve) + (string= "cat-and-mouse" (symbol-name (read-from-string "cat-and-mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :preserve) + (string= "Cat-And-Mouse" (symbol-name (read-from-string "Cat-And-Mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :preserve) + (string= "CAT-AND-MOUSE" (symbol-name (read-from-string "CAT-AND-MOUSE")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :invert) + (string= "CAT-AND-MOUSE" (symbol-name (read-from-string "cat-and-mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :invert) + (string= "Cat-And-Mouse" (symbol-name (read-from-string "Cat-And-Mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :invert) + (string= "cat-and-mouse" (symbol-name (read-from-string "CAT-AND-MOUSE")))) + +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :upcase) + (string= "CAT*AND*MOUSE" (symbol-name (read-from-string "cat*and*mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :upcase) + (string= "CAT*AND*MOUSE" (symbol-name (read-from-string "Cat*And*Mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :upcase) + (string= "CAT*AND*MOUSE" (symbol-name (read-from-string "CAT*AND*MOUSE")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :downcase) + (string= "cat*and*mouse" (symbol-name (read-from-string "cat*and*mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :downcase) + (string= "cat*and*mouse" (symbol-name (read-from-string "Cat*And*Mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :downcase) + (string= "cat*and*mouse" (symbol-name (read-from-string "CAT*AND*MOUSE")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :preserve) + (string= "cat*and*mouse" (symbol-name (read-from-string "cat*and*mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :preserve) + (string= "Cat*And*Mouse" (symbol-name (read-from-string "Cat*And*Mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :preserve) + (string= "CAT*AND*MOUSE" (symbol-name (read-from-string "CAT*AND*MOUSE")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :invert) + (string= "CAT*AND*MOUSE" (symbol-name (read-from-string "cat*and*mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :invert) + (string= "Cat*And*Mouse" (symbol-name (read-from-string "Cat*And*Mouse")))) +(let ((*readtable* (copy-readtable nil))) + (setf (readtable-case *readtable*) :invert) + (string= "cat*and*mouse" (symbol-name (read-from-string "CAT*AND*MOUSE")))) + + +(with-input-from-string (stream "a b") + (and (eq 'a (read-preserving-whitespace stream)) + (eq #\Space (read-char stream)) + (eq #\b (read-char stream)))) + +(handler-case (with-input-from-string (stream " ") (read stream)) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(let ((x nil)) + (and (eq t (handler-case (with-input-from-string (stream "a") + (setq x (read stream)) + (read stream)) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + (eq x 'a))) + +(progn + (let ((*readtable* (copy-readtable nil))) + (set-macro-character + #\/ + #'(lambda (stream char) + (declare (ignore char)) + `(path . ,(loop for dir = (read-preserving-whitespace stream t) + then (progn (read-char stream t nil t) + (read-preserving-whitespace stream t)) + collect dir + while (eql (peek-char nil stream nil nil t) #\/))))) + (equal (read-from-string "(zyedh /usr/games/zork /usr/games/boggle)") + '(zyedh (path usr games zork) (path usr games boggle))))) + +(progn + (let ((*readtable* (copy-readtable nil))) + (set-macro-character + #\/ + #'(lambda (stream char) + (declare (ignore char)) + `(path . ,(loop for dir = (read stream t) + then (progn (read-char stream t nil t) + (read stream t)) + collect dir + while (eql (peek-char nil stream nil nil t) #\/))))) + (equal (read-from-string "(zyedh /usr/games/zork /usr/games/boggle)") + '(zyedh (path usr games zork usr games boggle))))) + + +(let ((*readtable* (copy-readtable nil))) + (and (eq t (set-syntax-from-char #\7 #\;)) + (= 1235 (read-from-string "123579")))) + + + + + +(readtablep *readtable*) + +(readtablep (copy-readtable)) +(readtablep (copy-readtable nil)) +(readtablep (copy-readtable nil (copy-readtable))) +(let ((to (copy-readtable))) + (eq to (copy-readtable nil to))) + +(let ((zvar 123) + (table2 (copy-readtable))) + (declare (special zvar)) + (and (= zvar 123) + (set-syntax-from-char #\z #\' table2) + (= zvar 123) + (let ((*readtable* table2)) + (and (equal '(quote var) (read-from-string "zvar")) + (setq *readtable* (copy-readtable)) + (equal '(quote var) (read-from-string "zvar")) + (setq *readtable* (copy-readtable nil)) + (= 123 (eval (read-from-string "zvar"))))))) + +(not (eq (copy-readtable) *readtable*)) +(not (eq (copy-readtable) (copy-readtable))) +(not (eq (copy-readtable nil) *readtable*)) +(not (eq (copy-readtable nil) (copy-readtable nil))) + +(let ((*readtable* (copy-readtable nil))) + (and (handler-case (read-from-string "#<abc") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + (set-dispatch-macro-character #\# #\< + #'(lambda (s c n) + (declare (ignore c n)) + (read-char s t nil t) + (read s t nil t))) + (eq 'bc (read-from-string "#<abc")) + (setq *readtable* (copy-readtable)) + (eq 'bc (read-from-string "#<abc")) + (setq *readtable* (copy-readtable nil)) + (handler-case (read-from-string "#<abc") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)))) + +(let ((*readtable* (copy-readtable nil))) + (and (handler-case (read-from-string "#<abc") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + (set-dispatch-macro-character #\# #\< + #'(lambda (s c n) + (declare (ignore c n)) + (read-char s t nil t) + (read s t nil t))) + (eq 'bc (read-from-string "#<abc")) + (setq *readtable* (copy-readtable)) + (eq 'bc (read-from-string "#<abc")) + (set-dispatch-macro-character #\# #\< + #'(lambda (s c n) + (declare (ignore c n)) + (read-char s t nil t) + (read-char s t nil t) + (read s t nil t))) + (eq 'c (read-from-string "#<abc")) + (setq *readtable* (copy-readtable nil)) + (handler-case (read-from-string "#<abc") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)))) + + +(let ((table (copy-readtable nil))) + (and (eq :upcase (readtable-case table)) + (setf (readtable-case table) :invert) + (let ((copy (copy-readtable table))) + (and (not (eq table copy)) (eq (readtable-case copy) :invert))))) + +(let ((table (copy-readtable nil)) + copy) + (and (eq :upcase (readtable-case table)) + (setf (readtable-case table) :invert) + (eq (readtable-case table) :invert) + (setq copy (copy-readtable table)) + (eq (readtable-case copy) :invert) + (setf (readtable-case copy) :preserve) + (eq (readtable-case table) :invert))) + +(eq :upcase (let ((x (copy-readtable nil))) (readtable-case x))) +(let ((x (copy-readtable nil))) + (and (eq (setf (readtable-case x) :upcase) (readtable-case x)) + (eq (setf (readtable-case x) :downcase) (readtable-case x)) + (eq (setf (readtable-case x) :preserve) (readtable-case x)) + (eq (setf (readtable-case x) :invert) (readtable-case x)))) + +(handler-case (readtable-case 'not-a-readtable) + (type-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(handler-case (setf (readtable-case (copy-readtable nil)) :no-such-mode) + (type-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(let ((table (copy-readtable nil))) + (and (eq :upcase (readtable-case table)) + (setf (readtable-case table) :downcase) + (eq :downcase (readtable-case (copy-readtable table))))) + +(not (readtablep nil)) +(not (readtablep 'readtable)) +(readtablep *readtable*) +(readtablep (copy-readtable)) +(not (readtablep '*readtable*)) + +(null (get-dispatch-macro-character #\# #\0)) +(null (get-dispatch-macro-character #\# #\1)) +(null (get-dispatch-macro-character #\# #\2)) +(null (get-dispatch-macro-character #\# #\3)) +(null (get-dispatch-macro-character #\# #\4)) +(null (get-dispatch-macro-character #\# #\5)) +(null (get-dispatch-macro-character #\# #\6)) +(null (get-dispatch-macro-character #\# #\7)) +(null (get-dispatch-macro-character #\# #\8)) +(null (get-dispatch-macro-character #\# #\9)) + +(get-dispatch-macro-character #\# #\\) +(get-dispatch-macro-character #\# #\') +(get-dispatch-macro-character #\# #\() +(get-dispatch-macro-character #\# #\*) +(get-dispatch-macro-character #\# #\:) +(get-dispatch-macro-character #\# #\.) +(get-dispatch-macro-character #\# #\b) +(get-dispatch-macro-character #\# #\o) +(get-dispatch-macro-character #\# #\x) +(get-dispatch-macro-character #\# #\r) +(get-dispatch-macro-character #\# #\c) +(get-dispatch-macro-character #\# #\a) +(get-dispatch-macro-character #\# #\s) +(get-dispatch-macro-character #\# #\p) +(get-dispatch-macro-character #\# #\=) +(get-dispatch-macro-character #\# #\#) +(get-dispatch-macro-character #\# #\+) +(get-dispatch-macro-character #\# #\-) +(get-dispatch-macro-character #\# #\|) + +(get-dispatch-macro-character #\# #\newline) +(get-dispatch-macro-character #\# #\space) + +(handler-case (get-dispatch-macro-character #\a #\b) + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(handler-case (get-dispatch-macro-character #\a #\b nil) + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(handler-case (get-dispatch-macro-character #\a #\b *readtable*) + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(handler-case (set-dispatch-macro-character #\a #\b #'identity) + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(handler-case (set-dispatch-macro-character #\a #\b #'identity *readtable*) + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + + + +(let ((*readtable* (copy-readtable nil))) + (and (eq t (set-dispatch-macro-character + #\# #\{ ;dispatch on #{ + #'(lambda(s c n) + (declare (ignore c)) + (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)))) + (= 1 (read-from-string "#{(1 2 3 4)")) + (= 3 (read-from-string "#3{(0 1 2 3)")) + (= 123 (read-from-string "#{123")))) + +(let ((*readtable* (copy-readtable)) + (dollar #'(lambda (stream subchar arg) + (declare (ignore subchar arg)) + (list 'dollars (read stream t nil t))))) + (and (eq t (set-dispatch-macro-character #\# #\$ dollar)) + (equal '(dollars foo) (read-from-string "#$foo")))) + + + + +(and (let ((*readtable* (copy-readtable))) + (and (setf (readtable-case *readtable*) :invert) + (string= "ABC" (symbol-name (read-from-string "abc"))) + (string= "abc" (symbol-name (read-from-string "ABC"))) + (string= "AbC" (symbol-name (read-from-string "AbC"))) + (setf (readtable-case *readtable*) :preserve) + (string= "abc" (symbol-name (read-from-string "abc"))) + (string= "ABC" (symbol-name (read-from-string "ABC"))) + (string= "AbC" (symbol-name (read-from-string "AbC"))))) + (eq (readtable-case *readtable*) :upcase) + (string= "ABC" (symbol-name (read-from-string "abc"))) + (string= "ABC" (symbol-name (read-from-string "ABC"))) + (string= "ABC" (symbol-name (read-from-string "AbC")))) + + +(let ((*readtable* (copy-readtable))) + (and (setf (readtable-case *readtable*) :invert) + (set-macro-character #\< #'(lambda (stream c) + (declare (ignore c)) + (read-delimited-list #\> stream t)) + t) + (set-macro-character #\> (get-macro-character #\))) + (equal '(a b) (read-from-string "<a b>")))) + +(let ((*readtable* (copy-readtable))) + (and (setf (readtable-case *readtable*) :invert) + (set-macro-character #\< #'(lambda (stream c) + (declare (ignore c)) + (read-delimited-list #\> stream t))) + (set-macro-character #\> (get-macro-character #\))) + (with-input-from-string (stream "xyz<A b>jKl") + (and (eq 'xyz (read stream)) + (equal '(|a| b) (read stream)) + (eq '|jKl| (read stream)) + (eq 'end (read stream nil 'end)))))) + +(let ((*readtable* (copy-readtable nil))) + (and (equal (multiple-value-list (get-macro-character #\{)) '(nil nil)) + (eq t (make-dispatch-macro-character #\{)) + (get-macro-character #\{))) + +(let ((*readtable* (copy-readtable nil))) + (and (eq t (make-dispatch-macro-character #\{)) + (handler-case (read-from-string "{$a") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)))) + + +(let ((*readtable* (copy-readtable nil))) + (and (eq t (make-dispatch-macro-character #\{)) + #-clisp (handler-case (read-from-string "{$a") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + (set-dispatch-macro-character #\{ #\$ + #'(lambda (s c n) + (declare (ignore c n)) + (read s t nil t))) + (eq 'a (read-from-string "{$a")))) + + +(let ((*readtable* (copy-readtable nil))) + (and (eq t (make-dispatch-macro-character #\{)) + #-clisp (handler-case (read-from-string "{$a") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + (set-dispatch-macro-character #\{ #\$ + #'(lambda (s c n) + (declare (ignore c n)) + (read s t nil t))) + (with-input-from-string (stream "xyz{$a") + (and (eq 'xyz (read stream)) + (eq 'a (read stream)) + (eq 'end (read stream nil 'end)))))) + +(let ((*readtable* (copy-readtable nil))) + (and (eq t (make-dispatch-macro-character #\{ t)) + #-clisp (handler-case (read-from-string "{$a") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + (set-dispatch-macro-character #\{ #\$ + #'(lambda (s c n) + (declare (ignore c n)) + (read s t nil t))) + (with-input-from-string (stream "xyz{$a") + (and (eq '|XYZ{$A| (read stream)) + (eq 'end (read stream nil 'end)))))) + + +(let ((table (copy-readtable nil))) + (and (eq t (make-dispatch-macro-character #\{ nil table)) + #-clisp (let ((*readtable* table)) + (handler-case (read-from-string "{$a") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + (set-dispatch-macro-character #\{ #\$ + #'(lambda (s c n) + (declare (ignore c n)) + (read s t nil t)) + table) + (let ((*readtable* table)) + (with-input-from-string (stream "xyz{$a") + (and (eq 'xyz (read stream)) + (eq 'a (read stream)) + (eq 'end (read stream nil 'end))))))) + + +(let ((table (copy-readtable nil))) + (and (eq t (make-dispatch-macro-character #\{ t table)) + #-clisp (let ((*readtable* table)) + (handler-case (read-from-string "{$a") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + (set-dispatch-macro-character #\{ #\$ + #'(lambda (s c n) + (declare (ignore c n)) + (read s t nil t)) + table) + (let ((*readtable* table)) + (with-input-from-string (stream "xyz{$a") + (and (eq '|XYZ{$A| (read stream)) + (eq 'end (read stream nil 'end))))))) + + +(with-input-from-string (stream "") + (handler-case (read stream t) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + +(with-input-from-string (stream "") + (handler-case (read-preserving-whitespace stream t) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + +(with-input-from-string (stream "") + (handler-case (read stream t 'ignored) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + +(with-input-from-string (stream "") + (handler-case (read-preserving-whitespace stream t 'ignored) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + + +(with-input-from-string (stream "") + (eq 'end (read stream nil 'end))) + +(with-input-from-string (stream "") + (eq 'end (read-preserving-whitespace stream nil 'end))) + +(with-input-from-string (stream "a b") + (and (eq 'a (read-preserving-whitespace stream t nil nil)) + (equal (loop for c = (read-char stream nil nil) + while c collecting c) + '(#\space #\space #\b)))) + +(with-input-from-string (stream "a b") + (and (eq 'a (read-preserving-whitespace stream t nil)) + (equal (loop for c = (read-char stream nil nil) + while c collecting c) + '(#\space #\space #\b)))) + + +(with-input-from-string (stream "ok") + (let ((*standard-input* stream)) + (eq 'ok (read)))) + +(with-input-from-string (stream "ok") + (let ((*standard-input* stream)) + (eq 'ok (read-preserving-whitespace)))) + + +(with-input-from-string (stream "") + (let ((*standard-input* stream)) + (handler-case (read) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)))) + +(with-input-from-string (stream "") + (let ((*standard-input* stream)) + (handler-case (read-preserving-whitespace) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)))) + + +(with-input-from-string (stream "") + (let ((*standard-input* stream)) + (null (read nil nil)))) + +(with-input-from-string (stream "") + (let ((*standard-input* stream)) + (null (read-preserving-whitespace nil nil)))) + + +(with-input-from-string (*standard-input* "(a b") + (handler-case (read) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + +(with-input-from-string (*standard-input* "(a b") + (handler-case (read-preserving-whitespace) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + +(with-input-from-string (*standard-input* "(a (b") + (handler-case (read) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + +(with-input-from-string (*standard-input* "(a (b") + (handler-case (read-preserving-whitespace) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + +;; read-delimited-list +(with-input-from-string (*standard-input* "a b)") + (equal '(a b) (read-delimited-list #\)))) +(with-input-from-string (*standard-input* ")") + (null (read-delimited-list #\)))) +(with-input-from-string (*standard-input* "a b )") + (equal '(a b) (read-delimited-list #\)))) +(with-input-from-string (*standard-input* " a b )") + (equal '(a b) (read-delimited-list #\)))) +(with-input-from-string (*standard-input* " a b ) ") + (equal '(a b) (read-delimited-list #\)))) +(with-input-from-string (*standard-input* "a b c d e f g h i j k l m n o p q r)") + (equal '(a b c d e f g h i j k l m n o p q r) (read-delimited-list #\)))) + +(with-input-from-string + (*standard-input* "a (b) c (d) e f g h i j (k l m ) n o p q r)") + (equal '(a (b) c (d) e f g h i j (k l m) n o p q r) (read-delimited-list #\)))) +(with-input-from-string (*standard-input* "a x\\)x b)") + (equal '(a |X)X| b) (read-delimited-list #\)))) + +(with-input-from-string (*standard-input* "a b) xyz") + (and (equal '(a b) (read-delimited-list #\))) + (eq 'xyz (read)))) + +(with-input-from-string (*standard-input* "a #'car)") + (equal '(a #'car) (read-delimited-list #\)))) + +(with-input-from-string (*standard-input* "a #'car ;; +d #| e f |# g +z)") + (equal '(a #'car d g z) (read-delimited-list #\)))) + +(with-input-from-string (*standard-input* "a #'car ;; +d #| e f |# g +z) +xyz") + (and (equal '(a #'car d g z) (read-delimited-list #\))) + (eq 'xyz (read)))) + +(with-input-from-string (*standard-input* "1 2 3 4 5 6 ]") + (equal (read-delimited-list #\]) + '(1 2 3 4 5 6))) + +(get-macro-character #\) nil) + +(let ((*readtable* (copy-readtable nil)) + (f #'(lambda (stream char arg) + (declare (ignore char arg)) + (mapcon #'(lambda (x) + (mapcar #'(lambda (y) (list (car x) y)) (cdr x))) + (read-delimited-list #\} stream t))))) + (set-dispatch-macro-character #\# #\{ f) + (get-macro-character #\) nil) + (set-macro-character #\} (get-macro-character #\) nil)) + (with-input-from-string (*standard-input* "#{ p q z a}") + (equal (read) '((p q) (p z) (p a) (q z) (q a) (z a))))) +(handler-case (with-input-from-string (stream "1 2 3 . 4)") + (read-delimited-list #\) stream t)) + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + + +(get-dispatch-macro-character #\# #\( nil) +(set-syntax-from-char #\z #\' (copy-readtable nil) nil) + + +(equal '(abc 3) (multiple-value-list (read-from-string "abc"))) + +(handler-case (read-from-string "") + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(handler-case (read-from-string "" t 'ignored) + (end-of-file () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + +(eq 'end (read-from-string "" nil 'end)) + +(equal '(b 5) (multiple-value-list (read-from-string "(a b c)" t nil + :start 2 :end 6))) + +(equal '(b 4) (multiple-value-list (read-from-string "(a b c)" t nil + :start 2 + :preserve-whitespace t))) + +(null (read-from-string "" nil)) + +(multiple-value-bind (thing pos) (read-from-string " a b" t nil :start 3) + (and (eq thing 'b) + (or (= pos 4) (= pos 5)))) + +(multiple-value-bind (thing pos) (read-from-string "abcdefg" t nil :end 2) + (and (eq thing 'ab) + (or (= pos 2) (= pos 3)))) + +(equal '(ijk 3) + (multiple-value-list (read-from-string "ijk xyz" t nil + :preserve-whitespace t))) + +(equal '(def 7) + (multiple-value-list (read-from-string "abc def ghi" t nil + :start 4 :end 9 + :preserve-whitespace t))) + +(= 3 (read-from-string " 1 3 5" t nil :start 2)) +(multiple-value-bind (thing pos) (read-from-string "(a b c)") + (and (equal thing '(A B C)) + (or (= pos 7) (= pos 8)))) + +(handler-case (read-from-string "(a b") + (error () t) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + + +(let ((*readtable* (copy-readtable))) + (and (progn + #-clisp (handler-case (read-from-string "#<abc") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + #+clisp t) + (set-dispatch-macro-character #\# #\< + #'(lambda (s c n) + (declare (ignore c n)) + (read-char s t nil t) + (read s t nil t))) + (eq 'bc (read-from-string "#<abc")) + (setq *readtable* (copy-readtable)) + (eq 'bc (read-from-string "#<abc")) + (set-dispatch-macro-character #\# #\< + #'(lambda (s c n) + (declare (ignore c n)) + (read-char s t nil t) + (read-char s t nil t) + (read s t nil t))) + (eq 'c (read-from-string "#<abc")) + (setq *readtable* (copy-readtable nil)) + (progn + #-clisp + (handler-case (read-from-string "#<abc") + (reader-error () t) + (error () nil) + (:no-error (&rest rest) (declare (ignore rest)) nil)) + #+clisp t))) + + +(let ((*readtable* (copy-readtable))) + (and (eq t (make-dispatch-macro-character #\{)) + (eq t (set-dispatch-macro-character + #\{ #\s #'(lambda (s c n) + (declare (ignore c n)) + `(section ,(read s t nil t))))) + (equal '(section (x y z)) (read-from-string "{s (x y z)")) + (equal '(section (x y z)) (read-from-string "{S (x y z)")))) + + +(multiple-value-bind (function non-terminating-p) (get-macro-character #\") + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\#) + (and function non-terminating-p)) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\') + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\() + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\)) + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\,) + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\;) + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\`) + (and function (not non-terminating-p))) + +(multiple-value-bind (function non-terminating-p) (get-macro-character #\a) + (and (null function) (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\z) + (and (null function) (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\Space) + (and (null function) (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\Tab) + (and (null function) (not non-terminating-p))) + +(multiple-value-bind (function non-terminating-p) (get-macro-character #\" nil) + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\# nil) + (and function non-terminating-p)) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\' nil) + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\( nil) + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\) nil) + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\, nil) + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\; nil) + (and function (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\` nil) + (and function (not non-terminating-p))) + +(multiple-value-bind (function non-terminating-p) (get-macro-character #\a nil) + (and (null function) (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\z nil) + (and (null function) (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) + (get-macro-character #\Space nil) + (and (null function) (not non-terminating-p))) +(multiple-value-bind (function non-terminating-p) (get-macro-character #\Tab nil) + (and (null function) (not non-terminating-p))) + +(and (let ((*readtable* (copy-readtable))) + (and (eq t (set-macro-character #\$ + #'(lambda (s c) + (declare (ignore c)) + `(dollars ,(read s t nil t))))) + (equal '(dollars 100) (read-from-string "$100")) + (eq '|$100| (read-from-string "\\$100")) + (eq '|$100| (read-from-string "|$|100")))) + (null (get-macro-character #\$)) + (eq '|$100| (read-from-string "$100"))) + + +(let ((*readtable* (copy-readtable))) + (and (eq t (set-syntax-from-char #\[ #\()) + (equal '(0 1 2 3) (read-from-string "[0 1 2 3)")))) + +(let ((table1 (copy-readtable nil)) + (table2 (copy-readtable nil))) + (and (eq t (set-syntax-from-char #\[ #\( table1 table1)) + (equal '(0 1 2 3) (let ((*readtable* table1)) + (read-from-string "[0 1 2 3)"))) + (eq t (set-syntax-from-char #\{ #\[ table2 table1)) + (equal '(0 1 2 3) (let ((*readtable* table2)) + (read-from-string "{0 1 2 3)"))))) + +(let ((*readtable* (copy-readtable))) + (and (eq t (set-syntax-from-char #\[ #\.)) + (eq '|3[0| (read-from-string "3[0")))) + +(let* ((str (concatenate 'string + (loop repeat 100 collecting #\() + "kernel" + (loop repeat 100 collecting #\)))) + (thing (read-from-string str))) + (and (= 1 (length thing)) + (eq 'kernel (loop repeat 101 + for x = thing then (car x) + finally (return x))))) + + + + +(null (let ((*read-suppress* t)) (read-from-string "abc"))) +(null (let ((*read-suppress* t)) + (with-input-from-string (stream "abc") + (read stream)))) +(null (let ((*read-suppress* t)) + (with-input-from-string (stream "abc") + (read-preserving-whitespace stream)))) +(null (let ((*read-suppress* t)) + ;; http://www.lispworks.com/reference/HyperSpec/Body/v_rd_sup.htm + ;; If the value of *read-suppress* is true, read, + ;; read-preserving-whitespace, read-delimited-list, + ;; and read-from-string all return a primary value of nil + ;; when they complete successfully; + (with-input-from-string (stream "abc xyz)") + (read-delimited-list #\) stream)))) + +(flet ((num2str (n base) + (let* ((base-digits "0123456789ABCDEFGHIJKLMNOPQRSTUV") + (minus-p (< n 0)) + (n (if minus-p (- n) n)) + digits) + (loop with x = n + do (multiple-value-bind (q r) (floor x base) + (push (aref base-digits r) digits) + (setq x q) + (when (zerop q) (return)))) + (when minus-p (push #\- digits)) + (make-array (length digits) + :element-type 'character :initial-contents digits)))) + (loop for base from 2 upto 32 + always (loop for n from -100 upto 100 + always (= n (let ((*read-base* base)) + (read-from-string (num2str n base))))))) + +(labels ((int2str (n base) + (let* ((base-digits "0123456789ABCDEFGHIJKLMNOPQRSTUV") + (minus-p (< n 0)) + (n (if minus-p (- n) n)) + digits) + (loop with x = n + do (multiple-value-bind (q r) (floor x base) + (push (aref base-digits r) digits) + (setq x q) + (when (zerop q) (return)))) + (when minus-p (push #\- digits)) + (make-array (length digits) + :element-type 'character :initial-contents digits))) + (ratio2str (r base) + (concatenate 'string + (int2str (numerator r) base) + "/" + (int2str (denominator r) base)))) + (loop for base from 2 upto 32 + always (loop for numerator from -100 upto 100 by 23 + always (loop for denominator from 1 upto 300 by 51 + always (= (/ numerator denominator) + (let ((*read-base* base)) + (read-from-string + (ratio2str (/ numerator + denominator) + base)))))))) |