racket/collects/tests/racklog/unit.rkt
2010-05-18 23:47:31 -04:00

561 lines
18 KiB
Racket

#lang racket
(require racklog
tests/eli-tester)
(test
; Unification tests
(test
#:failure-prefix "unify"
(local [(define-syntax-rule (once t1 t2)
(test (%which () (%= t1 t2)) => empty
(%more) => #f
(let ([tmp t1]) (%which () (%== tmp tmp))) => empty
(%more) => #f
(%which () (%let (f s) (%and (%freeze t1 f) (%melt f s) (%= s t2)))) => empty
(%more) => #f
(%which () (%let (f s) (%and (%freeze t1 f) (%melt-new f s) (%= s t2)))) => empty
(%more) => #f
(%which () (%let (s) (%and (%copy t1 s) (%= s t2)))) => empty
(%more) => #f))
(define-syntax-rule (constant t1)
(test (%which () (%constant t1)) => empty
(%more) => #f
(%which () (%compound t1)) => #f))
(define-syntax-rule (compound t1)
(test (%which () (%compound t1)) => empty
(%more) => #f
(%which () (%constant t1)) => #f))
(define-syntax-rule (never t1 t2)
(test (%which () (%= t1 t2)) => #f
(%which () (%== t1 t2)) => #f
(%which () (%let (f s) (%and (%freeze t1 f) (%melt f s) (%= s t2)))) => #f
(%which () (%let (f s) (%and (%freeze t1 f) (%melt-new f s) (%= s t2)))) => #f
(%which () (%let (s) (%and (%copy t1 s) (%= s t2)))) => #f))]
(once #t #t)
(once #f #f)
(never #f #t)
(never #t #f)
(constant #t)
(constant #f)
(once 1 1)
(never 1 2)
(constant 1)
(once "foo" "foo")
(never "foo" "bar")
(constant "foo")
(once #"foo" #"foo")
(never #"foo" #"bar")
(constant #"foo")
(once #\a #\a)
(never #\a #\b)
(constant #\a)
(once 'a 'a)
(never 'a 'b)
(constant 'a)
(let ([rx #rx"a"]) (once rx rx))
(never #rx"a" #rx"b")
(let ([rx #px"a"]) (once rx rx))
(never #px"a" #rx"b")
(let ([rx #rx#"a"]) (once rx rx))
(never #rx#"a" #rx#"b")
(let ([rx #px#"a"]) (once rx rx))
(never #px#"a" #px#"b")
(constant #rx"a")
(constant #px"a")
(constant #rx#"a")
(constant #px#"a")
(let ([a (string->keyword "a")]
[b (string->keyword "b")])
(once a a)
(never a b)
(constant a))
(once empty empty)
(never empty #f)
(constant empty)
(let ([a add1]
[b sub1])
(once a a)
(never a b)
(constant a))
(once (void) (void))
(never (void) #f)
(constant (void))
(once (cons 1 1) (cons 1 1))
(never (cons 1 2) (cons 1 1))
(never (cons 2 1) (cons 1 1))
(compound (cons 1 1))
(once (vector 1 1) (vector 1 1))
(never (vector 1) (vector 1 1))
(never (vector 1 2) (vector 1 1))
(never (vector 2 1) (vector 1 1))
(compound (vector 1 1))
(once (mcons 1 1) (mcons 1 1))
(never (mcons 1 2) (mcons 1 1))
(never (mcons 2 1) (mcons 1 1))
(compound (mcons 1 1))
(once (box 1) (box 1))
(never (box 2) (box 1))
(compound (box 1))
(local [(define-syntax-rule (hash-test hash)
(test
(once (hash 1 2) (hash 1 2))
(never (hash 2 2) (hash 1 2))
(never (hash 1 1) (hash 1 2))
(never (hash 1 1) (hash 2 2))
(compound (hash 1 2))))]
(hash-test (λ (k v) (make-hash (list (cons k v)))))
(hash-test (λ (k v) (make-hasheq (list (cons k v)))))
(hash-test (λ (k v) (make-hasheqv (list (cons k v)))))
(hash-test (λ (k v) (make-weak-hash (list (cons k v)))))
(hash-test (λ (k v) (make-weak-hasheq (list (cons k v)))))
(hash-test (λ (k v) (make-weak-hasheqv (list (cons k v)))))
(hash-test (λ (k v) (make-immutable-hash (list (cons k v)))))
(hash-test (λ (k v) (make-immutable-hasheq (list (cons k v)))))
(hash-test (λ (k v) (make-immutable-hasheqv (list (cons k v))))))
(local [(define-syntax-rule (set-test set)
(test
(once (set 1 2) (set 1 2))
(never (set 2 2) (set 1 2))
(never (set 1 1) (set 1 2))
(never (set 1 1) (set 2 2))
(constant (set 1 2))))]
(set-test set)
(set-test seteqv)
(set-test seteq))
(local [(define (cs-struct-test make-foo)
(once (make-foo 1 1) (make-foo 1 1))
(never (make-foo 2 1) (make-foo 1 1))
(never (make-foo 1 2) (make-foo 1 1))
(never (make-foo 2 2) (make-foo 1 1))
(compound (make-foo 1 1)))
(define (a-struct-test make-foo)
(never (make-foo 1 1) (make-foo 1 1))
(never (make-foo 2 1) (make-foo 1 1))
(never (make-foo 1 2) (make-foo 1 1))
(never (make-foo 2 2) (make-foo 1 1))
(constant (make-foo 1 1)))]
(local [(define-struct foo (x y))]
(test #:failure-prefix "default"
(a-struct-test make-foo)))
(local [(define-struct foo (x y) #:prefab)]
(test #:failure-prefix "prefab"
(cs-struct-test make-foo)))
(local [(define-struct foo (x y) #:transparent)]
(test #:failure-prefix "transparent"
(cs-struct-test make-foo)))
(local [(define another-inspector (make-inspector))
(define-struct foo (x y) #:inspector another-inspector)]
(test #:failure-prefix "child"
(cs-struct-test make-foo)))
(local [(define some-inspector (make-sibling-inspector))
(define another-inspector (make-inspector some-inspector))
(define-struct foo (x y) #:inspector another-inspector)]
(test #:failure-prefix "sibling -> child"
(a-struct-test make-foo))))))
(test
#:failure-prefix "unify + logic var"
(local [(define-syntax-rule (uni x v has-x has-v)
(test (%which (x) (%= has-x has-v)) => (list (cons 'x v))
(%more) => #f
(%which () (%let (x) (%var has-x))) => empty
(%more) => #f
(%which () (%var has-v)) => #f))
(define-syntax-rule (iduni ve)
(let ([v ve])
(uni x v x v)))
(define-syntax-rule (nouni x v has-x has-v)
(test (%which (x) (%= has-x has-v)) => #f
(%which () (%let (x) (%var has-x))) => #f
(%which () (%var has-v)) => #f))]
(iduni #t)
(iduni #f)
(iduni 1)
(iduni "foo")
(iduni #"foo")
(iduni #\a)
(iduni 'a)
(iduni #rx"a")
(iduni #px"a")
(iduni #rx#"a")
(iduni #px#"a")
(iduni (string->keyword "a"))
(iduni empty)
(iduni add1)
(iduni (void))
(uni x 1 (cons x 2) (cons 1 2))
(uni x 2 (cons 1 x) (cons 1 2))
(uni x 1 (vector x 2) (vector 1 2))
(uni x 2 (vector 1 x) (vector 1 2))
(uni x 1 (mcons x 2) (mcons 1 2))
(uni x 2 (mcons 1 x) (mcons 1 2))
(uni x 1 (box x) (box 1))
(local [(define-syntax-rule (hash-test hash)
(test
; Logic variables not allowed as hash keys
(nouni x 1 (hash x 2) (hash 1 2))
(uni x 2 (hash 1 x) (hash 1 2))))]
(hash-test (λ (k v) (make-hash (list (cons k v)))))
(hash-test (λ (k v) (make-hasheq (list (cons k v)))))
(hash-test (λ (k v) (make-hasheqv (list (cons k v)))))
(hash-test (λ (k v) (make-weak-hash (list (cons k v)))))
(hash-test (λ (k v) (make-weak-hasheq (list (cons k v)))))
(hash-test (λ (k v) (make-weak-hasheqv (list (cons k v)))))
(hash-test (λ (k v) (make-immutable-hash (list (cons k v)))))
(hash-test (λ (k v) (make-immutable-hasheq (list (cons k v)))))
(hash-test (λ (k v) (make-immutable-hasheqv (list (cons k v))))))
(nouni x 1 (set x) (set 1))
(local [(define (cs-struct-test make-foo)
(test (uni x 1 (make-foo x 2) (make-foo 1 2))
(uni x 2 (make-foo 1 x) (make-foo 1 2))))
(define (a-struct-test make-foo)
(test (nouni x 1 (make-foo x 2) (make-foo 1 2))
(nouni x 2 (make-foo 1 x) (make-foo 1 2))))]
(local [(define-struct foo (x y))]
(test #:failure-prefix "default"
(a-struct-test make-foo)))
(local [(define-struct foo (x y) #:prefab)]
(test #:failure-prefix "prefab"
(cs-struct-test make-foo)))
(local [(define-struct foo (x y) #:transparent)]
(test #:failure-prefix "transparent"
(cs-struct-test make-foo)))
(local [(define another-inspector (make-inspector))
(define-struct foo (x y) #:inspector another-inspector)]
(test #:failure-prefix "child"
(cs-struct-test make-foo)))
(local [(define some-inspector (make-sibling-inspector))
(define another-inspector (make-inspector some-inspector))
(define-struct foo (x y) #:inspector another-inspector)]
(test #:failure-prefix "sibling -> child"
(a-struct-test make-foo))))))
; Unit tests
(logic-var? (_))
(%which () (%/= 1 1)) => #f
(%which () (%/= 1 2)) => empty
(%more) => #f
(%which (x) (%/== x x)) => #f
(%which (x y) (%/== x y)) => `((x . _) (y . _))
(%more) => #f
(%which () (%/== 1 1)) => #f
(%which () (%/== 1 2)) => empty
(%more) => #f
(%which () (%< 1 2)) => empty
(%more) => #f
(%which () (%< 1 1)) => #f
(%which () (%< 2 1)) => #f
(%which () (%< 'a 2)) => #f
(%which () (%< 1 'b)) => #f
(%which () (%< 'a 'b)) => #f
(%which () (%<= 1 2)) => empty
(%more) => #f
(%which () (%<= 1 1)) => empty
(%more) => #f
(%which () (%<= 2 1)) => #f
(%which () (%<= 'a 2)) => #f
(%which () (%<= 1 'b)) => #f
(%which () (%<= 'a 'b)) => #f
(%which () (%= 1 1)) => empty
(%more) => #f
(%which () (%= 'a 'a)) => empty
(%more) => #f
(%which () (%= (cons 1 2) (cons 1 2))) => empty
(%more) => #f
(%which () (%= (vector 1 2) (vector 1 2))) => empty
(%more) => #f
(%which (x) (%= x 1)) => `((x . 1))
(%more) => #f
(%which (x) (%= (cons x 2) (cons 1 2))) => `((x . 1))
(%more) => #f
(%which (x) (%= (vector x 2) (vector 1 2))) => `((x . 1))
(%more) => #f
(%which (x) (%and (%= x 1) (%= x 2))) => #f
(%which () (%= 1 2)) => #f
(%which () (%=/= 1 1)) => #f
(%which () (%=/= 'a 'a)) => #f
(%which () (%=/= 1 2)) => empty
(%more) => #f
(%which () (%=:= 1 1)) => empty
(%more) => #f
(%which () (%=:= 'a 'a)) => #f
(%which () (%=:= 1 2)) => #f
(%which () (%== 1 1)) => empty
(%more) => #f
(%which (x) (%== x x)) => `((x . _))
(%more) => #f
(%which (x) (%== (cons 1 x) (cons 1 x))) => `((x . _))
(%more) => #f
; XXX This answer seems wrong
(%which (x) (%and (%= x 1) (%== x 1))) => `((x . 1))
(%more) => #f
; XXX This answer seems wrong
(%which (x y) (%and (%= x 1) (%= y 1) (%== x y))) => `((x . 1) (y . 1))
(%more) => #f
(%which (x y) (%== x y)) => #f
(%which (x y) (%== (cons 1 x) (cons y 2))) => #f
(%which () (%> 2 1)) => empty
(%more) => #f
(%which () (%> 1 1)) => #f
(%which () (%> 1 2)) => #f
(%which () (%> 'a 2)) => #f
(%which () (%> 1 'b)) => #f
(%which () (%> 'a 'b)) => #f
(%which () (%>= 2 1)) => empty
(%more) => #f
(%which () (%>= 1 1)) => empty
(%more) => #f
(%which () (%>= 1 2)) => #f
(%which () (%>= 'a 2)) => #f
(%which () (%>= 1 'b)) => #f
(%which () (%>= 'a 'b)) => #f
(%which () (%and %true %true)) => empty
(%more) => #f
(%which () (%and %fail %true)) => #f
(%more) => #f
(%which () (%append empty empty empty)) => empty
(%more) => #f
(%which () (%append (list 1) empty (list 1))) => empty
(%more) => #f
(%which () (%append empty (list 2) (list 2))) => empty
(%more) => #f
(%which () (%append (list 1) (list 2) (list 1 2))) => empty
(%more) => #f
(let ([rel %empty-rel])
(test (%which (y) (rel 'x y)) => #f
(%assert! rel () [('x 1)])
(%which (y) (rel 'x y)) => `([y . 1])
(%more) => #f
(%assert-after! rel () [('x 2)])
(%which (y) (rel 'x y)) => `([y . 2])
(%more) => `([y . 1])
(%more) => #f
(%assert! rel () [('x 3)])
(%which (y) (rel 'x y)) => `([y . 2])
(%more) => `([y . 1])
(%more) => `([y . 3])
(%more) => #f))
(%which (y) (%let (x) (%bag-of x (%or (%= x 1) (%= x 1) (%= x 2)) y))) => `([y . (1 1 2)])
(%more) => #f
; XXX I don't know a program that would get these outputs
;(%which (y) (%let (x) (%bag-of x XXX y))) => `([y . ()])
(%more) => #f
(%which (y) (%let (x) (%bag-of-1 x (%or (%= x 1) (%= x 1) (%= x 2)) y))) => `([y . (1 1 2)])
(%more) => #f
; XXX I don't know a program that would get these outputs
;(%which (y) (%let (x) (%bag-of-1 x XXX y))) => #f
(%which () (%compound (cons 1 1))) => empty
(%more) => #f
(%which () (%compound (vector 1 1))) => empty
(%more) => #f
(%which () (%let (x) (%and (%= x (cons 1 1)) (%compound x)))) => empty
(%more) => #f
(%which () (%compound 1)) => #f
(%which () (%compound "1")) => #f
(%which () (%compound '1)) => #f
(%which () (%compound empty)) => #f
(%which () (%constant (cons 1 1))) => #f
(%which () (%constant (vector 1 1))) => #f
(%which () (%let (x) (%and (%= x 1) (%constant x)))) => empty
(%more) => #f
(%which () (%constant 1)) => empty
(%more) => #f
(%which () (%constant "1")) => empty
(%more) => #f
(%which () (%constant '1)) => empty
(%more) => #f
(%which () (%constant empty)) => empty
(%more) => #f
(%which (x) (%let (y) (%and (%copy x y) (%= y 1)))) => `([x . _])
(%more) => #f
! =error> "syntactically"
(%which () (%cut-delimiter %true)) => empty
(%more) => #f
(%which () (%cut-delimiter !)) => empty
(%more) => #f
(%which () (%cut-delimiter %fail)) => #f
(%which () (%or %true %true)) => empty
(%more) => empty
(%more) => #f
(%which () (%cut-delimiter (%or (%and ! %true) %true))) => empty
(%more) => #f
(%which () (%empty-rel 1 1)) => #f
(%which () %fail) => #f
; %free-vars example from documentation
(local [(define %knows
(%rel ()
[('Odysseus 'TeX)]
[('Odysseus 'Scheme)]
[('Odysseus 'Prolog)]
[('Odysseus 'Penelope)]
[('Penelope 'TeX)]
[('Penelope 'Prolog)]
[('Penelope 'Odysseus)]
[('Telemachus 'TeX)]
[('Telemachus 'calculus)]))]
(test (%which (someone things-known)
(%let (x)
(%set-of x (%knows someone x)
things-known)))
=>
`((someone . _) (things-known TeX Scheme Prolog Penelope Odysseus calculus))
(%more) => #f
(%which (someone things-known)
(%let (x)
(%bag-of x
(%free-vars (someone)
(%knows someone x))
things-known)))
=>
`((someone . Odysseus) (things-known TeX Scheme Prolog Penelope))
(%more) =>
`((someone . Penelope) (things-known TeX Prolog Odysseus))
(%more) =>
`((someone . Telemachus) (things-known TeX calculus))
(%more) =>
#f))
(%which (x) (%let (y) (%and (%freeze x y) (%nonvar y)))) => `([x . _])
(%which () (%if-then-else %true %true %true)) => empty
(%more) => #f
(%which () (%if-then-else %true %fail %true)) => #f
(%which () (%if-then-else %fail %true %true)) => empty
(%more) => #f
(%which (x) (%is x (* 6 7))) => `([x . 42])
(%more) => #f
(%which (x) (%let (y) (%and (%= y 7) (%is x (* 6 y))))) => `([x . 42])
(%more) => #f
(%which () (%let (x) (%= x x))) => empty
(%more) => #f
(%which (x) (%let (y z) (%and (%freeze x y) (%melt y z) (%= z 1)))) => `([x . 1])
(%more) => #f
(%which (x) (%let (y z) (%and (%freeze x y) (%melt-new y z) (%= z 1)))) => `([x . _])
(%more) => #f
(%which () (%member 3 (list 1 2 3))) => empty
(%more) => #f
(%which () (%member 3 (list 1 2 3 3))) => empty
(%more) => empty
(%more) => #f
(%which () (%member 3 (list 1 2))) => #f
(%which () (%let (x) (%nonvar x))) => #f
(%which () (%let (x) (%nonvar (cons 1 x)))) => #f
(%which () (%let (x) (%nonvar (vector x)))) => #f
(%which () (%let (x) (%nonvar 1))) => empty
(%more) => #f
(%which () (%let (x) (%and (%= x 1) (%nonvar x)))) => empty
(%more) => #f
(%which () (%not %true)) => #f
(%which () (%not %fail)) => empty
(%more) => #f
(%which () (%or %true %true)) => empty
(%more) => empty
(%more) => #f
(%which () (%or %true %fail %true)) => empty
(%more) => empty
(%more) => #f
(let ([rel (%rel () [(1)] [(2) %fail])])
(test (%which () (rel 1)) => empty
(%more) => #f
(%which () (rel 2)) => #f))
(let ([rel (%rel () [(1) !] [(1) (%repeat)])])
(test (%which () (rel 1)) => empty
(%more) => #f))
(local [(define (many-%more n)
(if (zero? n)
empty
(and (%more)
(many-%more (sub1 n)))))]
(test (%which () (%repeat)) => empty
(many-%more (random 50)) => empty))
(parameterize ([use-occurs-check? #f])
(%which () (%let (x) (%= x (cons 1 x)))))
=> empty
(parameterize ([use-occurs-check? #t])
(%which () (%let (x) (%= x (cons 1 x)))))
=> #f
(%which (y) (%let (x) (%set-of x (%or (%= x 1) (%= x 1) (%= x 2)) y))) => `([y . (1 2)])
(%more) => #f
; XXX I don't know a program that would get these outputs
;(%which (y) (%let (x) (%set-of x XXX y))) => `([y . ()])
(%more) => #f
(%which (y) (%let (x) (%set-of-1 x (%or (%= x 1) (%= x 1) (%= x 2)) y))) => `([y . (1 2)])
(%more) => #f
; XXX I don't know a program that would get these outputs
;(%which (y) (%let (x) (%set-of-1 x XXX y))) => #f
(%which () %true) => empty
(%more) => #f
(%which () (%let (x) (%var x))) => empty
(%more) => #f
(%which () (%let (x) (%var (cons 1 x)))) => empty
(%more) => #f
(%which () (%let (x) (%var (vector x)))) => empty
(%more) => #f
(%which () (%let (x) (%var 1))) => #f
(%which () (%let (x) (%and (%= x 1) (%var x)))) => #f
)