(module tl-test mzscheme
  (require "../reduction-semantics.ss")
  
  (define-syntax (test stx)
    (syntax-case stx ()
      [(_ expected got)
       (with-syntax ([line (syntax-line stx)]
                     [col (syntax-column stx)])
         (syntax (test/proc (λ () expected) got line col)))]))
  
  (define tests 0)
  (define (test/proc run expected line col)
    (let ([got (run)])
      (set! tests (+ tests 1))
      (unless (equal? got expected)
        (error 'test/proc "line ~a col ~a got ~s expected ~s" 
               line col
               got
               expected))))
  
  (define grammar
    (language (M (M M)
                 number)
              (E hole
                 (E M)
                 (number E))))
  
  (define add (reduction grammar
                         (number_1 number_2)
                         (+ (term number_1) (term number_2))))
  
  (test (reduce (list add) '(2 3)) (list 5))
  (test (reduce (list (context-closure add grammar 'E))
                '(2 3))
        (list 5))
  (test (reduce (list (compatible-closure add grammar 'M))
                '(2 3))
        (list 5))
  (test (reduce (list (compatible-closure add grammar 'M))
                '((2 3) (4 5)))
        (list '(5 (4 5))
              '((2 3) 9)))
 
  (test (reduce/tag-with-reduction (list add) '(2 3))
        (list (list add '5)))
  
  (test ((language->predicate grammar 'M) '(1 2))
        #t)
  
  (test ((language->predicate grammar 'M) '(3))
        #f)
  
  (printf "tl-test.ss: all ~a tests passed.\n" tests))