lispとrubyとpythonと その7 パターンマッチ(common lispだけ)

rubyとpythonにはパターンマッチがないみたい。たぶん。
comon lispではcl-matchでいける。
asdfで入れたヤツだとletmatchがなんかヘン。
二文字だけいじったら動いたけどあってんのかな。

;;パターンマッチ
;;cl-matchを使う
;;asdfで入れとくこと

(require 'cl-match)

;;defpattern
;;使い方がわからない

;;ifmatch
;;基本的なパターンマッチ

(defun pm0 (target)
  (cl-match:ifmatch (list a b c) target
      (format t "~A:~A:~A~%" a b c)
    (format t "nil~%")))

(pm0 '(1 2))
;;->nil

(pm0 '(1 2 3))
;;->1:2:3      

(defstruct struct0 fld0 fld1)

(defclass class0 () ((slot0 :initform nil :accessor class0-slot0)
    (slot1 :initform nil :accessor class0-slot1)))

(defclass class1 () ((slotA :initform nil :accessor class-slotA)
    (slotB :initform nil :accessor class-slotB)))

(defclass class2 () ((slotA :initform nil :accessor class-slotA)
    (slotB :initform nil :accessor class-slotB)))

;;letmatch
;;色々分配できるdestructuring-bind
;;match.lispを見ると
;; (defmac letmatch (patrn expr &body success)
;;   `(ifmatch (,patrn ,expr ,(succeed success) (error "LETMATCH:  mismatch."))))
;;になってんだけど、このままだとエラーになる
;; (defmac letmatch (patrn expr &body success)
;;   `(ifmatch ,patrn ,expr ,(succeed success) (error "LETMATCH:  mismatch.")))
;;の間違い??
;;とりあえず書き換えてみた。

(defun pm1 (target)
  (cl-match:letmatch (list a b c) target
      (format t "~A:~A:~A~%" a b c)))

(defun pm2 (target)
  (cl-match:letmatch (acsrs (class0-slot0 s0) (class0-slot1 s1)) target
      (format t "~A:~A~%" s0 s1)))

(let ((c (make-instance 'class0)))
  (setf (class0-slot0 c) "aaa")
  (setf (class0-slot1 c) "bbb")
  (pm2 c))
;;->aaa:bbb

;;マッチ
(defun pm3 (target)
  (cl-match:match target
    ((type class0) (format t "class0~%"))
    ((type atom) (format t "atom~%"))
    ((list a b c) (format t "~A:~A:~A~%" a b c))
    ((type list) (format t "list~%"))))

(let ((c (make-instance 'class0)))
  (pm3 c))
;;->class0

(pm3 nil)
;;->atom

(pm3 '(1 2 3))
;;->1:2:3

(pm3 '(1 2 3 4 5))
;;->list

;;指定できるパターン

;;acsrs
;;アクセサでマッチさせる
(let ((c (make-instance 'class0)))
  (setf (class0-slot0 c) "aaa")
  (setf (class0-slot1 c) "bbb")
  (cl-match:ifmatch 
      (acsrs (class0-slot0 s0) (class0-slot1 s1)) 
      c
      (format t "slot:~A:~A~%" s0 s1)))
;;->slot:aaa:bbb

;;and
;;複数のパターンを指定
;;これだとタイプとアクセサの両方でマッチさせてる
(let ((c (make-instance 'class1)))
  (setf (class-slotA c) "aaa")
  (setf (class-slotB c) "bbb")
  (cl-match:ifmatch 
      (and (type class1)
     (acsrs (class-slotA sA) (class-slotB sB)))
       c
       (format t "slot:~A:~A~%" sA sB)))
;;->slot:aaa:bbb

;;array
;;配列をマッチさせる
(cl-match:ifmatch (array 1 (a b c))
    #(1 2 3)
    (format t "array:~A:~A:~A~%" a b c))
;;->array:1:2:3

;;as
;;パターンに名前をつけて変数で参照できるようにする
(cl-match:ifmatch (as lst (list a b c))
    '(1 2 3)
    (format t "list:~A/~A:~A:~A~%" lst a b c))
;;->list:(1 2 3)/1:2:3

;;cons
;;consにマッチ
(cl-match:ifmatch (cons car cdr)
    '(1 . 2)
    (format t "~A:~A~%" car cdr))
;;->1:2

;;list
;;listにマッチさせる
(cl-match:ifmatch (list a (list b c))
    '(1 (2 3))
    (format t "~A:~A:~A~%" a b c ))
;;->1:2:3

;; list*
;;listと大体同じなんだけど末尾の扱いが違う
;;みたほうが分かるだろうから両方書いておく
(cl-match:ifmatch (list a b c)
    '(1 2 3)
    (format t "~A:~A:~A~%" a b c))
;;->1:2:3

(cl-match:ifmatch (list* a b c)
    '(1 2 3)
    (format t "~A:~A:~A~%" a b c))
;;->1:2:(3)

;; or
;;どっちかにマッチ...なんだけど
(cl-match:ifmatch (or 1 2) 
    2
    (format t "match~%")
  (format t "not match~%"))
;;->match

(cl-match:ifmatch (or 1 2) 
    3
    (format t "match~%")
  (format t "not match~%"))
;;->not match

(cl-match:ifmatch (list a b (or c))
    '(1 2 3)
    (format t "match:~A:~A~%" a b)
  (format t "not match"))
;;->match:1:2

;; quote
;;quoteしたのをマッチさせる
(cl-match:ifmatch 'a
    'a
    (format t "match~%")
  (format t "not match"))
;;->match
(cl-match:ifmatch 'a
    'b
    (format t "match~%")
  (format t "not match"))
;;->not match

;; slots
;;スロットでマッチさせる
(let ((c (make-instance 'class0)))
  (setf (class0-slot0 c) "aaa")
  (setf (class0-slot1 c) "bbb")
  (cl-match:ifmatch 
      (slots (slot0 s0) (slot1 s1))
      c
      (format t "slots:~A:~A~%" s0 s1)))
;;->slots:aaa:bbb

;; struct
;;構造体にマッチさせる
(cl-match:defpattern struct0 (&rest fields) `(struct struct0- ,@fields))

(let ((s (make-struct0 :fld0 "aaa" :fld1 "bbb")))
  (cl-match:ifmatch (struct struct0- (fld0 f0) (fld1 f1)) 
      s
      (format t "struct:~A:~A~%" f0 f1)))
;;->struct:aaa:bbb

;; type
;;型でマッチさせる
(let ((s (make-struct0 :fld0 "aaa" :fld1 "bbb")))
  (cl-match:ifmatch (type struct0)
      s
      (format t "match~%")))
;;->match

;; vals
;;多値にマッチさせる
(cl-match:ifmatch (vals a b c)
    (values 1 2 3)
    (format t "values:~A:~A:~A~%" a b c))
;;->values:1:2:3

;; vec
;;vectorにマッチ
(cl-match:ifmatch (vec (a b c))
    #(1 2 3)
    (format t "vec:~A:~A:~A~%" a b c))
;;->vec:1:2:3

;; when
;;マッチする条件をかける
(cl-match:ifmatch
    ;;リストが重複しない三つの値で一つ目が5より大きいときにマッチ
    (when (< 5 a) (list a b c))
     '(6 2 3)
     (format t "when test ~A:~A:~A" a b c))
;;->when test 6:2:3