parent
8b10cb6a46
commit
1094a85227
|
@ -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
|
||||||
|
|
|
@ -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")
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
|
@ -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; \
|
||||||
|
|
|
@ -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(¶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);
|
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)
|
||||||
|
|
Loading…
Reference in New Issue