<commit_before>;;;; Copyright (c) 2011-2016 <NAME> <<EMAIL>>
;;;; This code is licensed under the MIT license.

(in-package :sys.int)

(defconstant char-code-limit #x110000)

(declaim (special *unicode-info*
                  *unicode-name-store*
                  *unicode-encoding-table*
                  *unicode-name-trie*))

(defconstant +char-control-bit+ #b0001)
(defconstant +char-meta-bit+    #b0010)
(defconstant +char-super-bit+   #b0100)
(defconstant +char-hyper-bit+   #b1000)

(defconstant +char-code+ (byte 21 6))
(defconstant +char-bits+ (byte 4 27))

(defun make-character (code &key control meta super hyper)
  (%make-character code (logior (if control +char-control-bit+ 0)
                                (if meta +char-meta-bit+ 0)
                                (if super +char-super-bit+ 0)
                                (if hyper +char-hyper-bit+ 0))))

(defun char-bits (character)
  (check-type character character)
  (ldb +char-bits+ (lisp-object-address character)))

(defun char-bit (character bit)
  (let ((bits (char-bits character)))
    (logtest bits
             (ecase bit
               (:control +char-control-bit+)
               (:meta +char-meta-bit+)
               (:super +char-super-bit+)
               (:hyper +char-hyper-bit+)))))

(defun set-char-bit (character bit set-it)
  (let ((bit (ecase bit
               (:control +char-control-bit+)
               (:meta +char-meta-bit+)
               (:super +char-super-bit+)
               (:hyper +char-hyper-bit+)))
        (bits (char-bits character)))
    (if set-it
        (setf bits (logior bits bit))
        (setf bits (logand bits (lognot bit))))
    (%make-character (char-code character) bits)))

(define-setf-expander char-bit (character bit &environment env)
  (multiple-value-bind (temps vals stores
                              store-form access-form)
      (get-setf-expansion character env)
    (let ((btemp (gensym))     ;Temp var for bit name.
          (store (gensym))     ;Temp var for bit value to store.
          (stemp (first stores))) ;Temp var for character to store.
      (when (cdr stores) (error "Can't expand this."))
      ;; Return the setf expansion for LDB as five values.
      (values (append temps (list btemp))       ;Temporary variables.
              (append temps (list bit))          ;Value forms.
              (list store)             ;Store variables.
              `(let ((,stemp (set-char-bit ,access-form ,btemp ,store)))
                 ,store-form
                 ,store)               ;Storing form.
              `(char-bit ,access-form ,btemp) ;Accessing form.
              ))))

(defun character-designator-p (object)
  (or (characterp object)
      (and (or (stringp object)
               (symbolp object))<commit_msg>Fix the CHAR-BIT setf expander<commit_after>;;;; Copyright (c) 2011-2016 <NAME> <<EMAIL>>
;;;; This code is licensed under the MIT license.

(in-package :sys.int)

(defconstant char-code-limit #x110000)

(declaim (special *unicode-info*
                  *unicode-name-store*
                  *unicode-encoding-table*
                  *unicode-name-trie*))

(defconstant +char-control-bit+ #b0001)
(defconstant +char-meta-bit+    #b0010)
(defconstant +char-super-bit+   #b0100)
(defconstant +char-hyper-bit+   #b1000)

(defconstant +char-code+ (byte 21 6))
(defconstant +char-bits+ (byte 4 27))

(defun make-character (code &key control meta super hyper)
  (%make-character code (logior (if control +char-control-bit+ 0)
                                (if meta +char-meta-bit+ 0)
                                (if super +char-super-bit+ 0)
                                (if hyper +char-hyper-bit+ 0))))

(defun char-bits (character)
  (check-type character character)
  (ldb +char-bits+ (lisp-object-address character)))

(defun char-bit (character bit)
  (let ((bits (char-bits character)))
    (logtest bits
             (ecase bit
               (:control +char-control-bit+)
               (:meta +char-meta-bit+)
               (:super +char-super-bit+)
               (:hyper +char-hyper-bit+)))))

(defun set-char-bit (character bit set-it)
  (let ((bit (ecase bit
               (:control +char-control-bit+)
               (:meta +char-meta-bit+)
               (:super +char-super-bit+)
               (:hyper +char-hyper-bit+)))
        (bits (char-bits character)))
    (if set-it
        (setf bits (logior bits bit))
        (setf bits (logand bits (lognot bit))))
    (%make-character (char-code character) bits)))

(define-setf-expander char-bit (character bit &environment env)
  (multiple-value-bind (temps vals stores
                              store-form access-form)
      (get-setf-expansion character env)
    (let ((btemp (gensym))     ;Temp var for bit name.
          (store (gensym))     ;Temp var for bit value to store.
          (stemp (first stores))) ;Temp var for character to store.
      (when (cdr stores) (error "Can't expand this."))
      ;; Return the setf expansion for LDB as five values.
      (values (append temps (list btemp))       ;Temporary variables.
              (append vals (list bit))          ;Value forms.
              (list store)             ;Store variables.
              `(let ((,stemp (set-char-bit ,access-form ,btemp ,store)))
                 ,store-form
                 ,store)               ;Storing form.
              `(char-bit ,access-form ,btemp) ;Accessing form.
              ))))

(defun character-designator-p (object)
  (or (characterp object)
      (and (or (stringp object)
               (symbolp object))
{'fraction_non_alphanumeric': 0.13530465949820789, 'fraction_numerical': 0.014336917562724014, 'mean_word_length': 1.9686170212765957, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4401786', 'n_tokens_mistral': 1777, 'n_tokens_neox': 1653, 'n_words': 487}