diff --git a/src/examples/forbble.pbl b/src/examples/forbble.pbl index 5e63a85..01984c8 100644 --- a/src/examples/forbble.pbl +++ b/src/examples/forbble.pbl @@ -28,7 +28,9 @@ (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))) + (def left (pop)) + (def right (pop)) + (def val (op right left)) (stkadd val) )) ))) @@ -146,18 +148,66 @@ (for-each feval ( ": fib swap over + $" + + ; Peek at the top of the stack ": peek dup . $" + + ; Basic imperial distances (with inches as the base unit) + ": ft 12 * $" + ": yd 3 ft * $" + ": yds 3 ft * $" + ": in $" + ": >ft 1 ft / $" + ": >yds 1 yd / $" + + ; Convert between Farenheit and Celcius + ": f>c 32 - 5 * 9 / $" + ": c>f 9 * 5 / 32 + $" )) +(def plf-assert (fn (test expected) ( + (set stack ()) + (prn "Test '" test "'") + (feval test) + (def actual (at 0 stack)) + (if (= actual expected) + (prnl " passed!") + (prnl (cat " failed! Expected '" expected "' but received '" actual "'"))) +))) + +(def plf-tests (fn () ( + (plf-assert "100 c>f" 212) + (plf-assert "10 yds >ft" 30) + (plf-assert "1 1 fib fib fib fib fib fib fib" 34) + + (set stack ()) +))) + (def esc (ch 27)) (def reset (cat esc "[0m")) (def fprompt (cat esc "[33;1mplf:> " reset)) +(plf-tests) -; 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 +(def original-prompt prompt) +(def original-preprocess preprocess) + +(def restore-repl (fn () ( + (set prompt original-prompt) + (set preprocess original-preprocess) ))) + +(def plf-repl (fn () ( + ; Override the normal REPL prompt + (set prompt fprompt) + (set preprocess (fn (text) ( + (if (= "qqq" text) ((restore-repl) "") ( + (feval text) + (prn nl) + "" ; Have the underlying REPL do nothing + )) + ))) +))) + +(plf-repl) + +"forbble loaded" diff --git a/src/examples/forbble_old.pbl b/src/examples/forbble_old.pbl deleted file mode 100755 index 0a0334e..0000000 --- a/src/examples/forbble_old.pbl +++ /dev/null @@ -1,171 +0,0 @@ -#!/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/main.c b/src/main.c index 97dad85..1254f88 100644 --- a/src/main.c +++ b/src/main.c @@ -91,11 +91,11 @@ void repl(struct Environment* env) read_history(settings.historyFile); while ((buf = prompt(env)) != NULL) { + buf = preprocess(buf, env); if (strcmp("q", buf) == 0) { free(buf); break; } - buf = preprocess(buf, env); if (buf[0] == '\0') { free(buf); continue; diff --git a/src/plfunc/pc.c b/src/plfunc/pc.c index 96fc91b..eb8f35b 100644 --- a/src/plfunc/pc.c +++ b/src/plfunc/pc.c @@ -73,6 +73,7 @@ Object readFileToObject(Object* params, unused int length, unused struct Environ Object string = newObject(TYPE_STRING); string.string = readFileToString(file); + fclose(file); return string; }