Исправление den73, (текущая версия) :
Вот так вроде можно избавиться от фейковой записи ценой вставки двух форм в каждый файл, где возникает новый тип такого рода. Причём вторая из этих форм располагается весьма неудачно. Это изъян, жду ваших советов по исправлению.
;; def-type.asd
(defsystem :def-type
:serial t
:components ((:file "def-type-1")
(:file "def-type-2")
))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-1.lisp
(in-package :cl-user)
(defstruct str a b)
(defun foo ()
(make-str :a 1 :b "1"))
(defun only-values-of-plist (plist)
(let ((flag nil)
(result nil))
(dolist (e plist)
(if flag (push e result))
(setf flag (not flag)))
(nreverse result)))
(defvar *known-parametric-types*)
(defmacro generate-funs-for-known-parametric-types ()
(let* ((sources (only-values-of-plist *known-parametric-types*)))
`(progn
,@sources)))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-2.lisp
(in-package :cl-user)
;; от этой формы можно избавиться, если есть зацепка, позволяющая связать переменную
;; вокруг компиляции, например,
;; https://bitbucket.org/budden/budden-tools/src/default/let-around-compile-file-and-load.lisp?at=default&fileviewer=file-view-default
(eval-when (:compile-toplevel)
(setf *known-parametric-types* nil))
(deftype type-ab (type-a type-b)
(print "Вот выполняется тело (deftype type-ab)")
(let* ((predicate-name (intern (prin1-to-string `(type-ab ,type-a ,type-b))))
(predicate-source
`(defun ,predicate-name (value)
(and (typep (str-a value) ',type-a)
(typep (str-b value) ',type-b))))
(result `(and str (satisfies ,predicate-name))))
(setf (getf *known-parametric-types* predicate-name) predicate-source)
(format t "Результат deftype: ~S" result)
;; определяем предикат во время макрорасширения
(compile (eval predicate-source))
result))
(defun bar ()
(format t "Проверка типа вернула ~A~%"
(typep (foo) '(type-ab integer string))))
;; а это форма обезпечит создание предикатов при загрузке
;; она должна располагаться перед кодом, исполняемым при
;; загрузке, но после всех применений типов, что, естественно,
;; довольно ограничительно
(generate-funs-for-known-parametric-types)
(bar)
;; eof
Чтобы два раза не вставать: в SBCL нашёлся почти годный defadvice, он называется sb-int:encapsulate . После небольшой доработки напильником (см. недавние коммиты к budden-tools) получилось, в общем-то, не хуже чем в Lispworks.
Исправление den73, :
Вот так вроде можно избавиться от фейковой записи ценой вставки двух форм в каждый файл, где возникает новый тип такого рода. Причём вторая из этих форм располагается весьма неудачно. Это изъян, жду ваших советов по исправлению.
;; def-type.asd
(defsystem :def-type
:serial t
:components ((:file "def-type-1")
(:file "def-type-2")
))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-1.lisp
(in-package :cl-user)
(defstruct str a b)
(defun foo ()
(make-str :a 1 :b "1"))
(defun only-values-of-plist (plist)
(let ((flag nil)
(result nil))
(dolist (e plist)
(if flag (push e result))
(setf flag (not flag)))
(nreverse result)))
(defvar *known-parametric-types*)
(defmacro generate-funs-for-known-parametric-types ()
(let* ((sources (only-values-of-plist *known-parametric-types*)))
`(progn
,@sources)))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-2.lisp
(in-package :cl-user)
;; от этой формы можно избавиться, если есть зацепка, позволяющая связать переменную
;; вокруг компиляции, например,
;; https://bitbucket.org/budden/budden-tools/src/default/let-around-compile-file-and-load.lisp?at=default&fileviewer=file-view-default
(eval-when (:compile-toplevel)
(setf *known-parametric-types* nil))
(deftype type-ab (type-a type-b)
(print "Вот выполняется тело (deftype type-ab)")
(let* ((predicate-name (intern (prin1-to-string `(type-ab ,type-a ,type-b))))
(predicate-source
`(defun ,predicate-name (value)
(and (typep (str-a value) ',type-a)
(typep (str-b value) ',type-b))))
(result `(and str (satisfies ,predicate-name))))
(setf (getf *known-parametric-types* predicate-name) predicate-source)
(format t "Результат deftype: ~S" result)
;; определяем предикат во время макрорасширения
(compile (eval predicate-source))
result))
(defun bar ()
(format t "Проверка типа вернула ~A~%"
(typep (foo) '(type-ab integer string))))
;; а это форма обезпечит создание предикатов при загрузке
;; она должна располагаться перед кодом, исполняемым при загрузке
(generate-funs-for-known-parametric-types)
(bar)
;; eof
Чтобы два раза не вставать: в SBCL нашёлся почти годный defadvice, он называется sb-int:encapsulate . После небольшой доработки напильником (см. недавние коммиты к budden-tools) получилось, в общем-то, не хуже чем в Lispworks.
Исправление den73, :
Вот так вроде можно избавиться от фейковой записи ценой вставки двух форм в каждый файл, где возникает новый тип такого рода. Причём вторая из этих форм располагается весьма неудачно. Это изъян, жду ваших советов по исправлению.
;; def-type.asd
(defsystem :def-type
:serial t
:components ((:file "def-type-1")
(:file "def-type-2")
))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-1.lisp
(in-package :cl-user)
(defstruct str a b)
(defun foo ()
(make-str :a 1 :b "1"))
(defun only-values-of-plist (plist)
(let ((flag nil)
(result nil))
(dolist (e plist)
(if flag (push e result))
(setf flag (not flag)))
(nreverse result)))
(defvar *known-parametric-types*)
(defmacro generate-funs-for-known-parametric-types ()
(let* ((sources (only-values-of-plist *known-parametric-types*)))
`(progn
,@sources)))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-2.lisp
(in-package :cl-user)
;; от этой формы можно избавиться, если есть зацепка, позволяющая связать переменную
;; вокруг компиляции, например,
;; https://bitbucket.org/budden/budden-tools/src/default/let-around-compile-file-and-load.lisp?at=default&fileviewer=file-view-default
(eval-when (:compile-toplevel)
(setf *known-parametric-types* nil))
(deftype type-ab (type-a type-b)
(print "Вот выполняется тело (deftype type-ab)")
(let* ((predicate-name (intern (prin1-to-string `(type-ab ,type-a ,type-b))))
(predicate-source
`(defun ,predicate-name (value)
(and (typep (str-a value) ',type-a)
(typep (str-b value) ',type-b))))
(result `(and str (satisfies ,predicate-name))))
(setf (getf *known-parametric-types* predicate-name) predicate-source)
(format t "Результат deftype: ~S" result)
;; определяем предикат во время макрорасширения
(compile (eval predicate-source))
result))
(defun bar ()
(format t "Проверка типа вернула ~A~%"
(typep (foo) '(type-ab integer string))))
(bar)
;; а это форма обезпечит создание предикатов при загрузке
;; она должна располагаться перед кодом, исполняемым при загрузке
(generate-funs-for-known-parametric-types)
(bar)
;; eof
Чтобы два раза не вставать: в SBCL нашёлся почти годный defadvice, он называется sb-int:encapsulate . После небольшой доработки напильником (см. недавние коммиты к budden-tools) получилось, в общем-то, не хуже чем в Lispworks.
Исправление den73, :
Вот так вроде можно избавиться от фейковой записи ценой вставки двух форм в каждый файл, где возникает новый тип такого рода, от вставки форм можно избавиться ценой декорирования функции compile, к-рое тоже вполне осуществимо.
;; def-type.asd
(defsystem :def-type
:serial t
:components ((:file "def-type-1")
(:file "def-type-2")
))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-1.lisp
(in-package :cl-user)
(defstruct str a b)
(defun foo ()
(make-str :a 1 :b "1"))
(defun only-values-of-plist (plist)
(let ((flag nil)
(result nil))
(dolist (e plist)
(if flag (push e result))
(setf flag (not flag)))
(nreverse result)))
(defvar *known-parametric-types*)
(defmacro generate-funs-for-known-parametric-types ()
(let* ((sources (only-values-of-plist *known-parametric-types*)))
`(progn
,@sources)))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-2.lisp
(in-package :cl-user)
;; от этой формы можно избавиться, если есть зацепка, позволяющая связать переменную
;; вокруг компиляции, например,
;; https://bitbucket.org/budden/budden-tools/src/default/let-around-compile-file-and-load.lisp?at=default&fileviewer=file-view-default
(eval-when (:compile-toplevel)
(setf *known-parametric-types* nil))
(deftype type-ab (type-a type-b)
(print "Вот выполняется тело (deftype type-ab)")
(let* ((predicate-name (intern (prin1-to-string `(type-ab ,type-a ,type-b))))
(predicate-source
`(defun ,predicate-name (value)
(and (typep (str-a value) ',type-a)
(typep (str-b value) ',type-b))))
(result `(and str (satisfies ,predicate-name))))
(setf (getf *known-parametric-types* predicate-name) predicate-source)
(format t "Результат deftype: ~S" result)
;; определяем предикат во время макрорасширения
(compile (eval predicate-source))
result))
(defun bar ()
(format t "Проверка типа вернула ~A~%"
(typep (foo) '(type-ab integer string))))
(bar)
;; а это форма обезпечит создание предикатов при загрузке
;; она должна располагаться перед кодом, исполняемым при загрузке
(generate-funs-for-known-parametric-types)
(bar)
;; eof
Чтобы два раза не вставать: в SBCL нашёлся почти годный defadvice, он называется sb-int:encapsulate . После небольшой доработки напильником (см. недавние коммиты к budden-tools) получилось, в общем-то, не хуже чем в Lispworks.
Исправление den73, :
Вот так вроде можно избавиться от фейковой записи ценой вставки двух форм в каждый файл, где возникает новый тип такого рода, от вставки форм можно избавиться ценой декорирования функции compile, к-рое тоже вполне осуществимо.
;; def-type.asd
(defsystem :def-type
:serial t
:components ((:file "def-type-1")
(:file "def-type-2")
))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-1.lisp
(in-package :cl-user)
(defstruct str a b)
(defun foo ()
(make-str :a 1 :b "1"))
(defun only-values-of-plist (plist)
(let ((flag nil)
(result nil))
(dolist (e plist)
(if flag (push e result))
(setf flag (not flag)))
(nreverse result)))
(defvar *known-parametric-types*)
(defmacro generate-funs-for-known-parametric-types ()
(let* ((sources (only-values-of-plist *known-parametric-types*)))
`(progn
,@sources)))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-2.lisp
(in-package :cl-user)
;; от этой формы можно избавиться, если есть зацепка, позволяющая связать переменную
;; вокруг компиляции, например,
;; https://bitbucket.org/budden/budden-tools/src/default/let-around-compile-file-and-load.lisp?at=default&fileviewer=file-view-default
(eval-when (:compile-toplevel)
(setf *known-parametric-types* nil))
(deftype type-ab (type-a type-b)
(print "Вот выполняется тело (deftype type-ab)")
(let* ((predicate-name (intern (prin1-to-string `(type-ab ,type-a ,type-b))))
(predicate-source
`(defun ,predicate-name (value)
(and (typep (str-a value) ',type-a)
(typep (str-b value) ',type-b))))
(result `(and str (satisfies ,predicate-name))))
(setf (getf *known-parametric-types* predicate-name) predicate-source)
(format t "Результат deftype: ~S" result)
;; определяем предикат во время макрорасширения
(compile (eval predicate-source))
result))
(defun bar ()
(format t "Проверка типа вернула ~A~%"
(typep (foo) '(type-ab integer string))))
(bar)
;; а это форма обезпечит создание предикатов при загрузке
;; Опять же, если есть декоратор для процесса компиляции, то это можно убрать из файла
(generate-funs-for-known-parametric-types)
;; eof
Чтобы два раза не вставать: в SBCL нашёлся почти годный defadvice, он называется sb-int:encapsulate . После небольшой доработки напильником (см. недавние коммиты к budden-tools) получилось, в общем-то, не хуже чем в Lispworks.
Исходная версия den73, :
Вот так вроде можно избавиться от фейковой записи ценой вставки двух форм или ценой декорирования функции compile.
;; def-type.asd
(defsystem :def-type
:serial t
:components ((:file "def-type-1")
(:file "def-type-2")
))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-1.lisp
(in-package :cl-user)
(defstruct str a b)
(defun foo ()
(make-str :a 1 :b "1"))
(defun only-values-of-plist (plist)
(let ((flag nil)
(result nil))
(dolist (e plist)
(if flag (push e result))
(setf flag (not flag)))
(nreverse result)))
(defvar *known-parametric-types*)
(defmacro generate-funs-for-known-parametric-types ()
(let* ((sources (only-values-of-plist *known-parametric-types*)))
`(progn
,@sources)))
;; eof
;; -*- coding: utf-8; system :def-type; -*-
;; def-type-2.lisp
(in-package :cl-user)
;; от этой формы можно избавиться, если есть зацепка, позволяющая связать переменную
;; вокруг компиляции, например,
;; https://bitbucket.org/budden/budden-tools/src/default/let-around-compile-file-and-load.lisp?at=default&fileviewer=file-view-default
(eval-when (:compile-toplevel)
(setf *known-parametric-types* nil))
(deftype type-ab (type-a type-b)
(print "Вот выполняется тело (deftype type-ab)")
(let* ((predicate-name (intern (prin1-to-string `(type-ab ,type-a ,type-b))))
(predicate-source
`(defun ,predicate-name (value)
(and (typep (str-a value) ',type-a)
(typep (str-b value) ',type-b))))
(result `(and str (satisfies ,predicate-name))))
(setf (getf *known-parametric-types* predicate-name) predicate-source)
(format t "Результат deftype: ~S" result)
;; определяем предикат во время макрорасширения
(compile (eval predicate-source))
result))
(defun bar ()
(format t "Проверка типа вернула ~A~%"
(typep (foo) '(type-ab integer string))))
(bar)
;; а это форма обезпечит создание предикатов при загрузке
;; Опять же, если есть декоратор для процесса компиляции, то это можно убрать из файла
(generate-funs-for-known-parametric-types)
;; eof
Чтобы два раза не вставать: в SBCL нашёлся почти годный defadvice, он называется sb-int:encapsulate . После небольшой доработки напильником (см. недавние коммиты к budden-tools) получилось, в общем-то, не хуже чем в Lispworks.