Commit 1e88a3cc authored by Dave Cooper's avatar Dave Cooper

added args argument for not-handled-error

parent 59a9dda7
......@@ -93,13 +93,13 @@
`(unless (find-method (symbol-function ',(glisp:intern (symbol-name attr-sym) :gdl-slots))
nil (list (find-class 'gdl-basis)) nil)
(defmethod ,(glisp:intern (symbol-name attr-sym) :gdl-slots) ((,self-arg gdl-basis) &rest ,args-arg)
(declare (ignore ,args-arg))
;;(declare (ignore ,args-arg))
(let ((,parent-arg (the-object ,self-arg %parent%)))
(if (null ,parent-arg) (not-handled ,self-arg ,(make-keyword attr-sym))
(if (null ,parent-arg) (not-handled ,self-arg ,(make-keyword attr-sym) ,args-arg)
(let ((,val-arg (let (*error-on-not-handled?*)
(,(glisp:intern (symbol-name attr-sym) :gdl-inputs)
,parent-arg (the-object ,self-arg :%name%) ,self-arg))))
(if (eql ,val-arg 'gdl-rule:%not-handled%) (not-handled ,self-arg ,(make-keyword attr-sym)) ,val-arg))))))))))
(if (eql ,val-arg 'gdl-rule:%not-handled%) (not-handled ,self-arg ,(make-keyword attr-sym) ,args-arg) ,val-arg))))))))))
computed-slots))
......
......@@ -93,9 +93,9 @@
(not (find-method (symbol-function ',(glisp:intern (symbol-name attr-sym) :gdl-slots))
nil (list (find-class 'gdl-basis)) nil)))
(defmethod ,(glisp:intern (symbol-name attr-sym) :gdl-slots) ((,self-arg gdl-basis) &rest ,args-arg)
(declare (ignore ,args-arg))
;;(declare (ignore ,args-arg))
(let ((,parent-arg (the-object ,self-arg %parent%)))
(if (null ,parent-arg) (not-handled ,self-arg ,(make-keyword attr-sym))
(if (null ,parent-arg) (not-handled ,self-arg ,(make-keyword attr-sym) ,args-arg)
(,(glisp:intern (symbol-name attr-sym) :gdl-inputs)
,parent-arg (the-object ,self-arg :%name%) ,self-arg))))))))))
......
......@@ -21,9 +21,9 @@
(in-package :gdl)
(defun not-handled (object message)
(defun not-handled (object message &optional args)
(if *error-on-not-handled?*
(not-handled-error object message)
(not-handled-error object message args)
'gdl-rule:%not-handled%))
......@@ -98,7 +98,7 @@
(the-object ,parent-arg (fetch-input ,(make-keyword attr-sym) ,part-arg ,self-arg)))))
`(defmethod ,(glisp:intern (symbol-name attr-sym) :gdl-slots) ((self ,name) &rest ,args-arg)
(declare (ignore ,args-arg))
;;(declare (ignore ,args-arg))
(let ((*error-on-not-handled?* t))
(with-dependency-tracking (,attr-sym self)
(let ((,parent-arg (the-object self %parent%)))
......@@ -114,7 +114,7 @@
(gethash ,(make-keyword attr-sym) (the-object ,parent-arg :%trickle-down-slots%))
(,(glisp:intern (symbol-name attr-sym) :gdl-slots) ,parent-arg)
(funcall (symbol-function ',(glisp:intern (symbol-name attr-sym) :gdl-trickle-downs)) ,parent-arg)))
(t (not-handled self ,(make-keyword attr-sym))))))))))))) input-slots))
(t (not-handled self ,(make-keyword attr-sym) ,args-arg)))))))))))) input-slots))
(defun optional-input-slots-section (name input-slots &optional (defaulted? nil))
(mapcan
......
......@@ -42,9 +42,9 @@
`(unless (find-method (symbol-function ',(glisp:intern key :gdl-slots))
nil (list (find-class 'gdl-basis)) nil)
(defmethod ,(glisp:intern key :gdl-slots) ((,self-arg gdl-basis) &rest ,args-arg)
(declare (ignore ,args-arg))
;;(declare (ignore ,args-arg))
(let ((,parent-arg (the-object ,self-arg %parent%)))
(if (null ,parent-arg) (not-handled ,self-arg ,(make-keyword key))
(if (null ,parent-arg) (not-handled ,self-arg ,(make-keyword key) ,args-arg)
(,(glisp:intern key :gdl-inputs)
,parent-arg (the-object ,self-arg :%name%) ,self-arg)))))) object-input-keys))))
......
......@@ -81,12 +81,12 @@ set of arms contained in the body which is contained in the robot which is conta
(let ((,new-object (getf (gdl-slots::%parameters% ,object)
(make-keyword ,message) 'gdl-rule:%not-handled%)))
(if (eql ,new-object 'gdl-rule:%not-handled%)
(not-handled-error ,object ',message) ,new-object)))
(not-handled-error ,object ',message ',args) ,new-object)))
`(if (fboundp ',message) (,message ,object ,@args)
(let ((,new-object (getf (gdl-slots::%parameters% ,object)
,(make-keyword message) 'gdl-rule:%not-handled%)))
(if (eql ,new-object 'gdl-rule:%not-handled%)
(not-handled-error ,object ',message) ,new-object))))
(not-handled-error ,object ',message ',args) ,new-object))))
(cond ((and evaluate? apply?)
`(apply (symbol-function (glisp:intern (symbol-name ,message) :gdl-slots)) ,object
,args))
......@@ -111,13 +111,17 @@ This is often used for sending the <tt>index</tt> message to an element of a qua
`(the-object child ,@reference-chain))
(defun not-handled-error (object message)
(if (the-object object root?)
(error "~s, which is the root object, could not handle the ~s message." object (make-keyword message))
(error "Neither ~s nor any of its ancestor instances could handle the ~s message
(defun not-handled-error (object message &optional args)
(if (the-object object root?)
(error "~s, which is the root object, could not handle the ~s message~a."
object (make-keyword message)
(if args (format nil "~%with args: ~s " args) ""))
(error "Neither ~s nor any of its ancestor instances could handle the ~s message~a
The path to the containing object is: ~s"
object (make-keyword message) (append '(the :root) (symbols-as-keywords
(reverse (the-object object :root-path)))))))
object (make-keyword message)
(if args (format nil "~%with args: ~s " args) "")
(append '(the :root) (symbols-as-keywords
(reverse (the-object object :root-path)))))))
(defmacro with-format ((format stream-or-file &rest args) &body body)
"Void [Macro]. Used to establish an output format and a stream to which data is to be sent. This is the experimental
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment