Coverage report: /home/ellis/comp/core/lib/dat/sxp.lisp

KindCoveredAll%
expression1282 14.6
branch14 25.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; lib/dat/sxp.lisp --- S-eXPressions
2
 
3
 ;; A portable S-Expression data format
4
 
5
 ;;; Code:
6
 (in-package :dat/sxp)
7
 
8
 ;;; Conditions
9
 
10
  ;;; Protocol
11
 (defgeneric sxpp (self form))
12
 
13
 ;;; Objects
14
 (defmethod write-ast ((self ast:ast) stream &key (pretty *print-pretty*) (case :downcase))
15
   (write (ast:ast self)
16
          :stream stream
17
          :pretty pretty
18
          :case case))
19
 
20
 (defmethod read-ast ((self ast:ast) stream &key)
21
   (setf (ast:ast self) (slurp-stream-forms stream :count nil)))
22
 
23
 (defmethod read-ast ((self null) stream &key)
24
   (slurp-stream-forms stream :count nil))
25
 
26
 ;; (defsetf unwrap ) (defsetf wrap )
27
 
28
 ;;; Functions
29
 (defun read-sxp-file (file)
30
   (make-instance 'ast:ast :ast (read-file-forms file)))
31
 
32
 (defun write-sxp-file (sxp file &optional &key if-exists)
33
   (with-output-file (out file) :if-exists if-exists
34
     (write-ast sxp out)))
35
 
36
 (defun read-sxp-string (self str) (with-input-from-string (s str) (read-ast self s)))
37
 
38
 (defun write-sxp-string (sxp) 
39
   (let ((ast (ast:ast sxp)))
40
     (declare (list ast))
41
     (if (> (length ast) 1)
42
         (write-to-string ast)
43
         (write-to-string (car ast)))))
44
 
45
 (defun make-sxp (&rest form) (make-instance 'ast:ast :ast form))
46
 
47
 (deftype sxp-fmt-designator () '(member :canonical :collapsed :pretty))
48
 
49
 (defun file-read-forms (file)
50
   (declare (sb-kernel:pathname-designator file))
51
   (awhen (the list (read-file-forms file))
52
     (if (> (length it) 1)
53
         it
54
         (car it))))
55
 
56
 ;;; DAT proto
57
 (defmethod serialize (self (format (eql :sxp)) &key stream)
58
   (typecase self
59
       (ast (write-ast self stream))
60
       (t (write self :stream stream))))
61
 
62
 (defmethod deserialize ((from string) (format (eql :sxp)) &key)
63
   (with-input-from-string (s from)
64
     (read-ast nil s)))
65
 
66
 (defmethod deserialize ((from stream) (format (eql :sxp)) &key)
67
   (read-ast nil from))
68
 
69
 (defmethod deserialize ((from pathname) (format (eql :sxp)) &key)
70
   (read-sxp-file from))