Add dup, rot, and over to Forbble example
This commit is contained in:
parent
fe86f7c836
commit
35f0a94f40
|
@ -48,6 +48,16 @@
|
||||||
(def ^ "^")
|
(def ^ "^")
|
||||||
(def $ "$")
|
(def $ "$")
|
||||||
(def swap "swap")
|
(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
|
; Swap the top two elements of the stack, if possible
|
||||||
(def _swap (fn (_) (
|
(def _swap (fn (_) (
|
||||||
|
@ -58,6 +68,24 @@
|
||||||
(prnl "swap: STACK TOO SMALL")
|
(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
|
; Defines a given symbol using a given list of Forth inputs
|
||||||
(def compile (fn (func sym) (
|
(def compile (fn (func sym) (
|
||||||
(def _x (at 0 func))
|
(def _x (at 0 func))
|
||||||
|
@ -78,6 +106,9 @@
|
||||||
(if (= * _x) (twop *)
|
(if (= * _x) (twop *)
|
||||||
(if (= / _x) (twop /)
|
(if (= / _x) (twop /)
|
||||||
(if (= "swap" _x) (_swap 0)
|
(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) (pch (bop 0))
|
||||||
(if (= ":" _x) ( ; Compile a phrase into the next symbol
|
(if (= ":" _x) ( ; Compile a phrase into the next symbol
|
||||||
(def var (at 1 list))
|
(def var (at 1 list))
|
||||||
|
@ -88,7 +119,7 @@
|
||||||
(def _e (eval _x))
|
(def _e (eval _x))
|
||||||
(if (iserr (len _e)) () (feval _e))
|
(if (iserr (len _e)) () (feval _e))
|
||||||
)
|
)
|
||||||
)))))))))
|
))))))))))))
|
||||||
; A switch/case operator might be good, to avoid huge closing-paren chains
|
; A switch/case operator might be good, to avoid huge closing-paren chains
|
||||||
|
|
||||||
; If any list is left, recurse into it
|
; If any list is left, recurse into it
|
||||||
|
@ -113,10 +144,16 @@
|
||||||
(feval (: "in" $))
|
(feval (: "in" $))
|
||||||
(feval (: "i>f" 1 ft / $))
|
(feval (: "i>f" 1 ft / $))
|
||||||
(feval (: "i>y" 1 yd / $))
|
(feval (: "i>y" 1 yd / $))
|
||||||
|
|
||||||
; Convert between Farenheit and Celcius
|
; Convert between Farenheit and Celcius
|
||||||
(feval (: "f>c" 32 - 5 * 9 /$))
|
(feval (: "f>c" 32 - 5 * 9 /$))
|
||||||
(feval (: "c>f" 9 * 5 / 32 + $))
|
(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'
|
; A simple REPL. Exits on 'q'
|
||||||
(def repl (fn (_) (
|
(def repl (fn (_) (
|
||||||
(prn "forbble::> ")
|
(prn "forbble::> ")
|
||||||
|
|
Loading…
Reference in New Issue