Commit 7a5fda9c authored by CD's avatar CD
Browse files

Some ACT-R7 related updates

parent 14364076
File mode changed from 100644 to 100755
...@@ -282,6 +282,9 @@ ...@@ -282,6 +282,9 @@
;;; : * Fixed a couple typos from the previous update. ;;; : * Fixed a couple typos from the previous update.
;;; 2018.12.17 Dan ;;; 2018.12.17 Dan
;;; : * The remote whynot-dm wasn't using the external version. ;;; : * The remote whynot-dm wasn't using the external version.
;;; 2019.04.04 Dan
;;; : * Cache the result of chunk-spec-slots in the retrieval
;;; : request since that's costly don't want to do it twice.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; General Docs: ;;; General Docs:
...@@ -1510,58 +1513,59 @@ ...@@ -1510,58 +1513,59 @@
(print-warning x)) (print-warning x))
(return-from simulate-retrieval-request-plus-seed-fct))) (return-from simulate-retrieval-request-plus-seed-fct)))
(when (member :recently-retrieved (chunk-spec-slots request)) (let ((requested-slots (chunk-spec-slots request)))
(let ((recent (chunk-spec-slot-spec request :recently-retrieved))) (when (member :recently-retrieved requested-slots)
(cond ((> (length recent) 1) (let ((recent (chunk-spec-slot-spec request :recently-retrieved)))
(invalid '("Invalid retrieval request." ":recently-retrieved parameter used more than once."))) (cond ((> (length recent) 1)
((not (or (eq '- (caar recent)) (eq '= (caar recent)))) (invalid '("Invalid retrieval request." ":recently-retrieved parameter used more than once.")))
(invalid '("Invalid retrieval request." ":recently-retrieved parameter's modifier can only be = or -."))) ((not (or (eq '- (caar recent)) (eq '= (caar recent))))
((not (or (eq t (third (car recent))) (invalid '("Invalid retrieval request." ":recently-retrieved parameter's modifier can only be = or -.")))
(eq nil (third (car recent))) ((not (or (eq t (third (car recent)))
(and (eq 'reset (third (car recent))) (eq nil (third (car recent)))
(eq '= (caar recent))))) (and (eq 'reset (third (car recent)))
(invalid '("Invalid retrieval request." ":recently-retrieved parameter's value can only be t, nil, or reset."))) (eq '= (caar recent)))))
(invalid '("Invalid retrieval request." ":recently-retrieved parameter's value can only be t, nil, or reset.")))
(t ;; it's a valid value for recently-retrieved
(t ;; it's a valid value for recently-retrieved
(if (eq 'reset (third (car recent)))
(bt:with-lock-held ((dm-state-lock dm))
(setf (dm-finsts dm) nil))
(let ((finsts (remove-old-dm-finsts dm))) (if (eq 'reset (third (car recent)))
(bt:with-lock-held ((dm-state-lock dm))
(setf (dm-finsts dm) nil))
(cond ((or (and (eq t (third (car recent))) ;; = request t (let ((finsts (remove-old-dm-finsts dm)))
(eq (caar recent) '=))
(and (null (third (car recent))) ;; - request nil (cond ((or (and (eq t (third (car recent))) ;; = request t
(eq (caar recent) '-))) (eq (caar recent) '=))
(and (null (third (car recent))) ;; - request nil
;; only those chunks marked are available (eq (caar recent) '-)))
(setf chunk-list (intersection (mapcar 'car finsts) chunk-list)) ;; only those chunks marked are available
(command-output "Only recently retrieved chunks: ~s" chunk-list)) (setf chunk-list (intersection (mapcar 'car finsts) chunk-list))
(t
(command-output "Only recently retrieved chunks: ~s" chunk-list))
(command-output "Removing recently retrieved chunks:") (t
(setf chunk-list (command-output "Removing recently retrieved chunks:")
(remove-if (lambda (x)
(when (member x finsts :key 'car :test 'eq-chunks-fct) (setf chunk-list
(command-output "~s" x) (remove-if (lambda (x)
t)) (when (member x finsts :key 'car :test 'eq-chunks-fct)
chunk-list)))))))))) (command-output "~s" x)
t))
(when (member :mp-value (chunk-spec-slots request)) chunk-list))))))))))
(let ((mp-value (chunk-spec-slot-spec request :mp-value)))
(cond ((> (length mp-value) 1) (when (member :mp-value requested-slots)
(invalid '("Invalid retrieval request." ":mp-value parameter used more than once."))) (let ((mp-value (chunk-spec-slot-spec request :mp-value)))
((not (eq '= (caar mp-value))) (cond ((> (length mp-value) 1)
(invalid '("Invalid retrieval request." ":mp-value parameter's modifier can only be =."))) (invalid '("Invalid retrieval request." ":mp-value parameter used more than once.")))
((not (numornil (third (car mp-value)))) ((not (eq '= (caar mp-value)))
(invalid '("Invalid retrieval request." ":mp-value parameter's value can only be nil or a number."))) (invalid '("Invalid retrieval request." ":mp-value parameter's modifier can only be =.")))
((not (numornil (third (car mp-value))))
(t ;; it's a valid request (invalid '("Invalid retrieval request." ":mp-value parameter's value can only be nil or a number.")))
(setf mp (third (car mp-value)))))))
(t ;; it's a valid request
(setf mp (third (car mp-value))))))))
......
File mode changed from 100644 to 100755
File mode changed from 100644 to 100755
File mode changed from 100644 to 100755
File mode changed from 100644 to 100755
...@@ -13,7 +13,7 @@ ...@@ -13,7 +13,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; Filename : declarative-memory.lisp ;;; Filename : declarative-memory.lisp
;;; Version : 6.3 ;;; Version : 6.4
;;; ;;;
;;; Description : Implements the declarative memory module. ;;; Description : Implements the declarative memory module.
;;; ;;;
...@@ -466,6 +466,18 @@ ...@@ -466,6 +466,18 @@
;;; : the if since it defaults to 0 thus no need to keep setting ;;; : the if since it defaults to 0 thus no need to keep setting
;;; : it there if spreading-activation is off and that's a parameter ;;; : it there if spreading-activation is off and that's a parameter
;;; : which shouldn't change during a run. ;;; : which shouldn't change during a run.
;;; 2019.04.02 Dan
;;; : * Have hash-chunk-contents use the underlying chunk info
;;; : instead of going through the accessors.
;;; 2019.04.04 Dan
;;; : * Cache the result of chunk-spec-slots in the retrieval
;;; : request since that's costly don't want to do it twice.
;;; 2019.04.15 Dan
;;; : * Depend on splice-into-position-des being destructive and
;;; : don't setf with the returned value.
;;; 2019.05.17 Dan [6.4]
;;; : * Allow the sim-hook cache to persist across a reset. Only
;;; : clear the table when a new hook function is set.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; General Docs: ;;; General Docs:
...@@ -670,6 +682,8 @@ ...@@ -670,6 +682,8 @@
cache-sim-hook-results cache-sim-hook-results
(sim-hook-cache (make-hash-table :test 'equalp)) (sim-hook-cache (make-hash-table :test 'equalp))
last-sim-hook
(chunk-lock (bt:make-lock "dm-chunks")) ;; chunks and chunk-hash-table (chunk-lock (bt:make-lock "dm-chunks")) ;; chunks and chunk-hash-table
(param-lock (bt:make-lock "dm-params")) ;; things through sgp (param-lock (bt:make-lock "dm-params")) ;; things through sgp
(state-lock (bt:make-lock "dm-state")) ;; other slots (state-lock (bt:make-lock "dm-state")) ;; other slots
...@@ -813,14 +827,18 @@ ...@@ -813,14 +827,18 @@
;;; A function for converting a chunk to a list of its info ;;; A function for converting a chunk to a list of its info
(defun hash-chunk-contents (chunk) (defun hash-chunk-contents (chunk)
(cons (chunk-slots-vector chunk) (let ((c (get-chunk chunk)))
(mapcar (lambda (x) (when c
(let ((val (fast-chunk-slot-value-fct chunk x))) (bt:with-recursive-lock-held ((act-r-chunk-lock c))
(if (stringp val) (cons (act-r-chunk-filled-slots c)
(string-upcase val) (mapcar (lambda (x)
(true-chunk-name-fct val)))) (let ((val (cdr x)))
(chunk-filled-slots-list-fct chunk t)))) (if (stringp val)
(string-upcase val)
(true-chunk-name-fct val))))
(sort (copy-list (act-r-chunk-slot-value-lists c))
#'< :key (lambda (x) (act-r-slot-index (car x))))))))))
(defun reset-dm-module (dm) (defun reset-dm-module (dm)
...@@ -851,9 +869,14 @@ ...@@ -851,9 +869,14 @@
(setf (dm-current-trace dm) nil)) (setf (dm-current-trace dm) nil))
(bt:with-lock-held ((dm-param-lock dm)) #| Don't do that at reset
only when a new hook function gets
set so that results persist across a reset for
a given function.
(bt:with-lock-held ((dm-param-lock dm))
;; clear the sim-hook cache ;; clear the sim-hook cache
(clrhash (dm-sim-hook-cache dm))) (clrhash (dm-sim-hook-cache dm)))
|#
) )
(defun secondary-reset-dm-module (dm) (defun secondary-reset-dm-module (dm)
...@@ -1050,89 +1073,90 @@ ...@@ -1050,89 +1073,90 @@
(print-warning x)) (print-warning x))
(return-from start-retrieval))) (return-from start-retrieval)))
(when (member :recently-retrieved (chunk-spec-slots request)) (let ((requested-slots (chunk-spec-slots request)))
(let ((recent (chunk-spec-slot-spec request :recently-retrieved))) (when (member :recently-retrieved requested-slots)
(cond ((> (length recent) 1) (let ((recent (chunk-spec-slot-spec request :recently-retrieved)))
(invalid :too-many '("Invalid retrieval request." ":recently-retrieved parameter used more than once."))) (cond ((> (length recent) 1)
((not (or (eq '- (caar recent)) (eq '= (caar recent)))) (invalid :too-many '("Invalid retrieval request." ":recently-retrieved parameter used more than once.")))
(invalid :bad-modifier '("Invalid retrieval request." ":recently-retrieved parameter's modifier can only be = or -."))) ((not (or (eq '- (caar recent)) (eq '= (caar recent))))
((not (or (eq t (third (car recent))) (invalid :bad-modifier '("Invalid retrieval request." ":recently-retrieved parameter's modifier can only be = or -.")))
(eq nil (third (car recent))) ((not (or (eq t (third (car recent)))
(and (eq 'reset (third (car recent))) (eq nil (third (car recent)))
(eq '= (caar recent))))) (and (eq 'reset (third (car recent)))
(invalid :bad-value '("Invalid retrieval request." ":recently-retrieved parameter's value can only be t, nil, or reset."))) (eq '= (caar recent)))))
(t ;; it's a valid value for recently-retrieved (invalid :bad-value '("Invalid retrieval request." ":recently-retrieved parameter's value can only be t, nil, or reset.")))
(t ;; it's a valid value for recently-retrieved
(if (eq 'reset (third (car recent)))
(bt:with-lock-held ((dm-state-lock dm))
(setf (dm-finsts dm) nil))
(let ((finsts (remove-old-dm-finsts dm)))
(cond ((or (and (eq t (third (car recent))) ;; = request t (if (eq 'reset (third (car recent)))
(eq (caar recent) '=)) (bt:with-lock-held ((dm-state-lock dm))
(and (null (third (car recent))) ;; - request nil (setf (dm-finsts dm) nil))
(eq (caar recent) '-)))
(let ((finsts (remove-old-dm-finsts dm)))
;; only those chunks marked are available
(cond ((or (and (eq t (third (car recent))) ;; = request t
(setf chunk-list (intersection (mapcar 'car finsts) chunk-list)) (eq (caar recent) '=))
(and (null (third (car recent))) ;; - request nil
;; save that info for whynot (eq (caar recent) '-)))
(setf (last-request-finst last-request) :marked)
(setf (last-request-finst-chunks last-request) chunk-list) ;; only those chunks marked are available
(when sact (setf chunk-list (intersection (mapcar 'car finsts) chunk-list))
(bt:with-lock-held ((dm-state-lock dm))
(setf (sact-trace-only-recent (dm-current-trace dm)) t) ;; save that info for whynot
(setf (sact-trace-recents (dm-current-trace dm)) chunk-list))) (setf (last-request-finst last-request) :marked)
(setf (last-request-finst-chunks last-request) chunk-list)
(when (dm-act-level act 'high)
(model-output "Only recently retrieved chunks: ~s" chunk-list)))
(t
;; simply remove the marked items
;; may be "faster" to do this later
;; once the set is trimed elsewise, but
;; for now keep things simple
(unwind-protect
(progn
(when sact
(bt:acquire-lock (dm-state-lock dm))
(setf (sact-trace-remove-recent (dm-current-trace dm)) t))
(when (dm-act-level act 'high)
(model-output "Removing recently retrieved chunks:"))
(setf (last-request-finst last-request) :unmarked)
(setf chunk-list
(remove-if (lambda (x)
(when (member x finsts :key 'car :test 'eq-chunks-fct)
(when sact
(push-last x (sact-trace-recents (dm-current-trace dm))))
(when (dm-act-level act 'high)
(model-output "~s" x))
(push x (last-request-finst-chunks last-request))
t))
chunk-list)))
(when sact (when sact
(bt:release-lock (dm-state-lock dm)))))))))))) (bt:with-lock-held ((dm-state-lock dm))
(setf (sact-trace-only-recent (dm-current-trace dm)) t)
(setf (sact-trace-recents (dm-current-trace dm)) chunk-list)))
(when (member :mp-value (chunk-spec-slots request))
(let ((mp-value (chunk-spec-slot-spec request :mp-value))) (when (dm-act-level act 'high)
(cond ((> (length mp-value) 1) (model-output "Only recently retrieved chunks: ~s" chunk-list)))
(invalid :mp-multi '("Invalid retrieval request." ":mp-value parameter used more than once."))) (t
((not (eq '= (caar mp-value))) ;; simply remove the marked items
(invalid :mp-modifier '("Invalid retrieval request." ":mp-value parameter's modifier can only be =."))) ;; may be "faster" to do this later
((not (numornil (third (car mp-value)))) ;; once the set is trimed elsewise, but
(invalid :mp-not-num '("Invalid retrieval request." ":mp-value parameter's value can only be nil or a number."))) ;; for now keep things simple
(unwind-protect
(t ;; it's a valid request (progn
(setf mp (third (car mp-value))))))) (when sact
(bt:acquire-lock (dm-state-lock dm))
(setf (sact-trace-remove-recent (dm-current-trace dm)) t))
(when (dm-act-level act 'high)
(model-output "Removing recently retrieved chunks:"))
(setf (last-request-finst last-request) :unmarked)
(setf chunk-list
(remove-if (lambda (x)
(when (member x finsts :key 'car :test 'eq-chunks-fct)
(when sact
(push-last x (sact-trace-recents (dm-current-trace dm))))
(when (dm-act-level act 'high)
(model-output "~s" x))
(push x (last-request-finst-chunks last-request))
t))
chunk-list)))
(when sact
(bt:release-lock (dm-state-lock dm))))))))))))
(when (member :mp-value requested-slots)
(let ((mp-value (chunk-spec-slot-spec request :mp-value)))
(cond ((> (length mp-value) 1)
(invalid :mp-multi '("Invalid retrieval request." ":mp-value parameter used more than once.")))
((not (eq '= (caar mp-value)))
(invalid :mp-modifier '("Invalid retrieval request." ":mp-value parameter's modifier can only be =.")))
((not (numornil (third (car mp-value))))
(invalid :mp-not-num '("Invalid retrieval request." ":mp-value parameter's value can only be nil or a number.")))
(t ;; it's a valid request
(setf mp (third (car mp-value))))))))
(let ((best-val nil) (let ((best-val nil)
(best nil) (best nil)
...@@ -1583,7 +1607,18 @@ ...@@ -1583,7 +1607,18 @@
(setf (dm-finst-span dm) (safe-seconds->ms (cdr param) 'sgp)) (setf (dm-finst-span dm) (safe-seconds->ms (cdr param) 'sgp))
(cdr param)) (cdr param))
(:sim-hook (setf (dm-sim-hook dm) (cdr param))) (:sim-hook
;; If a different sim-hook is set clear the cache
(when (cdr param)
(when (and (dm-last-sim-hook dm)
(cdr param)
(not (equalp (cdr param) (dm-last-sim-hook dm))))
(clrhash (dm-sim-hook-cache dm)))
(setf (dm-last-sim-hook dm) (cdr param)))
(setf (dm-sim-hook dm) (cdr param)))
(:sji-hook (setf (dm-sji-hook dm) (cdr param))) (:sji-hook (setf (dm-sji-hook dm) (cdr param)))
(:w-hook (setf (dm-w-hook dm) (cdr param))) (:w-hook (setf (dm-w-hook dm) (cdr param)))
...@@ -1637,7 +1672,8 @@ ...@@ -1637,7 +1672,8 @@
(push (cdr param) (dm-chunk-add-hook dm))) (push (cdr param) (dm-chunk-add-hook dm)))
(setf (dm-chunk-add-hook dm) nil))) (setf (dm-chunk-add-hook dm) nil)))
(:nsji (setf (dm-nsji dm) (cdr param))) (:nsji (setf (dm-nsji dm) (cdr param)))
(:cache-sim-hook-results (setf (dm-cache-sim-hook-results dm) (cdr param))))) (:cache-sim-hook-results
(setf (dm-cache-sim-hook-results dm) (cdr param)))))
(t (t
(case param (case param
...@@ -1923,7 +1959,7 @@ ...@@ -1923,7 +1959,7 @@
(let ((result nil)) (let ((result nil))
(dolist (x ordering result) (dolist (x ordering result)
(aif (position-if (lambda (y) (find (car x) (cdr y))) result) (aif (position-if (lambda (y) (find (car x) (cdr y))) result)
(setf result (splice-into-position-des result it x)) (splice-into-position-des result it x)
(push-last x result))))) (push-last x result)))))
...@@ -2060,7 +2096,7 @@ ...@@ -2060,7 +2096,7 @@
(define-parameter :cache-sim-hook-results :valid-test 'tornil :default-value nil (define-parameter :cache-sim-hook-results :valid-test 'tornil :default-value nil
:warning "T or nil" :documentation "Whether the results of calling a sim-hook function should be cached to avoid future calls to the hook function")) :warning "T or nil" :documentation "Whether the results of calling a sim-hook function should be cached to avoid future calls to the hook function"))
:version "6.3" :version "6.4"
:documentation "The declarative memory module stores chunks from the buffers for retrieval" :documentation "The declarative memory module stores chunks from the buffers for retrieval"
;; The creation function returns a new dm structure ;; The creation function returns a new dm structure
......
File mode changed from 100644 to 100755
File mode changed from 100644 to 100755
...@@ -404,6 +404,9 @@ ...@@ -404,6 +404,9 @@
;;; : the result which is wrong: ;;; : the result which is wrong:
;;; : 1[5]: (DIRECTION= -2.7610862 2.8501358) ;;; : 1[5]: (DIRECTION= -2.7610862 2.8501358)
;;; : 1[5]: returned NIL ;;; : 1[5]: returned NIL
;;; 2019.04.23 Dan
;;; : * Create the chunk-type definition for motor extensions when
;;; : they're added instead of at every reset.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#+:packaged-actr (in-package :act-r) #+:packaged-actr (in-package :act-r)
...@@ -1176,9 +1179,13 @@ ...@@ -1176,9 +1179,13 @@
(bt:with-lock-held ((requests-table-lock dummy-module)) (bt:with-lock-held ((requests-table-lock dummy-module))
(if (gethash ct-name (new-requests-table dummy-module)) (if (gethash ct-name (new-requests-table dummy-module))
(print-warning "Request ~s is already an extension of the manual buffer. To redefine you must remove it first with remove-manual-request." ct-name) (print-warning "Request ~s is already an extension of the manual buffer. To redefine you must remove it first with remove-manual-request." ct-name)
(progn (let ((type-list
(if (listp (first chunk-type))
(append chunk-type (list (list 'cmd ct-name)))
(append (list (list ct-name '(:include motor-command))) (rest chunk-type) (list (list 'cmd ct-name))))))
(setf (gethash ct-name (new-requests-table dummy-module)) (setf (gethash ct-name (new-requests-table dummy-module))
(cons (copy-list chunk-type) function-name)) (cons type-list function-name))
t))))))) t)))))))
(defmacro remove-manual-request (chunk-type) (defmacro remove-manual-request (chunk-type)
...@@ -1297,15 +1304,12 @@ ...@@ -1297,15 +1304,12 @@
;; Define the chunk-types for the specified extensions ;; Define the chunk-types for the specified extensions
(maphash (lambda (name value) (maphash (lambda (name value)
(let* ((chunk-type-list (car value)) (let ((type (chunk-type-fct (car value))))
(type (chunk-type-fct (if (listp (first chunk-type-list))
(append chunk-type-list `((cmd ,name)))
(append `((,(first chunk-type-list) (:include motor-command))) (rest chunk-type-list) `((cmd ,name)))))))
(if type (if type
(unless (chunk-p-fct name) (unless (chunk-p-fct name)
(define-chunks-fct (list (list name 'isa name))) (define-chunks-fct (list (list name 'isa name)))
(make-chunk-immutable name)) (make-chunk-immutable name))
(print-warning "Failed to extend motor capabilities with chunk-type definition: ~s" chunk-type-list)))) (print-warning "Failed to extend motor capabilities with chunk-type definition: ~s" (car value)))))
(bt:with-lock-held ((requests-table-lock instance)) (new-requests-table instance))) (bt:with-lock-held ((requests-table-lock instance)) (new-requests-table instance)))
) )
......
...@@ -809,6 +809,15 @@ ...@@ -809,6 +809,15 @@
;;; : slot. ;;; : slot.
;;; 2019.03.06 Dan ;;; 2019.03.06 Dan
;;; : * Use valid-slot-index instead of valid-slot-name. ;;; : * Use valid-slot-index instead of valid-slot-name.
;;; 2019.05.03 Dan
;;; : * Can't use the length of (buffers) to set the lookup array
;;; : because if a buffer is removed and added back it'll get a
;;; : new index that's outside that range. Using the new max-
;;; : buffer-index command instead.
;;; 2019.05.16 Dan
;;; : * Fixed production-statement-text for the @ actions because
;;; : it assumed only the old style of '@buffer> chunk' was
;;; : possible.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; General Docs: ;;; General Docs:
...@@ -1093,7 +1102,7 @@ ...@@ -1093,7 +1102,7 @@
(setf (procedural-delayed-resolution prod) nil) (setf (procedural-delayed-resolution prod) nil)
(setf (procedural-buffer-indices prod) nil) (setf (procedural-buffer-indices prod) nil)
(setf (procedural-buffer-lookup prod) nil) (setf (procedural-buffer-lookup prod) nil)
(setf (procedural-buffer-lookup-size prod) (length (buffers))) (setf (procedural-buffer-lookup-size prod) (1+ (max-buffer-index)))
(setf (procedural-last-cr-time prod) nil) (setf (procedural-last-cr-time prod) nil)
(setf (procedural-search-buffer-table prod) (make-hash-table)) (setf (procedural-search-buffer-table prod) (make-hash-table))
...@@ -2176,7 +2185,14 @@ ...@@ -2176,7 +2185,14 @@
;; there's only one thing in the definition but leave it flexible... ;; there's only one thing in the definition but leave it flexible...
(format s " ~c~a> ~{~s~^ ~}~%" op target (replace-variables definition bindings)))) (format s " ~c~a> ~{~s~^ ~}~%" op target (replace-variables definition bindings))))
(#\@ (#\@
(format s " @~a> ~s~%" target (replace-variables (car definition) bindings))) (cond ((null definition)
(format s " @~a>~%" target))
((= (length definition) 1)
(format s " @~a> ~s~%" target (first (replace-variables definition bindings))))
(t
(format s " @~a>~%" target)
(dolist (slot (replace-variables (chunk-spec-slot-spec spec) bindings))
(format s " ~s ~s~%" (spec-slot-name slot) (spec-slot-value slot))))))
(#\! (#\!
(format s " !~a! ~{~s~^ ~}~%" target (replace-variables definition bindings))) (format s " !~a! ~{~s~^ ~}~%" target (replace-variables definition bindings)))
(#\+ (#\+
......
File mode changed from 100644 to 100755
...@@ -1148,6 +1148,21 @@ ...@@ -1148,6 +1148,21 @@