From fe86f7c836eee02b3cbe6c1d1b7880e84356454e Mon Sep 17 00:00:00 2001
From: Sage Vaillancourt <sagev9000@tutanota.com>
Date: Sun, 8 Nov 2020 12:25:43 -0500
Subject: [PATCH] Add Forbble example code

Forbble is a very, very, simple implementation of Forth, written in PebbLisp.
Forbble isn't very practical, but has been a great test-bed for finding areas
where PebbLisp is particularly lacking in features, or expressiveness.
---
 src/examples/forbble.pbl | 132 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 132 insertions(+)
 create mode 100755 src/examples/forbble.pbl

diff --git a/src/examples/forbble.pbl b/src/examples/forbble.pbl
new file mode 100755
index 0000000..324302c
--- /dev/null
+++ b/src/examples/forbble.pbl
@@ -0,0 +1,132 @@
+#!/usr/bin/pl
+
+; Print with a newline
+(def prnl (fn (_txt) (
+  (prn _txt)
+  (pch 10)
+  )))
+
+; 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")
+
+; 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")
+  ))))
+
+; Defines a given symbol using a given list of Forth inputs
+(def compile (fn (func sym) (
+  (def _x (at 0 func))
+  (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 (= "^" _x) (pch (bop 0))
+    (if (= ":" _x) ( ; Compile a phrase into the next symbol
+      (def var (at 1 list))
+        (defe var (+ "_" var))
+        (defe (+ "_" var) ())
+        (def list (compile (rest (rest list)) (+ "_" var))))
+      ( ; If none of the above hit, try to interpret as a compiled symbol
+        (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 (: "in" $))
+(feval (: "i>f" 1 ft / $))
+(feval (: "i>y" 1 yd / $))
+; Convert between Farenheit and Celcius
+(feval (: "f>c" 32 - 5 * 9 /$))
+(feval (: "c>f" 9 * 5 / 32 + $))
+
+; 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)