;;;
;;; 22 黒帯のためのLOOP
;;;
;; 説明よりも、コードサンプルを中心に考える。
;; 22.1 LOOPのパーツ
;; 特になし
;; 22.2 反復の制御
;; この例は動かせない。
;; (loop
;; for item in list
;; for i from 1 to 10
;; do (something))
;; 22.3 数えるループ
(loop for i upto 10 collect i)
; (0 1 2 3 4 5 6 7 8 9 10)
(loop for i downto -10 collect i)
; Error: Don't know where to start stepping.
(loop for i from 0 downto -10 collect i)
; (0 -1 -2 -3 -4 -5 -6 -7 -8 -9 -10)
;; 22.4 コレクションやパッケージについてループする。
(loop for i in (list 3 4 5 6) collect i)
; (3 4 5 6)
(loop for i in (list 3 4 5 6) by #'cddr collect i)
; (3 5)
(loop for i on (list 3 4 5 6) collect i)
; ((3 4 5 6) (4 5 6) (5 6) (6))
(loop for i on (list 3 4 5 6) by #'cddr collect i)
; ((3 4 5 6) (5 6))
(loop for x across "abcd" collect x)
; (#\a #\b #\c #\d)
(defparameter *v* excl::*package-table*)
(loop for x across *v* collect x)
; (NIL #<The COMMON-LISP package> #<The KEYWORD package> #<The EXCL package> #<The ACLMOP package> #<The SYSTEM package>
; #<The GARBAGE package> #<The COMMON-LISP-USER package> #<The TOP-LEVEL package> #<The COMPILER package> #<The FOREIGN-FUNCTIONS package>
; #<The DEBUGGER package> #<The MULTIPROCESSING package> #<The DEFSYSTEM package> #<The LEP package> #<The LEP-IO package>
; #<The NULL-PACKAGE-REPLY-SESSION package> #<The ACL-SOCKET package> #<The EXCL.SCM package> #<The CROSS-REFERENCE package>
; #<The PROFILER package> #<The INSPECT package> #<The NET.URI package> #<The ASDF package> #<The UTIL.AKA package>
; #<The ALEXANDRIA.0.DEV package> #<The CXML-SYSTEM package> #<The TRIVIAL-GRAY-STREAMS-SYSTEM package>
; #<The CLOSURE-COMMON-SYSTEM package> #<The PURI-SYSTEM package> #<The TRIVIAL-GRAY-STREAMS package> #<The BABEL-ENCODINGS package>
; #<The BABEL package> #<The RUNES package> #<The UTF8-RUNES package> #<The RUNES-ENCODING package> #<The HAX package> #<The PURI package>
; #<The CXML package> #<The SAX package> #<The CXML-XMLS package> #<The KLACKS package> #<The DOM package> #<The RUNE-DOM package>
; #<The DOMTEST package> #<The DOMTEST-TESTS package> #<The XMLCONF package> NIL NIL NIL)
;; 処理系が使っているハッシュテーブルを探す。
(do-all-symbols (sym)
(when (handler-case
(symbol-value sym)
(condition (c) nil))
(when (typep (symbol-value sym) 'hash-table)
(print sym))))
; ACL-SOCKET::*HOSTNAME-CACHE*
; ACL-SOCKET::*IPADDR-CACHE*
; ACL-SOCKET::*PORT-CACHE*
; ASDF::*DEFINED-SYSTEMS*
; BABEL::*STRING-VECTOR-MAPPINGS*
; BABEL-ENCODINGS::*ABSTRACT-MAPPINGS*
; BABEL-ENCODINGS::*CHARACTER-ENCODINGS*
; COMPILER::*LOC-PARAM-CONS*
; CXML:*DTD-CACHE*
; EXCL::*ADVISE-HASH-TABLE*
; EXCL::*EQL-SPECIALIZER-TABLE*
; EXCL::*PACKAGE-NAMES*
; EXCL::*LAP-EMITTERS*
; EXCL::*FSPEC->PATHNAME*
; EXCL::.SAVED-ENTRY-POINTS.
; EXCL::*PATHNAME->FSPECS*
; EXCL::*LONG-METHOD-COMBINATION-FUNCTIONS*
; EXCL::*PREVIOUS-NWRAPPERS*
; EXCL::*ARG-INFO-TABLE*
; EXCL::*EF-DUAL-CHANNEL-FUNCTIONS*
; EXCL::*FWRAP-HASH-TABLE*
; EXCL::*SHARED-ESLOTS*
; EXCL::*EF-SINGLE-CHANNEL-FUNCTIONS*
; EXCL::*LOGICAL-PATHNAME-TRANSLATIONS*
; EXCL::*SETF-FUNCTION-HASHTABLE*
; EXCL::*XP-PARSER-TABLE*
; EXCL::*PROPERTY-HASH-TABLE*
; EXCL::*EF-SINGLE-CHANNEL-DIRECT-FUNCTIONS*
; EXCL::*FIND-CLASS*
; EXCL::*NAME-TO-CHAR-TABLE*
; EXCL::*ENCAPSULATION-HASH-TABLE*
; EXCL::*SHARED-CONS-TABLE*
; EXCL::.SET-READTABLES.
; EXCL.SCM::*CHANGED-DEFINITIONS*
; EXCL.SCM::*FILE-SECTIONS*
; FOREIGN-FUNCTIONS::*ANON-IFTYPE-CACHE*
; NET.URI::*URIS*
; PURI::*URIS*
; RUNES::*RUNE-NAMES*
; RUNES-ENCODING::*NAMES*
; RUNES-ENCODING::*ENCODINGS*
; RUNES-ENCODING::*CHARSETS*
; TOP-LEVEL::*COMMAND-HASH-TABLE*
; NIL
(loop for k being the hash-keys in excl::*package-names* collect k)
; ("" "MULTIPROCESSING" "SI" "FOREIGN-FUNCTIONS" "CL-USER" "CXML-SYSTEM" "CL" "DEBUG" "DS" "NET.URI" ...)
(loop for k being the hash-keys in excl::*package-names* (hash-value v) collect v)
; (#<The KEYWORD package> #<The MULTIPROCESSING package> #<The SYSTEM package>
; #<The FOREIGN-FUNCTIONS package> #<The COMMON-LISP-USER package> #<The CXML-SYSTEM package>
; #<The COMMON-LISP package> #<The DEBUGGER package> #<The DEFSYSTEM package> #<The NET.URI package> ...)
(loop for v being the hash-values in excl::*package-names* collect v)
; (#<The KEYWORD package> #<The MULTIPROCESSING package> #<The SYSTEM package>
; #<The FOREIGN-FUNCTIONS package> #<The COMMON-LISP-USER package> #<The CXML-SYSTEM package>
; #<The COMMON-LISP package> #<The DEBUGGER package> #<The DEFSYSTEM package> #<The NET.URI package> ...)
(loop for sym being the symbols in (find-package :cl) collect sym)
; (COMMON-LISP::P LOGCOUNT TIME ARITHMETIC-ERROR-OPERANDS NSUBST CHANGE-CLASS MAPHASH EVAL-WHEN BLOCK MEMBER-IF ...)
(loop for sym being the symbols in (find-package :cl) count sym)
; 978
(loop for sym being the present-symbols in (find-package :cl) count sym)
; 978
(loop for sym being the external-symbols in (find-package :cl) count sym)
; 977
(loop for sym being the external-symbols in (find-package :excl) count sym)
; 588
(loop for sym being the present-symbols in (find-package :excl) count sym)
; 6947
(loop repeat 5) ; NIL
(loop repeat 5
for x = 0 then (1+ x)
collect x) ; (0 1 2 3 4)
(loop repeat 5
for x = 0 then y
for y = 1 then (+ x y)
collect y) ; (1 2 4 8 16)
(loop repeat 3 for k being the hash-keys in excl::*package-names* collect k)
; ("" "MULTIPROCESSING" "SI")
;; 22.6 ローカル変数
;; 特になし
;; 22.7 変数を分配する
(loop for (a b) in '((1 2) (3 4) (5 6))
do (format t "a: ~a; b: ~a~%" a b))
; a: 1; b: 2
; a: 3; b: 4
; a: 5; b: 6
; NIL
(loop for cons on (list 1 2 3 4 5)
do (format t "~a" (car cons))
when (cdr cons) do (format t ", "))
; 1, 2, 3, 4, 5
; NIL
(loop for (item . rest) on (list 1 2 3 4 5)
do (format t "~a" item)
when rest do (format t ", "))
; 1, 2, 3, 4, 5
; NIL
(defparameter *random* (loop repeat 100 collect (random 1000)))
(loop for i In *random*
counting (evenp i) into evens
counting (oddp i) into odds
summing i into total
maximizing i into max
minimizing i into min
finally (return (list min max total evens odds)))
; (0 998 54241 59 41)
;; 22.9 無条件実行
(loop for i from 1 to 10 do (print i))
; 1
; 2
; 3
; 4
; 5
; 6
; 7
; 8
; 9
; 10
; NIL
(block outer
(loop for i from 0 return 100)
(print "This will print")
200)
; "This will print"
; 200
(block outer
(loop for i from 0 do (return-from outer 100))
(print "This won't print")
200) ; 100
;; 22.10 条件実行
(loop for i from 1 to 10 do (when (evenp i) (print i)))
; 2
; 4
; 6
; 8
; 10
; NIL
(loop for i from 1 to 10 when (evenp i) sum i)
; 30
(loop for key in (list "CXML" "RUNE" "CL" "DEBUG" "HOGE" "PIYO")
when (gethash key excl::*package-names*) collect it)
; (#<The CXML package> #<The COMMON-LISP package> #<The DEBUGGER package>)
;; 22.11 セットアップと後始末
(loop named outer for p across excl::*package-table*
do (when p
(loop for sym being the symbols in p
do (if (equal "CAR" (symbol-name sym))
(return-from outer p))))) ; #<The COMMON-LISP package>
;; 22.12 終了条件のテスト
(if (loop for n in (list 1 2 3 4) always (evenp n))
(print "All numbers even.")) ; NIL
(if (loop for n in (mapcar #'(lambda (n) (* 2 n)) (list 1 2 3 4)) always (evenp n))
(print "All numbers even.")) ; "All numbers even."
(if (loop for n in (list 1 3 11 17) never (evenp n))
(print "All numbers odd.")) ; "All numbers odd."
(loop for char across "abc123" thereis (digit-char-p char)) ; 1
(loop for char across "abcdef" thereis (digit-char-p char)) ; NIL
;; 22.13 まとめ
特になし。
loop、便利だなぁ。
お、やっと後半戦に入れる。後半戦は実践の章。
こつこつ。
