<commit_before>;; property-access.lisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :sheeplette)

(defparameter *secret-unbound-value* (gensym))
(defparameter *secret-sheep-identifier* (gensym))
(define-condition unbound-property (sheeple-error) ())

(defun sheep-metasheep (sheep)
  (gethash 'metasheep sheep))

(defun (setf sheep-metasheep) (new-value sheep)
  (declare (ignore new-value sheep))
  (error "Adding or changing metasheep is not supported right now."))

(defun sheep-p (sheep)
  (when (and (hash-table-p sheep)
	     (eql (gethash *secret-sheep-identifier* sheep)
		  *secret-sheep-identifier*))
    t))

(defun std-sheep-p (sheep)
  (and (sheep-p sheep)
       (eql (sheep-metasheep sheep)
	    nil)))

;;;
;;; property access
;;;

(defun property-value (sheep property-name)
  (if (std-sheep-p sheep)
      (std-property-value sheep property-name)
      (property-value-using-metasheep (sheep-metasheep sheep) sheep property-name)))
(defun std-property-value (sheep property-name)
  (property-value-with-memoized-owner sheep property-name))

(defun property-value-with-hierarchy-list (sheep property-name)
  "Finds a property value under PROPERTY-NAME using a hierarchy list."
  (let ((list (sheep-hierarchy-list sheep)))
   (loop for sheep in list
      do (multiple-value-bind (prop-obj has-p) 
	     (%property-value-object sheep property-name)
	   (when has-p
	     (return-from property-value-with-hierarchy-list (%value prop-obj))))
      finally (error 'unbound-property))))

(defun property-value-with-memoized-owner (sheep property-name)
  ;; Find who the owner is...
  (multiple-value-bind (prop-owner has-p)
      (gethash property-name (gethash 'property-owners sheep))
    (if has-p
	;; Get the actual value from that owner..
	(multiple-value-bind (value has-p)
	    (gethash property-name (gethash 'properties prop-owner))
	  (if has-p
	      value
	      (error 'unbound-property)))
	(error 'unbound-property))))

(defun (setf property-value) (new-value sheep property-name)
  (if (std-sheep-p sheep)
      (setf (std-property-value sheep property-name) new-value)
      (setf-property-value-using-metasheep 
       new-value (sheep-metasheep sheep) sheep property-name)))
(defun (setf std-property-value) (new-value sheep property-name)
  (let ((property-table (gethash 'properties sheep)))
    (setf (gethash property-name property-table) new-value))
  (memoize-property-access sheep)
  (loop for child-pointer in (gethash 'children sheep)
     do (memoize-property-access (weak-pointer-value child-pointer)))
  new-value)

(defun get-cloneform (sheep property-name)
  (if (std-sheep-p sheep)
      (std-get-cloneform sheep property-name)
      (get-cloneform-using-metasheep (sheep-metasheep sheep) sheep property-name)))
(defun std-get-cloneform (sheep property-name)
  (loop for obj in (sheep-hierarchy-list sheep)
       do (let ((cloneform-table (gethash 'cloneforms obj)))
	    (multiple-value-bind (value has-p)
		(gethash property-name cloneform-table)
	      (when has-p
		(return-from std-get-cloneform value))))
       finally (return *secret-unbound-value*)))

(defun (setf get-cloneform) (new-value sheep property-name)
  (if (std-sheep-p sheep)
      (setf (std-get-cloneform sheep property-name) new-value)
      (setf-get-cloneform-using-metasheep
       new-value (sheep-metasheep sheep) sheep property-name)))
(defun (setf std-get-cloneform) (new-value sheep property-name)
  (setf (gethash property-name (gethash 'cloneforms sheep)) new-value))

(defun get-clonefunction (sheep property-name)
  (if (std-sheep-p sheep)
      (std-get-clonefunction sheep property-name)
      (get-clonefunction-using-metasheep (sheep-metasheep sheep) sheep property-name)))
(defun std-get-clonefunction (sheep property-name)
  (loop for obj in (sheep-hierarchy-list sheep)
       do (let ((clonefunction-table (gethash 'clonefunctions obj)))
	    (multiple-value-bind (value has-p)
		(gethash property-name clonefunction-table)
	      (when has-p
		(return-from std-get-clonefunction value))))
       finally (return *secret-unbound-value*)))

(defun (setf get-clonefunction) (new-value sheep property-name)
  (if (std-sheep-p sheep)
      (setf (std-get-clonefunction sheep property-name) new-value)
      (setf-get-clonefunction-using-metasheep
       new-value (sheep-metasheep sheep) sheep property-name)))
(defun (setf std-get-clonefunction) (new-value sheep property-name)
  (setf (gethash property-name (gethash 'clonefunctions sheep)) new-value))

(defun remove-property (sheep property-name)
  (if (std-sheep-p sheep)
      (std-remove-property sheep property-name)
      (remove-property-using-metasheep (sheep-metasheep sheep) sheep property-name)))
(defun std-remove-property (sheep property-name)
  (remhash property-name (gethash 'properties sheep))
  (memoize-property-access sheep))

(defun has-property-p (sheep property-name)
  "Returns T if a property with PROPERTY-NAME is available to SHEEP."
  (handler-case
      (when (property-value sheep property-name)
	t)
    (unbound-property () nil)))

(defun has-direct-property-p (sheep property-name)
  (if (std-sheep-p sheep)
      (std-has-direct-property-p sheep property-name)
      (has-direct-property-p-using-metasheep 
       (sheep-metasheep sheep) sheep property-name)))
(defun std-has-direct-property-p (sheep property-name)
  (multiple-value-bind (value has-p)
      (gethash property-name (gethash 'properties sheep))
    value
    has-p))

(defun who-sets (sheep property-name)
  (if (std-sheep-p sheep)
      (std-who-sets sheep property-name)
      (who-sets-using-metasheep (sheep-metasheep sheep) sheep property-name)))
(defun std-who-sets (sheep property-name)
  (multiple-value-bind (owner has-p)
      (gethash property-name (gethash 'property-owners sheep))
    (if has-p
	owner
	(error 'unbound-property))))<commit_msg>125 out of 126 pass (failure is CLOS-Fleecing) WOOT<commit_after>;; property-access.lisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :sheeplette)

(defparameter *secret-unbound-value* (gensym))
(defparameter *secret-sheep-identifier* (gensym))
(define-condition unbound-property (sheeple-error) ())

(defun sheep-metasheep (sheep)
  (gethash 'metasheep sheep))

(defun (setf sheep-metasheep) (new-value sheep)
  (declare (ignore new-value sheep))
  (error "Adding or changing metasheep is not supported right now."))

(defun sheep-p (sheep)
  (when (and (hash-table-p sheep)
	     (eql (gethash *secret-sheep-identifier* sheep)
		  *secret-sheep-identifier*))
    t))

(defun std-sheep-p (sheep)
  (and (sheep-p sheep)
       (eql (sheep-metasheep sheep)
	    nil)))

;;;
;;; property access
;;;

(defun property-value (sheep property-name)
  (if (std-sheep-p sheep)
      (std-property-value sheep property-name)
      (property-value-using-metasheep (sheep-metasheep sheep) sheep property-name)))
(defun std-property-value (sheep property-name)
  (property-value-with-memoized-owner sheep property-name))

(defun property-value-with-hierarchy-list (sheep property-name)
  "Finds a property value under PROPERTY-NAME using a hierarchy list."
  (let ((list (sheep-hierarchy-list sheep)))
   (loop for sheep in list
      do (multiple-value-bind (prop-obj has-p) 
	     (%property-value-object sheep property-name)
	   (when has-p
	     (return-from property-value-with-hierarchy-list (%value prop-obj))))
      finally (error 'unbound-property))))

(defun property-value-with-memoized-owner (sheep property-name)
  ;; Find who the owner is...
  (multiple-value-bind (prop-owner has-p)
      (gethash property-name (gethash 'property-owners sheep))
    (if has-p
	;; Get the actual value from that owner..
	(multiple-value-bind (value has-p)
	    (gethash property-name (gethash 'properties prop-owner))
	  (if has-p
	      value
	      (error 'unbound-property)))
	(error 'unbound-property))))

(defun (setf property-value) (new-value sheep property-name)
  (if (std-sheep-p sheep)
      (setf (std-property-value sheep property-name) new-value)
      (setf-property-value-using-metasheep 
       new-value (sheep-metasheep sheep) sheep property-name)))
(defun (setf std-property-value) (new-value sheep property-name)
  (let ((property-table (gethash 'properties sheep)))
    (setf (gethash property-name property-table) new-value))
  (memoize-property-access sheep)
  (loop for child-pointer in (gethash 'children sheep)
     do (memoize-property-access (weak-pointer-value child-pointer)))
  new-value)

(defun get-cloneform (sheep property-name)
  (if (std-sheep-p sheep)
      (std-get-cloneform sheep property-name)
      (get-cloneform-using-metasheep (sheep-metasheep sheep) sheep property-name)))
(defun std-get-cloneform (sheep property-name)
  (loop for obj in (sheep-hierarchy-list sheep)
       do (let ((cloneform-table (gethash 'cloneforms obj)))
	    (multiple-value-bind (value has-p)
		(gethash property-name cloneform-table)
	      (when has-p
		(return-from std-get-cloneform value))))
       finally (return *secret-unbound-value*)))

(defun (setf get-cloneform) (new-value sheep property-name)
  (if (std-sheep-p sheep)
      (setf (std-get-cloneform sheep property-name) new-value)
      (setf-get-cloneform-using-metasheep
       new-value (sheep-metasheep sheep) sheep property-name)))
(defun (setf std-get-cloneform) (new-value sheep property-name)
  (setf (gethash property-name (gethash 'cloneforms sheep)) new-value))

(defun get-clonefunction (sheep property-name)
  (if (std-sheep-p sheep)
      (std-get-clonefunction sheep property-name)
      (get-clonefunction-using-metasheep (sheep-metasheep sheep) sheep property-name)))
(defun std-get-clonefunction (sheep property-name)
  (loop for obj in (sheep-hierarchy-list sheep)
       do (let ((clonefunction-table (gethash 'clonefunctions obj)))
	    (multiple-value-bind (value has-p)
		(gethash property-name clonefunction-table)
	      (when has-p
		(return-from std-get-clonefunction value))))
       finally (return *secret-unbound-value*)))

(defun (setf get-clonefunction) (new-value sheep property-name)
  (if (std-sheep-p sheep)
      (setf (std-get-clonefunction sheep property-name) new-value)
      (setf-get-clonefunction-using-metasheep
       new-value (sheep-metasheep sheep) sheep property-name)))
(defun (setf std-get-clonefunction) (new-value sheep property-name)
  (setf (gethash property-name (gethash 'clonefunctions sheep)) new-value))

(defun remove-property (sheep property-name)
  (if (std-sheep-p sheep)
      (std-remove-property sheep property-name)
      (remove-property-using-metasheep (sheep-metasheep sheep) sheep property-name)))
(defun std-remove-property (sheep property-name)
  (when (remhash property-name (gethash 'properties sheep))
    (memoize-property-access sheep)
    t))

(defun has-property-p (sheep property-name)
  "Returns T if a property with PROPERTY-NAME is available to SHEEP."
  (handler-case
      (when (property-value sheep property-name)
	t)
    (unbound-property () nil)))

(defun has-direct-property-p (sheep property-name)
  (if (std-sheep-p sheep)
      (std-has-direct-property-p sheep property-name)
      (has-direct-property-p-using-metasheep 
       (sheep-metasheep sheep) sheep property-name)))
(defun std-has-direct-property-p (sheep property-name)
  (multiple-value-bind (value has-p)
      (gethash property-name (gethash 'properties sheep))
    value
    has-p))

(defun who-sets (sheep property-name)
  (if (std-sheep-p sheep)
      (std-who-sets sheep property-name)
      (who-sets-using-metasheep (sheep-metasheep sheep) sheep property-name)))
(defun std-who-sets (sheep property-name)
  (multiple-value-bind (owner has-p)
      (gethash property-name (gethash 'property-owners sheep))
    (if has-p
	owner
	(error 'unbound-property))))
{'fraction_non_alphanumeric': 0.1489433358592237, 'fraction_numerical': 0.0005051780752715333, 'mean_word_length': 3.8481632653061224, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4128635', 'n_tokens_mistral': 4117, 'n_tokens_neox': 4057, 'n_words': 971}