Coverage report: /development/source/library/org/datagraph/spocq-shard/src/spocq-server/reader.lisp

KindCoveredAll%
expression2359 39.0
branch00nil
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.server.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.server.implementation)
4
 
5
 
6
 (defparameter *property-readtable* (copy-readtable nil))
7
 
8
 (defclass table-class (c2mop:funcallable-standard-class)
9
   ())
10
 
11
 (eval-when (#+lispworks :compile-toplevel :load-toplevel :execute)
12
   (defmethod c2mop:validate-superclass ((subclass table-class)
13
                                         (superclass standard-class))
14
     t)
15
   (defmethod c2mop:validate-superclass ((subclass table-class)
16
                                         (superclass c2mop:funcallable-standard-class))
17
     t))
18
 
19
 (defclass table (c2mop:funcallable-standard-object)
20
   ((data :initform (make-hash-table) :reader table-data))
21
   (:metaclass table-class))
22
 
23
 (defgeneric merge-table (table data)
24
   (:method ((context table) (data table))
25
     (let ((result (make-hash-table)))
26
       (loop for key being each hash-key of context using (hash-value value)
27
             do (setf (gethash result key) value))
28
       (loop for key being each hash-key of data using (hash-value value)
29
             do (setf (gethash result key) value))
30
       result)))
31
 
32
 (defgeneric apply-table (table argument)
33
   (:method ((table table) (argument table))
34
     (merge-table table table))
35
   (:method ((table table) (argument t))
36
     (gethash argument (table-data table))))
37
 
38
 (defun table (&rest args)
39
   (declare (dynamic-extent args))
40
   (let ((table (make-hash-table :test 'equal)))
41
     (loop for (key  value) on args :by #'cddr
42
           do (setf (gethash key table) value))
43
     table))
44
 
45
 (defun read-property-table (stream char sub)
46
   (declare (ignore char sub))
47
   (let* ((*readtable* *property-readtable*)
48
          (content (read-delimited-list #\} stream)))
49
     (apply #'table content)))
50
 
51
 
52
 (defun enable-table-reader (&optional (readtable (copy-readtable *readtable*)))
53
   (set-dispatch-macro-character #\# #\{ #'read-property-table readtable)
54
   (setq *readtable* readtable))
55
 ;;; (enable-table-reader)
56
 
57
 (defun make-table-readtable (&optional (readtable (copy-readtable *readtable*)))
58
   (set-dispatch-macro-character #\# #\{ #'read-property-table readtable)
59
   (setf (readtable-case readtable) :preserve)
60
   (set-syntax-from-char #\} #\) readtable)
61
   readtable)
62
 
63
 (defmacro with-table-reader (&body body)
64
   `(let ((*readtable* *property-readtable*)) ,@body))
65
 
66
 (make-table-readtable *property-readtable*)