Add gensym

core/ids.c

@@ -460,7 +460,6 @@ const uint8_t *gst_string_end(Gst *vm, uint8_t *str) {
     check.data.string = (const uint8_t *) str;
     cached = gst_cache_add(vm, check);
     return cached.data.string;
-
 }
 
 /* Load a buffer as a string */
@@ -481,6 +480,60 @@ const uint8_t *gst_string_b(Gst *vm, const uint8_t *buf, uint32_t len) {
     }
 }
 
+static void inc_counter(uint8_t *digits, int base, int len) {
+    int i;
+    uint8_t carry = 1;
+    for (i = len - 1; i >= 0; --i) {
+        digits[i] += carry;
+        carry = 0;
+        if (digits[i] == base) {
+            digits[i] = 0;
+            carry = 1;
+        }
+    }
+}
+
+/* Generate a unique symbol */
+const uint8_t *gst_string_bu(Gst *vm, const uint8_t *buf, uint32_t len) {
+    static const char base64[] =
+        "0123456789"
+        "abcdefghijklmnopqrstuvwxyz"
+        "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+        "+-";
+    GstValue *bucket;
+    uint32_t hash;
+    uint8_t counter[6] = {63, 63, 63, 63, 63, 63};
+    /* Leave spaces for 6 base 64 digits and two dashes. That means 64^6 possible symbols, which
+     * is enough */
+    uint32_t newlen = len + 8;
+    uint32_t newbufsize = newlen + 2 * sizeof(uint32_t) + 1;
+    uint8_t *str = (uint8_t *)(gst_alloc(vm, newbufsize) + 2 * sizeof(uint32_t));
+    gst_string_length(str) = newlen;
+    gst_memcpy(str, buf, len);
+    str[len] = '-';
+    str[len + 1] = '-';
+    str[newlen] = 0;
+    uint8_t *saltbuf = str + len + 2;
+    int status = 1;
+    while (status) {
+        int i;
+        inc_counter(counter, 64, 6);
+        for (i = 0; i < 6; ++i)
+            saltbuf[i] = base64[counter[i]];
+        hash = gst_string_calchash(str, newlen);
+        bucket = gst_cache_strfind(vm, str, newlen, hash, &status);
+    }
+    gst_string_hash(str) = hash;
+    return gst_cache_add_bucket(vm, gst_wrap_string(str), bucket).data.string;
+}
+
+/* Generate a unique string from a cstring */
+const uint8_t *gst_string_cu(Gst *vm, const char *s) {
+    uint32_t len = 0;
+    while (s[len]) ++len;
+    return gst_string_bu(vm, (const uint8_t *)s, len);
+}
+
 /* Load a c string */
 const uint8_t *gst_string_c(Gst *vm, const char *str) {
     uint32_t len = 0;

core/stl.c

@@ -267,7 +267,7 @@ int gst_stl_slice(Gst *vm) {
     x = gst_arg(vm, 0);
     if (!gst_seq_view(x, &data, &length) &&
             !gst_chararray_view(x, &cdata, &length))  {
-        gst_c_throwc(vm, "expected array or tuple");
+        gst_c_throwc(vm, "expected array/tuple/buffer/symbol/string");
     }
 
     /* Get from index */
@@ -1011,6 +1011,22 @@ static int gst_stl_parse(Gst *vm) {
 /* Compilation */
 /***/
 
+/* Generate a unique symbol */
+static int gst_stl_gensym(Gst *vm) {
+    GstValue source = gst_arg(vm, 0);
+    const uint8_t *sym = NULL;
+    uint32_t len;
+    const uint8_t *data;
+    if (source.type == GST_NIL) {
+        sym = gst_string_cu(vm, "");
+    } else if (gst_chararray_view(source, &data, &len)) {
+        sym = gst_string_bu(vm, data, len);
+    } else {
+        gst_c_throwc(vm, "exepcted string/buffer/symbol/nil");
+    }
+    gst_c_return(vm, gst_wrap_symbol(sym));
+}
+
 /* Compile a value */
 static int gst_stl_compile(Gst *vm) {
     GstTable *env = vm->env;
@@ -1073,6 +1089,7 @@ static const GstModuleItem std_module[] = {
     {"parse-status", gst_stl_parser_status},
     {"parse", gst_stl_parse},
     /* Compile */
+    {"gensym", gst_stl_gensym},
     {"getenv", gst_stl_getenv},
     {"setenv", gst_stl_setenv},
     {"compile", gst_stl_compile},
@@ -1145,7 +1162,7 @@ void gst_stl_load(Gst *vm) {
         gst_module_put(vm, "std", "stdin", gst_wrap_userdata(inp));
         gst_module_put(vm, "std", "stdout", gst_wrap_userdata(outp));
         gst_module_put(vm, "std", "stderr", gst_wrap_userdata(outp));
-        // Now merge
+        /* Now merge */
         maybeEnv = gst_table_get(vm->modules, gst_string_cvs(vm, "std"));
         gst_env_merge(vm, vm->env, maybeEnv.data.table);
     }

gsttests/basic.gst

@@ -111,6 +111,18 @@
 (assert (= 110 (vargf 1 2 3 4)) "var arg tuple size 3")
 (assert (= 210 (vargf 1 2 3 4 10 10 10 10 10 10 10 10 10 10)) "var arg large tuple")
 
+# Gensym tests
+
+(assert (not= (gensym) (gensym)) "two gensyms not equal")
+(assert (not= (gensym 'abc) (gensym 'abc)) "two gensyms with arg not equal")
+((fn []
+	(def syms (table))
+	(var count 0)
+	(while (< count 128)
+		(set! syms (gensym 'beep) true)
+		(varset! count (+ 1 count)))
+	(assert (= (length syms) 128) "many symbols")))
+
 # report
 
 (print "\n" num-tests-passed " of " num-tests-run " tests passed\n")

include/gst/gst.h

@@ -453,6 +453,8 @@ const uint8_t *gst_string_c(Gst *vm, const char *cstring);
 GstValue gst_string_cv(Gst *vm, const char *string);
 GstValue gst_string_cvs(Gst *vm, const char *string);
 int gst_string_compare(const uint8_t *lhs, const uint8_t *rhs);
+const uint8_t *gst_string_bu(Gst *vm, const uint8_t *buf, uint32_t len);
+const uint8_t *gst_string_cu(Gst *vm, const char *s);
 
 /****/
 /* Struct functions */