-
-
Notifications
You must be signed in to change notification settings - Fork 5
/
racket-tests.lisp
88 lines (76 loc) · 3.76 KB
/
racket-tests.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
(in-package #:yacc-is-dead-tests)
(def-suite racket-tests
:description "Tests from the Racket implementation of YACC-IS-DEAD."
:in yacc-is-dead-tests)
(in-suite racket-tests)
(def-test simple ()
(let ((simple (~ 'a 'b)))
(is (eq nil (yacc-is-dead::nullablep simple)))))
(def-test xylist ()
(lazy-let ((xylist (choice (~ 'x yxlist)
(choice 'x *epsilon*)))
(yxlist (choice (~ 'y xylist)
'y)))
(is (eq t (yacc-is-dead::nullablep xylist)))
(is (eq nil (yacc-is-dead::nullablep yxlist)))
(is (eq t (recognizesp xylist '(x y x y))))))
(def-test alist ()
(lazy-let ((alist (choice (~ alist 'a) 'a))
(alist?? (choice (~ alist 'a) *epsilon*)))
(is (eq nil (yacc-is-dead::nullablep alist)))
(is (eq t (yacc-is-dead::nullablep alist??)))
(is (eq nil (recognizesp alist '(a a a b))))
(is (eq t (recognizesp alist '(a a a a))))))
(def-test rlist ()
(lazy-let ((rlist (choice (==> (~ 'r rlist)
(lambda (parse) (cons 'a (cdr parse))))
(eps (list nil)))))
(is (eq t (recognizesp rlist '(r r))))
(is (equal (yacc-is-dead::parse-derive 'r rlist) (yacc-is-dead::parse-derive 'r rlist)))
(is (equal (yacc-is-dead::parse-derive 'r (yacc-is-dead::parse-derive 'r rlist))
(yacc-is-dead::parse-derive 'r (yacc-is-dead::parse-derive 'r rlist))))
(is (equal (list '(a a))
(yacc-is-dead::parse-null (yacc-is-dead::parse-derive 'r
(yacc-is-dead::parse-derive 'r
rlist)))))
(is (equal (list '(a a a))
(yacc-is-dead::parse-null (yacc-is-dead::parse-derive
'r
(yacc-is-dead::parse-derive
'r
(yacc-is-dead::parse-derive 'r
rlist))))))
(is (equal (list '(a a a a a a a)) (parse rlist '(r r r r r r r))))))
(def-test nlist ()
(lazy-let ((nlist (choice (==> (~ (token #'integerp) nlist) #'identity)
(eps (list nil)))))
(is (equal (list '(1 2 3 4 5)) (parse nlist '(1 2 3 4 5))))))
(def-test llist ()
(lazy-let ((llist (choice (==> (~ llist (token #'symbolp))
(lambda (parse)
(append (car parse) (list (cdr parse)))))
(eps (list nil)))))
(is (equal (list '(a b c d e)) (parse llist '(a b c d e))))))
(def-test recognition ()
(lazy-let ((s (choice (~ s '+ s) 'n))
(good-input '(N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N))
(bad-input '(N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + N + + N)))
(is-true (time (recognizesp s good-input)))
(is-false (time (recognizesp s bad-input)))))
(defun make-sx-bench (n)
(loop for i from 0 to n collecting 'atom))
(defvar sxin
`(lp
lp lp lp lp lp lp lp lp lp lp
atom
rp rp rp rp rp rp rp rp rp rp
,@(make-sx-bench 100)
lp lp lp atom rp rp rp
rp))
(def-test benchmark ()
(lazy-let ((sx-list (choice (~ sx sx-list)
(eps '())))
(sx (choice (==> (~ 'lp sx-list 'rp)
(lambda (parse) (cadr parse)))
'atom)))
(time (parse sx-list sxin :compact #'compact))))