diff --git a/src/examples/forbble2.pbl b/src/examples/forbble2.pbl index 71aad6e..0d6167f 100644 --- a/src/examples/forbble2.pbl +++ b/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) () - (stkadd (op (pop) (pop))) - )))) + (if (< (len stack) 2) (prnl "stack too small!") ( + (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) - (if (= "??" word) (pstack) - (if (= "+" word) (twop +) - (if (= "-" word) (twop -) - (if (= "/" word) (twop /) - (if (= "*" word) (twop *) - (if (= "." word) (loud-pop) - (if (not (iserr (h-get dictionary word))) (_fmap (h-get dictionary word)) - (if (not (iserr (eval word))) (stdadd (eval word)) - (stkadd word) - )))))))))) - (_fmap (rest words))) + ; Or read a user-defined function + (if (noterr (h-get dictionary word)) (_fmap (h-get dictionary word)) ( + ; Or check the operations table + (if (noterr (switch word operations)) () ( + ; Or evaluate + (if (noterr (eval word)) (stkadd (eval word)) ( + ; Or add as a string + (stkadd word) + )))))) + (_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) diff --git a/src/examples/lib.pbl b/src/examples/lib.pbl index b640885..26e7316 100644 --- a/src/examples/lib.pbl +++ b/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) diff --git a/src/examples/pebblisp.pbl b/src/examples/pebblisp.pbl index 78abc96..919b84f 100644 --- a/src/examples/pebblisp.pbl +++ b/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 '") + (Alias "plf" "(loadfile forthFile)") (Alias "sudo" "echo -e '\e[1;31m' && sudo") )) diff --git a/src/hash.c b/src/hash.c index bbfe6d3..722791d 100644 --- a/src/hash.c +++ b/src/hash.c @@ -1,5 +1,7 @@ #include "hash.h" #include "env.h" +#include "pebblisp.h" +#include "object.h" #include #include @@ -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)); - addToTable(&table.table->table, strdup(name.string), cloneObject(add)); + + struct ObjectTable* table = ¶ms[0].table->table; + 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 = ¶ms[0].table->table; - //eprintf("*table = %p\n", table); - //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(¶ms[0].table->table, params[1].string); + struct StrippedObject* fetched = getFromTable(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); } diff --git a/src/hash.h b/src/hash.h index 0f9c39d..52d81bd 100644 --- a/src/hash.h +++ b/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", - "Insert into a hash table object." +tfn(addToHashTable, "h-insert", + ({ 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", - "Get a value from a hash table object." +tfn(getFromHashTable, "h-get", + ({ 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 diff --git a/src/object.c b/src/object.c index 7e6b8f1..0ab62ab 100644 --- a/src/object.c +++ b/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) diff --git a/src/object.h b/src/object.h index 9333707..5865658 100644 --- a/src/object.h +++ b/src/object.h @@ -162,6 +162,12 @@ struct Object { }; }; +struct TypeCheck { + int (* checkFunc)(Object); + + const char* name; +}; + struct StructDef { int fieldCount; char* name; diff --git a/src/pebblisp.h b/src/pebblisp.h index 5370614..80743bf 100644 --- a/src/pebblisp.h +++ b/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) diff --git a/src/tokens.c b/src/tokens.c index 6b31f48..7a3086c 100644 --- a/src/tokens.c +++ b/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++; }