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
|
;; -*-theme-d-*-
;; Copyright (C) 2008-2019, 2021 Tommi Höynälänmaa
;; Distributed under GNU Lesser General Public License version 3,
;; see file doc/LGPL-3.
;; The following procedures have been checked for result type safety
;; against Guile 3.0.7 source code:
;; integer->string, real->string, symbol->string
;; The result type safety of the following procedures has been checked:
;; string->integer, string->real
(define-body (standard-library object-string-conversion)
(import (standard-library string-utilities)
(standard-library list-utilities))
(add-method general-object->string
(lambda (((obj <object>)) <string> pure)
(string-append
"["
(match-type (class-of obj)
((cl1 <normal-class>)
(field-ref cl1 'str-name))
((:pair)
"(:pair ...)")
(else
;; We should probably raise an exception here.
"?"))
"]")))
(add-method integer->string
(unchecked-prim-proc number->string (<integer>) <string> pure))
(add-method real->string
(unchecked-prim-proc number->string (<real>) <string> pure))
(add-method symbol->string
(unchecked-prim-proc symbol->string (<symbol>) <string> pure))
(add-method null->string
(lambda (((obj <null>)) <string> pure)
"()"))
(add-method character->string
(lambda (((obj <character>)) <string> pure)
(string obj)))
(add-method string->string
(lambda (((obj <string>)) <string> pure)
obj))
(add-method boolean->string
(lambda (((b <boolean>)) <string> pure)
(if b "#t" "#f")))
(define-simple-method to-string0
(((obj <object>) (visited (:uniform-list <pair>)))
<string> pure)
(match-type obj
((o <pair>)
(let ((o1 (car o))
(o2 (cdr o)))
(if (member-objects? o visited)
"..."
(match-type o2
((<null>)
(string-append "(" (to-string0 o1 (cons o visited)) ")"))
((l2 <nonempty-list>)
(let* ((new-visited (cons o visited))
(lst
(append
(list (to-string0 o1 new-visited))
(map (lambda (((obj2 <object>)) <string> pure)
(to-string0 obj2 new-visited))
l2)))
(str (join-strings-with-sep lst " ")))
(string-append "(" str ")")))
(else
(let ((str1 (to-string0 o1 visited))
(str2 (to-string0 o2 visited)))
(string-append "(" str1 " . " str2 ")")))))))
(else (object->string obj))))
(define-simple-method pair->string
(((p <pair>)) <string> pure)
(to-string0 p null))
(include-virtual-methods object->string general-object->string)
(include-virtual-methods object->string integer->string)
(include-virtual-methods object->string real->string)
(include-virtual-methods object->string string->string)
(include-virtual-methods object->string symbol->string)
(include-virtual-methods object->string null->string)
(include-virtual-methods object->string character->string)
(include-virtual-methods object->string boolean->string)
(include-virtual-methods object->string pair->string)
(add-method string->symbol
(unchecked-prim-proc string->symbol (<string>) <symbol> pure))
(add-method string->integer
(unchecked-prim-proc theme-string->integer (<string>) <integer> pure))
(add-method string->real
(unchecked-prim-proc theme-string->real (<string>) <real> pure)))
|
