# pmacro testcase #1 -*- shell-script -*-

gen_cpu_file() {
    rtl_version=$1
    prefix=$2

    cat > ${cpu_file} <<EOF
(define-rtl-version ${rtl_version})
(include "${srcdir}/../cpu/simplify.inc")
(include "${srcdir}/testsuite.cpu")

(define-pmacro sym-const name1)
(define-pmacro str-const "string1")
(define-pmacro int-const 1)

(define-pmacro list-const
  (
   (name1 "string1" 1)
   (name2 "string2" 2)
   (name3 "string3" 3)
   )
)
(${prefix}print list-const "\n")

(test-name "${prefix}ref, ${prefix}car")
(${prefix}if (${prefix}not (${prefix}equal? (${prefix}ref (${prefix}car list-const) 2) 1))
     (${prefix}print "FAIL (${prefix}not (${prefix}equal? (${prefix}ref (${prefix}car list-const) 2) 1))\n"))

(test-name "${prefix}for-each, nested ${prefix}pmacros")
(print-match "adgbehcfi")
(print-thunk (${prefix}pmacro ()
               (${prefix}begin
                 (${prefix}for-each (${prefix}pmacro (x y z)
		              (${prefix}print x y z))
                            (a b c) (d e f) (g h i)))))
(test-name "nested ${prefix}pmacros with bindings")
(print-match "(+ 4 3)")
(print-thunk (${prefix}pmacro ()
               (${prefix}dump ((${prefix}pmacro (arg1 arg2)
                         ((${prefix}pmacro (bar) (+ arg2 bar)) arg1))
                       3 4))))

(test-name "${prefix}dump")
(print-match "(name1 \"string1\" 1)(name2 \"string2\" 2)(name3 \"string3\" 3)\n")
(${prefix}print "EXPR: ")
(${prefix}for-each (${prefix}pmacro (a) (${prefix}dump a)) list-const)
(newline)

(test-name "${prefix}sym")
(print-match "abc\n")
(print-expr (${prefix}sym a "b" c))

(test-name "${prefix}str")
(print-match "\"def\"\n")
(print-expr (${prefix}str d "e" f))

(test-name "${prefix}hex")
(print-match "\"2a\"")
(print-expr (${prefix}hex 42))

(test-name "${prefix}upcase")
(print-match "\"UPPER\"")
(print-expr (${prefix}upcase "upper"))
(print-match "UPPER")
(print-expr (${prefix}upcase upper))

(test-name "${prefix}downcase")
(print-match "\"downer\"")
(print-expr (${prefix}downcase "DOWNER"))
(print-match "downer")
(print-expr (${prefix}downcase DOWNER))

(test-name "${prefix}substring")
(print-match "\"zz\"")
(print-expr (${prefix}substring "xyzzy" 2 4))
(print-match "zz")
(print-expr (${prefix}substring xyzzy 2 4))

(test-name "${prefix}splice1")
(print-match "(now is the time)")
(print-expr (${prefix}splice now (${prefix}unsplice (is the time))))

;; Arguments to ${prefix}splice/${prefix}unsplice are evaluated.
(test-name "${prefix}splice2")
(print-match "(now is the time)")
(define-pmacro splice2-piece now)
(print-expr (${prefix}splice splice2-piece (${prefix}unsplice (is the time))))

;; Arguments to ${prefix}splice/${prefix}unsplice are evaluated.
(test-name "${prefix}splice3")
(print-match "(now is the time)")
(define-pmacro splice3-piece the)
(print-expr (${prefix}splice now (${prefix}unsplice (is splice3-piece time))))

(test-name "${prefix}iota")
(print-match "(0 1 2 3)")
(print-expr (${prefix}iota 4))
(print-match "(1 2 3 4)")
(print-expr (${prefix}iota 4 1))
(print-match "(2 4 6 8)")
(print-expr (${prefix}iota 4 2 2))

(test-name "${prefix}map")
(print-match "(\"a\" \"b\" \"c\")")
(print-expr (${prefix}map ${prefix}hex (10 11 12)))
(print-match "(\"a\" \"b\" \"c\")")
(print-expr (${prefix}map (${prefix}pmacro (x) (${prefix}hex x)) (10 11 12)))

(test-name "${prefix}apply")
(print-match "ABC")
(print-expr (${prefix}apply ${prefix}upcase (abc)))

(test-name "${prefix}pmacro?")
(print-match "#t")
(print-expr (${prefix}pmacro? ${prefix}pmacro?))
(print-match "#t")
(print-expr (${prefix}pmacro? test-name))
(print-match "#t")
(print-expr (${prefix}pmacro? (${prefix}pmacro (a) (add a 1))))
(print-match "#f")
(print-expr (${prefix}pmacro? 42))

(test-name "${prefix}eval")
(print-match "(explicitly-undefined 42)")
(define-pmacro (eval-test1 a) (explicitly-undefined a))
(print-expr (${prefix}eval (${prefix}splice eval-test1 (${prefix}unsplice (42)))))

(test-name "${prefix}let")
(print-match "xyzzy")
(print-expr (${prefix}let ((x xyzzy)) x))
;; FIXME: This is the currently defined behaviour, but it's somewhat
;; unintuitive.
;; pmacro expansion re-evaluates the result if it's also a pmacro,
;; so x -> y -> x and y -> x -> y.
(print-match "(x y)")
(print-expr (${prefix}let ((x y) (y x)) (${prefix}list x y)))

(test-name "${prefix}let*")
(print-match "(1 2)")
(print-expr (${prefix}let* ((x 1) (y (${prefix}add x 1))) (${prefix}list x y)))

(test-name "${prefix}if")
(print-match "then")
(print-expr (${prefix}if #t then else))
(print-match "else")
(print-expr (${prefix}if #f then else))

(test-name "${prefix}case")
(print-match "123")
(print-expr (${prefix}case seba ((seba beach) 123) (else 456)))
(print-match "123")
(print-expr (${prefix}case beach ((seba beach) 123) (else 456)))
(print-match "456")
(print-expr (${prefix}case 0 ((seba beach) 123) (else 456)))

(test-name "${prefix}cond")
(print-match "yep")
(print-expr (${prefix}cond ((${prefix}eq 1 1) yep) (else nope)))
(print-match "nope")
(print-expr (${prefix}cond ((${prefix}eq 1 2) yep) (else nope)))

(test-name "${prefix}begin")
(print-match "xyz")
(print-thunk (${prefix}pmacro () (${prefix}begin (${prefix}print "x") (${prefix}print "y") (${prefix}print "z"))))

(test-name "${prefix}list, ${prefix}ref")
(print-match "grief")
(print-expr (${prefix}ref (${prefix}list good grief) 1))

(test-name "${prefix}length")
(print-match "6")
(print-expr (${prefix}length snoopy))
(print-match "9")
(print-expr (${prefix}length "woodstock"))
(print-match "4")
(print-expr (${prefix}length (good grief charlie brown)))

(test-name "${prefix}replicate")
(print-match "(no no no no)")
(print-expr (${prefix}replicate 4 no))

(test-name "${prefix}find")
(print-match "(0 1)")
(print-expr (${prefix}find (${prefix}pmacro (n) (${prefix}lt n 2)) (${prefix}iota 4)))

(test-name "${prefix}equal?")
(print-match "#t")
(print-expr (${prefix}equal? (yo yo) (yo yo)))
(print-match "#f")
(print-expr (${prefix}equal? (yo yo) (yo x)))

(test-name "${prefix}andif")
(print-match "andif")
(print-expr (${prefix}andif 1 #t andif))
(print-match "#f")
(print-expr (${prefix}andif 1 #f andif))
(print-match "#t")
(print-expr (${prefix}andif))

(test-name "${prefix}orif")
(print-match "orif")
(print-expr (${prefix}orif #f orif))
(print-match "#f")
(print-expr (${prefix}orif #f #f))
(print-match "#f")
(print-expr (${prefix}orif))

(test-name "${prefix}not")
(print-match "yep")
(print-expr (${prefix}if (${prefix}not #f) yep nope))
(print-match "nope")
(print-expr (${prefix}if (${prefix}not #t) yep nope))

(test-name "${prefix}eq")
(print-match "eq")
(print-expr (${prefix}if (${prefix}eq foo foo) eq ne))
(print-match "eq2")
(print-expr (${prefix}if (${prefix}eq 1 1) eq2 ne2))

(test-name "${prefix}ne")
(print-match "ne")
(print-expr (${prefix}if (${prefix}ne foo bar) ne eq))
(print-match "ne2")
(print-expr (${prefix}if (${prefix}ne 1 2) ne2 eq2))

(test-name "${prefix}lt")
(print-match "lt")
(print-expr (${prefix}if (${prefix}lt 1 2) lt nope))

(test-name "${prefix}gt")
(print-match "gt")
(print-expr (${prefix}if (${prefix}gt 1 0) gt nope))

(test-name "${prefix}le")
(print-match "le1")
(print-expr (${prefix}if (${prefix}le 1 1) le1 nope))
(print-match "le2")
(print-expr (${prefix}if (${prefix}le 1 2) le2 nope))

(test-name "${prefix}ge")
(print-match "ge1")
(print-expr (${prefix}if (${prefix}ge 1 1) ge1 nope))
(print-match "ge2")
(print-expr (${prefix}if (${prefix}ge 1 0) ge2 nope))

(test-name "${prefix}add")
(print-match "3")
(print-expr (${prefix}add 1 2))

(test-name "${prefix}sub")
(print-match "-1")
(print-expr (${prefix}sub 1 2))

(test-name "${prefix}mul")
(print-match "6")
(print-expr (${prefix}mul 2 3))

(test-name "${prefix}div")
(print-match "4")
(print-expr (${prefix}div 8 2))

(test-name "${prefix}rem")
(print-match "0")
(print-expr (${prefix}rem 8 2))

(test-name "${prefix}sll")
(print-match "8")
(print-expr (${prefix}sll 1 3))
(print-match "4")
(print-expr (${prefix}sll 4 0))

(test-name "${prefix}srl")
(print-match "1")
(print-expr (${prefix}srl 8 3))
(print-match "4")
(print-expr (${prefix}srl 4 0))

(test-name "${prefix}sra")
(print-match "-1")
(print-expr (${prefix}sra -1 0))
(print-match "-1")
(print-expr (${prefix}sra -1 1))
(print-match "-2")
(print-expr (${prefix}sra -3 1))

(test-name "${prefix}and")
(print-match "8")
(print-expr (${prefix}and 15 8))

(test-name "${prefix}or")
(print-match "15")
(print-expr (${prefix}or 15 8))

(test-name "${prefix}xor")
(print-match "7")
(print-expr (${prefix}xor 15 8))

(test-name "${prefix}inv")
(print-match "-6")
(print-expr (${prefix}inv 5))

(test-name "${prefix}car")
(print-match "car")
(print-expr (${prefix}car (car cdr)))

(test-name "${prefix}cdr")
(print-match "(cdr)")
(print-expr (${prefix}cdr (car cdr)))

(test-name "${prefix}caar")
(print-match "caar")
(print-expr (${prefix}caar ((caar cdar) cadr cddr)))

(test-name "${prefix}cadr")
(print-match "cadr")
(print-expr (${prefix}cadr ((caar cdar) cadr cddr)))

(test-name "${prefix}cdar")
(print-match "(cdar)")
(print-expr (${prefix}cdar ((caar cdar) cadr cddr)))

(test-name "${prefix}cddr")
(print-match "(cddr)")
(print-expr (${prefix}cddr ((caar cdar) cadr cddr)))

EOF
}

# Run the test twice, once for each kind of prefix.

for iter in dot percent
do
    test="pmacros-1-${iter}"

    source ./test-utils.sh

    cpu_file=${test}.test.cpu
    rm -f ${cpu_file}

    case ${iter} in
    dot) gen_cpu_file "0 8" "." ;;
    percent) gen_cpu_file "0 9" "%" ;;
    esac

    run_cgen ${cpu_file}

    post_process
done

finish
