Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
(defpsmacro defstruct (name-and-options &rest slot-description)
"This is the tiny subset of defsturt in terms of syntax.
name-and-options::= structure-name | (structure-name (:include included-structure-name))
slot-description::= slot-name | (slot-name slot-init-form)"
(bind:bind (((:values name parent)
(parse-defstruct-name-and-options name-and-options))
(slots
(parse-defstruct-slot-description slot-description)))
(setf slots (merge-defstruct-slots parent slots))
(register-defstruct-slots name slots)
`(progn
;; JavaScriptにおけるクラス定義
(defun ,name ()
,@(mapcar (lambda (slot)
`(setf (@ this ,(car slot)) ,(cadr slot)))
slots))
;; 構造体を作成するmake-xxx関数の定義
(defun ,(symbolicate 'make- name) (&key ,@slots)
(let ((result (new (,name))))
,@(mapcar (lambda (elem)
`(setf (@ result ,(car elem)) ,(car elem)))
slots)
result))
;; アクセサの定義(ここのdefmacroが問題)
,@(mapcar (lambda (slot)
`(defmacro ,(symbolicate name '- (car slot)) (obj)
`(@ ,obj ,',(car slot))))
slots)
;; 型判別用のxxx-p関数の定義
(defun ,(symbolicate name '-p) (obj)
(instanceof obj ,name))
;; JavaScriptにおける継承関係の設定
,(when parent
`(funcall (lambda ()
(defun temp-ctor ())
(setf (@ temp-ctor prototype) (@ ,parent prototype))
(setf (@ ,name super-class_) (@ ,parent prototype))
(setf (@ ,name prototype) (new (temp-ctor)))
(setf (@ ,name prototype constructor) ,name)))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment