Fixed configure. Main and interpreter updated for memory size tracking

configure

@@ -102,10 +102,11 @@ fi
 echo "Creating Makefile"
 { 
 if [ $LISPTYPE=sbcl ]; then
+    INSTANS_HOME=`pwd`
     cat <<EOF
 DYNAMIC_SPACE_SIZE=$DYNAMIC_SPACE_SIZE
 VERSION := \$(subst SBCL ,,\$(shell sbcl --version))
-CACHE=\$(subst VERSION,\$(VERSION),\$(HOME)/.cache/common-lisp/sbcl-VERSION-macosx-x64\$(HOME)/instans/)
+CACHE=\$(subst VERSION,\$(VERSION),${HOME}/.cache/common-lisp/sbcl-VERSION-macosx-x64${INSTANS_HOME})
 EOF
 fi
 cat <<EOF
@@ -131,7 +132,13 @@ all: \$(EXECUTABLE)
                     --load-system instans \\
                     --eval '(in-package :instans)'
 
-.PHONY: all
+show-cache:
+	ls -d \$(CACHE)
+
+cache-contents:
+	ls -lR \$(CACHE)
+
+.PHONY: all show-cache cache-contents
 EOF
 if [ $LISPTYPE=sbcl ]; then
 cat <<EOF

src/main/main.lisp

@@ -160,6 +160,7 @@
 	 ;; expected
 	 debug
 	 reporting
+	 report-memory-sizes-file
 	 rete-html-file)
     (labels ((valid-value-p (value accepted-values &key test)
 	       (or (funcall test value accepted-values)
@@ -491,6 +492,15 @@
 		      unless (member (first tail) '(:select :construct :modify :rete-add :rete-remove :queue :call-succ-nodes :all :memory-summaries :memory-sizes :rdf-operations :execute))
 		      do (usage))
 		(initialize-reporting instans reporting))
+	       (report-sizes-file
+		:options ("--report-sizes-file=FILE")
+		:usage ("The CSV file to contain the sizes")
+		(setf report-memory-sizes-file value)
+		(unless (getf reporting :memory-sizes)
+		  (setf reporting (cons :memory-sizes (cons 1 reporting))))
+		(setf (instans-memory-sizes-report-stream instans) (open-file report-memory-sizes-file :direction :output :if-exists :supersede :fmt "main: open ~{~A~^ ~}"))
+		(initialize-reporting instans reporting)
+		(report-memory-sizes-headers instans))
 	       (prefix-encoding
 		:options ("--prefix-encoding=BOOL")
 		:usage ("If true, use known prefixes when printing IRIs. If false (the default), print IRIs as such.")
@@ -530,4 +540,6 @@
 	(when time-output-stream
 	  (output-time "Done")
 	  (close-stream-not-stdout-stderr time-output-stream))
+	(when report-memory-sizes-file
+	  (close-stream-not-stdout-stderr (instans-memory-sizes-report-stream instans)))
 	(instans-close-open-streams instans)))))

src/rete/interpreter.lisp

@@ -347,7 +347,6 @@
 		     (t
 		      (error* "Illegal op ~S" op)))))))))
 
-
 (defgeneric initialize-reporting (instans reporting)
   (:method ((this instans) reporting)
     (setf (instans-report-operation-kinds this) reporting)
@@ -359,9 +358,13 @@
       (let ((store-sizes-alist (loop for (node . store) in (instans-stores this) collect (list node store (hash-table-count store)))))
 	(setf (instans-store-sizes-alist this) store-sizes-alist))
       (let ((index-sizes-alist (loop for index in (instans-indices this) collect (list index (hash-table-count (hash-token-index-table index))))))
-	(setf (instans-index-sizes-alist this) index-sizes-alist)))))
+	(setf (instans-index-sizes-alist this) index-sizes-alist))
+      ;; (inform "~A" (instans-store-sizes-alist this))
+      ;; (inform "~A" (instans-index-sizes-alist this))
+      )))
+
 
-(defgeneric report-sizes (instans)
+(defgeneric report-memory-summaries (instans)
  (:method ((this instans))
     (let ((stream (instans-default-output this)))
       (loop for item in (instans-store-sizes-alist this)
@@ -410,15 +413,40 @@
 	(format stream "queue-select-count = ~S~%" (rule-instance-queue-select-count queue))
 	(format stream "queue-modify-count = ~S~%" (rule-instance-queue-modify-count queue))))))
 
+(defgeneric report-memory-sizes-headers (instans)
+  (:method ((this instans))
+    (let ((store-names (loop for item in (instans-store-sizes-alist this) collect (node-name (first item))))
+	  (index-names (loop for item in (instans-index-sizes-alist this) collect (hash-token-index-id (first item)))))
+      (format (instans-memory-sizes-report-stream this) "~&~(~{~A~^,~}~)~%" (append store-names index-names)))))
+
+(defgeneric report-memory-sizes (instans)
+  (:method ((this instans))
+    (let* ((deltap (instans-memory-sizes-report-delta-p this))
+	   (store-sizes (loop for item in (instans-store-sizes-alist this)
+			      for count = (third item)
+			      for new-count = (hash-table-count (second item))
+			      do (setf (third item) new-count)
+			      collect (if deltap (- new-count count) new-count)))
+	   (index-sizes (loop for item in (instans-index-sizes-alist this)
+			      for count = (second item)
+			      for new-count = (hash-table-count (hash-token-index-table (first item)))
+			      do (setf (second item) new-count)
+			      collect (if deltap (- new-count count) new-count))))
+      (format (instans-memory-sizes-report-stream this) "~&~{~A~^,~}~%" (append store-sizes index-sizes)))))
+
 (defgeneric execute-rules (instans &optional policy)
   (:method ((this instans) &optional policy)
     (unless policy (setf policy (instans-queue-execution-policy this)))
     (let ((queue (instans-rule-instance-queue this)))
 ;      (inform "(instans-size-report-interval this) = ~A" (instans-size-report-interval this))
       (when (instans-memory-summaries-report-interval this)
 	(when (zerop (mod (instans-memory-summaries-report-counter this) (instans-memory-summaries-report-interval this)))
-	  (report-sizes this))
+	  (report-memory-summaries this))
 	(incf (instans-memory-summaries-report-counter this)))
+      (when (instans-memory-sizes-report-interval this)
+	(when (zerop (mod (instans-memory-sizes-report-counter this) (instans-memory-sizes-report-interval this)))
+	  (report-memory-sizes this))
+	(incf (instans-memory-sizes-report-counter this)))
       (if (operation-report-p this :execute) 
 	  (format (instans-default-output this) "~&~A: Execute rules with policy ~A~%~%" (instans-name this) policy))
       (case policy

src/rete/rete-classes.lisp

@@ -289,6 +289,8 @@
    (indices :accessor instans-indices :initform nil)
    (memory-sizes-report-interval :accessor instans-memory-sizes-report-interval :initform nil)
    (memory-sizes-report-counter :accessor instans-memory-sizes-report-counter :initform 0)
+   (memory-sizes-report-delta-p :accessor instans-memory-sizes-report-delta-p :initform nil)
+   (memory-sizes-report-stream :accessor instans-memory-sizes-report-stream :initform t)
    (memory-summaries-report-interval :accessor instans-memory-summaries-report-interval :initform nil)
    (memory-summaries-report-counter :accessor instans-memory-summaries-report-counter :initform 0)
    (store-sizes-alist :accessor instans-store-sizes-alist :initform 0)