diff --git a/base/rest/source/bodies.lisp b/base/rest/source/bodies.lisp index 658d3d7ebdcd643472026a6818500dc8bac8c2fb..faa7a14688f6b81b54062ae0b1e549f32802a2b1 100755 --- a/base/rest/source/bodies.lisp +++ b/base/rest/source/bodies.lisp @@ -48,14 +48,14 @@ (gethash keyword (the-object parent %trickle-down-slots%)) (apply (symbol-function slot-symbol) parent args)) (t (apply (symbol-function (glisp:intern slot-symbol :gdl-trickle-downs)) parent args)))))) - (if (eql result 'gdl-rule:%not-handled%) (not-handled self keyword) result)) + (if (eql result 'gdl-rule:%not-handled%) (not-handled self keyword args) result)) result)))))) (defun trickle-down-basis (self slot args) (let ((keyword (make-keyword slot))) (let (*error-on-not-handled?* (parent (the parent))) - (cond ((null parent) (not-handled self keyword)) + (cond ((null parent) (not-handled self keyword args)) (;;(member keyword (the-object parent %trickle-down-slots%)) (gethash keyword (the-object parent %trickle-down-slots%)) (apply (symbol-function (glisp:intern slot :gdl-slots)) parent args)) diff --git a/patches/1590/p001.lisp b/patches/1590/p001.lisp index da23c3247977c87d2b852ab030fdf2dd5532f520..0deccd9fff85063a98caa579c14c6643e6c96954 100644 --- a/patches/1590/p001.lisp +++ b/patches/1590/p001.lisp @@ -19,6 +19,11 @@ ;; . ;; + +These changes have been merged into codebase. + +#| + (in-package :gdl) @@ -292,3 +297,5 @@ The path to the containing object is: ~s" (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)))))) + +|# diff --git a/patches/1590/p002.lisp b/patches/1590/p002.lisp new file mode 100644 index 0000000000000000000000000000000000000000..e5957c241e0b0f8037f77c190d552b74556f7dec --- /dev/null +++ b/patches/1590/p002.lisp @@ -0,0 +1,31 @@ +(in-package :gdl) + +(excl:without-package-locks + (excl:without-redefinition-warnings + (defun chase-up-trickle-down (slot-symbol self args) + (let ((keyword (make-keyword slot-symbol))) + (let ((parent (the-object self parent))) + (if (null parent) (not-handled self keyword) + (let ((result + (let (*error-on-not-handled?*) + (funcall (symbol-function (glisp:intern slot-symbol :gdl-inputs)) parent (the %name%) self)))) + (if (eql result 'gdl-rule:%not-handled%) + (let ((result + (let (*error-on-not-handled?*) + (cond ( ;;(member keyword (the-object parent %trickle-down-slots%)) + (gethash keyword (the-object parent %trickle-down-slots%)) + (apply (symbol-function slot-symbol) parent args)) + (t (apply (symbol-function (glisp:intern slot-symbol :gdl-trickle-downs)) parent args)))))) + (if (eql result 'gdl-rule:%not-handled%) (not-handled self keyword args) result)) + result)))))) + + (defun trickle-down-basis (self slot args) + (let ((keyword (make-keyword slot))) + (let (*error-on-not-handled?* (parent (the parent))) + (cond ((null parent) (not-handled self keyword args)) + ( ;;(member keyword (the-object parent %trickle-down-slots%)) + (gethash keyword (the-object parent %trickle-down-slots%)) + (apply (symbol-function (glisp:intern slot :gdl-slots)) parent args)) + (t (apply (symbol-function (glisp:intern slot :gdl-trickle-downs)) parent args)))))))) + +