string

runtime/gyehoek.c

@@ -2,20 +2,54 @@
 #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;
@@ -24,11 +58,18 @@ SCM scm_words (scm_t_bits word_0, uint32_t n_words) {
 
 SCM scm_from_utf8_string (const char *str, size_t len) {
   SCM r = scm_words (scm_tc7_string, 3);
-  const char *s = GC_malloc (len);
   SCM_SET_CELL_WORD (r, 1, len);
-  SCM_SET_CELL_WORD (r, 2, s);
+  SCM_SET_CELL_WORD (r, 2, str);
+  printf ("str: %p\n", str);
   return r;
 }
 
-SCM scm_from_utf8_symbol (const char *s) {
+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);
 }

runtime/gyehoek.h

@@ -1,6 +1,7 @@
 #ifndef GYEHOEK_H
 #define GYEHOEK_H
 
+#include <stddef.h>
 #include <stdint.h>
 
 
@@ -38,7 +39,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
    Guile also known as a cons-cell): This is done by first checking that
    the SCM variable holds a heap object, and second, by checking that
    tc1==0 holds for the SCM_CELL_TYPE of the SCM variable.  */
-#define SCM_I_CONSP(x)  (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
+#define SCM_CONSP(x)  (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
 
 
 
@@ -49,7 +50,12 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 #define SCM_ITAG3(x) (7 & SCM_UNPACK (x))
 #define SCM_TYP3(x) (7 & SCM_CELL_TYPE (x))
 
-#define scm_tc3_cons 0
+/* #define scm_tc3_cons 0 */
+extern const long scm_tc3_cons;
+
+SCM scm_cons (SCM car, SCM cdr);
+SCM scm_car (SCM x);
+SCM scm_cdr (SCM x);
 
 
 
@@ -64,22 +70,29 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 #define SCM_SET_CELL_WORD(x, n, v)  \
   (SCM_SET_CELL_OBJECT ((x), (n), SCM_PACK (v)))
 
-#define SCM_CELL_TYPE(x) SCM_CELL_WORD (x)
+#define SCM_CELL_TYPE(x) SCM_CELL_WORD (x, 0)
 #define SCM_TYP7(x) (0x7f & SCM_CELL_TYPE (x))
 #define SCM_HAS_HEAP_TYPE(x, type, tag)         \
   (SCM_NIMP (x) && type (x) == (tag))
 #define SCM_HAS_TYP7(x, tag)    (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag))
 
-#define scm_tc7_obarray 0x55
-#define scm_tc7_symbol 0x05
-#define scm_tc7_string 0x15
+extern const long scm_tc7_obarray;
+extern const long scm_tc7_symbol;
+extern const long scm_tc7_string;
+
+
+
+#define SCM_STRINGP(x) (SCM_TYP7 (x) == scm_tc7_string)
 
 
 
 SCM scm_words (scm_t_bits word_0, uint32_t n_words);
 
-/* Construct a symbol from a UTF-8 string. */
-SCM scm_from_utf8 (const char *);
+/* Construct a Scheme string. */
+SCM scm_from_utf8_string (const char *str, size_t len);
+
+/* Intern a symbol with a UTF-8 string name. */
+SCM scm_from_utf8_symbol (const char *s, size_t len);