-
Notifications
You must be signed in to change notification settings - Fork 0
/
derivative.rkt
133 lines (109 loc) · 3.86 KB
/
derivative.rkt
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
#lang racket
(require rackunit)
(require "./util/constants.rkt")
(require "./util/predicates.rkt")
(require "./util/reducers.rkt")
(require "./util/structs.rkt")
(require "./delta.rkt")
(define (rhs-derivative grammar-hash rhs symbol [depth INITIAL-DEPTH] [max-depth MAX-DEPTH])
(define new-depth (+ depth 1))
(cond
((> depth max-depth) ∅)
((rhs-empty? rhs) ∅)
((rhs-invalid? rhs) ∅)
((match-terminal rhs (lambda (terminal)
(cond
((eq? terminal symbol) ε)
((empty? symbol) rhs)
(else ∅)))))
((match-non-terminal rhs (lambda (non-terminal)
(rhs-derivative grammar-hash (hash-ref grammar-hash non-terminal ∅) symbol new-depth max-depth))))
((match-seq rhs (lambda (rhs1 rhs2)
(alt (seq (rhs-derivative grammar-hash rhs1 symbol new-depth max-depth) rhs2)
(seq (rhs-delta grammar-hash rhs1 new-depth max-depth) (rhs-derivative grammar-hash rhs2 symbol new-depth max-depth))))))
((match-alt rhs (lambda (rhs1 rhs2)
(alt (rhs-derivative grammar-hash rhs1 symbol new-depth max-depth) (rhs-derivative grammar-hash rhs2 symbol new-depth max-depth)))))
(else ∅)
))
(test-case
"Exceeding depth should fail"
(check-equal? (rhs-derivative NOOP-GRAMMAR NOOP-RHS UNKNOWN EXCEEDING-DEPTH MAX-DEPTH) ∅)
)
(test-case
"d(a , a) = ε"
(check-equal? (rhs-derivative NOOP-GRAMMAR (T 'a) 'a) ε)
)
(test-case
"d(a , ε) = ∅"
(check-equal? (rhs-derivative NOOP-GRAMMAR (T 'a) ε) ∅)
)
(test-case
"d(a , b) = ∅"
(check-equal? (rhs-derivative NOOP-GRAMMAR (T 'a) 'b) ∅)
)
(test-case
"d(ab , a) = b"
(check-equal? (rhs-derivative NOOP-GRAMMAR (Seq (T 'a) (T 'b)) 'a) (T 'b))
)
(test-case
"d(εb , b) = ε"
(check-equal? (rhs-derivative NOOP-GRAMMAR (Seq ε (T 'b)) 'b) ε)
)
(test-case
"d(εa , b) = ∅"
(check-equal? (rhs-derivative NOOP-GRAMMAR (Seq ε (T 'a)) 'b) ∅)
)
(test-case
"d(ab , b) = ∅"
(check-equal? (rhs-derivative NOOP-GRAMMAR (Seq (T 'a) (T 'b)) 'b) ∅)
)
(test-case
"d(a|b , a) = ε"
(check-equal? (rhs-derivative NOOP-GRAMMAR (Alt (T 'a) (T 'b)) 'a) ε)
)
(test-case
"d(a|b , b) = ε"
(check-equal? (rhs-derivative NOOP-GRAMMAR (Alt (T 'a) (T 'b)) 'b) ε)
)
(test-case
"d(a|ε , a) = ε"
(check-equal? (rhs-derivative NOOP-GRAMMAR (Alt (T 'a) ε) 'a) ε)
)
(test-case
"d(a|ε , b) = ∅"
(check-equal? (rhs-derivative NOOP-GRAMMAR (Alt (T 'a) ε) 'b) ∅)
)
(test-case
"d(ab|cd , c) = d"
(check-equal? (rhs-derivative NOOP-GRAMMAR (Alt (Seq (T 'a) (T 'b)) (Seq (T 'c) (T 'd))) 'c) (T 'd))
)
(test-case
"A -> a AND d(A , a) = ε"
(check-equal? (rhs-derivative (reduce-production (list (Production (NT 'A) (T 'a)))) (NT 'A) 'a) ε)
)
(test-case
"A -> a AND d(A , b) = ∅"
(check-equal? (rhs-derivative (reduce-production (list (Production (NT 'A) (T 'a)))) (NT 'A) 'b) ∅)
)
(test-case
"A -> ab AND d(A , a) = b"
(check-equal? (rhs-derivative (reduce-production (list (Production (NT 'A) (Seq (T 'a) (T 'b))))) (NT 'A) 'a) (T 'b))
)
(test-case
"A -> Bc, B -> ab AND d(AB , a) = bcB"
(check-equal? (rhs-derivative
(reduce-production (list
(Production (NT 'A) (Seq (NT 'B) (T 'c)))
(Production (NT 'B) (Seq (T 'a) (T 'b)))
))
(Seq (NT 'A) (NT 'B)) 'a) (Seq (Seq (T 'b) (T 'c)) (NT 'B)))
)
(test-case
"A -> ab AND d(B , a) = ∅"
(check-equal? (rhs-derivative (reduce-production (list (Production (NT 'A) (Seq (T 'a) (T 'b))))) (NT 'B) 'a) ∅)
)
(test-case
"A -> Aa AND d(A , a) = ∅"
(check-equal? (rhs-derivative (reduce-production (list (Production (NT 'A) (Seq (NT 'A) (T 'a))))) (NT 'A) 'a) ∅)
)
(provide rhs-derivative)