#lang racket (require redex) (require racket/set) (require "../../private/compiler/match.rkt") (require "../../private/compiler/redextomatrix.rkt") (define the-hole (term hole)) (define no-context #f) (define in-context #t) (define ∅ #f) (define context-match (make-parameter no-context)) (define (variable-prefix? x y) (let* ([prefix-str (symbol->string x)] [prefix-len (string-length prefix-str)]) (and (symbol? y) (let ([str (symbol->string y)]) (and ((string-length str) . >= . prefix-len) (string=? (substring str 0 prefix-len) prefix-str)))))) (define (m-test matrix input expected) (let ((r ((compile matrix) input))) (unless (equal? (apply set r) (apply set expected)) (printf "Matrix: ~s Input: ~s ==> Expected: ~s Got: ~s\n" matrix input expected r)))) (define (compiled-test func f-name input expected) (let ((r (func input))) (unless (equal? (apply set r) (apply set expected)) (printf "Func: ~s Input: ~s ==> Expected: ~s Got: ~s\n" f-name input expected r)))) (define number-f (compile `(matrix (a) (((lit-number -> (set! results (cons 1 results))))) () () 0 #f))) (define real-f (compile `(matrix (a) (((lit-real -> (set! results (cons 1 results))))) () () 0 #f))) (define integer-f (compile `(matrix (a) (((lit-integer -> (set! results (cons 1 results))))) () () 0 #f))) (define natural-f (compile `(matrix (a) (((lit-natural -> (set! results (cons 1 results))))) () () 0 #f))) (define nine-f (compile `(matrix (a) (((9 -> (set! results (cons 1 results))))) () () 0 #f))) (define numbers-f (compile `(matrix (a) (((lit-number -> (set! results (cons 1 results)))) ((lit-real -> (set! results (cons 2 results)))) ((lit-integer -> (set! results (cons 3 results)))) ((lit-natural -> (set! results (cons 4 results)))) ((9 -> (set! results (cons 5 results))))) () () 0 #f))) (define list-of-any-3-f (compile `(matrix (a) ((((cons wc (cons wc (cons wc '()))) -> (set! results (cons 1 results))))) () () 0 #f))) (define variable-f (compile `(matrix (a) (((lit-variable -> (set! results (cons 1 results))))) () () 0 #f))) (define empty-f (compile `(matrix (a) ((('() -> (set! results (cons 1 results))))) () () 0 #f))) (define x-f (compile `(matrix (a) ((('x -> (set! results (cons 1 results))))) () () 0 #f))) (define string-x-f (compile `(matrix (a) ((("x" -> (set! results (cons 1 results))))) () () 0 #f))) (define string-f (compile `(matrix (a) (((lit-string -> (set! results (cons 1 results))))) () () 0 #f))) (define hole-f (compile `(matrix (a) (((lit-hole -> (set! results (cons 1 results))))) () () 0 #f))) (define in-hole-f (compile `(matrix (a) ((((lit-in-hole (cons lit-number (cons lit-hole '())) lit-number) -> (set! results (cons 1 results))))) () () 0 #f))) (define hide-hole-f (compile `(matrix (a) ((((lit-in-hole (cons (lit-hide-hole lit-hole) (cons lit-hole '())) lit-number) -> (set! results (cons 1 results))))) () () 0 #f))) (define repeat-number-f (compile `(matrix (a) ((((repeat lit-number '()) -> (set! results (cons 1 results))))) () () 0 #f))) (define repeat-number-number-f (compile `(matrix (a) ((((repeat (cons lit-number (cons lit-number '())) '()) -> (set! results (cons 1 results))))) () () 0 #f))) (define number_1-number_1-f (compile `(matrix (a) ((((cons (lit-name number_1 lit-number) (cons (lit-name number_1 lit-number) '())) -> (set! results (cons 1 results))) (number_1 #f))) () () 0 #f))) (define repeat-number-repeat-any-f (compile `(matrix (a) ((((repeat lit-number (repeat wc '())) -> (set! results (cons 1 results))))) () () 0 #f))) (define repeat-repeat-number_1-f (compile `(matrix (a) ((((repeat (repeat (lit-name number_1 lit-number) '()) '()) -> (set! results (cons 1 results))) (((number_1 ,'...) ,'...) #f))) () () 0 #f))) (define true-false-f (compile `(matrix (a) (((#t -> (set! results (cons 1 results)))) ((#f -> (set! results (cons 2 results))))) () () 0 #f))) (define variable-prefix-x-f (compile `(matrix (a) ((((lit-variable-prefix x) -> (set! results (cons 1 results))))) () () 0 #f))) (define variable-except-x-y-z-f (compile `(matrix (a) ((((lit-variable-except x y z) -> (set! results (cons 1 results))))) () () 0 #f))) (define (test) (compiled-test number-f 'number-f 'x '()) (compiled-test real-f 'real-f 'x '()) (compiled-test integer-f 'integer-f 'x '()) (compiled-test natural-f 'natural-f 'x '()) (compiled-test nine-f 'nine-f 'x '()) (compiled-test numbers-f 'numbers-f 'x '()) (compiled-test number-f 'number-f 0+4/5i '(1)) (compiled-test real-f 'real-f 0+4/5i '()) (compiled-test integer-f 'integer-f 0+4/5i '()) (compiled-test natural-f 'natural-f 0+4/5i '()) (compiled-test nine-f 'nine-f 0+4/5i '()) (compiled-test numbers-f 'numbers-f 0+4/5i '(1)) (compiled-test number-f 'number-f 9.0 '(1)) (compiled-test real-f 'real-f 9.0 '(1)) (compiled-test integer-f 'integer-f 9.0 '()) (compiled-test natural-f 'natural-f 9.0 '()) (compiled-test nine-f 'nine-f 9.0 '()) (compiled-test numbers-f 'numbers-f 9.0 '(1 2)) (compiled-test number-f 'number-f -1 '(1)) (compiled-test real-f 'real-f -1 '(1)) (compiled-test integer-f 'integer-f -1 '(1)) (compiled-test natural-f 'natural-f -1 '()) (compiled-test nine-f 'nine-f -1 '()) (compiled-test numbers-f 'numbers-f -1 '(1 2 3)) (compiled-test number-f 'number-f 6 '(1)) (compiled-test real-f 'real-f 6 '(1)) (compiled-test integer-f 'integer-f 6 '(1)) (compiled-test natural-f 'natural-f 6 '(1)) (compiled-test nine-f 'nine-f 6 '()) (compiled-test numbers-f 'numbers-f 6 '(1 2 3 4)) (compiled-test number-f 'number-f 9 '(1)) (compiled-test real-f 'real-f 9 '(1)) (compiled-test integer-f 'integer-f 9 '(1)) (compiled-test natural-f 'natural-f 9 '(1)) (compiled-test nine-f 'nine-f 9 '(1)) (compiled-test numbers-f 'numbers-f 9 '(1 2 3 4 5)) (compiled-test list-of-any-3-f 'list-of-any-3-f 'a '()) (compiled-test list-of-any-3-f 'list-of-any-3-f '(() () ()) '(1)) (compiled-test list-of-any-3-f 'list-of-any-3-f '(1 2 3) '(1)) (compiled-test list-of-any-3-f 'list-of-any-3-f '(1 (2 3) ((4))) '(1)) (compiled-test variable-f 'variable-f '() '()) (compiled-test variable-f 'variable-f 'x '(1)) (compiled-test variable-f 'variable-f '|x y x| '(1)) (compiled-test variable-f 'variable-f '\|x '(1)) (compiled-test empty-f 'empty-f '() '(1)) (compiled-test empty-f 'empty-f (list '()) '()) (compiled-test empty-f 'empty-f 'x '()) (compiled-test empty-f 'empty-f 9 '()) (compiled-test empty-f 'empty-f '(1 2 3) '()) (compiled-test x-f 'x-f 'x '(1)) (compiled-test x-f 'x-f 'y '()) (compiled-test x-f 'x-f '() '()) (compiled-test x-f 'x-f 9 '()) (compiled-test x-f 'x-f '(1 2 3) '()) (compiled-test string-x-f 'string-x-f "x" '(1)) (compiled-test string-x-f 'string-x-f "y" '()) (compiled-test string-x-f 'string-x-f 'x '()) (compiled-test string-x-f 'string-x-f 'y '()) (compiled-test string-x-f 'string-x-f '() '()) (compiled-test string-x-f 'string-x-f 9 '()) (compiled-test string-x-f 'string-x-f '(1 2 3) '()) (compiled-test string-f 'string-f "x" '(1)) (compiled-test string-f 'string-f "zyx" '(1)) (compiled-test string-f 'string-f 'x '()) (compiled-test string-f 'string-f 'y '()) (compiled-test string-f 'string-f '() '()) (compiled-test string-f 'string-f 9 '()) (compiled-test string-f 'string-f '(1 2 3) '()) (compiled-test hole-f 'hole-f the-hole '(1)) (compiled-test hole-f 'hole-f 'hole '()) (compiled-test in-hole-f 'in-hole-f '(1 2) '(1)) (compiled-test in-hole-f 'in-hole-f (term (1 hole)) '()) (compiled-test in-hole-f 'in-hole-f '(1 x) '()) (compiled-test hide-hole-f 'hide-hole-f (term (hole 2)) '(1)) (compiled-test hide-hole-f 'hide-hole-f '(1 2) '()) (compiled-test hide-hole-f 'hide-hole-f (term (1 hole)) '()) (compiled-test hide-hole-f 'hide-hole-f '(1 x) '()) (compiled-test repeat-number-f 'repeat-number-f '() '(1)) (compiled-test repeat-number-f 'repeat-number-f '(9) '(1)) (compiled-test repeat-number-f 'repeat-number-f '(x) '()) (compiled-test repeat-number-f 'repeat-number-f 9 '()) (compiled-test repeat-number-f 'repeat-number-f '(1 2 3 4 5) '(1)) (compiled-test repeat-number-f 'repeat-number-f '(1 2 3 4 y) '()) (compiled-test repeat-number-f 'repeat-number-f '(1 2 3 4 ()) '()) (compiled-test repeat-number-number-f 'repeat-number-number-f '() '(1)) (compiled-test repeat-number-number-f 'repeat-number-number-f '((1 2)) '(1)) (compiled-test repeat-number-number-f 'repeat-number-number-f '((1 2) (4 5)) '(1)) (compiled-test repeat-number-number-f 'repeat-number-number-f '((1 2) (1 1) (1 2 3)) '()) (compiled-test repeat-number-number-f 'repeat-number-number-f '((1 2) (x 9)) '()) (compiled-test repeat-number-number-f 'repeat-number-number-f '(()) '()) (compiled-test number_1-number_1-f 'number_1-number_1-f '(-1 -1) '(1)) (compiled-test number_1-number_1-f 'number_1-number_1-f '(-1 1) '()) (compiled-test repeat-number-repeat-any-f 'repeat-number-repeat-any-f '(1 2 3 4 5) '(1)) (compiled-test repeat-number-repeat-any-f 'repeat-number-repeat-any-f '(1 2 x 4 5) '(1)) (compiled-test repeat-number-repeat-any-f 'repeat-number-repeat-any-f '(x 2 3 4 5) '(1)) (compiled-test repeat-number-repeat-any-f 'repeat-number-repeat-any-f '() '(1)) (compiled-test repeat-number-repeat-any-f 'repeat-number-repeat-any-f '(1 2 (3 4 5)) '(1)) (compiled-test repeat-number-repeat-any-f 'repeat-number-repeat-any-f '1 '()) (compiled-test repeat-repeat-number_1-f 'repeat-repeat-number_1-f '() '(1)) (compiled-test repeat-repeat-number_1-f 'repeat-repeat-number_1-f '(()) '(1)) (compiled-test repeat-repeat-number_1-f 'repeat-repeat-number_1-f '(() ()) '(1)) (compiled-test true-false-f 'true-false-f #t '(1)) (compiled-test true-false-f 'true-false-f #f '(2)) (compiled-test true-false-f 'true-false-f 'true '()) (compiled-test variable-prefix-x-f 'variable-prefix-x-f 'x '(1)) (compiled-test variable-prefix-x-f 'variable-prefix-x-f 'xyz '(1)) (compiled-test variable-prefix-x-f 'variable-prefix-x-f 'zyx '()) (compiled-test variable-except-x-y-z-f 'variable-except-x-y-z-f 'x '()) (compiled-test variable-except-x-y-z-f 'variable-except-x-y-z-f 'y '()) (compiled-test variable-except-x-y-z-f 'variable-except-x-y-z-f 'z '()) (compiled-test variable-except-x-y-z-f 'variable-except-x-y-z-f 'xyz '(1)) ) (test)