LINUX.ORG.RU

История изменений

Исправление den73, (текущая версия) :

Ну, может быть, с помощью магии make-load-form это и можно сделать, но я не знаю как. Поэтому я поступил следующим образом: во время компиляции генерируется вспомогательный файл с определениями всех предикатов. Это делается в конец компиляции. В начале загрузки основного файла загружается вспомогательный. У меня в budden-tools для этого было почти всё необходимое и кое-что пришлось сейчас добавить. Теперь всё это выглядит так: 

;; 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 eval-factory-for-predicates-of-known-parametric-types (filename)
  (declare (ignore filename))
  `(eval-when (:load-toplevel)
     (load (compile-file (defun-to-file:|Полное-имя-файла-для-Defun-to-file| 'my-factory)))
     (my-factory)))

(defmacro def-factory-for-predicates-of-known-parametric-types (filename)
  (declare (ignore filename))
  (let* ((sources (only-values-of-plist *known-parametric-types*)))
    `(defun-to-file::defun-to-file my-factory () 
       ,@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-factory-for-predicates-of-known-parametric-types #.*compile-file-truename*)

(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) 

(eval-when (:compile-toplevel)
  (def-factory-for-predicates-of-known-parametric-types #.*compile-file-truename*))

;; eof

Это пока не полное решение, т.к. функция, порождающая предикаты, называется my-factory, а она на самом деле должна бы называться по имени файла, который мы компилируем. Но это техническая мелочь. Чуть бОльшая проблема состоит в том, что если некий тип (type-ab integer string) применяется более чем в одном файле, то функция |(type-ab integer string)| будет также переопределяться. Это не слишком хорошо, но можно определять её лениво (только если она ещё не определена). ПРавда, тут потянутся проблемы, если мы захотим на горячую поменять способ генерации предикатов.

Хотя если генерировать по файлу для каждого типа (type-ab x y), то проблемы с переопределением, наверное, не будет - функции можно переопределять сколько угодно раз по месту.

Осталось выяснить, насколько плохо само по себе satisfies - ведь выводить типы для него практически невозможно.

Исправление den73, :

Ну, может быть, с помощью магии make-load-form это и можно сделать, но я не знаю как. Поэтому я поступил следующим образом: во время компиляции генерируется вспомогательный файл с определениями всех предикатов. Это делается в конец компиляции. В начале загрузки основного файла загружается вспомогательный. У меня в budden-tools для этого было почти всё необходимое и кое-что пришлось сейчас добавить. Теперь всё это выглядит так: 

;; 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)))

(defmacro eval-factory-for-predicates-of-known-parametric-types (filename)
  (declare (ignore filename))
  `(eval-when (:load-toplevel)
     (load (compile-file (defun-to-file:|Полное-имя-файла-для-Defun-to-file| 'my-factory)))
     (my-factory)))

(defmacro def-factory-for-predicates-of-known-parametric-types (filename)
  (declare (ignore filename))
  (let* ((sources (only-values-of-plist *known-parametric-types*)))
    `(defun-to-file::defun-to-file my-factory () 
       ,@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-factory-for-predicates-of-known-parametric-types #.*compile-file-truename*)

(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) 

(eval-when (:compile-toplevel)
  (def-factory-for-predicates-of-known-parametric-types #.*compile-file-truename*))

;; eof

Это пока не полное решение, т.к. функция, порождающая предикаты, называется my-factory, а она на самом деле должна бы называться по имени файла, который мы компилируем. Но это техническая мелочь. Чуть бОльшая проблема состоит в том, что если некий тип (type-ab integer string) применяется более чем в одном файле, то функция |(type-ab integer string)| будет также переопределяться. Это не слишком хорошо, но можно определять её лениво (только если она ещё не определена). ПРавда, тут потянутся проблемы, если мы захотим на горячую поменять способ генерации предикатов.

Хотя если генерировать по файлу для каждого типа (type-ab x y), то проблемы с переопределением, наверное, не будет - функции можно переопределять сколько угодно раз по месту.

Осталось выяснить, насколько плохо само по себе satisfies - ведь выводить типы для него практически невозможно.

Исходная версия den73, :

Ну, может быть, с помощью магии make-load-form это и можно сделать, но я не знаю как. Поэтому я поступил следующим образом: во время компиляции генерируется вспомогательный файл с определениями всех предикатов. Это делается в конец компиляции. В начале загрузки основного файла загружается вспомогательный. У меня в budden-tools для этого было почти всё необходимое и кое-что пришлось сейчас добавить. Теперь всё это выглядит так: 

;; 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)))

(defmacro eval-factory-for-predicates-of-known-parametric-types (filename)
  (declare (ignore filename))
  `(eval-when (:load-toplevel)
     (load (compile-file (defun-to-file:|Полное-имя-файла-для-Defun-to-file| 'my-factory)))
     (my-factory)))

(defmacro def-factory-for-predicates-of-known-parametric-types (filename)
  (declare (ignore filename))
  (let* ((sources (only-values-of-plist *known-parametric-types*)))
    `(defun-to-file::defun-to-file my-factory () 
       ,@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-factory-for-predicates-of-known-parametric-types #.*compile-file-truename*)

(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) 

(eval-when (:compile-toplevel)
  (def-factory-for-predicates-of-known-parametric-types #.*compile-file-truename*))

;; eof

Это пока не полное решение, т.к. функция, порождающая предикаты, называется my-factory, а она на самом деле должна бы называться по имени файла, который мы компилируем. Но это техническая мелочь. Чуть бОльшая проблема состоит в том, что если некий тип (type-ab integer string) применяется более чем в одном файле, то функция |(type-ab integer string)| будет также переопределяться. Это не слишком хорошо, но можно определять её лениво (только если она ещё не определена). ПРавда, тут потянутся проблемы, если мы захотим на горячую поменять способ генерации предикатов.

Хотя если генерировать по файлу для каждого типа (type-ab x y), то проблемы с переопределением, наверное, не будет - функции можно переопределять сколько угодно раз по месту.

Осталось выяснить, насколько плохо само по себе satisfies - ведь выводить типы для него практически невозможно.