Forbble tests are back on the menu.
This commit is contained in:
Sage Vaillancourt
Sage Vaillancourt
parent
bd6b26331b
commit
a47e280c76
|
|
@ -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))))
|
||||
|
||||
; 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))
|
||||
"Add the given value to the stack" (
|
||||
(set stack (pre stack a))
|
||||
)))
|
||||
|
||||
; 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")
|
||||
))))
|
||||
(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"))
|
||||
))
|
||||
|
||||
; 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))
|
||||
(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)
|
||||
))
|
||||
)
|
||||
))))))))))))
|
||||
; 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)) ())
|
||||
(def swap (fn () (
|
||||
(def top (pop))
|
||||
(def bottom (pop))
|
||||
(stkadd top)
|
||||
(stkadd bottom)
|
||||
)))
|
||||
|
||||
) () ; Meow!
|
||||
))))
|
||||
(def get-words (fn (text) (
|
||||
(split text " ")
|
||||
)))
|
||||
|
||||
; 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)
|
||||
)))
|
||||
(def pstack (fn () (
|
||||
(prnl (cat "Stack: " stack))
|
||||
)))
|
||||
|
||||
;; 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 / $))
|
||||
(def e (fn (code) (
|
||||
(eval code)
|
||||
)))
|
||||
|
||||
; Convert between Farenheit and Celcius
|
||||
(feval (: "f>c" 32 - 5 * 9 /$))
|
||||
(feval (: "c>f" 9 * 5 / 32 + $))
|
||||
(def loud-pop (fn () (
|
||||
(prnl (pop))
|
||||
)))
|
||||
|
||||
; Math
|
||||
(feval (: "sq" dup * $))
|
||||
; Gets next Fibonacci number from two on stack
|
||||
(feval (: "_f" swap over + $))
|
||||
(feval (: "fib" _f dup . $))
|
||||
(def get-code (fn (words) (
|
||||
(def next (first words))
|
||||
(if (iserr next) ()
|
||||
(if (= "$" next) ()
|
||||
(pre (get-code (rest words)) next)))
|
||||
)))
|
||||
|
||||
;; 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)
|
||||
(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
|
||||
)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
)))
|
||||
|
|
@ -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)
|
||||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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 "ForbbleDefine" '(loadfile "examples/forbble.pbl") (feval ( : "cubed" dup dup * * $ )) (feval (4 cubed .)) ""' "64"
|
||||
title "Forbble"
|
||||
check "BasicForbbleOp" '(loadfile "examples/forbble.pbl") (feval "10 10 * .") ""' "100"
|
||||
check "Basic Forbble Definition" '(loadfile "examples/forbble.pbl") (feval ": ft 12 * $") (feval "10 ft .") ""' "120"
|
||||
#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 )"
|
||||
|
|
|
|||
Loading…
Reference in New Issue