diff --git a/src/examples/forbble.pbl b/src/examples/forbble.pbl index 0fdc160..4b3a710 100644 --- a/src/examples/forbble.pbl +++ b/src/examples/forbble.pbl @@ -4,7 +4,7 @@ (def stack ()) (def dictionary (table)) -(def stkadd (fn (a) +(def push-down (fn (a) "Add the given value to the stack" ( (set stack (pre stack a)) ))) @@ -18,6 +18,15 @@ ) (prnl "pop: STACK EMPTY")) )) +(def popN (fn (n) + "Pops n items off the stack and returns as a list." ( + (def popped (pop)) + (if (< n 2) + ( popped ) + (pre (popN (- n 1)) popped) + ) +))) + (def drop (fn () "Remove the top of the stack" (if (> (len stack) 0) ( @@ -28,38 +37,34 @@ (def twop (fn (op) "Apply the given operation to the top two stack elements" ( (if (< (len stack) 2) (prnl "stack too small!") ( - (def left (pop)) - (def right (pop)) - (def val (op right left)) - (stkadd val) + (def '(top bottom) (popN 2)) + (def val (op bottom top)) + (push-down val) )) ))) (def swap (fn () ( - (def top (pop)) - (def bottom (pop)) - (stkadd top) - (stkadd bottom) + (def '(top bottom) (popN 2)) + (push-down top) + (push-down bottom) ))) (def dup (fn () ( (def top (pop)) - (stkadd top) - (stkadd top) + (push-down top) + (push-down top) ))) (def over (fn () ( (def second (at 1 stack)) - (stkadd second) + (push-down second) ))) (def rot (fn () ( - (def a (pop)) - (def b (pop)) - (def c (pop)) - (stkadd b) - (stkadd a) - (stkadd c) + (def '(a b c) (popN 3)) + (push-down b) + (push-down a) + (push-down c) ))) (def get-words (fn (text) ( @@ -96,23 +101,30 @@ (if bool F T) )) +(def help (fn () ( + (prnl (? (at 0 stack))) +))) + (def operations (table)) -(def add-op (fn (name op) ( +(def def-op (fn (name op) ( (h-insert operations name op) ))) -(add-op "cls" '(sys "clear")) -(add-op "drop" '(drop)) -(add-op "over" '(over)) -(add-op "rot" '(rot)) -(add-op "dup" '(dup)) -(add-op "swap" '(swap)) -(add-op "??" '(pstack)) -(add-op "." '(loud-pop)) -(add-op "+" '(twop +)) -(add-op "-" '(twop -)) -(add-op "/" '(twop /)) -(add-op "*" '(twop *)) -(add-op "=" '(twop =)) +(def-op "cls" '(sys "clear")) +(def-op "drop" '(drop)) +(def-op "over" '(over)) +(def-op "rot" '(rot)) +(def-op "dup" '(dup)) +(def-op "swap" '(swap)) +(def-op "?" '(help)) +(def-op "??" '(pstack)) +(def-op "." '(loud-pop)) +(def-op "+" '(twop +)) +(def-op "-" '(twop -)) +(def-op "/" '(twop /)) +(def-op "*" '(twop *)) +(def-op "=" '(twop =)) +(def-op ">" '(twop >)) +(def-op "<" '(twop <)) (def noterr (fn (e) (not (iserr e)))) @@ -128,9 +140,9 @@ (if (noterr (switch word operations)) () ( ; Or evaluate (def evaluated-word (eval word)) - (if (noterr evaluated-word) (stkadd evaluated-word) ( + (if (noterr evaluated-word) (push-down evaluated-word) ( ; Or add as a string - (stkadd word) + (push-down word) )))))) (fmap (rest words)) )) @@ -147,6 +159,7 @@ ))) (for-each feval ( + ": sq dup * $" ": fib swap over + $" ; Peek at the top of the stack @@ -176,6 +189,7 @@ ))) (def plf-tests (fn () ( + (plf-assert "12 sq" 144) (plf-assert "100 c>f" 212) (plf-assert "10 yds >ft" 30) (plf-assert "1 1 fib fib fib fib fib fib fib" 34) @@ -193,13 +207,14 @@ (def restore-repl (fn () ( (set prompt original-prompt) (set preprocess original-preprocess) + "" ; Have the underlying REPL do nothing ))) (def plf-repl (fn () ( ; Override the normal REPL prompt (set prompt fprompt) (set preprocess (fn (text) ( - (if (= "qqq" text) ((restore-repl) "") ( + (if (= "q" text) (restore-repl) ( (feval text) (prn nl) "" ; Have the underlying REPL do nothing diff --git a/src/examples/pebblisp.pbl b/src/examples/pebblisp.pbl index d815965..46036f6 100644 --- a/src/examples/pebblisp.pbl +++ b/src/examples/pebblisp.pbl @@ -33,7 +33,7 @@ (Alias "r" "(reloadConfig)") (Alias "cd ~" (cat "cd " ~)) (Alias "rename" "git commit --amend --author 'Sage Vaillancourt '") - (Alias "plf" "(loadfile forthFile)") + (Alias "plf" "((loadfile forthFile) (plf-tests))") (Alias "sudo" "echo -e '\e[1;31m' && sudo") )) diff --git a/src/object.h b/src/object.h index 93218c3..1e0fdae 100644 --- a/src/object.h +++ b/src/object.h @@ -19,7 +19,7 @@ #define printd(...) do { } while (0) #endif -#define MAX_TOK_CNT 1024 +#define MAX_TOK_CNT 2048 #define FOR_POINTER_IN_LIST(_list) \ for(Object *_element = (_list)->list; \ diff --git a/src/pebblisp.c b/src/pebblisp.c index b590274..d2ebbcd 100644 --- a/src/pebblisp.c +++ b/src/pebblisp.c @@ -10,6 +10,31 @@ #endif +Object singleDef(Object* string, Object* value, struct Environment* env) +{ + const char* name = string->string; + + Object finalValue = eval(value, env); + + addToEnv(env, name, finalValue); + cleanObject(&finalValue); + + return cloneObject(*string); +} + +Object listDef(Object* nameList, Object* valueList, struct Environment* env) +{ + Object* value = valueList->list; + FOR_POINTER_IN_LIST(nameList) { + if (!value) { + break; + } + singleDef(POINTER, value, env); + value = value->forward; + } + return cloneObject(*nameList); +} + /** * Inserts a variable into the environment with a given name and value. * @@ -21,16 +46,17 @@ * @param env The environment to add the new definition to * @return The symbol(s) defined */ -Object def(Object* params, unused int length, unused struct Environment* env) +Object def(Object* params, unused int length, struct Environment* env) { - const char* name = params[0].string; + if (isStringy(params[0])) { + return singleDef(¶ms[0], ¶ms[1], env); + } - Object finalValue = eval(¶ms[1], env); + if (length == 2 && isListy(params[0]) && isListy(params[1])) { + return listDef(¶ms[0], ¶ms[1], env); + } - addToEnv(env, name, finalValue); - cleanObject(&finalValue); - - return cloneObject(params[0]); + throw(BAD_TYPE, "Poorly constructed (def)"); } Object set(Object* params, unused int length, unused struct Environment* env)