Merge branch 'string-symbol'

contrib/20.r7rs/src/system.c

@@ -17,7 +17,7 @@ pic_system_cmdline(pic_state *pic)
   for (i = 0; i < pic->argc; ++i) {
     size_t ai = pic_gc_arena_preserve(pic);
 
-    v = pic_cons(pic, pic_obj_value(pic_make_str_cstr(pic, pic->argv[i])), v);
+    v = pic_cons(pic, pic_obj_value(pic_make_cstr(pic, pic->argv[i])), v);
     pic_gc_arena_restore(pic, ai);
   }
 
@@ -84,7 +84,7 @@ pic_system_getenv(pic_state *pic)
   if (val == NULL)
     return pic_nil_value();
   else
-    return pic_obj_value(pic_make_str_cstr(pic, val));
+    return pic_obj_value(pic_make_cstr(pic, val));
 }
 
 static pic_value
@@ -108,7 +108,7 @@ pic_system_getenvs(pic_state *pic)
       ;
 
     key = pic_make_str(pic, *envp, i);
-    val = pic_make_str_cstr(pic, getenv(pic_str_cstr(pic, key)));
+    val = pic_make_cstr(pic, getenv(pic_str_cstr(pic, key)));
 
     /* push */
     data = pic_acons(pic, pic_obj_value(key), pic_obj_value(val), data);

contrib/30.readline/src/readline.c

@@ -19,7 +19,7 @@ pic_rl_readline(pic_state *pic)
   result = readline(prompt);
 
   if(result)
-    return pic_obj_value(pic_make_str_cstr(pic, result));
+    return pic_obj_value(pic_make_cstr(pic, result));
   else
     return pic_eof_object();
 }
@@ -87,7 +87,7 @@ pic_rl_current_history(pic_state *pic)
 {
   pic_get_args(pic, "");
 
-  return pic_obj_value(pic_make_str_cstr(pic, current_history()->line));
+  return pic_obj_value(pic_make_cstr(pic, current_history()->line));
 }
 
 static pic_value
@@ -100,7 +100,7 @@ pic_rl_history_get(pic_state *pic)
   
   e = history_get(i);
 
-  return e ? pic_obj_value(pic_make_str_cstr(pic, e->line))
+  return e ? pic_obj_value(pic_make_cstr(pic, e->line))
     : pic_false_value();
 }
 
@@ -114,7 +114,7 @@ pic_rl_remove_history(pic_state *pic)
   
   e = remove_history(i);
 
-  return e ? pic_obj_value(pic_make_str_cstr(pic, e->line))
+  return e ? pic_obj_value(pic_make_cstr(pic, e->line))
     : pic_false_value();
 }
 
@@ -148,7 +148,7 @@ pic_rl_previous_history(pic_state *pic)
 
   e = previous_history();
 
-  return e ? pic_obj_value(pic_make_str_cstr(pic, e->line))
+  return e ? pic_obj_value(pic_make_cstr(pic, e->line))
     : pic_false_value();
 }
 
@@ -161,7 +161,7 @@ pic_rl_next_history(pic_state *pic)
 
   e = next_history();
 
-  return e ? pic_obj_value(pic_make_str_cstr(pic, e->line))
+  return e ? pic_obj_value(pic_make_cstr(pic, e->line))
     : pic_false_value();
 }
 
@@ -240,7 +240,7 @@ pic_rl_history_expand(pic_state *pic)
   if(status == -1 || status == 2)
     pic_errorf(pic, "%s\n", result);
 
-  return pic_obj_value(pic_make_str_cstr(pic, result));
+  return pic_obj_value(pic_make_cstr(pic, result));
 }
 
 void

contrib/30.regexp/src/regexp.c

@@ -146,7 +146,7 @@ pic_regexp_regexp_split(pic_state *pic)
     input += match.rm_eo;
   }
 
-  pic_push(pic, pic_obj_value(pic_make_str_cstr(pic, input)), output);
+  pic_push(pic, pic_obj_value(pic_make_cstr(pic, input)), output);
 
   return pic_reverse(pic, output);
 }
@@ -157,7 +157,7 @@ pic_regexp_regexp_replace(pic_state *pic)
   pic_value reg;
   const char *input;
   regmatch_t match;
-  pic_str *txt, *output = pic_make_str(pic, NULL, 0);
+  pic_str *txt, *output = pic_make_lit(pic, "");
 
   pic_get_args(pic, "ozs", &reg, &input, &txt);
 

extlib/benz/debug.c

@@ -11,18 +11,18 @@ pic_get_backtrace(pic_state *pic)
   pic_callinfo *ci;
   pic_str *trace;
 
-  trace = pic_make_str(pic, NULL, 0);
+  trace = pic_make_lit(pic, "");
 
   for (ci = pic->ci; ci != pic->cibase; --ci) {
     struct pic_proc *proc = pic_proc_ptr(ci->fp[0]);
 
-    trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, "  at "));
+    trace = pic_str_cat(pic, trace, pic_make_lit(pic, "  at "));
-    trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, "(anonymous lambda)"));
+    trace = pic_str_cat(pic, trace, pic_make_lit(pic, "(anonymous lambda)"));
 
     if (pic_proc_func_p(proc)) {
-      trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (native function)\n"));
+      trace = pic_str_cat(pic, trace, pic_make_lit(pic, " (native function)\n"));
     } else if (pic_proc_irep_p(proc)) {
-      trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (unknown location)\n")); /* TODO */
+      trace = pic_str_cat(pic, trace, pic_make_lit(pic, " (unknown location)\n")); /* TODO */
     }
   }
 

extlib/benz/error.c

@@ -21,30 +21,29 @@ void
 pic_warnf(pic_state *pic, const char *fmt, ...)
 {
   va_list ap;
-  pic_value err_line;
+  pic_str *err;
 
   va_start(ap, fmt);
-  err_line = pic_xvformat(pic, fmt, ap);
+  err = pic_vformat(pic, fmt, ap);
   va_end(ap);
 
-  xfprintf(pic, pic_stderr(pic)->file, "warn: %s\n", pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line))));
+  xfprintf(pic, pic_stderr(pic)->file, "warn: %s\n", pic_str_cstr(pic, err));
 }
 
 void
 pic_errorf(pic_state *pic, const char *fmt, ...)
 {
   va_list ap;
-  pic_value err_line, irrs;
   const char *msg;
+  pic_str *err;
 
   va_start(ap, fmt);
-  err_line = pic_xvformat(pic, fmt, ap);
+  err = pic_vformat(pic, fmt, ap);
   va_end(ap);
 
-  msg = pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line)));
+  msg = pic_str_cstr(pic, err);
-  irrs = pic_cdr(pic, err_line);
 
-  pic_error(pic, msg, irrs);
+  pic_error(pic, msg, pic_nil_value());
 }
 
 pic_value
@@ -101,7 +100,7 @@ pic_make_error(pic_state *pic, pic_sym *type, const char *msg, pic_value irrs)
 
   e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TT_ERROR);
   e->type = type;
-  e->msg = pic_make_str_cstr(pic, msg);
+  e->msg = pic_make_cstr(pic, msg);
   e->irrs = irrs;
   e->stack = stack;
 

extlib/benz/eval.c

@@ -117,7 +117,7 @@ analyzer_scope_destroy(pic_state *pic, analyze_scope *scope)
 }
 
 static bool
-search_scope(analyze_scope *scope, pic_sym *sym)
+search_scope(pic_state *pic, analyze_scope *scope, pic_sym *sym)
 {
   return kh_get(a, &scope->args, sym) != kh_end(&scope->args) || kh_get(a, &scope->locals, sym) != kh_end(&scope->locals) || scope->depth == 0;
 }
@@ -128,7 +128,7 @@ find_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
   int depth = 0, ret;
 
   while (scope) {
-    if (search_scope(scope, sym)) {
+    if (search_scope(pic, scope, sym)) {
       if (depth > 0) {
         kh_put(a, &scope->captures, sym, &ret); /* capture! */
       }
@@ -145,13 +145,15 @@ define_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
 {
   int ret;
 
-  if (search_scope(scope, sym)) {
+  if (search_scope(pic, scope, sym)) {
-    if (scope->depth > 0 || (pic_reg_has(pic, pic->globals, sym) && ! pic_invalid_p(pic_box_ptr(pic_reg_ref(pic, pic->globals, sym))->value))) {
+    if (scope->depth > 0 || pic_reg_has(pic, pic->globals, sym)) {
       pic_warnf(pic, "redefining variable: ~s", pic_obj_value(sym));
     }
     return;
   }
 
+  pic_reg_set(pic, pic->globals, sym, pic_invalid_value());
+
   kh_put(a, &scope->locals, sym, &ret);
 }
 
@@ -514,15 +516,11 @@ index_local(codegen_context *cxt, pic_sym *sym)
 static int
 index_global(pic_state *pic, codegen_context *cxt, pic_sym *name)
 {
-  extern struct pic_box *pic_vm_gref_slot(pic_state *, pic_sym *);
   int pidx;
-  struct pic_box *slot;
-
-  slot = pic_vm_gref_slot(pic, name);
 
   check_pool_size(pic, cxt);
   pidx = (int)cxt->plen++;
-  cxt->pool[pidx] = (struct pic_object *)(slot);
+  cxt->pool[pidx] = (struct pic_object *)name;
 
   return pidx;
 }

extlib/benz/gc.c

@@ -35,7 +35,6 @@ struct pic_object {
     struct pic_port port;
     struct pic_error err;
     struct pic_lib lib;
-    struct pic_box box;
     struct pic_checkpoint cp;
   } u;
 };
@@ -385,6 +384,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     break;
   }
   case PIC_TT_SYMBOL: {
+    LOOP(obj->u.sym.str);
     break;
   }
   case PIC_TT_REG: {
@@ -394,12 +394,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     pic->heap->regs = reg;
     break;
   }
-  case PIC_TT_BOX: {
-    if (pic_obj_p(obj->u.box.value)) {
-      LOOP(pic_obj_ptr(obj->u.box.value));
-    }
-    break;
-  }
   case PIC_TT_CP: {
     if (obj->u.cp.prev) {
       gc_mark_object(pic, (struct pic_object *)obj->u.cp.prev);
@@ -566,7 +560,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     break;
   }
   case PIC_TT_SYMBOL: {
-    pic_free(pic, (void *)obj->u.sym.cstr);
+    /* TODO: remove this symbol's entry from pic->syms immediately */
     break;
   }
   case PIC_TT_REG: {
@@ -588,7 +582,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_LIB:
   case PIC_TT_RECORD:
   case PIC_TT_CP:
-  case PIC_TT_BOX:
     break;
 
   case PIC_TT_NIL:

extlib/benz/include/picrin.h

@@ -45,7 +45,7 @@ typedef struct pic_state pic_state;
 #include "picrin/read.h"
 #include "picrin/gc.h"
 
-KHASH_DECLARE(s, const char *, pic_sym *)
+KHASH_DECLARE(s, pic_str *, pic_sym *)
 
 typedef struct pic_checkpoint {
   PIC_OBJECT_HEADER
@@ -251,7 +251,6 @@ pic_value pic_fdisplay(pic_state *, pic_value, xFILE *);
 #include "picrin/symbol.h"
 #include "picrin/vector.h"
 #include "picrin/reg.h"
-#include "picrin/box.h"
 
 #if defined(__cplusplus)
 }

extlib/benz/include/picrin/box.h

@@ -1,34 +0,0 @@
-/**
- * See Copyright Notice in picrin.h
- */
-
-#ifndef PICRIN_BOX_H
-#define PICRIN_BOX_H
-
-#if defined(__cplusplus)
-extern "C" {
-#endif
-
-struct pic_box {
-  PIC_OBJECT_HEADER
-  pic_value value;
-};
-
-#define pic_box_p(v) (pic_type(v) == PIC_TT_BOX)
-#define pic_box_ptr(v) ((struct pic_box *)pic_ptr(v))
-
-PIC_INLINE struct pic_box *
-pic_box(pic_state *pic, pic_value value)
-{
-  struct pic_box *box;
-
-  box = (struct pic_box *)pic_obj_alloc(pic, sizeof(struct pic_box), PIC_TT_BOX);
-  box->value = value;
-  return box;
-}
-
-#if defined(__cplusplus)
-}
-#endif
-
-#endif

extlib/benz/include/picrin/khash.h

@@ -27,6 +27,8 @@
 #ifndef AC_KHASH_H
 #define AC_KHASH_H
 
+#include <stddef.h>
+
 typedef int khint_t;
 typedef khint_t khiter_t;
 
@@ -41,23 +43,6 @@ typedef khint_t khiter_t;
 #define ac_roundup32(x)                                                 \
   (--(x), (x)|=(x)>>1, (x)|=(x)>>2, (x)|=(x)>>4, (x)|=(x)>>8, (x)|=(x)>>16, ++(x))
 
-PIC_INLINE khint_t ac_X31_hash_string(const char *s)
-{
-  khint_t h = (khint_t)*s;
-  if (h) for (++s ; *s; ++s) h = (h << 5) - h + (khint_t)*s;
-  return h;
-}
-PIC_INLINE khint_t ac_Wang_hash(khint_t key)
-{
-  key += ~(key << 15);
-  key ^=  (key >> 10);
-  key +=  (key << 3);
-  key ^=  (key >> 6);
-  key += ~(key << 11);
-  key ^=  (key >> 16);
-  return key;
-}
-
 #define ac_fsize(m) ((m) < 16? 1 : (m)>>4)
 #define ac_hash_upper(x) ((((x) * 2) * 77 / 100 + 1) / 2)
 
@@ -71,7 +56,7 @@ PIC_INLINE khint_t ac_Wang_hash(khint_t key)
   void kh_init_##name(kh_##name##_t *h);                                \
   void kh_destroy_##name(pic_state *, kh_##name##_t *h);                 \
   void kh_clear_##name(kh_##name##_t *h);                               \
-  khint_t kh_get_##name(const kh_##name##_t *h, khkey_t key);           \
+  khint_t kh_get_##name(pic_state *, const kh_##name##_t *h, khkey_t key); \
   void kh_resize_##name(pic_state *, kh_##name##_t *h, khint_t new_n_buckets); \
   khint_t kh_put_##name(pic_state *, kh_##name##_t *h, khkey_t key, int *ret); \
   void kh_del_##name(kh_##name##_t *h, khint_t x);
@@ -95,8 +80,9 @@ PIC_INLINE khint_t ac_Wang_hash(khint_t key)
       h->size = h->n_occupied = 0;                                      \
     }                                                                   \
   }                                                                     \
-  khint_t kh_get_##name(const kh_##name##_t *h, khkey_t key)            \
+  khint_t kh_get_##name(pic_state *pic, const kh_##name##_t *h, khkey_t key) \
   {                                                                     \
+    (void)pic;                                                          \
     if (h->n_buckets) {                                                 \
       khint_t k, i, last, mask, step = 0;                               \
       mask = h->n_buckets - 1;                                          \
@@ -220,9 +206,6 @@ PIC_INLINE khint_t ac_Wang_hash(khint_t key)
 #define kh_ptr_hash_equal(a, b) ((a) == (b))
 #define kh_int_hash_func(key) (int)(key)
 #define kh_int_hash_equal(a, b) ((a) == (b))
-#define kh_str_hash_func(key) ac_X31_hash_string(key)
-#define kh_str_hash_equal(a, b) (strcmp(a, b) == 0)
-#define kh_int_hash_func2(k) ac_Wang_hash((khint_t)key)
 
 /* --- END OF HASH FUNCTIONS --- */
 
@@ -232,7 +215,7 @@ PIC_INLINE khint_t ac_Wang_hash(khint_t key)
 #define kh_clear(name, h) kh_clear_##name(h)
 #define kh_resize(name, h, s) kh_resize_##name(pic, h, s)
 #define kh_put(name, h, k, r) kh_put_##name(pic, h, k, r)
-#define kh_get(name, h, k) kh_get_##name(h, k)
+#define kh_get(name, h, k) kh_get_##name(pic, h, k)
 #define kh_del(name, h, k) kh_del_##name(h, k)
 
 #define kh_exist(h, x) (!ac_iseither((h)->flags, (x)))

extlib/benz/include/picrin/reg.h

@@ -26,7 +26,6 @@ pic_value pic_reg_ref(pic_state *, struct pic_reg *, void *);
 void pic_reg_set(pic_state *, struct pic_reg *, void *, pic_value);
 void pic_reg_del(pic_state *, struct pic_reg *, void *);
 bool pic_reg_has(pic_state *, struct pic_reg *, void *);
-void *pic_reg_rev_ref(pic_state *, struct pic_reg *, pic_value);
 
 #if defined(__cplusplus)
 }

extlib/benz/include/picrin/string.h

@@ -20,23 +20,20 @@ void pic_rope_decref(pic_state *, struct pic_rope *);
 #define pic_str_p(v) (pic_type(v) == PIC_TT_STRING)
 #define pic_str_ptr(o) ((struct pic_string *)pic_ptr(o))
 
-pic_str *pic_make_str(pic_state *, const char * /* nullable */, int);
+pic_str *pic_make_str(pic_state *, const char *, int);
-pic_str *pic_make_str_cstr(pic_state *, const char *);
+#define pic_make_cstr(pic, cstr) pic_make_str(pic, (cstr), strlen(cstr))
+#define pic_make_lit(pic, lit) pic_make_str(pic, "" lit, -((int)sizeof lit - 1))
 
 char pic_str_ref(pic_state *, pic_str *, int);
 int pic_str_len(pic_str *);
 pic_str *pic_str_cat(pic_state *, pic_str *, pic_str *);
 pic_str *pic_str_sub(pic_state *, pic_str *, int, int);
 int pic_str_cmp(pic_state *, pic_str *, pic_str *);
+int pic_str_hash(pic_state *, pic_str *);
 const char *pic_str_cstr(pic_state *, pic_str *);
 
 pic_str *pic_format(pic_state *, const char *, ...);
 pic_str *pic_vformat(pic_state *, const char *, va_list);
-void pic_vfformat(pic_state *, xFILE *, const char *, va_list);
-
-pic_value pic_xformat(pic_state *, const char *, ...);
-pic_value pic_xvformat(pic_state *, const char *, va_list);
-pic_value pic_xvfformat(pic_state *, xFILE *, const char *, va_list);
 
 #if defined(__cplusplus)
 }

extlib/benz/include/picrin/symbol.h

@@ -13,7 +13,7 @@ struct pic_id {
   union {
     struct pic_symbol {
       PIC_OBJECT_HEADER
-      const char *cstr;
+      pic_str *str;
     } sym;
     struct {
       PIC_OBJECT_HEADER

extlib/benz/include/picrin/type.h

@@ -156,7 +156,6 @@ enum pic_tt {
   PIC_TT_DICT,
   PIC_TT_REG,
   PIC_TT_RECORD,
-  PIC_TT_BOX,
   PIC_TT_CXT,
   PIC_TT_CP
 };
@@ -311,8 +310,6 @@ pic_type_repr(enum pic_tt tt)
     return "dict";
   case PIC_TT_REG:
     return "reg";
-  case PIC_TT_BOX:
-    return "box";
   case PIC_TT_RECORD:
     return "record";
   case PIC_TT_CP:

extlib/benz/proc.c

@@ -175,35 +175,24 @@ pic_get_args(pic_state *pic, const char *format, ...)
   return argc;
 }
 
-struct pic_box *
-pic_vm_gref_slot(pic_state *pic, pic_sym *uid) /* TODO: make this static */
-{
-  struct pic_box *box;
-
-  if (pic_reg_has(pic, pic->globals, uid)) {
-    return pic_box_ptr(pic_reg_ref(pic, pic->globals, uid));
-  }
-  box = pic_box(pic, pic_invalid_value());
-  pic_reg_set(pic, pic->globals, uid, pic_obj_value(box));
-  return box;
-}
-
 static pic_value
-vm_gref(pic_state *pic, struct pic_box *slot, pic_sym *uid)
+vm_gref(pic_state *pic, pic_sym *uid)
 {
-  if (pic_invalid_p(slot->value)) {
+  if (! pic_reg_has(pic, pic->globals, uid)) {
-    if (uid == NULL) {
+    pic_reg_set(pic, pic->globals, uid, pic_invalid_value());
-      uid = pic_reg_rev_ref(pic, pic->globals, pic_obj_value(slot));
+
-    }
     pic_errorf(pic, "uninitialized global variable: %s", pic_symbol_name(pic, uid));
+
+    return pic_invalid_value();
   }
-  return slot->value;
+
+  return pic_reg_ref(pic, pic->globals, uid);
 }
 
 static void
-vm_gset(struct pic_box *slot, pic_value value)
+vm_gset(pic_state *pic, pic_sym *uid, pic_value value)
 {
-  slot->value = value;
+  pic_reg_set(pic, pic->globals, uid, value);
 }
 
 static void
@@ -423,11 +412,11 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
       NEXT;
     }
     CASE(OP_GREF) {
-      PUSH(vm_gref(pic, (struct pic_box *)(pic->ci->irep->pool[c.a]), NULL)); /* FIXME */
+      PUSH(vm_gref(pic, (pic_sym *)pic->ci->irep->pool[c.a]));
       NEXT;
     }
     CASE(OP_GSET) {
-      vm_gset((struct pic_box *)(pic->ci->irep->pool[c.a]), POP());
+      vm_gset(pic, (pic_sym *)pic->ci->irep->pool[c.a], POP());
       PUSH(pic_undef_value());
       NEXT;
     }
@@ -972,7 +961,7 @@ pic_ref(pic_state *pic, struct pic_lib *lib, const char *name)
     pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
   }
 
-  return vm_gref(pic, pic_vm_gref_slot(pic, uid), uid);
+  return vm_gref(pic, uid);
 }
 
 void
@@ -986,7 +975,7 @@ pic_set(pic_state *pic, struct pic_lib *lib, const char *name, pic_value val)
     pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
   }
 
-  vm_gset(pic_vm_gref_slot(pic, uid), val);
+  vm_gset(pic, uid, val);
 }
 
 static struct pic_proc *

extlib/benz/string.c

@@ -26,8 +26,6 @@ struct pic_rope {
 #define CHUNK_DECREF(c) do {                    \
     struct pic_chunk *c_ = (c);                 \
     if (! --c_->refcnt) {                       \
-      if (c_->str != c_->buf)                   \
-        pic_free(pic, c_->str);                 \
       pic_free(pic, c_);                        \
     }                                           \
   } while (0)
@@ -56,7 +54,7 @@ pic_make_chunk(pic_state *pic, const char *str, size_t len)
 {
   struct pic_chunk *c;
 
-  c = pic_malloc(pic, sizeof(struct pic_chunk) + len);
+  c = pic_malloc(pic, offsetof(struct pic_chunk, buf) + len + 1);
   c->refcnt = 1;
   c->str = c->buf;
   c->len = len;
@@ -66,6 +64,19 @@ pic_make_chunk(pic_state *pic, const char *str, size_t len)
   return c;
 }
 
+static struct pic_chunk *
+pic_make_chunk_lit(pic_state *pic, const char *str, size_t len)
+{
+  struct pic_chunk *c;
+
+  c = pic_malloc(pic, sizeof(struct pic_chunk));
+  c->refcnt = 1;
+  c->str = (char *)str;
+  c->len = len;
+
+  return c;
+}
+
 static struct pic_rope *
 pic_make_rope(pic_state *pic, struct pic_chunk *c)
 {
@@ -213,7 +224,7 @@ rope_cstr(pic_state *pic, struct pic_rope *x)
     return x->chunk->str;       /* reuse cached chunk */
   }
 
-  c = pic_malloc(pic, sizeof(struct pic_chunk) + x->weight);
+  c = pic_malloc(pic, offsetof(struct pic_chunk, buf) + x->weight + 1);
   c->refcnt = 1;
   c->len = x->weight;
   c->str = c->buf;
@@ -228,16 +239,17 @@ rope_cstr(pic_state *pic, struct pic_rope *x)
 pic_str *
 pic_make_str(pic_state *pic, const char *str, int len)
 {
-  if (str == NULL && len > 0) {
+  struct pic_chunk *c;
-    pic_errorf(pic, "zero length specified against NULL ptr");
-  }
-  return pic_make_string(pic, pic_make_rope(pic, pic_make_chunk(pic, str, len)));
-}
 
-pic_str *
+  if (len > 0) {
-pic_make_str_cstr(pic_state *pic, const char *cstr)
+    c = pic_make_chunk(pic, str, len);
-{
+  } else {
-  return pic_make_str(pic, cstr, strlen(cstr));
+    if (len == 0) {
+      str = "";
+    }
+    c = pic_make_chunk_lit(pic, str, -len);
+  }
+  return pic_make_string(pic, pic_make_rope(pic, c));
 }
 
 int
@@ -276,19 +288,31 @@ pic_str_cmp(pic_state *pic, pic_str *str1, pic_str *str2)
   return strcmp(pic_str_cstr(pic, str1), pic_str_cstr(pic, str2));
 }
 
+int
+pic_str_hash(pic_state *pic, pic_str *str)
+{
+  const char *s;
+  int h = 0;
+
+  s = pic_str_cstr(pic, str);
+  while (*s) {
+    h = (h << 5) - h + *s++;
+  }
+  return h;
+}
+
 const char *
 pic_str_cstr(pic_state *pic, pic_str *str)
 {
   return rope_cstr(pic, str->rope);
 }
 
-pic_value
+static void
-pic_xvfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
+pic_vfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
 {
   char c;
-  pic_value irrs = pic_nil_value();
 
-  while ((c = *fmt++)) {
+  while ((c = *fmt++) != '\0') {
     switch (c) {
     default:
       xfputc(pic, c, file);
@@ -336,52 +360,17 @@ pic_xvfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
         xfputc(pic, '\n', file);
         break;
       case 'a':
-        irrs = pic_cons(pic, pic_fdisplay(pic, va_arg(ap, pic_value), file), irrs);
+        pic_fdisplay(pic, va_arg(ap, pic_value), file);
         break;
       case 's':
-        irrs = pic_cons(pic, pic_fwrite(pic, va_arg(ap, pic_value), file), irrs);
+        pic_fwrite(pic, va_arg(ap, pic_value), file);
         break;
       }
       break;
     }
   }
  exit:
-
+  return;
-  return pic_reverse(pic, irrs);
-}
-
-pic_value
-pic_xvformat(pic_state *pic, const char *fmt, va_list ap)
-{
-  struct pic_port *port;
-  pic_value irrs;
-
-  port = pic_open_output_string(pic);
-
-  irrs = pic_xvfformat(pic, port->file, fmt, ap);
-  irrs = pic_cons(pic, pic_obj_value(pic_get_output_string(pic, port)), irrs);
-
-  pic_close_port(pic, port);
-  return irrs;
-}
-
-pic_value
-pic_xformat(pic_state *pic, const char *fmt, ...)
-{
-  va_list ap;
-  pic_value objs;
-
-  va_start(ap, fmt);
-  objs = pic_xvformat(pic, fmt, ap);
-  va_end(ap);
-
-  return objs;
-}
-
-void
-pic_vfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
-{
-  pic_xvfformat(pic, file, fmt, ap);
 }
 
 pic_str *
@@ -547,7 +536,7 @@ pic_str_string_append(pic_state *pic)
 
   pic_get_args(pic, "*", &argc, &argv);
 
-  str = pic_make_str(pic, NULL, 0);
+  str = pic_make_lit(pic, "");
   for (i = 0; i < argc; ++i) {
     if (! pic_str_p(argv[i])) {
       pic_errorf(pic, "type error");
@@ -651,7 +640,7 @@ pic_str_list_to_string(pic_state *pic)
   pic_get_args(pic, "o", &list);
 
   if (pic_length(pic, list) == 0) {
-    return pic_obj_value(pic_make_str(pic, NULL, 0));
+    return pic_obj_value(pic_make_lit(pic, ""));
   }
 
   buf = pic_malloc(pic, pic_length(pic, list));

extlib/benz/symbol.c

@@ -4,43 +4,39 @@
 
 #include "picrin.h"
 
-KHASH_DEFINE(s, const char *, pic_sym *, kh_str_hash_func, kh_str_hash_equal)
+#define kh_pic_str_hash(a) (pic_str_hash(pic, (a)))
+#define kh_pic_str_cmp(a, b) (pic_str_cmp(pic, (a), (b)) == 0)
+
+KHASH_DEFINE(s, pic_str *, pic_sym *, kh_pic_str_hash, kh_pic_str_cmp)
 
 pic_sym *
 pic_intern_str(pic_state *pic, pic_str *str)
-{
-  return pic_intern(pic, pic_str_cstr(pic, str));
-}
-
-pic_sym *
-pic_intern(pic_state *pic, const char *cstr)
 {
   khash_t(s) *h = &pic->syms;
   pic_sym *sym;
   khiter_t it;
   int ret;
-  char *copy;
 
-  it = kh_put(s, h, cstr, &ret);
+  it = kh_put(s, h, str, &ret);
   if (ret == 0) {               /* if exists */
     sym = kh_val(h, it);
     pic_gc_protect(pic, pic_obj_value(sym));
     return sym;
   }
 
-  copy = pic_malloc(pic, strlen(cstr) + 1);
-  strcpy(copy, cstr);
-  kh_key(h, it) = copy;
-
-  kh_val(h, it) = pic->sQUOTE; /* insert dummy */
-
   sym = (pic_sym *)pic_obj_alloc(pic, sizeof(pic_sym), PIC_TT_SYMBOL);
-  sym->cstr = copy;
+  sym->str = str;
   kh_val(h, it) = sym;
 
   return sym;
 }
 
+pic_sym *
+pic_intern(pic_state *pic, const char *cstr)
+{
+  return pic_intern_str(pic, pic_make_cstr(pic, cstr));
+}
+
 pic_id *
 pic_make_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
 {
@@ -53,9 +49,9 @@ pic_make_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
 }
 
 const char *
-pic_symbol_name(pic_state PIC_UNUSED(*pic), pic_sym *sym)
+pic_symbol_name(pic_state *pic, pic_sym *sym)
 {
-  return sym->cstr;
+  return pic_str_cstr(pic, sym->str);
 }
 
 const char *
@@ -104,7 +100,7 @@ pic_symbol_symbol_to_string(pic_state *pic)
 
   pic_get_args(pic, "m", &sym);
 
-  return pic_obj_value(pic_make_str_cstr(pic, sym->cstr));
+  return pic_obj_value(sym->str);
 }
 
 static pic_value

extlib/benz/write.c

@@ -437,7 +437,7 @@ pic_printf(pic_state *pic, const char *fmt, ...)
 
   va_start(ap, fmt);
 
-  str = pic_str_ptr(pic_car(pic, pic_xvformat(pic, fmt, ap)));
+  str = pic_vformat(pic, fmt, ap);
 
   va_end(ap);