More (table) use in Forbble2.

Clean objects when adding duplicates to a hash table.
Type-check hash functions.
Add (switch) (first-where) and (match) to lib.pbl.
Support escaping in (standalone) strings.

src/examples/forbble2.pbl

@@ -5,9 +5,9 @@
 (def dictionary (table))
 
 (def stkadd (fn (a)
-  "Add the given value to the stack"
+  "Add the given value to the stack" (
   (set stack (pre stack a))
-))
+)))
 
 (def pop (fn ()
   "Remove the top of the stack"
@@ -15,14 +15,16 @@
     (def top (at 0 stack))
     (set stack (rest stack))
     top
-  ) (prn "pop: STACK EMPTY"))
+  ) (prnl "pop: STACK EMPTY"))
 ))
 
 (def twop (fn (op)
   "Apply the given operation to the top two stack elements" (
-  (if (< (len stack) 2) ()
+  (if (< (len stack) 2) (prnl "stack too small!") (
-    (stkadd (op (pop) (pop)))
+    (def val (op (pop) (pop)))
-  ))))
+    (stkadd val)
+  ))
+)))
 
 (def swap (fn () (
   (def top (pop))
@@ -49,7 +51,6 @@
 
 (def get-code (fn (words) (
   (def next (first words))
-  (prnl (cat "next: " next))
   (if (iserr next) ()
     (if (= "$" next) ()
       (pre (get-code (rest words)) next)))
@@ -67,24 +68,36 @@
   (if bool F T)
 ))
 
+(def operations (table))
+(h-insert operations "cls" '(sys "clear"))
+(h-insert operations "swap" '(swap))
+(h-insert operations "??" '(pstack))
+(h-insert operations "+" '(twop +))
+(h-insert operations "-" '(twop -))
+(h-insert operations "/" '(twop /))
+(h-insert operations "*" '(twop *))
+(h-insert operations "." '(loud-pop))
+
+(def noterr (fn (e) (not (iserr e))))
+
 (def _fmap (fn (words) (
   ;(prnl (cat "fmap: " word))
   (def word (at 0 words))
 
   (if (iserr word) () (
+    ; Define a user function
     (if (= ":" word) (compile words) (
-      (if (= "swap" word) (swap)
+      ; Or read a user-defined function
-      (if (= "??" word) (pstack)
+      (if (noterr (h-get dictionary word)) (_fmap (h-get dictionary word)) (
-      (if (= "+" word) (twop +)
+        ; Or check the operations table
-      (if (= "-" word) (twop -)
+        (if (noterr (switch word operations)) () (
-      (if (= "/" word) (twop /)
+          ; Or evaluate
-      (if (= "*" word) (twop *)
+          (if (noterr (eval word)) (stkadd (eval word)) (
-      (if (= "." word) (loud-pop)
+            ; Or add as a string
-      (if (not (iserr (h-get dictionary word))) (_fmap (h-get dictionary word))
+            (stkadd word)
-      (if (not (iserr (eval word))) (stdadd (eval word))
+        ))))))
-      (stkadd word)
+      (_fmap (rest words))
-      ))))))))))
+    ))
-      (_fmap (rest words)))
   ))
 )))
 
@@ -93,8 +106,12 @@
   (_fmap words)
 )))
 
+(def esc (ch 27))
+(def reset (cat esc "[0m"))
+(def fprompt (cat esc "[33;1mplf:> " reset))
+
 ; Override the normal REPL prompt
-(set prompt "plf:> ")
+(set prompt fprompt)
 (set preprocess (fn (text) (
   (fmap text)
   (prn nl)

src/examples/lib.pbl

@@ -1,6 +1,30 @@
 #!/usr/bin/pl
 (def string (fn (a) (cat "" a)))
 
+(def switch (fn (val dict) (
+  (def fetched (h-get dict val))
+               ; Bubble up errors
+  (if (iserr fetched) fetched (eval fetched))
+                              ; Otherwise invoke
+)))
+
+(def first-where (fn (list condition) (
+  (def next (first list))
+  (if (iserr next) ()
+    (if (condition next) next (first-where (rest list) condition))
+  )
+)))
+
+(def match (fn (list) (
+  (def next (first list))
+  (if (iserr next) () (
+    (def condition (first next))
+    (if (eval condition)
+      (eval (second next))
+      (match (rest list)))
+  ))
+)))
+
 (def nl (ch 10))
 
 (def prnl (fn (_txt)

src/examples/pebblisp.pbl

@@ -22,6 +22,7 @@
   (reloadConfig)
 )))
 
+(def forthFile "/home/sagevaillancourt/projects/pebblisp/src/examples/forbble2.pbl")
 (struct Alias (name value))
 (def aliases (
   (Alias "ls" "ls --color")
@@ -31,6 +32,8 @@
   (Alias "tags" "ctags --exclude=node_modules -f newtags -R . && mv newtags tags")
   (Alias "r" "(reloadConfig)")
   (Alias "cd ~" (cat "cd " ~))
+  (Alias "rename" "git commit --amend --author 'Sage Vaillancourt <sagev9000@tutanota.com>'")
+  (Alias "plf" "(loadfile forthFile)")
   (Alias "sudo" "echo -e '\e[1;31m' && sudo")
 ))
 

src/hash.c

@@ -1,5 +1,7 @@
 #include "hash.h"
 #include "env.h"
+#include "pebblisp.h"
+#include "object.h"
 
 #include <string.h>
 #include <stdio.h>
@@ -128,10 +130,16 @@ size_t addStripped(struct ObjectTable* table, char* name, struct StrippedObject
     extendTable(table);
     size_t initial = hash(name, table);
     size_t h = initial % table->capacity;
-    while (table->elements[h].symbol) {
+    while (table->elements[h].symbol && strcmp(table->elements[h].symbol, name) != 0) {
         h = (h + 1) % table->capacity;
     }
-    //eprintf("adding at %ld: `%s`\n", h, name);
+
+    if (table->elements[h].symbol) {
+        Object previous = deStrip(table->elements[h].object);
+        cleanObject(&previous);
+        free(table->elements[h].symbol);
+    }
+
     table->elements[h].symbol = name;
     table->elements[h].object = object;
     table->count += 1;
@@ -152,44 +160,49 @@ size_t addToTable(struct ObjectTable* table, char* name, Object object)
 
 #ifdef STANDALONE
 
+int isHash(const Object test)
+{
+    return test.type == TYPE_HASH_TABLE;
+}
+
 Object buildHashTable(Object* params, int length, struct Environment* env)
 {
     long capacity = 16;
     if (length > 0 && params[0].type == TYPE_NUMBER) {
         capacity = params[0].number;
     }
+
     Object table = newObject(TYPE_HASH_TABLE);
     table.table = malloc(sizeof(struct ObjectTableObject));
     table.table->table = buildTable(capacity);
     table.table->refs = 1;
+
     return table;
 }
 
 Object addToHashTable(Object* params, int length, struct Environment* env)
 {
-    Object table = params[0];
+    checkTypes(addToHashTable)
+
     Object name = params[1];
     Object add = params[2];
-    //eprintf("Adding `%s`\n", table.string);
+
-    //eprintf("Adding `%s`\n", strdup(name.string));
+    struct ObjectTable* table = &params[0].table->table;
-    addToTable(&table.table->table, strdup(name.string), cloneObject(add));
+    addToTable(table, strdup(name.string), cloneObject(add));
     return numberObject(0);
 }
 
 Object getFromHashTable(Object* params, int length, struct Environment* env)
 {
-    //eprintf("getFromHashTable()\n");
+    checkTypes(getFromHashTable)
+
     struct ObjectTable* table = &params[0].table->table;
-    //eprintf("*table = %p\n", table);
+    struct StrippedObject* fetched = getFromTable(table, params[1].string);
-    //eprintf("*table->capacity = %d\n", table->capacity);
+
-    for (int i = 0; i < table->capacity; i++) {
-        //eprintf("for i = %d\n", i);
-        //eprintf("[%d] %s\n", i, table->elements[i].symbol);
-    }
-    struct StrippedObject* fetched = getFromTable(&params[0].table->table, params[1].string);
     if (fetched) {
-        return deStrip(*fetched);
+        return cloneObject(deStrip(*fetched));
     }
+
     throw(DID_NOT_FIND_SYMBOL, "Hash table does not contain %s", params[1].string);
 }
 

src/hash.h

@@ -22,21 +22,32 @@ void deleteTable(struct ObjectTable* table);
 
 #ifdef STANDALONE
 
+int isHash(const Object test);
+
 struct ObjectTableObject {
     struct ObjectTable table;
     int refs;
 };
 
 fn(buildHashTable, "table",
-   "Create a hash table object."
+   "Create a hash table object.\n",
+   "(def t (table))\n  "
+   "(h-insert t \"key\" 12345)\n  "
+   "(h-get t \"key\")", /* => */ "12345"
 );
 
-fn(addToHashTable, "h-insert",
+tfn(addToHashTable, "h-insert",
-   "Insert into a hash table object."
+    ({ expect(isHash), expect(isStringy), anyType, anyType }),
+    "Insert into a hash table object.\n"
+    "See (table)\n\n"
+    "(h-insert my-table \"destination\" value)"
 );
 
-fn(getFromHashTable, "h-get",
+tfn(getFromHashTable, "h-get",
-   "Get a value from a hash table object."
+   ({ expect(isHash), expect(isStringy), anyType }),
+   "Get a value from a hash table object.\n"
+   "See (table)\n\n"
+   "(h-get my-table \"mykey\") => myvalue"
 );
 
 #endif

src/object.c

@@ -418,7 +418,7 @@ void cleanObject(Object* target)
     switch (target->type) {
         case TYPE_STRING:
         case TYPE_SYMBOL:
-            if (!(target->string[-1] -= 1)) {
+            if ((target->string[-1] -= 1) == 0) {
                 free(target->string - 1);
             }
             break;
@@ -738,9 +738,35 @@ inline Object nullTerminated(const char* string)
 
 inline Object stringFromSlice(const char* string, int len)
 {
+#ifdef STANDALONE
+    Object o = withLen(len, TYPE_STRING);
+    int c = 0;
+    for (int i = 0; i < len; i++) {
+        if (string[i] == '\\') {
+            switch (string[i + 1]) {
+                case '"':
+                    o.string[c] = '"';
+                    break;
+                case '\\':
+                    o.string[c] = '\\';
+                    break;
+                default:
+                    o.string[c] = string[i + 1];
+                    break;
+            }
+            i++;
+        } else {
+            o.string[c] = string[i];
+        }
+        c++;
+    }
+    o.string[c] = '\0';
+    return o;
+#else
     Object o = symFromSlice(string, len);
     o.type = TYPE_STRING;
     return o;
+#endif
 }
 
 inline Object symFromSlice(const char* string, int len)

src/object.h

@@ -162,6 +162,12 @@ struct Object {
     };
 };
 
+struct TypeCheck {
+    int (* checkFunc)(Object);
+
+    const char* name;
+};
+
 struct StructDef {
     int fieldCount;
     char* name;

src/pebblisp.h

@@ -6,12 +6,6 @@
 #include "env.h"
 #include "object.h"
 
-struct TypeCheck {
-    int (* checkFunc)(Object);
-
-    const char* name;
-};
-
 #define trueObject() boolObject(1)
 
 #define falseObject() boolObject(0)

src/tokens.c

@@ -115,7 +115,7 @@ struct Slice* nf_tokenize(const char* input, struct Error* err)
                 }
             } else {
                 // Simple string
-                while (input[++i] != '"' && input[i] != '\0') {
+                while ((input[++i] != '"' || input[i - 1] == '\\') && input[i] != '\0') {
                     if (input[i] == '\n') {
                         lineNumber++;
                     }