Starting MOP code.

This commit is contained in:
Kyle Isom 2015-08-31 20:45:43 -07:00 committed by Kyle
parent ca7fb58b38
commit 0cda04e9e3
3 changed files with 57 additions and 0 deletions

42
kmop/kmop.lisp Normal file
View File

@ -0,0 +1,42 @@
;;;; kmop.lisp
(in-package #:kutils-mop)
;;; metaobject interactions
(defun get-class-initargs (slots)
)
(defun get-all-init-args (class-sym &optional (package *package*))
(let ((class-val (find-class
(find-symbol
(mkstr class-sym)
package))))
(when class-val
(closer-mop:ensure-finalized class-val)
(flatten
(remove-if (lambda (slot)
(null (closer-mop:slot-definition-initargs slot)))
(closer-mop:class-slots class-val))))))
(defun kw-key (kw)
(string-downcase
(mkstr kw)))
(defun dispatch-get-value (value))
(defun zip-initargs-hash-table (args ht)
(flatten
(mapcar (lambda (slot)
(list slot (gethash (kw-key slot) ht)))
args)))
(defun make-instance-from-hash-table (class-type table &optional (package *package*))
(let ((class-sym (find-class class-type)))
(when class-sym
(apply #'make-instance class-sym
(zip-initargs-hash-table
(get-all-init-args class-type package)
table)))))

4
kmop/package.lisp Normal file
View File

@ -0,0 +1,4 @@
;;;; package.lisp
(defpackage #:kutils-mop
(:use #:cl #:kutils))

11
kutils-mop.asd Normal file
View File

@ -0,0 +1,11 @@
;;;; kutils-mop.asd
(asdf:defsystem #:kutils-mop
:description "Kyle's MOP utilities."
:author "K. Isom <kyle@metacircular.net>"
:license "MIT License"
:serial t
:depends-on (#:closer-mop #:kutils)
:components ((:file "kmop/package")
(:file "kmop/kmop")))