Add list-defs back.

Use them in Forbble.

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

src/examples/pebblisp.pbl

@@ -33,7 +33,7 @@
   (Alias "r" "(reloadConfig)")
   (Alias "cd ~" (cat "cd " ~))
   (Alias "rename" "git commit --amend --author 'Sage Vaillancourt <sagev9000@tutanota.com>'")
-  (Alias "plf" "(loadfile forthFile)")
+  (Alias "plf" "((loadfile forthFile) (plf-tests))")
   (Alias "sudo" "echo -e '\e[1;31m' && sudo")
 ))
 

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; \

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(&params[0], &params[1], env);
+    }
 
-    Object finalValue = eval(&params[1], env);
+    if (length == 2 && isListy(params[0]) && isListy(params[1])) {
+        return listDef(&params[0], &params[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)