Lisp 食べ比べ (1)

## はじめに(環境説明)

私が Lisp を使った順番で言えば、Common Lisp ⇒ Emacs Lisp ⇒ Scheme (Racket) となります。
(今まで使ったことがありませんが Gauche Scheme も追加しました。)

```
$ sbcl --version
SBCL 2.2.10

$ emacs --version
GNU Emacs 28.2

$ racket --version
Welcome to Racket v8.6 [cs].

$ gosh -V
Gauche scheme shell, version 0.9.12 [utf-8,wthreads], x86_64-w64-mingw32
```

**上記の環境を使って、「Lisp 食べ比べ」をしてみたいと思います。**

## どうやってやるか

* sbcl (Common Lisp) と racket (Scheme) は元々バッチ実行ができますから、ソースを実行ファイルに食わせるだけでいいのですが、emacs (Emacs Lisp) はどうするかといいますと「バッチモード実行」を使います。

* また、emacs では、以下の記事に載せてある xprint.el がホームディレクトリに置かれてあることを前提とします。

> [Emacs Lisp でプリントデバッグをする (5) - Qiita](https://qiita.com/javacommons/items/50b2ac5e84143308c2cc)

## どんなソースになるか

以下に3つのソースを示します。
sbcl, emacs, racket の実行ファイルにパスが通っているのを前提にbashのshebangを使って実行しています。

```cl:Common Lisp [SBCL] (test01.lsp)
#! /usr/bin/env -S sbcl --script
(prin1 (+ 11 22))
(terpri)

;;; Welcome to the Emacs shell
;;; 
;;; ~/racket $ cd "d:/Users/javac/Documents/.repo/env/racket/" && time "./test01.lsp"
;;; 33
;;; 0.209 secs
;;; ~/racket $
```

```elisp:Emacs Lisp (test01.el)
#! /usr/bin/env -S emacs -batch -l
(load "~/xprint.el")
(xprint (+ 11 22))

;;; Welcome to the Emacs shell
;;; 
;;; ~/racket $ cd "d:/Users/javac/Documents/.repo/env/racket/" && time "./test01.el"
;;; Loading d:/Users/javac/Documents/.repo/env/xprint.el (source)...
;;; 33
;;; 0.301 secs
;;; ~/racket $
```

```racket:Scheme [Racket] (test01.rkt)
#! /usr/bin/env racket
#lang racket
(println (+ 11 22))

;;; Welcome to the Emacs shell
;;; 
;;; ~/racket $ cd "d:/Users/javac/Documents/.repo/env/racket/" && time "./test01.rkt"
;;; 33
;;; 0.624 secs
;;; ~/racket $ 
```

```scheme:Scheme [Gauche] (test01.scm)
#! /usr/bin/env gosh
(print (+ 11 22))

;;; Welcome to the Emacs shell
;;; 
;;; ~/racket $ cd "d:/Users/javac/Documents/.repo/env/racket/" && time "./test01.scm"
;;; 33
;;; 0.295 secs
;;; ~/racket $
```

----

**Common Lisp、Emacs Lisp、Scheme のそれぞれの書き方で同じことをする・・・というのをアップしていきたいと思います。**

※ この記事のために xprint.el をバッチ実行に対応させました。

連載の一回目だけ xprint.el を載せておきます：

```elisp:xprint.el
;;;; xprint.el v1.2.2                ;;;;
;;;; Last Modified: 2023/01/07 03:39 ;;;;

(require 'cl-lib)
(require 'cl-extra)

(defun xprint (&rest args)
  (let ((raw nil))
    (when (eq (car args) :raw)
      (setq raw t)
      (setq args (cdr args))
      )
    (prog1 args
      (let ((msg ""))
        (dotimes (i (length args))
          (if (zerop i) nil
            (setq msg (concat msg " "))
            )
          (setq msg (concat msg (format (if raw "%s" "%S") (nth i args))))
          )
        (if noninteractive (message "%s" msg)
          (let ((cb (current-buffer))
                (cw (selected-window)))
            (if (equal (buffer-name) "*xprint*") nil
              (switch-to-buffer-other-window "*xprint*")
              )
            ;;(emacs-lisp-mode)
            ;;(lisp-interaction-mode)
            (unless (derived-mode-p 'lisp-interaction-mode)
              (lisp-interaction-mode))
            (goto-char (point-max))
            (insert msg)
            (insert "\n")
            (let ((wins (window-list)))
              (dolist (win wins)
                (select-window win)
                (when (equal (buffer-name) "*xprint*")
                  (goto-char (point-max))
                  (cond
                   ((pos-visible-in-window-p (point)) nil)
                   ((< (point) (window-start)) (recenter 0))
                   (t (recenter -1)))
                  )
                )
              )
            (select-window cw)
            (switch-to-buffer cb)
            )
          )
        )
      )
    )
  )

(defmacro xdump (&rest list)
  (let ((exp '(xprint)))
    (dolist (x list)
      (if (and (not (consp x)) (not (and (symbolp x) (not (keywordp x))))) (push x exp)
        (push (list 'quote x) exp)
        (push := exp)
        (push x exp)
        )
      )
    (reverse exp)
    )
  )

(defun xclear ()
  (interactive)
  (let ((cb (current-buffer))
        (cw (selected-window)))
    (let ((wins (window-list)))
      (dolist (win wins)
        (select-window win)
        (when (equal (buffer-name) "*xprint*")
          (ignore-errors (delete-window win))
          )
        )
      )
    (ignore-errors (kill-buffer "*xprint*"))
    (ignore-errors (select-window cw))
    nil)
  )

(defun xsleep (millisec)
  (when millisec
    (sit-for 0)
    (sleep-for 0 millisec)
    )
  )

(defmacro xmessage (&rest list)
  (let ((sleep nil))
    (if (and (not (integerp (nth 0 list))) (not (symbolp (nth 0 list)))) nil
      (setq sleep (pop list))
      )
    (if (not sleep)
        `(message ,@list)
      `(progn (message ,@list) (xsleep ,sleep))
      )
    )
  )

(defmacro xformat (&rest list)
  `(xprint :raw (format ,@list))
  )

(defun xpp (x)
  (xprint :raw (xpp-to-string x))
  )

(defun xpp-to-string (form)
  (with-temp-buffer
    (cl-prettyprint form)
    (let ((str (buffer-string)))
      (replace-regexp-in-string "\\`[ \t\n\r]*\\|[ \t\n\r]*\\'" "" str)
      )
    )
  )

(defun xpand-macro-scan (form callback data)
  (cond
   ((symbolp form) (funcall callback form data))
   ((consp form)
    (cons
     (xpand-macro-scan (car form) callback data)
     (xpand-macro-scan (cdr form) callback data)))
   (t form)
   )
  )

(defun xpand-macro (form)
  (let ((result (macroexpand-all form))
        (hash (make-hash-table :test #'equal)))
    (xprint :raw "")
    (xprint :raw ";;; Expanding Macro:")
    (xprint
     :raw
     (xpp-to-string form)
     )
    (xprint :raw "    |")
    (xprint :raw "    |")
    (xprint :raw "    v")
    (xpand-macro-scan
     result
     #'(lambda (sym data)
         (let ((lst (gethash (symbol-name sym) data)))
           (when (not (member sym lst))
             (push sym lst)
             (puthash (symbol-name sym) lst data)
             )
           )
         )
     hash
     )
    (setq result
          (xpand-macro-scan
           result
           #'(lambda (sym data)
               (let ((lst (gethash (symbol-name sym) data)))
                 (if (= 1 (length lst)) sym
                   (intern (format "%s_%d" sym (length (member sym lst))))
                   )
                 )
               )
           hash
           )
          )
    (xprint
     :raw
     (xpp-to-string result)
     )
    result
    )
  )

(defmacro xpand (form)
  `(xpand-macro (quote ,form))
  )

(provide 'xprint)
```