76 lines
1.7 KiB
C
76 lines
1.7 KiB
C
#include <stdio.h>
|
|
#include <gc.h>
|
|
#include "gyehoek.h"
|
|
|
|
|
|
|
|
const long scm_tc3_cons = 0;
|
|
|
|
const long scm_tc7_obarray = 0x55;
|
|
const long scm_tc7_symbol = 0x05;
|
|
const long scm_tc7_string = 0x15;
|
|
|
|
|
|
|
|
SCM scm_newline () {
|
|
putc ('\n', stdout);
|
|
return SCM_PACK(NULL);
|
|
}
|
|
|
|
static void scm_write_string (SCM x) {
|
|
const size_t len = SCM_CELL_WORD (x, 1);
|
|
const char *s = (const char *) SCM_UNPACK_POINTER (SCM_CELL_OBJECT (x, 2));
|
|
/* FIXME: this is a very naïve implementation with no escaping. */
|
|
printf ("some unrelated unicode lol: %s\n", "왜 하냐??");
|
|
printf ("\"%.*s\"", (int) len, s);
|
|
}
|
|
|
|
SCM scm_write (SCM x) {
|
|
if (SCM_IMP (x)) {
|
|
printf ("%ld", SCM_UNPACK (x) >> 2);
|
|
} else if (SCM_CONSP (x)) {
|
|
printf ("(");
|
|
scm_write (scm_car (x));
|
|
printf (" . ");
|
|
scm_write (scm_cdr (x));
|
|
printf (")");
|
|
} else if (SCM_STRINGP (x)) {
|
|
scm_write_string (x);
|
|
} else {
|
|
printf ("#<heap object 0x%016lx>", SCM_UNPACK (x));
|
|
}
|
|
return SCM_PACK(NULL);
|
|
}
|
|
|
|
SCM scm_car (SCM x) {
|
|
return SCM_CELL_OBJECT (x, 0);
|
|
}
|
|
|
|
SCM scm_cdr (SCM x) {
|
|
return SCM_CELL_OBJECT (x, 1);
|
|
}
|
|
|
|
SCM scm_words (scm_t_bits word_0, uint32_t n_words) {
|
|
scm_t_bits *r = GC_malloc (n_words * sizeof (scm_t_bits));
|
|
r[0] = word_0;
|
|
return SCM_PACK (r);
|
|
}
|
|
|
|
SCM scm_from_utf8_string (const char *str, size_t len) {
|
|
SCM r = scm_words (scm_tc7_string, 3);
|
|
SCM_SET_CELL_WORD (r, 1, len);
|
|
SCM_SET_CELL_WORD (r, 2, str);
|
|
printf ("str: %p\n", str);
|
|
return r;
|
|
}
|
|
|
|
SCM scm_from_utf8_symbol (const char *s, size_t len) {
|
|
}
|
|
|
|
SCM scm_cons (SCM car, SCM cdr) {
|
|
scm_t_bits *r = GC_malloc (2 * sizeof (scm_t_bits));
|
|
r[0] = SCM_UNPACK (car);
|
|
r[1] = SCM_UNPACK (cdr);
|
|
return SCM_PACK (r);
|
|
}
|