A Lisp implemented in AWK
#!/bin/sh

# SPDX-License-Identifier: BSD-2-Clause

LOG_LEVEL=1

# vvv  https://github.com/dnmfarrell/tap.sh/
TAP_TEST_COUNT=0
TAP_FAIL_COUNT=0

tap_pass() {
	TAP_TEST_COUNT=$((TAP_TEST_COUNT + 1))
	echo "ok $TAP_TEST_COUNT $1"
}

tap_fail() {
	TAP_TEST_COUNT=$((TAP_TEST_COUNT + 1))
	TAP_FAIL_COUNT=$((TAP_FAIL_COUNT + 1))
	echo "not ok $TAP_TEST_COUNT $1"
}

tap_end() {
	num_tests="$1"
	[ -z "$num_tests" ] && num_tests="$TAP_TEST_COUNT"
#	echo "1..$num_tests"
	[ "$num_tests" = "$TAP_TEST_COUNT" ] || exit 1
	exit $((TAP_FAIL_COUNT > 0)) # C semantics
}

tap_ok() {
	if [ "$1" -eq 0 ]; then
		tap_pass "$2"
	else
		tap_fail "$2"
	fi
}

tap_cmp() {
	if [ "$1" = "$2" ]; then
		tap_pass "$3"
	else
		tap_fail "$3 - expected '$2' but got '$1'"
	fi
}
# ^^^

lisp_with_string () {
  echo "$@" | original-awk -v PROMPT= -v LOG_LEVEL=$LOG_LEVEL -f glotawk

  # importantly, awk is the last thing in this pipeline so we can see
  # its exitcode
}

lisp_eval_should_be () {
    [ $LOG_LEVEL -ge 2 ] && echo "INF ---- test $(($TAP_TEST_COUNT + 1)) ---------"
    local output="$(lisp_with_string "$1")"
    local exitcode=$?
    if [ "$exitcode" -ne 0 ] ; then
        tap_fail "$3 - nonzero exit code"
    else
        tap_cmp "$output" "$2" "$3"
    fi
}

if [ "$#" -gt 0 ]; then
    while [ "$#" -gt 0 ]; do
        if [ "$1" = "-v" ]; then
            if [ $LOG_LEVEL -lt 3 ]; then
                LOG_LEVEL=$(( $LOG_LEVEL + 1 ))
            fi
        elif [ "$1" = "-vv" ]; then
            if [ $LOG_LEVEL -lt 2 ]; then
                LOG_LEVEL=$(( $LOG_LEVEL + 2 ))
            fi
        fi
        shift
    done
fi

TEST_COUNT=0

lisp_eval_should_be '(quote 5)' '5' 'basic quote'
lisp_eval_should_be '5' '5' 'numbers are literal'
lisp_eval_should_be '((lambda (x) 3) 5)' '3' 'lambda evaluation'
lisp_eval_should_be '(label ((foo 3)) foo)' '3' 'label evaluation'
lisp_eval_should_be '(cond (false 5) (true 3))' '3' 'cond evaluation'
lisp_eval_should_be '(atom 5)' 'true' 'atom: number'
lisp_eval_should_be '(atom (quote "foo"))' 'true' 'atom: string'
lisp_eval_should_be '(atom (quote (1 2 3)))' 'false' 'atom: list'
lisp_eval_should_be '(atom (quote (1 . 2)))' 'false' 'atom: pair'
lisp_eval_should_be '(atom (quote socrates))' 'true' 'atom: symbol'
lisp_eval_should_be '(cons (quote foo) (quote bar))' '(foo . bar)' 'cons: pair'
lisp_eval_should_be '(cons 1 (cons 2 (cons 3 nil)))' '(1 2 3)' 'cons: list'
lisp_eval_should_be '(car (quote (foo bar)))' 'foo' 'car'
lisp_eval_should_be '(cdr (quote (foo bar)))' '(bar)' 'cdr'
lisp_eval_should_be '(eq "foo" "bar")' 'false' 'eq: unequal strings'
lisp_eval_should_be '(eq "foo" "foo")' 'false' 'eq: strings are not interned (non-normative)'
lisp_eval_should_be '((lambda xs (car xs)) 1 2 3)' '1' 'lexpr'
# the first result 3 is the return value of setq; the second is the
# result of evaluating symbol three
lisp_eval_should_be '(setq three 3)
three' \
                    '3
3' \
                    'setq global'
lisp_eval_should_be '(setq fst (lambda (a b) a))
(fst 9 8)' \
                    '(*lambda (a b) a)
9' \
                    'setq global tailable lambda'
lisp_eval_should_be '(setq a (quote (1 2 3)))
(setq b (quote (4 5)))
(nconc a b)
a
b' '(1 2 3)
(4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(4 5)' 'nconc'
# the macro function returns the name of the macro; that's what the q
# in the output is
lisp_eval_should_be '(macro q (lambda (x) (list (quote quote) (car x))))
(q foo)' \
                    'q
foo' 'macro'
lisp_eval_should_be '(quote (1 2 3))' '(1 2 3)' 'quote double-check'
lisp_eval_should_be \''(1 2 3)'       '(1 2 3)' 'reader syntax: apostrophe short for quote'
lisp_eval_should_be '(quasiquote (1 (unquote (+ 2 3)) 4))' '(1 5 4)' 'quasiquote with words'
lisp_eval_should_be '`(1 ,(+ 2 3) 4)' '(1 5 4)' 'quasiquote with reader syntax'
lisp_eval_should_be '(+ 1 2 3)' '6' 'multiarg +'
lisp_eval_should_be '(* 2 3 5)' '30' 'multiarg *'
lisp_eval_should_be '(/ 3 5)' '0.6' '/'
lisp_eval_should_be '(// 6 5)' '1' 'quotient'
lisp_eval_should_be '(% 6 5)'  '1' 'modulo'
lisp_eval_should_be '(** 3 4)' '81' 'power'
lisp_eval_should_be '(atan2 0 -1)' '3.14159' 'atan2'
lisp_eval_should_be '(sin 0)' '0' 'sin'
lisp_eval_should_be '(cos 0)' '1' 'cos'
lisp_eval_should_be '(sqrt 9)' '3' 'sqrt'
lisp_eval_should_be '(tolower "Title Case")' '"title case"' 'tolower'
lisp_eval_should_be '(toupper "Title Case")' '"TITLE CASE"' 'toupper'
lisp_eval_should_be '(substr "Foo" 2)' '"oo"' 'substr 2'
lisp_eval_should_be '(substr "Foo" 1 2)' '"Fo"' 'substr 3'
lisp_eval_should_be '(list-length '\''(1 2 3 4 5))' '5' 'list-length'
lisp_eval_should_be '(string-length "1234567890")' '10' 'string-length'
lisp_eval_should_be '(split "a b c d e" " ")' '("a" "b" "c" "d" "e")' 'split'
lisp_eval_should_be '(sprintf "foo %d bar %d baz %s" 3 5 "bletch")' \
                    '"foo 3 bar 5 baz bletch"' 'sprintf'
lisp_eval_should_be '(strcat "foo" "bar" "baz")' '"foobarbaz"' 'strcat'
lisp_eval_should_be '(sprintf "%03d%%03d%s" 5 "foo")' \
                    '"005%03dfoo"' 'sprintf % escape'
lisp_eval_should_be '(sub "o" "e" "foo quux blotch")' \
                    '"feo quux blotch"' 'sub'
lisp_eval_should_be '(gsub "o" "e" "foo quux blotch")' \
                    '"fee quux bletch"' 'gsub'
lisp_eval_should_be '(with-ors "" (print "foo"))' \
                    '"foo"()' 'with-ors'
lisp_eval_should_be '(printf "%03d%%03d%s" 5 "foo")' \
                    '005%03dfoo()' 'printf'
lisp_eval_should_be '(with-output-to ">>" "/dev/null" (printf "%03d%%03d%s" 5 "foo"))' \
                    '()' 'with-output-to'
lisp_eval_should_be '(let ((seconds '\''(4 5 6))) `(1 2 3 ,@(mapcar (lambda (x) (+ 2 x)) seconds) 1 ,(+ 5 7) 3))' '(1 2 3 6 7 8 1 12 3)' 'quasiquote with unquote and unquote-splicing'
f=$(mktemp)
lisp_eval_should_be "(progn (with-output-to \">\" \"${f}\" (print \"foo\") (print 3) (fflush)) (close \"${f}\"))" '()' 'with-output-to print close'
lisp_eval_should_be "(with-input-from \"<\" \"${f}\" (print (getline)) (print (getline)))" '(""foo"" 1)
("3" 1)
()' 'with-input-from getline'


tap_end