From 7352d1932e15b6da85774853e6953c0b390fd75b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 18 Mar 2019 14:57:14 +0100
Subject: Working.

---
 json.c | 112 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 112 insertions(+)
 create mode 100644 json.c

(limited to 'json.c')

diff --git a/json.c b/json.c
new file mode 100644
index 0000000..9504e35
--- /dev/null
+++ b/json.c
@@ -0,0 +1,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
+}
-- 
cgit v1.2.3