Source File csv/csv.ils
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 (defclass VedaCsvParser ()
43 ((filename @initarg filename)
44 (line @initform 1)
45 (cell @initform nil)
46 (row @initform nil)
47 (rows @initform nil)))
48
49 50 (let ()
51 52 53 (defun Export (suffix fn)
54 (putd (concat 'VedaCsv suffix) fn))
55
56 57
58 (define asciiQuotationMark (intToChar 0x22))
59
60 (define asciiComma (intToChar 0x2c))
61
62 (define asciiLineFeed (intToChar 0xa))
63
64 (define asciiCarriageReturn (intToChar 0x0d))
65
66 (define endOfRow (list nil asciiLineFeed))
67
68 69 (defun MakeParser (filename)
70 (makeInstance 'VedaCsvParser ?filename filename))
71
72 73
74 (defun FinishCell (p)
75 (letseq ((str (buildString (reverse p->cell) ""))
76 (newrow (cons str p->row)))
77 (p->row = newrow)
78 (p->cell = nil)))
79
80 (defun FinishRow (p)
81 (let ((newrows (cons (reverse p->row) p->rows)))
82 (p->rows = newrows)
83 (p->row = nil)
84 (p->cell = nil)))
85
86 (defun Rows (p)
87 (reverse p->rows))
88
89 (defun PushToCell (p c)
90 (let ((newcell (cons c p->cell)))
91 (p->cell = newcell)))
92
93 (defun Error (p msg)
94 (let (pieces)
95 (push (sprintf nil "%L" p->line) pieces)
96 (push (or p->filename "<input>") pieces)
97 (let ((prefix (buildString pieces ":")))
98 (error "%s: %s" prefix msg))))
99
100 101
102 103 104 (defun NewRowState (p c)
105 (unless (null c)
106 (p->row = nil)
107 (p->cell = nil)
108 (CellState p c)))
109
110 111 (defun CellState (p c)
112 (cond
113 ((eq c asciiComma)
114 (FinishCell p)
115 CellState)
116 ((eq c asciiQuotationMark)
117 QuotedCellState)
118 ((memq c endOfRow)
119 (FinishCell p)
120 (FinishRow p)
121 (when c
122 NewRowState))
123 ((eq c asciiCarriageReturn)
124 125 CellState)
126 (t
127 (PushToCell p c)
128 CellState)))
129
130 131 132 (defun QuotedCellState (p c)
133 (cond
134 ((eq c asciiQuotationMark)
135 QuotedCellStateSeenQuote)
136 ((null c)
137 (Error p "Unexpected EOF within quoted CSV cell."))
138 (t
139 (PushToCell p c)
140 QuotedCellState)))
141
142 143 144 145 (defun QuotedCellStateSeenQuote (p c)
146 (cond
147 ((eq c asciiQuotationMark)
148 (PushToCell p c)
149 QuotedCellState)
150 (t
151 (CellState p c))))
152
153 154
155 156 157 158 159 160 (defun ParseCharStream (cs @optional filename)
161 (let ((p (MakeParser filename))
162 (state NewRowState))
163 (while state
164 (let ((c (funcall cs)))
165 (when (eq c asciiLineFeed)
166 (p->line = (p->line + 1)))
167 (setq state (funcall state p c))))
168 (Rows p)))
169
170 171 172 (defun MakeLinesCharStream (lines)
173 (cond
174 ((null lines)
175 (lambda () nil))
176 (t
177 (let ((index 1)
178 (end (strlen (car lines)))
179 (line (pop lines)))
180 (lambda ()
181 (cond
182 ((index > end)
183 (when lines
184 (setq line (pop lines))
185 (setq index 1)
186 (setq end (strlen line))
187 asciiLineFeed))
188 (t
189 (prog1
190 (getchar line index)
191 (setq index (index + 1))))))))))
192
193 194 195 196 197 198 199 200 201 202 203 (defun ParseLines (lines)
204 (ParseCharStream (MakeLinesCharStream lines)))
205
206 (Export 'ParseLines ParseLines)
207
208 209 210 211 212 (defun ParsePort (port)
213 (ParseCharStream (lambda () (getc port))))
214
215 (Export 'ParsePort ParsePort)
216
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 (defun ParseFile (filename)
240 (let ((port (or (infile filename)
241 (error "Unable to open %L for reading" filename))))
242 243 (prog1
244 (ParseCharStream (lambda () (getc port)) filename)
245 (close port))))
246
247 (Export 'ParseFile ParseFile))
248
249