diff --git a/src/examples/forbble.pbl b/src/examples/forbble.pbl old mode 100755 new mode 100644 index 0a0334e..ea5e228 --- a/src/examples/forbble.pbl +++ b/src/examples/forbble.pbl @@ -2,170 +2,117 @@ ; Initialize an empty stack (def stack ()) +(def dictionary (table)) -; Add the given num to the stack (def stkadd (fn (a) - (def stack (pre stack a)))) - -; Silently remove the top of the stack -(def _pop (fn (_) - (def stack (rest stack)))) - -; Remove and return the stack top -(def bop (fn (_) ( - (def _a (at 0 stack)) - (_pop 0) - _a - ))) - -; Loud, checked version of _pop -(def pop (fn (_) - (if (> (len stack 0) 0) ( - (prn (at 0 stack)) - (_pop 0)) - (prnl "pop: STACK EMPTY") - ))) - -; Takes a two-parameter operation and -; applies it to the top two stack elements -(def twop (fn (_op) ( - (if (> (len stack) 1) ( - (def (_b _a) ((bop 0) (bop 0))) - (stkadd (_op _a _b))) - (prnl "twop: STACK TOO SMALL") - )))) - -; Define important symbols/functions -; An annoying hack for right now -(def . ".") -(def : ":") -(def ^ "^") -(def $ "$") -(def swap "swap") -(def dup "dup") -(def rot "rot") -(def over "over") - -; Duplicate the top element of the stack -(def _dup (fn (_) ( - (def _top (at 0 stack)) - (if (iserr _top) (prnl "dup: STACK EMPTY") - (stkadd _top)) + "Add the given value to the stack" ( + (set stack (pre stack a)) ))) -; Swap the top two elements of the stack, if possible -(def _swap (fn (_) ( - (if (> (len stack) 1) ( - (def (_b _a) ((bop 0) (bop 0))) - (stkadd _b) - (stkadd _a)) - (prnl "swap: STACK TOO SMALL") - )))) +(def pop (fn () + "Remove the top of the stack" + (if (> (len stack) 0) ( + (def top (at 0 stack)) + (set stack (rest stack)) + top + ) (prnl "pop: STACK EMPTY")) +)) -; Rotate the third element to be above the first and second elements -(def _rot (fn (_) ( - (if (> (len stack) 2) ( - (def (_c _b _a) ((bop 0) (bop 0) (bop 0))) - (stkadd _b) - (stkadd _c) - (stkadd _a)) - (prnl "rot: STACK TOO SMALL") - )))) +(def twop (fn (op) + "Apply the given operation to the top two stack elements" ( + (if (< (len stack) 2) (prnl "stack too small!") ( + (def val (op (pop) (pop))) + (stkadd val) + )) +))) -; Rotate the third element to be above the first and second elements -(def _over (fn (_) ( - (if (> (len stack) 1) ( - (def _a (at 1 stack)) - (stkadd _a)) - (prnl "over: STACK TOO SMALL") - )))) +(def swap (fn () ( + (def top (pop)) + (def bottom (pop)) + (stkadd top) + (stkadd bottom) +))) -; Defines a given symbol using a given list of Forth inputs -(def compile (fn (func sym) ( - ; Get next symbol - (def _x (at 0 func)) - (if (iserr _x) _x - (if (= _x "$") (rest func) - (at 1 ( - (defe sym (ap (eval sym) _x)) - (compile (rest func) sym))) - ))))) +(def get-words (fn (text) ( + (split text " ") +))) -; Evaluate a list of Forth inputs -(def feval (fn (list) ( - (if (> (len list) 0) ( - (def _x (at 0 list)) - (if (isnum _x) (stkadd _x) ; Push to the stack if it's a number - (if (= "." _x) (pop 0) ; Pop if it's a dot - (if (= + _x) (twop +) ; Try basic arithmetic - (if (= - _x) (twop -) - (if (= * _x) (twop *) - (if (= / _x) (twop /) - (if (= "swap" _x) (_swap 0) - (if (= "dup" _x) (_dup 0) - (if (= "rot" _x) (_rot 0) - (if (= "over" _x) (_over 0) - (if (= "^" _x) (pch (bop 0)) - (if (= ":" _x) ( ; Compile a phrase into the next symbol - (def var (at 1 list)) ; Collect the symbol to define, as a string - (defe var (+ "_" var)) ; Add an underscore for the internal storage - (defe (+ "_" var) ()) ; Define _func internally as an empty list - (def list (compile ; Overwrite list with output of (compile) - (rest (rest list)) ; Current list, not including ':' or the symbol - (+ "_" var)))) ; The internal variable name - ( ; If none of the above hit, try to interpret as a compiled symbol - (if (iserr _x) (prnl _x) ( - (def _e (eval _x)) - (if (iserr (len _e)) () (feval _e)) - )) - ) - )))))))))))) - ; A switch/case operator might be good, to avoid huge closing-paren chains +(def pstack (fn () ( + (prnl (cat "Stack: " stack)) +))) - ; If any list is left, recurse into it - (if (> (len list) 0) (feval (rest list)) ()) +(def e (fn (code) ( + (eval code) +))) - ) () ; Meow! - )))) +(def loud-pop (fn () ( + (prnl (pop)) +))) -; A simple test of the built-in arithmetic -(def test (fn (_) ( - (prnl "Should match:") - (prnl "18 33 4 -4") - (feval ( 6 3 * . 32 ^ 100 3 / . 32 ^ 2 2 + . 32 ^ 5 9 - . )) - (pch 10) - (pch 10) - ))) +(def get-code (fn (words) ( + (def next (first words)) + (if (iserr next) () + (if (= "$" next) () + (pre (get-code (rest words)) next))) +))) -;; Example Compilations -; Basic imperial distances -(feval (: "ft" 12 * $)) -(feval (: "yd" ft 3 * $)) -(feval (: "yds" yd $)) -(feval (: "in" $)) -(feval (: ">ft" 1 ft / $)) -(feval (: ">yds" 1 yd / $)) +(def compile (fn (words) ( + (def name (second words)) + (def code (get-code (rest (rest words)))) + (h-insert dictionary name code) +))) -; Convert between Farenheit and Celcius -(feval (: "f>c" 32 - 5 * 9 /$)) -(feval (: "c>f" 9 * 5 / 32 + $)) +(def not (fn (bool) + (if bool F T) +)) -; Math -(feval (: "sq" dup * $)) -; Gets next Fibonacci number from two on stack -(feval (: "_f" swap over + $)) -(feval (: "fib" _f dup . $)) +(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)) -;; A simple REPL. Exits on 'q' -;(def repl (fn (_) ( -; (prn "forbble::> ") -; (def _inp (inp 0 0)) -; (if (= "q" _inp) () ( -; (def _str (+ "(feval (" _inp "))" )) -; (eval _str) -; (pch 10) -; (repl 0) -; ))))) -; -;; Run the REPL -;(repl 0) +(def noterr (fn (e) (not (iserr e)))) + +(def fmap (fn (words) ( + (def word (at 0 words)) + + (if (iserr word) () ( + ; Define a user function + (if (= ":" word) (compile 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 + (def evaluated-word (eval word)) + (if (noterr evaluated-word) (stkadd evaluated-word) ( + ; Or add as a string + (stkadd word) + )))))) + (fmap (rest words)) + )) + )) +))) + +(def feval (fn (text) ( + (def words (get-words text)) + (fmap words) +))) + +(def esc (ch 27)) +(def reset (cat esc "[0m")) +(def fprompt (cat esc "[33;1mplf:> " reset)) + +; Override the normal REPL prompt +; Also nice because it doesn't force into the REPL when just loading this file +(set prompt fprompt) +(set preprocess (fn (text) ( + (feval text) + (prn nl) + "" ; Have the underlying REPL do nothing +))) diff --git a/src/examples/forbble2.pbl b/src/examples/forbble2.pbl deleted file mode 100644 index aaf976b..0000000 --- a/src/examples/forbble2.pbl +++ /dev/null @@ -1,117 +0,0 @@ -#!/usr/bin/pl - -; Initialize an empty stack -(def stack ()) -(def dictionary (table)) - -(def stkadd (fn (a) - "Add the given value to the stack" ( - (set stack (pre stack a)) -))) - -(def pop (fn () - "Remove the top of the stack" - (if (> (len stack) 0) ( - (def top (at 0 stack)) - (set stack (rest stack)) - top - ) (prnl "pop: STACK EMPTY")) -)) - -(def twop (fn (op) - "Apply the given operation to the top two stack elements" ( - (if (< (len stack) 2) (prnl "stack too small!") ( - (def val (op (pop) (pop))) - (stkadd val) - )) -))) - -(def swap (fn () ( - (def top (pop)) - (def bottom (pop)) - (stkadd top) - (stkadd bottom) -))) - -(def get-words (fn (text) ( - (split text " ") -))) - -(def pstack (fn () ( - (prnl (cat "Stack: " stack)) -))) - -(def e (fn (code) ( - (eval code) -))) - -(def loud-pop (fn () ( - (prnl (pop)) -))) - -(def get-code (fn (words) ( - (def next (first words)) - (if (iserr next) () - (if (= "$" next) () - (pre (get-code (rest words)) next))) -))) - -(def compile (fn (words) ( - (def name (second words)) - (def code (get-code (rest (rest words)))) - (h-insert dictionary name code) -))) - -(def not (fn (bool) - (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) ( - (def word (at 0 words)) - - (if (iserr word) () ( - ; Define a user function - (if (= ":" word) (compile 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 - (def evaluated-word (eval word)) - (if (noterr evaluated-word) (stkadd evaluated-word) ( - ; Or add as a string - (stkadd word) - )))))) - (fmap (rest words)) - )) - )) -))) - -(def feval (fn (text) ( - (def words (get-words text)) - (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 fprompt) -(set preprocess (fn (text) ( - (feval text) - (prn nl) - "" ; Have the underlying REPL do nothing -))) diff --git a/src/examples/forbble_old.pbl b/src/examples/forbble_old.pbl new file mode 100755 index 0000000..0a0334e --- /dev/null +++ b/src/examples/forbble_old.pbl @@ -0,0 +1,171 @@ +#!/usr/bin/pl + +; Initialize an empty stack +(def stack ()) + +; Add the given num to the stack +(def stkadd (fn (a) + (def stack (pre stack a)))) + +; Silently remove the top of the stack +(def _pop (fn (_) + (def stack (rest stack)))) + +; Remove and return the stack top +(def bop (fn (_) ( + (def _a (at 0 stack)) + (_pop 0) + _a + ))) + +; Loud, checked version of _pop +(def pop (fn (_) + (if (> (len stack 0) 0) ( + (prn (at 0 stack)) + (_pop 0)) + (prnl "pop: STACK EMPTY") + ))) + +; Takes a two-parameter operation and +; applies it to the top two stack elements +(def twop (fn (_op) ( + (if (> (len stack) 1) ( + (def (_b _a) ((bop 0) (bop 0))) + (stkadd (_op _a _b))) + (prnl "twop: STACK TOO SMALL") + )))) + +; Define important symbols/functions +; An annoying hack for right now +(def . ".") +(def : ":") +(def ^ "^") +(def $ "$") +(def swap "swap") +(def dup "dup") +(def rot "rot") +(def over "over") + +; Duplicate the top element of the stack +(def _dup (fn (_) ( + (def _top (at 0 stack)) + (if (iserr _top) (prnl "dup: STACK EMPTY") + (stkadd _top)) +))) + +; Swap the top two elements of the stack, if possible +(def _swap (fn (_) ( + (if (> (len stack) 1) ( + (def (_b _a) ((bop 0) (bop 0))) + (stkadd _b) + (stkadd _a)) + (prnl "swap: STACK TOO SMALL") + )))) + +; Rotate the third element to be above the first and second elements +(def _rot (fn (_) ( + (if (> (len stack) 2) ( + (def (_c _b _a) ((bop 0) (bop 0) (bop 0))) + (stkadd _b) + (stkadd _c) + (stkadd _a)) + (prnl "rot: STACK TOO SMALL") + )))) + +; Rotate the third element to be above the first and second elements +(def _over (fn (_) ( + (if (> (len stack) 1) ( + (def _a (at 1 stack)) + (stkadd _a)) + (prnl "over: STACK TOO SMALL") + )))) + +; Defines a given symbol using a given list of Forth inputs +(def compile (fn (func sym) ( + ; Get next symbol + (def _x (at 0 func)) + (if (iserr _x) _x + (if (= _x "$") (rest func) + (at 1 ( + (defe sym (ap (eval sym) _x)) + (compile (rest func) sym))) + ))))) + +; Evaluate a list of Forth inputs +(def feval (fn (list) ( + (if (> (len list) 0) ( + (def _x (at 0 list)) + (if (isnum _x) (stkadd _x) ; Push to the stack if it's a number + (if (= "." _x) (pop 0) ; Pop if it's a dot + (if (= + _x) (twop +) ; Try basic arithmetic + (if (= - _x) (twop -) + (if (= * _x) (twop *) + (if (= / _x) (twop /) + (if (= "swap" _x) (_swap 0) + (if (= "dup" _x) (_dup 0) + (if (= "rot" _x) (_rot 0) + (if (= "over" _x) (_over 0) + (if (= "^" _x) (pch (bop 0)) + (if (= ":" _x) ( ; Compile a phrase into the next symbol + (def var (at 1 list)) ; Collect the symbol to define, as a string + (defe var (+ "_" var)) ; Add an underscore for the internal storage + (defe (+ "_" var) ()) ; Define _func internally as an empty list + (def list (compile ; Overwrite list with output of (compile) + (rest (rest list)) ; Current list, not including ':' or the symbol + (+ "_" var)))) ; The internal variable name + ( ; If none of the above hit, try to interpret as a compiled symbol + (if (iserr _x) (prnl _x) ( + (def _e (eval _x)) + (if (iserr (len _e)) () (feval _e)) + )) + ) + )))))))))))) + ; A switch/case operator might be good, to avoid huge closing-paren chains + + ; If any list is left, recurse into it + (if (> (len list) 0) (feval (rest list)) ()) + + ) () ; Meow! + )))) + +; A simple test of the built-in arithmetic +(def test (fn (_) ( + (prnl "Should match:") + (prnl "18 33 4 -4") + (feval ( 6 3 * . 32 ^ 100 3 / . 32 ^ 2 2 + . 32 ^ 5 9 - . )) + (pch 10) + (pch 10) + ))) + +;; Example Compilations +; Basic imperial distances +(feval (: "ft" 12 * $)) +(feval (: "yd" ft 3 * $)) +(feval (: "yds" yd $)) +(feval (: "in" $)) +(feval (: ">ft" 1 ft / $)) +(feval (: ">yds" 1 yd / $)) + +; Convert between Farenheit and Celcius +(feval (: "f>c" 32 - 5 * 9 /$)) +(feval (: "c>f" 9 * 5 / 32 + $)) + +; Math +(feval (: "sq" dup * $)) +; Gets next Fibonacci number from two on stack +(feval (: "_f" swap over + $)) +(feval (: "fib" _f dup . $)) + +;; A simple REPL. Exits on 'q' +;(def repl (fn (_) ( +; (prn "forbble::> ") +; (def _inp (inp 0 0)) +; (if (= "q" _inp) () ( +; (def _str (+ "(feval (" _inp "))" )) +; (eval _str) +; (pch 10) +; (repl 0) +; ))))) +; +;; Run the REPL +;(repl 0) diff --git a/src/examples/pebblisp.pbl b/src/examples/pebblisp.pbl index 919b84f..ea6f841 100644 --- a/src/examples/pebblisp.pbl +++ b/src/examples/pebblisp.pbl @@ -22,7 +22,7 @@ (reloadConfig) ))) -(def forthFile "/home/sagevaillancourt/projects/pebblisp/src/examples/forbble2.pbl") +(def forthFile "/home/sagevaillancourt/projects/pebblisp/src/examples/forbble.pbl") (struct Alias (name value)) (def aliases ( (Alias "ls" "ls --color") diff --git a/src/tests.sh b/src/tests.sh index 20f3052..bc6e0f4 100755 --- a/src/tests.sh +++ b/src/tests.sh @@ -241,10 +241,11 @@ check "Map Filter" \ '(eval "(fil (fn (a) (< 50 a)) (map sq (1 2 3 4 5 6 7 8 9 10 11 12)))")' \ "( 64 81 100 121 144 )" -title "Forbble" disabled -check "BasicForbbleOp" '(loadfile "examples/forbble.pbl") (feval (10 10 * .)) ""' "100" -check "FibForbble" '(loadfile "examples/forbble.pbl") (feval (1 1 _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f .)) ""' "28657" -check "ForbbleDefine" '(loadfile "examples/forbble.pbl") (feval ( : "cubed" dup dup * * $ )) (feval (4 cubed .)) ""' "64" +title "Forbble" +check "BasicForbbleOp" '(loadfile "examples/forbble.pbl") (feval "10 10 * .") ""' "100" +check "Basic Forbble Definition" '(loadfile "examples/forbble.pbl") (feval ": ft 12 * $") (feval "10 ft .") ""' "120" +#check "FibForbble" '(loadfile "examples/forbble.pbl") (feval (1 1 _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f .)) ""' "28657" +#check "ForbbleDefine" '(loadfile "examples/forbble.pbl") (feval ( : "cubed" dup dup * * $ )) (feval (4 cubed .)) ""' "64" title "Environment" check "EnvStressTestEarly" '(def a 1)(def b 20)(def c "yee")(def d "yeehunnid")(def e 3) (a)' "( 1 )"