Add list-defs back.

Use them in Forbble.
This commit is contained in:
Sage Vaillancourt 2022-04-22 13:09:15 -04:00 committed by Sage Vaillancourt
parent 8b10cb6a46
commit 1094a85227
4 changed files with 85 additions and 44 deletions

View File

@ -4,7 +4,7 @@
(def stack ()) (def stack ())
(def dictionary (table)) (def dictionary (table))
(def stkadd (fn (a) (def push-down (fn (a)
"Add the given value to the stack" ( "Add the given value to the stack" (
(set stack (pre stack a)) (set stack (pre stack a))
))) )))
@ -18,6 +18,15 @@
) (prnl "pop: STACK EMPTY")) ) (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 () (def drop (fn ()
"Remove the top of the stack" "Remove the top of the stack"
(if (> (len stack) 0) ( (if (> (len stack) 0) (
@ -28,38 +37,34 @@
(def twop (fn (op) (def twop (fn (op)
"Apply the given operation to the top two stack elements" ( "Apply the given operation to the top two stack elements" (
(if (< (len stack) 2) (prnl "stack too small!") ( (if (< (len stack) 2) (prnl "stack too small!") (
(def left (pop)) (def '(top bottom) (popN 2))
(def right (pop)) (def val (op bottom top))
(def val (op right left)) (push-down val)
(stkadd val)
)) ))
))) )))
(def swap (fn () ( (def swap (fn () (
(def top (pop)) (def '(top bottom) (popN 2))
(def bottom (pop)) (push-down top)
(stkadd top) (push-down bottom)
(stkadd bottom)
))) )))
(def dup (fn () ( (def dup (fn () (
(def top (pop)) (def top (pop))
(stkadd top) (push-down top)
(stkadd top) (push-down top)
))) )))
(def over (fn () ( (def over (fn () (
(def second (at 1 stack)) (def second (at 1 stack))
(stkadd second) (push-down second)
))) )))
(def rot (fn () ( (def rot (fn () (
(def a (pop)) (def '(a b c) (popN 3))
(def b (pop)) (push-down b)
(def c (pop)) (push-down a)
(stkadd b) (push-down c)
(stkadd a)
(stkadd c)
))) )))
(def get-words (fn (text) ( (def get-words (fn (text) (
@ -96,23 +101,30 @@
(if bool F T) (if bool F T)
)) ))
(def help (fn () (
(prnl (? (at 0 stack)))
)))
(def operations (table)) (def operations (table))
(def add-op (fn (name op) ( (def def-op (fn (name op) (
(h-insert operations name op) (h-insert operations name op)
))) )))
(add-op "cls" '(sys "clear")) (def-op "cls" '(sys "clear"))
(add-op "drop" '(drop)) (def-op "drop" '(drop))
(add-op "over" '(over)) (def-op "over" '(over))
(add-op "rot" '(rot)) (def-op "rot" '(rot))
(add-op "dup" '(dup)) (def-op "dup" '(dup))
(add-op "swap" '(swap)) (def-op "swap" '(swap))
(add-op "??" '(pstack)) (def-op "?" '(help))
(add-op "." '(loud-pop)) (def-op "??" '(pstack))
(add-op "+" '(twop +)) (def-op "." '(loud-pop))
(add-op "-" '(twop -)) (def-op "+" '(twop +))
(add-op "/" '(twop /)) (def-op "-" '(twop -))
(add-op "*" '(twop *)) (def-op "/" '(twop /))
(add-op "=" '(twop =)) (def-op "*" '(twop *))
(def-op "=" '(twop =))
(def-op ">" '(twop >))
(def-op "<" '(twop <))
(def noterr (fn (e) (not (iserr e)))) (def noterr (fn (e) (not (iserr e))))
@ -128,9 +140,9 @@
(if (noterr (switch word operations)) () ( (if (noterr (switch word operations)) () (
; Or evaluate ; Or evaluate
(def evaluated-word (eval word)) (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 ; Or add as a string
(stkadd word) (push-down word)
)))))) ))))))
(fmap (rest words)) (fmap (rest words))
)) ))
@ -147,6 +159,7 @@
))) )))
(for-each feval ( (for-each feval (
": sq dup * $"
": fib swap over + $" ": fib swap over + $"
; Peek at the top of the stack ; Peek at the top of the stack
@ -176,6 +189,7 @@
))) )))
(def plf-tests (fn () ( (def plf-tests (fn () (
(plf-assert "12 sq" 144)
(plf-assert "100 c>f" 212) (plf-assert "100 c>f" 212)
(plf-assert "10 yds >ft" 30) (plf-assert "10 yds >ft" 30)
(plf-assert "1 1 fib fib fib fib fib fib fib" 34) (plf-assert "1 1 fib fib fib fib fib fib fib" 34)
@ -193,13 +207,14 @@
(def restore-repl (fn () ( (def restore-repl (fn () (
(set prompt original-prompt) (set prompt original-prompt)
(set preprocess original-preprocess) (set preprocess original-preprocess)
"" ; Have the underlying REPL do nothing
))) )))
(def plf-repl (fn () ( (def plf-repl (fn () (
; Override the normal REPL prompt ; Override the normal REPL prompt
(set prompt fprompt) (set prompt fprompt)
(set preprocess (fn (text) ( (set preprocess (fn (text) (
(if (= "qqq" text) ((restore-repl) "") ( (if (= "q" text) (restore-repl) (
(feval text) (feval text)
(prn nl) (prn nl)
"" ; Have the underlying REPL do nothing "" ; Have the underlying REPL do nothing

View File

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

View File

@ -19,7 +19,7 @@
#define printd(...) do { } while (0) #define printd(...) do { } while (0)
#endif #endif
#define MAX_TOK_CNT 1024 #define MAX_TOK_CNT 2048
#define FOR_POINTER_IN_LIST(_list) \ #define FOR_POINTER_IN_LIST(_list) \
for(Object *_element = (_list)->list; \ for(Object *_element = (_list)->list; \

View File

@ -10,6 +10,31 @@
#endif #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. * 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 * @param env The environment to add the new definition to
* @return The symbol(s) defined * @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); throw(BAD_TYPE, "Poorly constructed (def)");
cleanObject(&finalValue);
return cloneObject(params[0]);
} }
Object set(Object* params, unused int length, unused struct Environment* env) Object set(Object* params, unused int length, unused struct Environment* env)