LINUX.ORG.RU
Форум — Development  

тип записи, ограничивающий тип его элемента

 , ,


1

3

Икс принадлежит типу ТТ(а,б), если: 

1. X является типом Моя-запись
2. Поле Поле1 имеет тип а
3. Поле Поле2 имеет тип б

Это не то же, что «Моя запись всегда имеет тип Поля1, равный а» - тип Поле1 в Моя-запись, вообще говоря, может быть любым, но мне нужно рассмотрить именно ситуацию, когда он равен а.

Я не придумал, как это сделать с напрямую помощью deftype и мне пришлось сделать так (вот реальный код, там я делаю «свои cons-ы»)

(defmacro DEF-Тип-ТТ-от-а-и-б (имя а б)
   ...)

(DEF-Тип-ТТ-от-а-и-б ТТ-от-integer-и-string integer string)

(typep X 'ТТ-от-integer-и-string)

Есть ли у кого-нибудь лучшие идеи? По сути моя проблема сводится к следующей: как из deftype запрограммировать действия в load-time? Может быть, я просто туплю или чего-то не знаю, но у меня пока нет идей.

★★★★★

Последнее исправление: den73 (всего исправлений: 1)

Вероятно, можно воткнуть в тип фальшивый литерал структуры, и определить для него make-load-form, к-рый будет определять нужные функции. Будет время - попробую, а пока жду ваших идей.

den73 ★★★★★
() автор топика
Ответ на: комментарий от Jini

satisfies, но он принимает символ. Т.е. нужно сгенерировать соответствующий предикат и воткнуть обращение к нему в макрорасширение типа.

den73 ★★★★★
() автор топика
Ответ на: комментарий от den73

Например, так?

(deftype type-ab (type-a type-b)
  (let ((predicate (gensym)))
    (setf (symbol-function predicate)
          (lambda (value)
            (and (typep (slot-value value 'a) type-a)
                 (typep (slot-value value 'b) type-b))))
    `(satisfies ,predicate)))
Jini ★★
()
Последнее исправление: Jini (всего исправлений: 1)
Ответ на: комментарий от Jini

В REPL подобное сработает. В компилируемом файле, по идее, не должно - ведь функция будет создана только в compile-time, а кто создаст её в load-time? Например, если файл скомпилирован в одном образе, а fasl этой компиляции загружен в другом? Я думаю, что никто. В этом и проблема.

den73 ★★★★★
() автор топика
Ответ на: комментарий от den73

Возьми да проверь, я не понимаю в чём проблема. Ты говоришь так, как будто в fasl нельзя хранить замыкания. К deftype предъявляются те же требования, что к defmacro.

Jini ★★
()
Ответ на: комментарий от den73

Да, ты прав. Только через привязку имени генерируемого предиката к типам. Вообще, если нужен удобный контроль типов в рантайме, то лучше что-то типа https://github.com/kisom/cl-contracts прикручивать.

monk ★★★★★
()
Ответ на: комментарий от Jini

К deftype предъявляются те же требования, что к defmacro.

Именно. И если у тебя функция определяется в момент раскрытия макроса, а в результате раскрытия только её вызов, то в fasl попадёт только результат раскрытия.

monk ★★★★★
()
Ответ на: комментарий от Jini

Блин, оно работает в SBCL. С чего бы? Тело deftype выполняется и в load-time тоже. Этого я никак не ожидал. Теперь нужно понять, соответствует ли это стандарту.

den73 ★★★★★
() автор топика
Ответ на: комментарий от den73

А, нет, всё нормально, не работает. Я сначала написал его в top-level форм и тогда оно работало, а вот так не работает: 

;;; def-type.asd
(defsystem :def-type
  :serial t
  :components ((:file "def-type-1")
               (:file "def-type-2")
               ))
;;; eof

;;; def-type-1.lisp
(deftype type-ab (type-a type-b)
  (let ((predicate (gensym)))
    (print "Вот выполняется тело (deftype type-ab)")
    (setf (symbol-function predicate)
          (lambda (value)
            (and (typep (slot-value value 'a) type-a)
                 (typep (slot-value value 'b) type-b))))
    `(satisfies ,predicate)))


(defstruct str a b)
;;; eof 

;;; def-type-2.lisp
(defun foo ()
  (make-str :a 1 :b "1"))

(defun bar () 
  (format t "Проверка типа вернула ~A~%"
          (typep (foo) '(type-ab integer string))))

(bar) 
;;; eof
Работало, пока была top-level форма format t и т.п. и возвращала истину. Когда внёс в ф-ю, ругается на неопределённую функцию #:G23 в вызове bar.

Контракты не хочу. Для хорошей спецификации типов будет язык Яр, хотя я посмотрю, как они сделаны. Я уже опытный лиспер и стараюсь поменьше трогать стандартный лисп. Меньше тронешь - меньше проблем себе наживёшь :)

den73 ★★★★★
() автор топика
Ответ на: комментарий от den73

Вот так работает вроде: 

;;; def-type.asd
(defsystem :def-type
  :serial t
  :components ((:file "def-type-1")
               (:file "def-type-2")
               ))
;;; eof

;;; def-type-1.lisp
;; -*- coding: utf-8; system :def-type;  -*- 

(defstruct function-to-define-at-load-time source)

(defmethod make-load-form ((e function-to-define-at-load-time) &optional env)
  (declare (ignore env))
  (let ((src (slot-value e 'source)))
  `(progn
     (compile (eval ',src))
     ;; нужно создать что-то осмысленное и, желательно, похожее на то, что было в compile time
     (make-function-to-define-at-load-time :source ',src)
     )))

(defstruct str a b)

(defun foo ()
  (make-str :a 1 :b "1"))
;;; eof 

;;; def-type-2.lisp
;; -*- coding: utf-8; system :def-type;  -*- 

(deftype type-ab (type-a type-b)
  (print "Вот выполняется тело (deftype type-ab)")
  (let* ((predicate-name (gensym))
         (predicate-source
          `(defun ,predicate-name (value) 
             (and (typep (str-a value) ',type-a)
                  (typep (str-b value) ',type-b))))
         (fake-entry
          (make-function-to-define-at-load-time
           :source predicate-source))
         (result 
          `(or (satisfies ,predicate-name)
               (eql ,fake-entry))))
    (format t "Результат deftype: ~S" result)
    ;; определяем предикат во время макрорасширения
    (compile (eval predicate-source))
    result))

(defun bar () 
  (format t "Проверка типа вернула ~A~%"
          (typep (foo) '(type-ab integer string))))

(bar) 

(defstruct str a b)
 
;;; eof

den73 ★★★★★
() автор топика
Ответ на: комментарий от monk

И если у тебя функция определяется в момент раскрытия макроса, а в результате раскрытия только её вызов, то в fasl попадёт только результат раскрытия.

Я понял, спасибо. В случае defmacro можно раскрыться в load-time-value, однако для deftype, похоже, подобного механизма не предусмотрено. Моя мотивация иссякла, и решения через satisfies я не нашёл. den73, спасибо за вопрос, я узнал что-то новое сегодня :)

Jini ★★
()
Ответ на: комментарий от Jini

А, вот оно что! load-time-value - я про него вообще не знал. Видимо, моё последнее решение можно упростить: вместо фейкового (or eql) просто вызвать load-time-value. Попробую при случае.

den73 ★★★★★
() автор топика
Ответ на: комментарий от den73

Хотя похоже, что и правда load-time-value тут принципиально ничем не помогает. Не получится обойтись без фейкового (or eql).

den73 ★★★★★
() автор топика
Ответ на: комментарий от Oxdeadbeef

когда-то встречал, безусловно, но когда надо - не вспомнил. Ты лучше не смейся, а предложи более правильное решение задачи.

den73 ★★★★★
() автор топика
17 сентября 2017 г.

Вот так вроде можно избавиться от фейковой записи ценой вставки двух форм в каждый файл, где возникает новый тип такого рода. Причём вторая из этих форм располагается весьма неудачно. Это изъян, жду ваших советов по исправлению. 

;; 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 ★★★★★
() автор топика
Последнее исправление: den73 (всего исправлений: 5)
Ответ на: комментарий от 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 ★★★★★
() автор топика
Последнее исправление: den73 (всего исправлений: 2)
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.
Development