-
Notifications
You must be signed in to change notification settings - Fork 6
/
deserialize.lisp
159 lines (132 loc) · 6.08 KB
/
deserialize.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
(in-package #:vivace-graph-v2)
;; The foundation of the serialization code comes from Sonja Keene's
;; "Object-Oriented Programming in Common Lisp." Thanks Sonja!
(defgeneric deserialize (code stream))
(defgeneric deserialize-action (code stream))
(defun deserialize-file (file)
(with-open-file (stream file :element-type '(unsigned-byte 8))
(do ((code (read-byte stream nil :eof) (read-byte stream nil :eof)))
((eql code :eof))
(format t "CODE ~A: ~A~%" code (deserialize code stream)))))
(defmethod deserialize :around (code stream)
(handler-case
(call-next-method)
(error (condition)
(error 'deserialization-error :instance stream :reason condition))))
(defun deserialize-integer (stream)
(let ((int 0) (n-bytes (read-byte stream)))
(dotimes (i n-bytes)
(setq int (dpb (read-byte stream) (byte 8 (* i 8)) int)))
int))
(defmethod deserialize ((code (eql +negative-integer+)) stream)
(- (deserialize-integer stream)))
(defmethod deserialize ((code (eql +positive-integer+)) stream)
(deserialize-integer stream))
(defmethod deserialize ((code (eql +ratio+)) stream)
(let ((numerator (deserialize (read-byte stream) stream))
(denominator (deserialize (read-byte stream) stream)))
(/ numerator denominator)))
(defmethod deserialize ((code (eql +single-float+)) stream)
(ieee-floats:decode-float32 (deserialize-integer stream)))
(defmethod deserialize ((code (eql +double-float+)) stream)
(ieee-floats:decode-float64 (deserialize-integer stream)))
(defmethod deserialize ((code (eql +character+)) stream)
(let ((char-code (deserialize-integer stream)))
(code-char char-code)))
(defmethod deserialize ((code (eql +string+)) stream)
(let* ((length (deserialize (read-byte stream) stream))
(array (make-array length :element-type '(unsigned-byte 8))))
(dotimes (i length)
(setf (aref array i) (read-byte stream)))
(babel:octets-to-string array)))
(defmethod deserialize ((code (eql +compressed-string+)) stream)
(let* ((length (deserialize (read-byte stream) stream))
(array (make-array length :element-type '(unsigned-byte 8))))
(dotimes (i length)
(setf (aref array i) (read-byte stream)))
(babel:octets-to-string (chipz:decompress nil 'chipz:zlib array))))
(defmethod deserialize ((code (eql +t+)) stream)
t)
(defmethod deserialize ((code (eql +null+)) stream)
nil)
(defmethod deserialize ((code (eql +symbol+)) stream)
(let ((code (read-byte stream)))
(when (and (/= +string+ code) (/= +compressed-string+ code))
(error 'deserialization-error :instance code :reason
"Symbol-name is not a string!"))
(let ((symbol-name (deserialize code stream)))
(setq code (read-byte stream))
(when (and (/= +string+ code) (/= +compressed-string+ code))
(error 'deserialization-error :instance code :reason
"Symbol-package is not a string!"))
(let* ((pkg-name (deserialize code stream))
(pkg (find-package pkg-name)))
(when (null pkg)
(error 'deserialization-error :instance code :reason
(format nil "Symbol-package ~A does not exist!" pkg-name)))
(intern symbol-name pkg)))))
(defun deserialize-sequence (stream type)
(let* ((length (deserialize (read-byte stream) stream))
(seq (make-sequence type length)))
(dotimes (i length)
(setf (elt seq i) (deserialize (read-byte stream) stream)))
seq))
(defmethod deserialize ((code (eql +list+)) stream)
(deserialize-sequence stream 'list))
(defmethod deserialize ((code (eql +vector+)) stream)
(deserialize-sequence stream 'vector))
(defmethod deserialize ((code (eql +uuid+)) stream)
(let ((array (make-array 16 :element-type '(unsigned-byte 8))))
(dotimes (i 16)
(let ((byte (read-byte stream)))
(cond ((= i 4) (setf (aref array 5) byte))
((= i 5) (setf (aref array 4) byte))
((= i 6) (setf (aref array 7) byte))
((= i 7) (setf (aref array 6) byte))
((= i 10) (setf (aref array 15) byte))
((= i 11) (setf (aref array 14) byte))
((= i 12) (setf (aref array 13) byte))
((= i 13) (setf (aref array 12) byte))
((= i 14) (setf (aref array 11) byte))
((= i 15) (setf (aref array 10) byte))
(t (setf (aref array i) byte)))))
(uuid:byte-array-to-uuid array)))
(defun deserialize-triple-slot (stream)
(let* ((type-byte (read-byte stream))
(value (deserialize type-byte stream)))
(if (or (eq type-byte +string+) (eq type-byte +compressed-string+))
(intern value :graph-words)
value)))
(defmethod deserialize ((code (eql +triple+)) (stream stream))
(let ((subject (deserialize-triple-slot stream))
(predicate (deserialize-triple-slot stream))
(object (deserialize-triple-slot stream))
(graph (deserialize-triple-slot stream))
(id (deserialize (read-byte stream) stream))
(deleted? (deserialize (read-byte stream) stream))
(cf (deserialize (read-byte stream) stream)))
(%add-triple subject predicate object id graph cf deleted?)))
(defmethod deserialize-action ((code (eql +transaction+)) (stream stream))
(do ((code (read-byte stream nil :eof) (read-byte stream nil :eof)))
((or (eql code :eof) (null code)))
(deserialize-action code stream)))
(defmethod deserialize-action ((code (eql +add-triple+)) stream)
(let ((subject (deserialize-triple-slot stream))
(predicate (deserialize-triple-slot stream))
(object (deserialize-triple-slot stream))
(graph (deserialize-triple-slot stream))
(id (deserialize (read-byte stream) stream))
(deleted? (deserialize (read-byte stream) stream))
(cf (deserialize (read-byte stream) stream)))
(%add-triple subject predicate object id graph cf deleted?)))
(defmethod deserialize-action ((code (eql +delete-triple+)) stream)
(let ((id (deserialize (read-byte stream) stream))
(timestamp (deserialize (read-byte stream) stream)))
(%delete-triple id timestamp)))
(defmethod deserialize-action ((code (eql +undelete-triple+)) stream)
(let ((id (deserialize (read-byte stream) stream)))
(%undelete-triple id)))
(defmethod deserialize-action ((code (eql +set-cf+)) stream)
(let ((id (deserialize (read-byte stream) stream))
(cf (deserialize (read-byte stream) stream)))
(%set-triple-cf id cf)))