pebblisp/src/examples/forbble.pbl

#!/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")
(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) (
  (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 (= "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 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
      (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 + $))

; Math
(feval (: "sq" dup * $))
; Gets next Fibonacci number from two on stack
(feval (: "fib" swap over + 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)