Commit 97c1d001 authored by root's avatar root

Fixed bad git folder

parent 1ec8b0f8

Too many changes to show.

To preserve performance only 1000 of 1000+ files are displayed.

No preview for this file type
*.dx64fsl
*.dx32fsl
*.ds_store
modules/Display_Scholar_sdsd/
modules/SolverOut1032531681
modules/Structure_Stochastic_asdsdsds/
*.lx32fsl
*.lx64fsl
*.wx32fsl
*.wx64fsl
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -43,6 +43,8 @@
;;; : the same (doesn't affect the matching itself).
;;; 2011.04.28 Dan
;;; : * Added some declares to quite compliation warnings.
;;; 2013.10.18 Dan
;;; : * Added a few more stats to conflict-tree-stats.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; General Docs:
......@@ -83,9 +85,12 @@
;;; are valid
;;; :sets - the number of different sets of productions found at in the
;;; non-empty leaf nodes
;;; :average-set - the mean size of non-empty sets
;;; :largest-set - the size of the largest set
;;;
;;; > (conflict-tree-stats )
;;; ((:DEPTH . 24) (:MIN-DEPTH . 3) (:TOTAL-NODES . 4670) (:TERMINAL . 3422) (:NON-EMPTY . 3373) (:SETS . 1073))
;;; ((:DEPTH . 24) (:MIN-DEPTH . 3) (:TOTAL-NODES . 4670) (:TERMINAL . 3422) (:NON-EMPTY . 3373) (:SETS . 1073)
;;; (:AVERAGE-SET . 4.746098) (:LARGEST-SET . 187))
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
......@@ -233,10 +238,14 @@
(defun conflict-tree-stats ()
(setf *tree-data* nil)
(mapcar #'cons '(:depth :min-depth :total-nodes :terminal :non-empty :sets)
(mapcar #'cons '(:depth :min-depth :total-nodes :terminal :non-empty :sets :average-set :largest-set)
(append (multiple-value-list (get-tree-stats (procedural-conflict-tree (get-module procedural))))
(list (length *tree-data*)) (list (length (remove nil *tree-data*)))
(list (length (remove-duplicates *tree-data* :test 'equalp))))))
(list (length (remove-duplicates *tree-data* :test 'equalp)))
(list (let ((nodes (remove nil *tree-data*)))
(unless (null nodes)
(* 1.0 (/ (reduce '+ (mapcar 'length nodes)) (length nodes))))))
(list (reduce 'max (mapcar 'length *tree-data*))))))
(defmethod get-tree-stats ((node binary-test-node))
(let ((max-depth 0)
......
This diff is collapsed.
......@@ -305,6 +305,20 @@
;;; 2011.04.28 Dan
;;; : * Added some declaims to avoid compiler warnings about
;;; : undefined functions and removed some unneeded let variables.
;;; 2013.08.05 Dan
;;; : * Clear the hashtables for the style warnings in clear-productions.
;;; 2013.08.09 Dan
;;; : * Added the command decalare-buffer-usage to avoid style
;;; : warnings when chunks are being set through code or otherwise
;;; : not in the initial model definition.
;;; 2013.08.12 Dan
;;; : * Changed declare-buffer-usage to return t/nil.
;;; 2013.10.18 Dan
;;; : * Finally fixed the typo in test-and-perfrom.
;;; 2013.11.14 Dan
;;; : * Changed declare-buffer-usage to also allow suppressing the
;;; : "modified without use" style warnings by adding the slots to
;;; : the procedural-cond-style-usage-table as well.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; General Docs:
......@@ -370,6 +384,13 @@
(if prod
(progn
(print-warning "Clearing the productions is not recommended")
(clrhash (procedural-cond-style-usage-table prod))
(clrhash (procedural-req-style-usage-table prod))
(clrhash (procedural-mod-style-usage-table prod))
(clrhash (procedural-retrieval-cond-style-usage-table prod))
(clrhash (procedural-retrieval-req-style-usage-table prod))
(dolist (p (productions-list prod))
(remove-production p prod)))
(print-warning "No procedural module was found."))))
......@@ -543,10 +564,10 @@
(unless (production-disabled production)
(when (and (conflict-tests procedural (production-constants production) production 'test-constant-condition :report nil)
(conflict-tests procedural (production-binds production) production 'test-and-perfrom-bindings :report nil)
(conflict-tests procedural (production-binds production) production 'test-and-perform-bindings :report nil)
(conflict-tests procedural (production-others production) production 'test-other-condition :report nil)
(conflict-tests procedural (production-searches production) production 'test-search-buffers :report nil)
(conflict-tests procedural (production-search-binds production) production 'test-and-perfrom-bindings :report nil)
(conflict-tests procedural (production-search-binds production) production 'test-and-perform-bindings :report nil)
(conflict-tests procedural (production-search-others production) production 'test-other-condition :report nil)
)
......@@ -600,8 +621,39 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; A command to avoid style warnings.
(defmacro declare-buffer-usage (buffer type &rest slots)
`(declare-buffer-usage-fct ',buffer ',type ',slots))
(defun declare-buffer-usage-fct (buffer type &optional slots)
(let ((procedural (get-module procedural)))
(if procedural
(cond ((not (find buffer (buffers)))
(print-warning "Cannot declare usage for ~S because it does not name a buffer in the model." buffer))
((not (chunk-type-p-fct type))
(print-warning "Cannot declare usage for buffer ~s because ~s does not name a chunk-type in the model." buffer type))
((not (or (eq slots :all)
(and (listp slots) (= (length slots) 1) (eq (car slots) :all))
(every (lambda (x)
(possible-chunk-type-slot type x))
slots)))
(print-warning "Cannot declare usage for buffer ~s because the slots (~{~s~^ ~}) are not valid for chunk-type ~s."
buffer (remove-if (lambda (x)
(possible-chunk-type-slot type x))
slots)
type))
(t
(when (or (eq slots :all)
(and (listp slots) (= (length slots) 1) (eq (car slots) :all)))
(setf slots (chunk-type-possible-slot-names-fct type)))
(push type slots)
(push slots (gethash buffer (procedural-cond-style-usage-table procedural)))
(push buffer slots)
(push slots (procedural-init-chunk-types procedural))
t))
(print-warning "No procedural module found. Cannot declare buffer usage."))))
......
......@@ -248,6 +248,9 @@
;;; : by attend-sound to set the offset and duration of the chunk
;;; : in the aural-location buffer if it's still there when the
;;; : attended sound stops.
;;; 2013.10.02 Dan
;;; : * Commented out the optimize proclaim since that persists and
;;; : may or may not be useful anyway.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#+:packaged-actr (in-package :act-r)
......@@ -260,8 +263,8 @@
;#+:allegro (eval-when (:compile-toplevel :Load-toplevel :execute)
; (setf *enable-package-locked-errors* nil))
(eval-when (:compile-toplevel :Load-toplevel :execute)
(proclaim '(optimize (speed 3) (space 0))))
;(eval-when (:compile-toplevel :Load-toplevel :execute)
; (proclaim '(optimize (speed 3) (space 0))))
(declaim (ftype (function (t) t) get-articulation-time))
......
This diff is collapsed.
......@@ -193,6 +193,17 @@
;;; : * Replaced pm-warning calls with model-warning.
;;; 2011.05.17 Dan
;;; : * Replaced queue-command calls with schedule-event-relative.
;;; 2013.10.01 Dan
;;; : * Update move-cursor so that incremental movements with a