Forbble tests are back on the menu.

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))))
+  "Add the given value to the stack" (
-
+  (set 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 ()
-(def pop (fn (_)
+  "Remove the top of the stack"
-  (if (> (len stack 0) 0) (
+  (if (> (len stack) 0) (
-    (prn (at 0 stack))
+    (def top (at 0 stack))
-      (_pop 0))
+    (set stack (rest stack))
-    (prnl "pop: STACK EMPTY")
+    top
-  )))
+  ) (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
+(def twop (fn (op)
-    (if (> (len list) 0) (feval (rest list)) ())
+  "Apply the given operation to the top two stack elements" (
-
+  (if (< (len stack) 2) (prnl "stack too small!") (
-  ) () ; Meow!
+    (def val (op (pop) (pop)))
-  ))))
+    (stkadd val)
-
+  ))
-; 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
+(def swap (fn () (
-; Basic imperial distances
+  (def top (pop))
-(feval (: "ft" 12 * $))
+  (def bottom (pop))
-(feval (: "yd" ft 3 * $))
+  (stkadd top)
-(feval (: "yds" yd $))
+  (stkadd bottom)
-(feval (: "in" $))
+)))
-(feval (: ">ft" 1 ft / $))
-(feval (: ">yds" 1 yd / $))
 
-; Convert between Farenheit and Celcius
+(def get-words (fn (text) (
-(feval (: "f>c" 32 - 5 * 9 /$))
+  (split text " ")
-(feval (: "c>f" 9 * 5 / 32 + $))
+)))
 
-; Math
+(def pstack (fn () (
-(feval (: "sq" dup * $))
+  (prnl (cat "Stack: " stack))
-; Gets next Fibonacci number from two on stack
+)))
-(feval (: "_f" swap over + $))
-(feval (: "fib" _f dup . $))
 
-;; A simple REPL. Exits on 'q'
+(def e (fn (code) (
-;(def repl (fn (_) (
+  (eval code)
-;  (prn "forbble::> ")
+)))
-;  (def _inp (inp 0 0))
+
-;  (if (= "q" _inp) () (
+(def loud-pop (fn () (
-;    (def _str (+ "(feval (" _inp "))" ))
+  (prnl (pop))
-;    (eval _str)
+)))
-;    (pch 10)
+
-;    (repl 0)
+(def get-code (fn (words) (
-;  )))))
+  (def next (first words))
-;
+  (if (iserr next) ()
-;; Run the REPL
+    (if (= "$" next) ()
-;(repl 0)
+      (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
+; 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
+)))

src/examples/forbble2.pbl

@@ -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
-)))

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)

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")

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
+title "Forbble"
-check "BasicForbbleOp" '(loadfile "examples/forbble.pbl") (feval (10 10 * .)) ""' "100"
+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 "Basic Forbble Definition" '(loadfile "examples/forbble.pbl") (feval ": ft 12 * $") (feval "10 ft .") ""' "120"
-check "ForbbleDefine" '(loadfile "examples/forbble.pbl") (feval ( : "cubed" dup dup * * $ )) (feval (4 cubed .)) ""' "64"
+#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 )"