p015.lisp 2.88 KB
Newer Older
Dave Cooper's avatar
Dave Cooper committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
;;
;; Copyright 2015 Genworks International 
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;; 
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;; 
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file.  If not, see
;; <http://www.gnu.org/licenses/>.
;; 

(in-package :gdl)

(defparameter *1588p015-doc* 
  "Adds overridable initialize-instance! function to vanilla-mixin and calls this from make-object and make-object-internal.")

(defun make-object (object-type &rest args)
  "GDL Object. Instantiates an object with specified initial values for input-slots.

:arguments (object-name \"Symbol. Should name a GDL object type.\"
            arguments \"spliced-in plist. A plist of keyword symbols and values for initial <tt>input-slots</tt>.\")"
  (let (*notify-cons*
        (keys (plist-keys args))
        (vals (plist-values args)))
    (let ((object (apply #'make-instance 
                         object-type 
                         :allow-other-keys t
                         (append (list :%name% (list (format nil "~a" object-type) nil t)
                                       :%parent% (list nil nil t))
                                 (mapcan #'(lambda(key val)
                                             (list key (list val nil t)))
                                         keys vals)))))
      
      (setf (gdl-acc::%root% object) object
            (gdl-acc::%toplevel-inputs% object) args)

      (the-object object initialize-instance!) object)))


(defun make-object-internal (object-type &rest args)
  (let ((object (apply #'make-instance object-type :allow-other-keys t args)))
    (the-object object initialize-instance!) object))


(define-object-amendment vanilla-mixin ()
  :functions ((initialize-instance! ())))


(in-package :gdl-user)


(define-object make-object-regression& ()

  :functions
  ((initialize-instance! ()
			 (format *standard-output* "Hey Now to *standard-out*.~%")
			 (format t "Hey Now to t.~%"))))


(define-object make-object-regression ()
  :computed-slots ((regression-test-data (with-output-to-string (*standard-output*)
					   (make-object 'make-object-regression&)))


		   (seed-data "Hey Now to *standard-out*.
Hey Now to t.
" )

		   (pass? (equalp (the seed-data) (the regression-test-data)))))


(defun make-object-test () (the-object (make-object 'make-object-regression) pass?))