LISPでオブジェクト指向プログラミングのサンプル

LISPでオブジェクト指向プログラミング（クラス定義とか）をしたことがほとんどなかったので，下記問題解答を記述してみたものを，サンプルと備忘録を兼ねて掲載．元はC++の構造体を用いる問題なので，継承も集約もMOPもないけど．

* APG4b：[EX24 - 時計の実装](https://atcoder.jp/contests/apg4b/tasks/APG4b_by)

入力例（上2行，時刻と変更秒数）と出力例（下2行，変更前と変更後）を抜粋．

```
0 0 0
90
00:00:00
00:01:30
```
```
0 0 0
-5
00:00:00
23:59:55
```
```
23 59 30
30
23:59:30
00:00:00
```
```
6 57 9
-4195
06:57:09
05:47:14
```

#Common Lisp（CLOS）の場合

```common-lisp
(defclass Clock ()
  ((hour   :initform 0)
   (minute :initform 0)
   (second :initform 0)))
 
(defmethod setc ((c Clock) h m s)
  (setf (slot-value c 'hour  ) h)
  (setf (slot-value c 'minute) m)
  (setf (slot-value c 'second) s)
  t)
 
(defmethod to_str ((c Clock))
  (let ((h (slot-value c 'hour))
        (m (slot-value c 'minute))
        (s (slot-value c 'second)))
    (concatenate 'string
      (if (< h 10) "0" "") (write-to-string h) ":"
      (if (< m 10) "0" "") (write-to-string m) ":"
      (if (< s 10) "0" "") (write-to-string s))))
 
(defmethod shift ((c Clock) diff_second)
  (let ((h (slot-value c 'hour))
        (m (slot-value c 'minute))
        (s (slot-value c 'second)))
    (let ((tmp (+ (* h 3600) (* m 60) s diff_second)))
      (let* ((sd (mod (mod tmp 3600) 60))
             (md (mod (/ (- tmp sd) 60) 60))
             (hd (/ (- tmp sd (* md 60)) 3600)))
        (if (< hd 0) (setq hd (+ 24 hd)))
        (if (= hd 24) (setq hd 0))
        (if (< md 0) (setq md (+ 60 md)))
        (if (< sd 0) (setq sd (+ 60 hd)))
        (setc c hd md sd)
        t))))
 
(defparameter hour (read))
(defparameter mint (read))
(defparameter secd (read))
(defparameter diff (read))
 
(defparameter clk (make-instance 'Clock))
(setc clk hour mint secd)
(format t "~A~%" (to_str clk))
(shift clk diff)
(format t "~A~%" (to_str clk))
```

#Emacs Lisp（EIEIO）の場合
* ドキュメント：[EIEIO](https://www.gnu.org/software/emacs/manual/html_node/eieio/)

Common Lispの場合の記述に次の修正を行うことで実行可能．

| Common Lisp | Emacs Lisp |
|:-:|:-:|
|   | 冒頭で`(require 'eieio)` |
| `(concatenate 'string ...)` | `(concat ...)` |
| `write-to-string` | `number-to-string` |
| `defparameter` | `setq` |
| `(format t "~A~%" ...)` | `(princ ...) (princ "\n")` |

#Scheme（Gauche）の場合
* ドキュメント：[7 オブジェクトシステム](https://practical-scheme.net/gauche/man/gauche-refj/obuziekutosisutemu.html)

```scheme
(define-class <Clock> ()
  ((hour   :init-value 0)
   (minute :init-value 0)
   (second :init-value 0)))

(define-method setc! ((c <Clock>) h m s)
  (set! (ref c 'hour  ) h)
  (set! (ref c 'minute) m)
  (set! (ref c 'second) s))

(define-method to_str ((c <Clock>))
  (let ((h (ref c 'hour)) (m (ref c 'minute)) (s (ref c 'second)))
    (string-append
      (if (< h 10) "0" "") (number->string h) ":"
      (if (< m 10) "0" "") (number->string m) ":"
      (if (< s 10) "0" "") (number->string s))))

(define-method shift! ((c <Clock>) diff_second)
  (let ((h (ref c 'hour)) (m (ref c 'minute)) (s (ref c 'second)))
    (let ((t (+ (* h 3600) (* m 60) s diff_second)))
      (let* ((sd (mod (mod t 3600) 60))
             (md (mod (/ (- t sd) 60) 60))
             (hd (/ (- t sd (* md 60)) 3600)))
        (if (< hd 0) (set! hd (+ 24 hd)))
        (if (= hd 24) (set! hd 0))
        (if (< md 0) (set! md (+ 60 md)))
        (if (< sd 0) (set! sd (+ 60 hd)))
        (setc! c hd md sd)
        #t))))

(define hour        (read))
(define minute      (read))
(define second      (read))
(define diff_second (read))

(define clock (make <Clock>))
(setc! clock hour minute second)
(display (to_str clock)) (newline)
(shift! clock diff_second)
(display (to_str clock)) (newline)
```

#Scheme（GNU Guile）の場合
* ドキュメント：[8 GOOPS](https://www.gnu.org/software/guile/manual/html_node/GOOPS.html)

```Scheme
(use-modules (oop goops))

(define-class <Clock> ()
  (hour   #:init-value 0)
  (minute #:init-value 0)
  (second #:init-value 0))

(define-method (setc! (c <Clock>) h m s)
  (slot-set! c 'hour   h)
  (slot-set! c 'minute m)
  (slot-set! c 'second s)
  #t)

(define-method (to_str (c <Clock>))
  (let ((h (slot-ref c 'hour))
        (m (slot-ref c 'minute))
        (s (slot-ref c 'second)))
    (string-append
      (if (< h 10) "0" "") (number->string h) ":"
      (if (< m 10) "0" "") (number->string m) ":"
      (if (< s 10) "0" "") (number->string s))))

(define-method (shift! (c <Clock>) diff_second)
  (let ((h (slot-ref c 'hour))
        (m (slot-ref c 'minute))
        (s (slot-ref c 'second)))
    (let ((t (+ (* h 3600) (* m 60) s diff_second)))
      (let* ((sd (modulo (modulo t 3600) 60))
             (md (modulo (/ (- t sd) 60) 60))
             (hd (/ (- t sd (* md 60)) 3600)))
        (if (< hd 0) (set! hd (+ 24 hd)))
        (if (= hd 24) (set! hd 0))
        (if (< md 0) (set! md (+ 60 md)))
        (if (< sd 0) (set! sd (+ 60 hd)))
        (setc! c hd md sd)
        #t))))

(define hour        (read))
(define minute      (read))
(define second      (read))
(define diff_second (read))

(define clock (make <Clock>))
(setc! clock hour minute second)
(display (to_str clock)) (newline)
(shift! clock diff_second)
(display (to_str clock)) (newline)
```

#備考

##記事に関する補足
* GaucheはCLOSスタイルを踏襲，GNU Guile（GOOPS）はよりSchemeスタイルって感じかな．僕が設計しろと言われたら，Scheme上でこんな感じで書けるといいなあとか．たいして違いはないか…．

```scheme
(define Clock
  (class ()
    (hour :init-value 0)))

(define setc!
  (method ((c Clock) h)
    (set! c 'hour h)))
```

##変更履歴
* 2020-08-27：Common Lisp，Emacs Lispの例を追加
* 2020-08-26：初版公開（Gauche，GNU Guile）