194 lines
10 KiB
Racket
194 lines
10 KiB
Racket
#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)
|