Update code to 7.27

Author: asmaloney

commands/conflict-tree.lisp

@@ -293,6 +293,9 @@
 ;;; 2019.12.02 Dan
 ;;;             : * Clear-dm should set the in-dm parameter to nil so that the
 ;;;             :   chunks can be added back if needed.
+;;; 2021.04.19 Dan
+;;;             : * Fixed a bug with the external definition of set-base-levels
+;;;             :   and set-base-levels-fct.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; General Docs:
@@ -582,14 +585,14 @@
 
 
 (defun set-base-levels-external (&rest settings)
-  (get-base-level-fct (string->name-recursive settings)))
+  (set-base-levels-fct (string->name-recursive settings)))
 
 (defun set-base-levels-fct-external (settings)
-  (get-base-level-fct (string->name-recursive settings)))
+  (set-base-levels-fct (string->name-recursive settings)))
 
 
 (add-act-r-command "set-base-levels" 'set-base-levels-external "Set the base-level activation of chunks in DM. Params: (chunk level {creation-time})*")
-(add-act-r-command "set-base-levels-fct" 'set-base-levels-external-fct "Set the base-level activation of chunks in DM. Params: ((chunk level {creation-time})*)")
+(add-act-r-command "set-base-levels-fct" 'set-base-levels-fct-external "Set the base-level activation of chunks in DM. Params: ((chunk level {creation-time})*)")
 
 (defun set-all-base-levels (base-level &optional creation-time)
   "Function to set the base-level activation of all dm chunks"

commands/dm-commands.lisp

@@ -387,6 +387,15 @@
 ;;; 2020.08.26 Dan
 ;;;             : * Removed the path for require-compiled since it's not needed
 ;;;             :   and results in warnings in SBCL.
+;;; 2021.07.08 Dan
+;;;             : * Fixed a typo in the warning for p-fct about no procedural
+;;;             :   module being available.
+;;; 2021.08.23 Dan 
+;;;             : * Fixed a problem with production-failure-reason because it
+;;;             :   didn't work when the buffer array mechanism was used since
+;;;             :   productions not in the matching buffer set didn't have their
+;;;             :   failure-condition cleared or set.  Now, it sets the ones
+;;;             :   that aren't in the buffer set to indicate that.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; General Docs:
@@ -635,8 +644,26 @@
 
 
 (defun production-failure-reason (p-name)
-  (let ((production (get-production p-name)))
+  ; only called with the procedural-cr-lock already held since it's
+  ; called during the conflict-set-hook by the procedural history recorder
+  
+  (let ((production (get-production p-name))
+        (procedural (get-module procedural)))
     (bt:with-recursive-lock-held ((production-lock production))
+  
+      (when (procedural-buffer-use-array procedural)
+        (let* ((buffer-state 
+                (let ((m (current-model-struct)))
+                  (bt:with-lock-held ((act-r-model-buffers-lock m))
+                    (act-r-model-buffer-state m))))
+               
+               (tested-productions (aref (procedural-buffer-use-array procedural) 
+                                         (aref (procedural-master-buffer-map procedural) buffer-state))))
+      
+          (unless (find production tested-productions)
+            (setf (production-failure-condition production) (cons :buffer-state buffer-state)))
+          ))
+  
       (if (and production (production-failure-condition production))
           (failure-reason-string (production-failure-condition production) production)
         ""))))
@@ -743,7 +770,7 @@
   (let ((prod (get-module procedural)))  
     (if (procedural-p prod)  
         (create-production prod definition) 
-      (print-warning "No procedural modulue found cannot create production."))))
+      (print-warning "No procedural module found cannot create production."))))
 
 
 (defun delete-production (prod-name)

commands/procedural-cmds.lisp

@@ -13,7 +13,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Filename    : audio.lisp
-;;; Version     : 6.0
+;;; Version     : 6.1
 ;;; 
 ;;; Description : Source for RPM's Audition Module
 ;;; 
@@ -476,6 +476,9 @@
 ;;; 2020.08.26 Dan
 ;;;             : * Removed the path for require-compiled since it's not needed
 ;;;             :   and results in warnings in SBCL.
+;;; 2021.06.09 Dan [6.1]
+;;;             : * Make sure the aural-location buffer always gets a new 
+;;;             :   chunk when it's set with buffer-requires-copies.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 #+:packaged-actr (in-package :act-r)
@@ -504,7 +507,7 @@
 
    (last-stuffed-event :accessor last-stuffed-event :initform nil))
    (:default-initargs
-     :version-string "6.0"
+     :version-string "6.1"
      :name :AUDIO))
 
 
@@ -1160,7 +1163,7 @@
     (setf (default-spec instance)
       (define-chunk-spec :attended nil)))
 
-  
+  (buffer-requires-copies 'aural-location)
 
   )
 

core-modules/audio.lisp

@@ -13,7 +13,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Filename    : declarative-memory.lisp
-;;; Version     : 6.6
+;;; Version     : 7.0
 ;;; 
 ;;; Description : Implements the declarative memory module.
 ;;; 
@@ -508,6 +508,11 @@
 ;;;             : * Added an :rt-value request parameter that can be used to set
 ;;;             :   a new :rt value to use during this retrieval, just like the
 ;;;             :   :mp-value changes the :mp parameter.
+;;; 2021.03.10 Dan [6.8]
+;;;             : * Set the :do-not-query parameter for goal buffer now.
+;;; 2021.06.04 Dan [7.0]
+;;;             : * When merging chunks from a buffer need to check if it's
+;;;             :   storable or not if it's being added as a new chunk.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; General Docs:
@@ -918,7 +923,7 @@
 (defun secondary-reset-dm-module (dm)
   (declare (ignore dm))
 
-  (sgp :dcsc-hook dm-fm-rh))
+  (sgp :dcsc-hook dm-fm-rh :do-not-query retrieval))
 
 
 (defun tertiary-reset-dm-module (dm)
@@ -1805,7 +1810,9 @@
 
           ;; otherwise add it to the list
 
-          (add-chunk-into-dm dm chunk key))))))
+          (if (chunk-not-storable chunk)
+              (add-chunk-into-dm dm (copy-chunk-fct chunk) key)
+            (add-chunk-into-dm dm chunk key)))))))
 
 ;; add-chunk-into-dm
 ;;;
@@ -2161,7 +2168,7 @@
         (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"))
 
-  :version "6.7" 
+  :version "7.0" 
   :documentation "The declarative memory module stores chunks from the buffers for retrieval"
 
   ;; The creation function returns a new dm structure

core-modules/declarative-memory.lisp

@@ -13,7 +13,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Filename    : goal.lisp
-;;; Version     : 2.2
+;;; Version     : 2.3
 ;;; 
 ;;; Description : Implementation of the goal module.
 ;;; 
@@ -131,6 +131,8 @@
 ;;; 2020.08.26 Dan
 ;;;             : * Removed the path for require-compiled since it's not needed
 ;;;             :   and results in warnings in SBCL.
+;;; 2021.03.10 Dan [2.3]
+;;;             : * Set the :do-not-query parameter for goal buffer now.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; General Docs:
@@ -209,7 +211,9 @@
   (bt:with-lock-held ((goal-module-lock instance))
     (setf (goal-module-delayed instance) nil))
   ; Do NOT strict harvest the goal buffer by default
-  (sgp :do-not-harvest goal)
+  ; and don't add explicit queries when requests are made
+  (sgp :do-not-harvest goal :do-not-query goal)
+  
   )
 
 (defun goal-query (instance buffer-name slot value)
@@ -232,7 +236,7 @@
 
 (define-module-fct 'goal '((goal (:ga 0.0)))
   nil
-  :version "2.2"
+  :version "2.3"
   :documentation "The goal module creates new goals for the goal buffer"
   :creation 'create-goal-module
   :query 'goal-query

core-modules/goal.lisp

@@ -13,7 +13,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Filename    : imaginal.lisp
-;;; Version     : 5.0
+;;; Version     : 6.0
 ;;; 
 ;;; Description : An actual imaginal module.
 ;;; 
@@ -150,6 +150,10 @@
 ;;; 2020.08.26 Dan
 ;;;             : * Removed the path for require-compiled since it's not needed
 ;;;             :   and results in warnings in SBCL.
+;;; 2021.06.14 Dan [6.0]
+;;;             : * Allow the simple imaginal-action request to accept a chunk
+;;;             :   description list as the return value and then use that to
+;;;             :   set the buffer instead of creating a temp chunk.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; General Docs:
@@ -197,15 +201,18 @@
 ;;;
 ;;; The function named in the action slot is called at the time of the request,
 ;;; the imaginal buffer is cleared, and the imaginal module is marked as busy. 
-;;; The action function should return either a chunk name or nil.  If a chunk
-;;; name is returned then that chunk will be put into the imaginal buffer after
-;;; the current delay time for the imaginal module passes and the module will
-;;; then be marked as free.  If the function returns nil then after the current
-;;; imaginal delay time passes the module will be marked as free and the error
-;;; state will be set to t.  If the slots slot
-;;; is specified with a list of symbols which name valid slots for a chunk then
-;;; those slot names will be passed to the action function in the order provided 
-;;; i.e. this is what will effectively happen: (apply <action> <slots list>).  
+;;; The action function should return either a chunk name, a list of slots and
+;;; values that describe a chunk, or nil.  If a chunk name or list of slots and
+;;; values is returned then the named chunk will be copied into the imaginal 
+;;; buffer after the current delay time for the imaginal module passes and the
+;;; module will then be marked as free.  If a slots and values list is returned
+;;; then that will be used to create a new chunk in the imaginal buffer after the
+;;; current delay time passes and then the module will be marked as free.  If the
+;;; function returns nil then after the current imaginal delay time passes the 
+;;; module will be marked as free and the error state will be set to t.  If the 
+;;; slots slot is specified with a list of symbols which name valid slots for a 
+;;; chunk then those slot names will be passed to the action function in the order
+;;; provided i.e. this is what will effectively happen: (apply <action> <slots list>).  
 ;;; If the slots list is provided but not valid then no action is taken and a warning
 ;;; is printed.
 
@@ -380,6 +387,12 @@
                                                 ((chunk-p-fct (string->name c)) ;; set module free and buffer chunk
                                                  (schedule-set-buffer-chunk 'imaginal (string->name c) delay :time-in-ms t :module 'imaginal :priority -1000)
                                                  (schedule-event-relative delay 'set-imaginal-free :time-in-ms t :module 'imaginal :output nil :priority -1001 :maintenance t))
+                                                ((listp c)
+                                                 (aif (define-chunk-spec-fct (decode-string-names c))
+                                                      (schedule-set-buffer-chunk 'imaginal it delay :time-in-ms t :module 'imaginal :priority -1000)
+                                                   (progn
+                                                     (bt:acquire-lock (imaginal-module-lock instance)) ;; since the bad exit releases it
+                                                     (bad-action-exit "Invalid result from the action of an imaginal-action simple-action function."))))
                                                 (t
                                                  (bt:acquire-lock (imaginal-module-lock instance)) ;; since the bad exit releases it
                                                  (bad-action-exit "Invalid result from the action of an imaginal-action simple-action function."))))))))
@@ -433,7 +446,7 @@
    (define-parameter :vidt :valid-test 'tornil :default-value nil
           :warning "T or nil" :documentation "Variable Imaginal Delay Time"))
 
-  :version "5.0"
+  :version "6.0"
   :documentation "The imaginal module provides a goal style buffer with a delay and an action buffer for manipulating the imaginal chunk"
   :creation 'create-imaginal
   :query 'imaginal-query