18.2他の構造
> (dbind (a b c) #(1 2 3)
(list a b c))
(1 2 3)
> (dbind (a (b c) d) '( 1 #(2 3) 4)
(list a b c d))
(1 2 3 4)
> (dbind (a (b . c) &rest d) '(1 "fribble" 2 3 4)
(list a b c d))
(1 #\f "ribble" (2 3 4))
- 少し難しくなってきたので、自分で実装してみよう。
- 以下のようになればいい。
> (destruc '(a b c) 'seq #'atom)
((A (ELT SEQ 0)) (B (ELT SEQ 1)) (C (ELT SEQ 2)))
> (destruc '(a (b . c) &rest d) 'seq)
((A (ELT SEQ 0))
((#:G2 (ELT SEQ 1)) (B (ELT #:G2 0)) (C (SUBSEQ #:G2 1)))
(D (SUBSEQ SEQ 2)))
> (dbind-ex (destruc '(a (b . c) &rest d) 'seq) '(body))
(LET ((A (ELT SEQ 0))
(#:G4 (ELT SEQ 1))
(D (SUBSEQ SEQ 2)))
(LET ((B (ELT #:G4 0))
(C (SUBSEQ #:G4 1)))
(PROGN BODY)))
(defun destruc2 (bind seq &optional (n 0) restp)
(when bind
(when (atom bind)
(setq bind (list bind) restp t))
(let ((sym (car bind)))
(remove t
`( ,(if (atom sym)
(if (member sym '(&rest &body))
(setq n (1- n) restp t)
`(,sym (,(if restp 'subseq 'elt) ,seq ,n)))
(let ((new-seq (gensym)))
`((,new-seq (elt ,seq ,n))
,@(destruc2 sym new-seq))))
,@(destruc2 (cdr bind) seq (1+ n) restp))))))
(defun dbind-ex2 (binds body)
(if binds
(let (here-binds under-binds)
(dolist (bind binds)
(if (atom (car bind))
(setq here-binds (cons bind here-binds))
(setq here-binds (cons (car bind) here-binds)
under-binds (nconc under-binds (cdr bind)))))
`(let ,(nreverse here-binds)
,(dbind-ex2 under-binds body)))
`(progn ,@body)))
> (destruc2 '(a b c) 'seq)
((A (ELT SEQ 0)) (B (ELT SEQ 1)) (C (ELT SEQ 2)))
> (destruc2 '(a (b . c) &rest d) 'seq)
((A (ELT SEQ 0))
((#:G849 (ELT SEQ 1)) (B (ELT #:G849 0)) (C (SUBSEQ #:G849 1)))
(D (SUBSEQ SEQ 2)))
> (dbind-ex2 (destruc2 '(a (b . c) &rest d) 'seq) '(body))
(LET ((A (ELT SEQ 0)) (#:G850 (ELT SEQ 1)) (D (SUBSEQ SEQ 2)))
(LET ((B (ELT #:G850 0)) (C (SUBSEQ #:G850 1)))
(PROGN BODY)))
> (defmacro dbind2 (pat seq &body body)
(let ((gseq (gensym)))
`(let ((,gseq ,seq))
,(dbind-ex2 (destruc2 pat gseq) body))))
> (dbind2 (a b c) #(1 2 3)
(list a b c))
> (dbind2 (a (b c) d) '( 1 #(2 3) 4)
(list a b c d))
> (dbind2 (a (b . c) &rest d) '(1 "fribble" 2 3 4)
(list a b c d))
> (dbind2 (a b c) (list 1 2))
>>Error
- となってしまうが、safe-eltとsafe-subseqというマクロを作ってやれば回避できる。
(defmacro safe-elt (sequence index)
`(if (> (length ,sequence) ,index)
(elt ,sequence ,index)))
(defmacro safe-elt2 (sequence index)
`(if (> (length ,sequence) ,index)
(elt ,sequence ,index)
(when (typep ,sequence 'string)
#\Nul)))
(defmacro safe-subseq (sequence start &optional end)
`(let ((ret (safe-subseq2 ,sequence ,start ,end)))
(unless (or (null ret) (equalp ret #()) (equal ret ""))
ret)))
(defmacro safe-subseq2 (sequence start &optional end)
(with-gensyms (seq len)
`(let* ((,seq ,sequence)
(,len (length ,seq)))
(subseq ,seq
(min ,start ,len)
,(if end `(min ,len ,end))))))
- destruc2のeltとsubseqを置き換えてつかう。
- safe-eltとsafe-subseqはマッチしない変数にはすべてnilを束縛する。
- safe-elt2とsafe-subseq2はマッチしない変数にはその場のタイプに対応したnull-valueを束縛する。
> (dbind2 (a (b c d) (e f . g) h) '(0 "ab" "cd") (list a b c d e f g h))
(0 #\a #\b NIL #\c #\d NIL NIL)
> (dbind2 (a (b c d) (e f . g) h) '(0 "ab" "cd") (list a b c d e f g h))
(0 #\a #\b #\Nul #\c #\d "" NIL)
