<commit_before>;;;; types.lisp
;;;;
;;;; This file is part of the MONGO-CL-DRIVER library, released under Lisp-LGPL.
;;;; See file COPYING for details.
;;;;
;;;; Author: <NAME> <<EMAIL>>

(in-package #:mongo-cl-driver.bson)

(deftype ub8 () '(unsigned-byte 8))
(deftype ub8-sarray (&optional (size '*))
  `(simple-array ub8 (,size)))
(deftype ub8-vector (&optional (size '*))
  `(vector ub8 ,size))

;;; Min and Max keys

(defconstant +min-key+ '+min-key+)
(defconstant +max-key+ '+max-key+)

;;;; ObjectId

(defclass object-id ()
  ((raw :initform (make-array 12 :element-type '(unsigned-byte 8)))))

(defvar *object-id-inc* 0)

(defvar *object-id-inc-lock*
  (bordeaux-threads:make-lock "ObjectId inc lock"))

(defmethod shared-initialize :after ((id object-id) slot-names &key raw text)
  (cond
    (raw (assert (= (length raw) 12))
         (replace (slot-value id 'raw)
                  raw))
    
    (text (assert (= (length text) 12))
          (replace (slot-value id 'raw)
                   (map 'vector #'char-code text)))
    
    (t (generate-id (slot-value id 'raw)))))

(defun generate-id (raw)
  (let ((time (local-time:timestamp-to-unix (local-time:now)))
        (hostname (ironclad:digest-sequence
                   :md5
                   (babel:string-to-octets (machine-instance) :encoding :utf-8)))
        (pid #+clisp (system::process-id)
             #+(and lispworks (or unix windows)) (system::getpid)
             #+(and sbcl unix) (sb-unix:unix-getpid)
             #+(and cmu unix) (unix:unix-getpid)
             #+openmcl (ccl::getpid)
             #-(or clisp (and lispworks unix) (and sbcl unix) (and cmu unix) (and openmcl unix) openmcl)
             (error "Impossible to determine the PID"))
        (inc (bordeaux-threads:with-recursive-lock-held (*object-id-inc-lock*)
               (setf *object-id-inc*
                     (rem (1+ *object-id-inc*)
                          #xFFFFFF)))))
<commit_msg>Correct Added support lispworks on windows for getpid call<commit_after>;;;; types.lisp
;;;;
;;;; This file is part of the MONGO-CL-DRIVER library, released under Lisp-LGPL.
;;;; See file COPYING for details.
;;;;
;;;; Author: <NAME> <<EMAIL>>

(in-package #:mongo-cl-driver.bson)

(deftype ub8 () '(unsigned-byte 8))
(deftype ub8-sarray (&optional (size '*))
  `(simple-array ub8 (,size)))
(deftype ub8-vector (&optional (size '*))
  `(vector ub8 ,size))

;;; Min and Max keys

(defconstant +min-key+ '+min-key+)
(defconstant +max-key+ '+max-key+)

;;;; ObjectId

(defclass object-id ()
  ((raw :initform (make-array 12 :element-type '(unsigned-byte 8)))))

(defvar *object-id-inc* 0)

(defvar *object-id-inc-lock*
  (bordeaux-threads:make-lock "ObjectId inc lock"))

(defmethod shared-initialize :after ((id object-id) slot-names &key raw text)
  (cond
    (raw (assert (= (length raw) 12))
         (replace (slot-value id 'raw)
                  raw))
    
    (text (assert (= (length text) 12))
          (replace (slot-value id 'raw)
                   (map 'vector #'char-code text)))
    
    (t (generate-id (slot-value id 'raw)))))

(defun generate-id (raw)
  (let ((time (local-time:timestamp-to-unix (local-time:now)))
        (hostname (ironclad:digest-sequence
                   :md5
                   (babel:string-to-octets (machine-instance) :encoding :utf-8)))
        (pid #+clisp (system::process-id)
             #+(and lispworks (or unix windows)) (system::getpid)
             #+(and sbcl unix) (sb-unix:unix-getpid)
             #+(and cmu unix) (unix:unix-getpid)
             #+openmcl (ccl::getpid)
             #-(or clisp (and lispworks (or unix windows)) (and sbcl unix) (and cmu unix) (and openmcl unix) openmcl)
             (error "Impossible to determine the PID"))
        (inc (bordeaux-threads:with-recursive-lock-held (*object-id-inc-lock*)
               (setf *object-id-inc*
                     (rem (1+ *object-id-inc*)
                          #xFFFFFF)))))

{'fraction_non_alphanumeric': 0.17096611026808295, 'fraction_numerical': 0.008598887202832575, 'mean_word_length': 2.5662759242560864, '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': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7171102', 'n_tokens_mistral': 1423, 'n_tokens_neox': 1350, 'n_words': 352}