js-module-by-ps.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload '(:parenscript) :silent t))

(defpackage :ros.script.first-sample.ros.3671797562
  (:use :cl
        :parenscript))

(in-package :ros.script.first-sample.ros.3671797562)

;; とりあえずhash-tableをサポート
(defpsmacro make-hash-table ()
  `(@ {}))

(defpsmacro gethash (key hash-table)
  `(aref ,hash-table ,key))

;; Common Lisp風
(defun make-js-module-1 ()
  (ps (defvar counter
        (funcall (lambda ()
                   (let* ((count 0)
                          (add (lambda (x)
                                 (incf count x)))
                          (public-body (make-hash-table)))
                     (setf (gethash :get public-body)
                           (lambda () count)
                           (gethash :increment public-body)
                           (lambda (x) (add x))
                           (gethash :decrement public-body)
                           (lambda (x) (add (* x -1))))
                     public-body))))))

;; hash-tableの初期化構文を導入する
(defmacro+ps init-hash-table (&rest pairs)
  (let ((hash (gensym)))
    `(let ((,hash (make-hash-table)))
       ,(cons 'setf (mapcan (lambda (pair)
                              `((gethash ,(car pair) ,hash)
                                ,(cadr pair)))
                            pairs))
       ,hash)))

(defun make-js-module-2 ()
  (ps (defvar counter
        (funcall (lambda ()
                   (let* ((count 0)
                          (add (lambda (x)
                                 (incf count x))))
                     (init-hash-table
                      (:get (lambda () count))
                      (:increment (lambda (x) (add x)))
                      (:decrement (lambda (x) (add (* x -1)))))))))))

;; 最初のdefmodule
;; make-js-moduleと番号を合わせるため1, 2は欠番
(defmacro+ps defmodule-3 (name &body body)
  `(defvar ,name
     (funcall (lambda ()
                ,@body))))

(defun make-js-module-3 ()
  (ps (defmodule-3 counter
        (let* ((count 0)
               (add (lambda (x)
                      (incf count x))))
          (init-hash-table
           (:get (lambda () count))
           (:increment (lambda (x) (add x)))
           (:decrement (lambda (x) (add (* x -1)))))))))

;; let*とinit-hash-tableを隠す
(defmacro+ps defmodule-4 (name private-vars &body body)
  `(defvar ,name
     (funcall (lambda ()
                (let* ,private-vars
                  (init-hash-table ,@body))))))

(defun make-js-module-4 ()
  (ps (defmodule-4 counter
        ((count 0)
         (add (lambda (x)
                (incf count x))))
        (:get (lambda () count))
        (:increment (lambda (x) (add x)))
        (:decrement (lambda (x) (add (* x -1)))))))

;; lambdaをなくしてみる
(defmacro+ps defmodule (name private-vars &body body)
  `(defvar ,name
     (funcall (lambda ()
                (let* ,private-vars
                  (init-hash-table
                   ,@(mapcar (lambda (method-def)
                               `(,(car method-def) (lambda ,@(cdr method-def))))
                             body)))))))

(defun make-js-module ()
  (ps (defmodule counter
        ((count 0)
         (add (lambda (x)
                (incf count x))))
        (:get () count)
        (:increment (x) (add x))
        (:decrement (x) (add (* x -1))))))

(defun main (&rest argv)
  (declare (ignorable argv))
  (print (make-js-module-1))
  (print "--------------")
  (print (make-js-module-2))
  (print "--------------")
  (print (make-js-module-3))
  (print "--------------")
  (print (make-js-module-4))
  (print "--------------")
  (print (make-js-module))
  (print "--------------"))