-
Notifications
You must be signed in to change notification settings - Fork 762
/
qif-parse.scm
482 lines (435 loc) · 19.9 KB
/
qif-parse.scm
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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; qif-parse.scm
;;; routines to parse values and dates in QIF files.
;;;
;;; Bill Gribble <grib@billgribble.com> 20 Feb 2000
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash qif-import qif-parse))
(eval-when (compile load eval expand)
(load-extension "libgnc-gnome" "scm_init_sw_gnome_module"))
(use-modules (sw_gnome))
(use-modules (gnucash core-utils))
(use-modules (gnucash utilities))
(use-modules (gnucash engine))
(use-modules (gnucash qif-import qif-guess-map))
(use-modules (gnucash string))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-13))
(use-modules (ice-9 regex))
(export qif-parse:check-date-format)
(export qif-parse:check-number-format)
(export qif-parse:check-number-formats)
(export qif-parse:parse-acct-type)
(export qif-parse:parse-action-field)
(export qif-parse:parse-bang-field)
(export qif-parse:parse-cleared-field)
(export qif-parse:parse-date/format)
(export qif-parse:parse-number/format)
(export qif-parse:parse-numbers/format)
(export qif-parse:print-date)
(export qif-parse:print-number)
(export qif-parse:print-numbers)
(export qif-split:parse-category)
(export qif-parse:fix-year)
(define regexp-enabled?
(defined? 'make-regexp))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-split:parse-category
;; this one just gets nastier and nastier.
;; ATM we return a list of 6 elements:
;; parsed category name (without [] if it was an account name)
;; bool stating if it was an account name
;; class of account or #f
;; string representing the "miscx category" if any
;; bool if miscx category is an account
;; class of miscx cat or #f
;; gosh, I love regular expressions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define qif-category-compiled-rexp
(and regexp-enabled?
(make-regexp "^ *(\\[)?([^]/|]*)(]?)(/?)([^|]*)(\\|(\\[)?([^]/]*)(]?)(/?)(.*))? *$")))
(define (qif-split:parse-category self value)
;; example category regex matches (excluding initial 'L'):
;; field1
;; field1/field2
;; field1/|field3
;; field1/|field3/field4
;; where field1 is a category or [account]
;; and field2 is a class
;; and field3 is a miscx-category or [miscx-account]
;; and field4 is a miscx-class
(cond
((regexp-exec qif-category-compiled-rexp value) =>
(lambda (rmatch)
(list (match:substring rmatch 2)
(and (match:substring rmatch 1)
(match:substring rmatch 3)
#t)
(and (match:substring rmatch 4)
(match:substring rmatch 5))
;; miscx category name
(and (match:substring rmatch 6)
(match:substring rmatch 8))
;; is it an account?
(and (match:substring rmatch 7)
(match:substring rmatch 9)
#t)
(and (match:substring rmatch 10)
(match:substring rmatch 11)))))
(else
;; Parsing failed. Bug detected!
(gnc:warn "qif-split:parse-category: can't parse [" value "].")
(throw 'bug "qif-split:parse-category""Can't parse account or category ~A."
(list value) #f))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-parse:fix-year
;; this is where we handle y2k fixes etc. input is a string
;; containing the year ("00", "2000", and "19100" all mean the same
;; thing). output is an integer representing the year in the C.E.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:fix-year year-string y2k-threshold)
(let* ((fixed-string
(cond
((char=? (string-ref year-string 0) #\')
(gnc:warn "qif-file:fix-year: weird QIF year [" year-string "].")
(substring year-string 2 (string-length year-string)))
(else year-string)))
(post-read-value (with-input-from-string fixed-string read)))
(cond
;; 2-digit numbers less than the window size are interpreted to
;; be post-2000.
((and (integer? post-read-value) (< post-read-value y2k-threshold))
(+ 2000 post-read-value))
;; there's a common bug in printing post-2000 dates that prints
;; 2000 as 19100 etc.
((and (integer? post-read-value) (> post-read-value 19000))
(+ 1900 (- post-read-value 19000)))
;; normal dates represented in unix years (i.e. year-1900, so
;; 2000 => 100.) We also want to allow full year specifications,
;; (i.e. 1999, 2001, etc) and there's a point at which you can't
;; determine which is which. this should eventually be another
;; field in the qif-file struct but not yet.
((and (integer? post-read-value) (< post-read-value 1902))
(+ 1900 post-read-value))
;; this is a normal, 4-digit year spec (1999, 2000, etc).
((integer? post-read-value) post-read-value)
;; No idea what the string represents. Maybe a new bug in Quicken!
(else
(gnc:warn "qif-file:fix-year: ay! What is this? [" year-string "].")
#f))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parse-acct-type : set the type of the account, using gnucash
;; conventions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:parse-acct-type read-value errorproc errortype)
(define string-map-alist
(list (list "bank" GNC-BANK-TYPE)
(list "port" GNC-BANK-TYPE)
(list "cash" GNC-CASH-TYPE)
(list "ccard" GNC-CCARD-TYPE)
(list "invst" GNC-BANK-TYPE)
(list "401(k)/403(b)" GNC-BANK-TYPE)
(list "oth a" GNC-ASSET-TYPE GNC-BANK-TYPE GNC-CASH-TYPE)
(list "oth l" GNC-LIABILITY-TYPE GNC-CCARD-TYPE)
(list "oth s" GNC-ASSET-TYPE GNC-BANK-TYPE GNC-CASH-TYPE)
(list "mutual" GNC-BANK-TYPE)))
(or (assoc-ref string-map-alist (string-downcase! (string-trim-both read-value)))
;; Translators: Mapping the QIF account type to a GnuCash account type.
;; see https://en.wikipedia.org/wiki/Quicken_Interchange_Format#Detail_items
(let ((msg (format #f (G_ "The account type ~s is unknown, using 'bank' instead.")
read-value)))
(errorproc errortype msg)
(list GNC-BANK-TYPE))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parse-bang-field : the bang fields switch the parse context
;; for the qif file.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:parse-bang-field read-value)
(let ((bang-field (string-downcase! (string-trim-right read-value))))
;; The QIF files output by the WWW site of Credit Lyonnais
;; begin by: !type bank
;; instead of: !Type:bank
(if (>= (string-length bang-field) 5)
(if (string=? (substring bang-field 0 5) "type ")
(string-set! bang-field 4 #\:)))
(string->symbol bang-field)))
(define (qif-parse:parse-action-field read-value errorproc errortype)
(define action-map
'((buy cvrshrt kauf)
(buyx cvrshrtx kaufx)
(cglong cglong kapgew)
(cglongx cglongx kapgewx)
(cgmid cgmid)
(cgmidx cgmidx)
(cgshort cgshort k.gewsp)
(cgshortx cgshortx k.gewspx)
(div div)
(divx divx)
;; (exercise exercise)
;; (exercisx exercisx)
;; (expire expire)
;; (grant grant)
(intinc int intinc)
(intincx intx intincx)
(margint margint)
(margintx margintx)
(miscexp miscexp)
(miscexpx miscexpx)
(miscinc miscinc cash)
(miscincx miscincx)
(reinvdiv reinvdiv)
(reinvint reinvint reinvzin)
(reinvlg reinvlg reinvkur)
(reinvmd reinvmd)
(reinvsg reinvsg reinvksp)
(reinvsh reinvsh)
(reminder reminder erinnerg)
(rtrncap rtrncap)
(rtrncapx rtrncapx)
(sell sell shtsell verkauf)
(sellx sellx shtsellx verkaufx)
(shrsin shrsin aktzu)
(shrsout shrsout aktab)
(stksplit stksplit aktsplit)
(xin xin contribx)
(xout xout withdrwx)))
(and read-value
(let ((sym (string->symbol (string-downcase (string-trim-both read-value)))))
(or (any (lambda (lst) (and (memq sym lst) (car lst))) action-map)
;; Translators: This is an error message about actions like buy, sell …
(let ((msg (format #f (G_ "Unrecognized action '~a'.") read-value)))
(errorproc errortype msg))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parse-cleared-field : In a "C" (cleared status) QIF line,
;; * or C means cleared, X or R means reconciled, and ! or ?
;; mean some budget related stuff I don't understand.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:parse-cleared-field read-value errorproc errortype)
(define maplist
'((reconciled #\X #\x #\R #\r)
(cleared #\* #\C #\c)
(budgeted #\? #\!)))
(and
(string? read-value)
(not (string-null? read-value))
(let* ((secondchar (string-ref read-value 0)))
(or (any (lambda (m) (and (memq secondchar (cdr m)) (car m))) maplist)
;; Translators: Error message about reconciliation status, see msgctxt "Reconciled flag …"
(let ((msg (format #f (G_ "The unknown reconciliation status '~a' will be replaced by 'uncleared'.")
read-value)))
(errorproc errortype msg))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parse-check-date-format
;; given a match-triple (matches in spaces 1, 2, 3) and a
;; list of possible date formats, return the list of formats
;; that this date string could actually be.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (parse-check-date-format match possible-formats)
(define (date? d m y ys)
(and (number? d) (<= 1 d 31)
(number? m) (<= 1 m 12)
(number? y) (or (not (= 4 (string-length ys)))
(> y 1930))))
(let* ((date-parts (list (match:substring match 1)
(match:substring match 2)
(match:substring match 3)))
(numeric-date-parts (map (lambda (elt) (with-input-from-string elt read))
date-parts))
(n1 (car numeric-date-parts))
(n2 (cadr numeric-date-parts))
(n3 (caddr numeric-date-parts))
(s1 (car date-parts))
(s3 (caddr date-parts))
(format-alist (list (list 'd-m-y n1 n2 n3 s3)
(list 'm-d-y n2 n1 n3 s3)
(list 'y-m-d n3 n2 n1 s1)
(list 'y-d-m n2 n3 n1 s1))))
(let lp ((possible-formats possible-formats)
(res '()))
(cond
((null? possible-formats) (reverse res))
(else
(lp (cdr possible-formats)
(let ((args (assq (car possible-formats) format-alist)))
(if (apply date? (cdr args)) (cons (car args) res) res))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-parse:check-date-format
;; given a list of possible date formats, return a pruned list
;; of possibilities.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define qif-date-compiled-rexp
(and regexp-enabled?
(make-regexp "^ *([0-9]+) *[-/.'] *([0-9]+) *[-/.'] *([0-9]+).*$|^ *([0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]).*$")))
(define qif-date-mdy-compiled-rexp
(and regexp-enabled?
(make-regexp "([0-9][0-9])([0-9][0-9])([0-9][0-9][0-9][0-9])")))
(define qif-date-ymd-compiled-rexp
(and regexp-enabled?
(make-regexp "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")))
(define (qif-parse:check-date-format date-string possible-formats)
(and (string? date-string)
(not (string-null? date-string))
(let ((rmatch (regexp-exec qif-date-compiled-rexp date-string)))
(if rmatch
(if (match:substring rmatch 1)
(parse-check-date-format rmatch possible-formats)
;; Uh oh -- this is a string XXXXXXXX; we don't know which
;; way to test.. So test both YYYYxxxx and xxxxYYYY,
;; and let the parser verify the year is valid.
(let* ((newstr (match:substring rmatch 4))
(date-ymd (regexp-exec qif-date-ymd-compiled-rexp newstr))
(date-mdy (regexp-exec qif-date-mdy-compiled-rexp newstr)))
(append
(if (or (memq 'y-d-m possible-formats)
(memq 'y-m-d possible-formats))
(parse-check-date-format date-ymd possible-formats))
(if (or (memq 'd-m-y possible-formats)
(memq 'm-d-y possible-formats))
(parse-check-date-format date-mdy possible-formats)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-parse:parse-date/format
;; given a date-string and a format, convert the string to a
;; date and return a list of day, month, year
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:parse-date/format date-string dateformat)
(define (date? d m y)
(and (number? d) (<= 1 d 31)
(number? m) (<= 1 m 12)))
(let* ((rmatch (regexp-exec qif-date-compiled-rexp date-string))
(date-parts
(if rmatch
(if (match:substring rmatch 1)
(list (match:substring rmatch 1)
(match:substring rmatch 2)
(match:substring rmatch 3))
;; This is of the form XXXXXXXX; split the string based on
;; whether the format is YYYYxxxx or xxxxYYYY
(let ((date-str (match:substring rmatch 4)))
(case dateformat
((d-m-y m-d-y)
(let ((m (regexp-exec qif-date-mdy-compiled-rexp date-str)))
(list (match:substring m 1)
(match:substring m 2)
(match:substring m 3))))
((y-m-d y-d-m)
(let ((m (regexp-exec qif-date-ymd-compiled-rexp date-str)))
(list (match:substring m 1)
(match:substring m 2)
(match:substring m 3)))))))
'()))
;; get the strings into numbers (but keep the strings around)
(numeric-date-parts (map (lambda (elt) (with-input-from-string elt read))
date-parts)))
(define (refs->list dd mm yy)
(let ((d (list-ref numeric-date-parts dd))
(m (list-ref numeric-date-parts mm))
(y (qif-parse:fix-year (list-ref date-parts yy) 50)))
(cond
((date? d m y) (list d m y))
(else (gnc:warn "qif-parse:parse-date/format: format is " dateformat
" but date is [" date-string "].") #f))))
;; if the date parts list doesn't have 3 parts, we're in trouble
(cond
((not (= 3 (length date-parts)))
(gnc:warn "qif-parse:parse-date/format: can't interpret date ["
date-string "]\nDate parts: " date-parts) #f)
((eq? dateformat 'd-m-y) (refs->list 0 1 2))
((eq? dateformat 'm-d-y) (refs->list 1 0 2))
((eq? dateformat 'y-m-d) (refs->list 2 1 0))
((eq? dateformat 'y-d-m) (refs->list 2 0 1)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; number format predicates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; eg 1000.00 or 1,500.00 or 2'000.00
(define decimal-radix-regexp
(and regexp-enabled?
(make-regexp "^ *[$]?[+-]?[$]?[0-9]+[+-]?$|^ *[$]?[+-]?[$]?[0-9]?[0-9]?[0-9]?([,'][0-9][0-9][0-9])*(\\.[0-9]*)?[+-]? *$|^ *[$]?[+-]?[$]?[0-9]+\\.[0-9]*[+-]? *$")))
;; eg 5.000,00 or 4'500,00
(define comma-radix-regexp
(and regexp-enabled?
(make-regexp "^ *[$]?[+-]?[$]?[0-9]+[+-]?$|^ *[$]?[+-]?[$]?[0-9]?[0-9]?[0-9]?([\\.'][0-9][0-9][0-9])*(,[0-9]*)?[+-]? *$|^ *[$]?[+-]?[$]?[0-9]+,[0-9]*[+-]? *$")))
;; eg 456 or 123
(define integer-regexp
(and regexp-enabled?
(make-regexp "^[$]?[+-]?[$]?[0-9]+[+-]? *$")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-parse:check-number-format
;; given a list of possible number formats, return a pruned list
;; of possibilities.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:check-number-format value-string possible-formats)
(define numtypes-alist
(list (cons 'decimal decimal-radix-regexp)
(cons 'comma comma-radix-regexp)
(cons 'integer integer-regexp)))
(filter (lambda (fmt) (regexp-exec (assq-ref numtypes-alist fmt) value-string))
possible-formats))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-parse:parse-number/format
;; assuming we know what the format is, parse the string.
;; returns a gnc-numeric; the denominator is set so as to exactly
;; represent the number
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the following is a working refactored function
(define (qif-parse:parse-number/format value-string format)
(let* ((has-minus? (string-index value-string #\-))
(filtered-string (gnc:string-delete-chars value-string "$'+-"))
(read-string (case format
((decimal) (gnc:string-delete-chars filtered-string ","))
((comma) (gnc:string-replace-char
(gnc:string-delete-chars filtered-string ".")
#\, #\.))
((integer) filtered-string)))
(num (or (string->number (string-append "#e" read-string)) 0)))
(if has-minus? (- num) num)))
;; input: list of numstrings eg "10.50" "20.54"
;; input: formats to test '(decimal comma integer)
;; output: list of formats applicable eg '(decimal)
(define (qif-parse:check-number-formats amt-strings formats)
(let lp ((amt-strings amt-strings)
(formats formats))
(if (null? amt-strings)
formats
(lp (cdr amt-strings)
(if (car amt-strings)
(qif-parse:check-number-format (car amt-strings) formats)
formats)))))
;; list of number-strings and format -> list of numbers eg '("1,00"
;; "2,50" "3,99") 'comma --> '(1 5/2 399/100) this function would
;; formerly attempt to return #f if a list element couldn't be parsed;
;; but in practice always returns a list, with unparsed numbers as 0.
(define (qif-parse:parse-numbers/format amt-strings format)
(map (lambda (amt) (if amt (qif-parse:parse-number/format amt format) 0))
amt-strings))
(define (qif-parse:print-date date-list)
(let ((tm (gnc-localtime (current-time))))
(set-tm:mday tm (car date-list))
(set-tm:mon tm (- (cadr date-list) 1))
(set-tm:year tm (- (caddr date-list) 1900))
(gnc-print-time64 (gnc-mktime tm) "%a %B %d %Y")))
(define (qif-parse:print-number num)
(with-output-to-string
(lambda ()
(write num))))
(define (qif-parse:print-numbers num)
(with-output-to-string
(lambda ()
(write num))))