Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/hash-table.lisp

KindCoveredAll%
expression5357 93.0
branch12 50.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 
6
 ;;;
7
 ;;; hash tables as global registries
8
 ;;;
9
 ;;; a registry is an hash table with a weak equal key which maps between lexical expressions and their
10
 ;;; internal representation. intern-literal, for example,  uses two. one binds native values to their
11
 ;;; literal string and the other binds the native (and literal) string for non-native terms to the
12
 ;;; datatype object (string or uri)
13
 ;;;
14
 ;;; As each run-time implments a different degree of thread-safety for hash tables, each requires its own
15
 ;;; expression for specifying thread-safety and weakness.
16
 ;;;
17
 ;;; so long as the reduction is doen by a single thread, local registries - eg. in a hash join, use standard
18
 ;;; hash tables, as they do not require thread-safety.
19
 
20
 (require-features (or :digitool :sbcl :clozure :lispworks)
21
                   "This file must be conditionalized for ~a."
22
                   (lisp-implementation-type))
23
 
24
 #+clozure
25
 (defun make-registry (&key (weakness nil) (test 'eq))
26
   "Make a thread-safe registry with the given test and weakness"
27
   (if weakness
28
     (make-hash-table :test test :weak weakness :lock-free t :shared t)
29
     (make-hash-table :test test :lock-free t :shared t)))
30
 
31
 #+digitool 
32
 (defun make-registry (&key (weakness nil) (test 'eq))
33
   "Make a thread-safe registry with the given test and weakness"
34
   (if weakness
35
     (make-hash-table :test test :weak weakness)
36
     (make-hash-table :test test)))
37
 
38
 #+lispworks
39
 (defun make-registry (&key (weakness nil) (test 'eq))
40
   "Make a thread-safe registry with the given test and weakness"
41
   (if weakness
42
     (make-hash-table :test test :weak-kind weakness :single-thread nil)
43
     (make-hash-table :test test :single-thread nil)))
44
 
45
 #+sbcl
46
 (defun make-registry (&key (weakness nil) (test 'eq))
47
   "Make a thread-safe registry with the given test and weakness"
48
   (if weakness
49
     (make-hash-table :test test :weakness weakness :synchronized t)
50
     (make-hash-table :test test :synchronized t)))
51
 
52
 (defun get-registry (key registry &optional default)
53
   (gethash key registry default))
54
 
55
 (defun (setf get-registry) (value key registry)
56
   (setf (gethash key registry) value))
57
 
58
 #+(or clozure digitool)
59
 (defun map-registry (function registry)
60
   (declare (dynamic-extent function))
61
   (maphash function registry))
62
 
63
 #+lispworks
64
 (defun map-registry (function registry)
65
   (declare (dynamic-extent function))
66
   (hcl:with-hash-table-locked registry
67
     (maphash function registry)))
68
 
69
 #+sbcl
70
 (defun map-registry (function registry)
71
   (declare (dynamic-extent function))
72
   (sb-ext:with-locked-hash-table (registry)
73
     (maphash function registry)))
74
 
75
 #+sbcl
76
 (defmacro with-locked-registry ((registry) &body body)
77
   `(sb-ext:with-locked-hash-table (,registry)
78
      ,@body))
79
 
80
 (defun rem-registry (key registry)
81
   (remhash key registry))
82
 
83
 (defun registry-count (registry)
84
   (hash-table-count registry))
85
 
86
 (defun clear-registry (registry)
87
   (with-locked-registry (registry) (clrhash registry)))
88
 
89
 (defun copy-registry (table &key (single-thread #+sbcl (not (sb-ext:hash-table-synchronized-p table))
90
                                                 #+lispworks (hcl:hash-table-single-thread-p table)
91
                                                 #+digitool t))
92
   #+digitool (declare (ignore single-thread))
93
   (let ((new (apply #'make-hash-table
94
                     :size (hash-table-size table)
95
                     :test (hash-table-test table)
96
                     :rehash-size (hash-table-rehash-size table)
97
                     :rehash-threshold (hash-table-rehash-threshold table)
98
                     #+sbcl (list :synchronized (not single-thread))
99
                     #+lispworks (list :single-thread single-thread)
100
                     #+digitool nil)))
101
     (loop for key being each hash-key of table
102
           using (hash-value value)
103
           do (setf (gethash key new) value))
104
     new))
105
 
106
 ;; (defun test-copy (r count) (dotimes (i count) (copy-registry r)))