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
|
#include <cjson/cJSON.h>
#include <libguile.h>
#include <sys/mman.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
static SCM json_type;
static inline void assert_json (SCM item)
{ scm_assert_foreign_object_type (json_type, item); }
static inline cJSON* to_json (SCM item)
{ return scm_foreign_object_ref (item, 0); }
static inline SCM from_json (cJSON* item)
{ return scm_make_foreign_object_1 (json_type, item); }
SCM_DEFINE (parse_json, "parse-json", 1, 0, 0,
(SCM filename),
"")
{
char* fname = scm_to_utf8_stringn (filename, NULL);
int fd = open(fname, O_RDONLY);
struct stat sb;
fstat(fd, &sb);
const char* buf = mmap(NULL, sb.st_size, PROT_READ, MAP_SHARED, fd, 0);
return from_json (cJSON_Parse(buf));
}
SCM json_to_scheme (cJSON* j) {
cJSON* node;
switch (j->type) {
case cJSON_Invalid:
return scm_from_utf8_symbol("invalid");
case cJSON_False:
return SCM_BOOL_F;
case cJSON_True:
return SCM_BOOL_T;
case cJSON_NULL:
return SCM_EOL;
case cJSON_Number:
return scm_values(scm_list_2(
scm_from_int(j->valueint),
scm_from_double(j->valuedouble)));
case cJSON_String:
return scm_from_utf8_string(j->valuestring);
case cJSON_Array:
node = j->child;
SCM list = SCM_EOL;
while (node != NULL) {
list = scm_cons(json_to_scheme(node), list);
node = node->next;
}
return scm_vector(scm_reverse_x (list, SCM_EOL));
case cJSON_Object:
node = j->child;
SCM table = scm_c_eval_string ("(make-hash-table)");
while (node->next != NULL) {
scm_hashq_set_x (table,
scm_from_utf8_symbol(node->string),
json_to_scheme(node));
node = node->next;
}
return table;
case cJSON_Raw:
return scm_from_utf8_symbol("raw");
}
return scm_from_utf8_symbol("nocase");
}
SCM_DEFINE(json_to_scheme_, "json->scm", 1, 0, 0,
(SCM json),
"")
{
assert_json(json);
cJSON* j = to_json(json);
return json_to_scheme (j);
}
static void finilize_json (SCM json) {
cJSON* j = to_json(json);
cJSON_Delete (j);
}
static void init_json_type (void) {
SCM name = scm_from_utf8_symbol("json");
SCM slot = scm_list_1(scm_from_utf8_symbol("data"));
scm_t_struct_finalize finilizer = finilize_json;;
json_type = scm_make_foreign_object_type (name, slot, finilizer);
}
void init_json (void) {
init_json_type ();
#ifndef SCM_MAGIC_SNARFER
#include "json.x"
#endif
}
|
