133 lines
3.0 KiB
Plaintext
133 lines
3.0 KiB
Plaintext
|
#!/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)
|