Check-in [d33f642607]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Made a 'datalog::database' class that instantiates a FDDD database integrated with the Datalog compiler, and a 'datalogMethod' command to introduce an instance method (representing a Datalog program) on such a database.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:d33f6426077c40eafaafca787d558d3dfc272066
User & Date: kbk 2014-11-23 21:54:52
Context
2015-01-10
04:18
Remove debug prints left in inadvertently. check-in: 2a326f8369 user: kbk tags: trunk
2014-11-23
21:54
Made a 'datalog::database' class that instantiates a FDDD database integrated with the Datalog compiler, and a 'datalogMethod' command to introduce an instance method (representing a Datalog program) on such a database. check-in: d33f642607 user: kbk tags: trunk
2014-10-26
04:09
Adjust Datalog tests to cover EQUALITY check-in: c991aa8ae7 user: kbk tags: trunk
Changes

Changes to library/datalog.tcl.

6
7
8
9
10
11
12


13
14
15
16
17
18
19
....
2025
2026
2027
2028
2029
2030
2031
2032















2033
# Copyright (c) 2013 by Kevin B. Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------



package require Tcl 8.6
package require tclbdd 0.1
package require tclbdd::fddd 0.1
package require coroutine::corovar 1.0
package require coroutine::iterator 1.0
package require grammar::aycock 1.0

................................................................................

	$program destroy

    }
    return $result

}
















package provide tclbdd::datalog 0.1







>
>







 








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
# Copyright (c) 2013 by Kevin B. Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

puts "START: [info script]"

package require Tcl 8.6
package require tclbdd 0.1
package require tclbdd::fddd 0.1
package require coroutine::corovar 1.0
package require coroutine::iterator 1.0
package require grammar::aycock 1.0

................................................................................

	$program destroy

    }
    return $result

}

puts "DEFINE: bdd::datalog::database"
oo::class create bdd::datalog::database {
    superclass ::bdd::fddd::database

    constructor {args} {
	next {*}$args
    }

    method datalogMethod {name arglist args} {
	oo::objdefine [self] method $name $arglist \
	    [bdd::datalog::compileProgram [self] {*}$args]
    }
    
}

package provide tclbdd::datalog 0.1

Changes to tests/datalog.test.

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
134
135
136
137
...
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166

167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191

192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
...
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
# Copyright (c) 2014 by Kevin B. Kenny.

package require tcltest 2
namespace import -force ::tcltest::test
loadTestedCommands
package require tclbdd::datalog





proc init0 {} {
    variable people
    variable p
    set i 0
    set people {
	Andrew Anne Beatrice Charles Edward
	Elizabeth Eugenie George Harry
	James Louise William
    }
    foreach x $people {
	set p($x) $i
	incr i
    }	
    bdd::fddd::database create db \
	[bdd::fddd::interleave \
	     [bdd::fddd::domain p1 5 bigendian] \
	     [bdd::fddd::domain p2 5 bigendian] \
	     [bdd::fddd::domain p3 5 bigendian]]
    db relation isParentOf p1 p2
    db relation isGrandparentOf p1 p2
}

proc init1 {} {
    variable p
    init0
    interp alias {} loadIsParentOf {} {*}[db loader isParentOf]
    foreach {parent child} {
	Elizabeth Charles	Elizabeth Anne		Elizabeth Andrew
	Elizabeth Edward	Charles William		Charles Harry
	Andrew Beatrice		Andrew Eugenie		Edward Louise
................................................................................
	Edward James		William George
    } {
	loadIsParentOf $p($parent) $p($child)
    }
    rename loadIsParentOf {}
}

proc fini0 {} {
    variable people
    variable p
    db destroy
    catch {unset p}
    catch {unset people}
}
proc fini1 {} {
    fini0
}

test datalog-1.1 {assert a single fact and enumerate over it} {*}{
    -setup init0
    -body {
	proc t {parent child} [bdd::datalog::compileProgram db {
	} {
	    isParentOf($parent,$child).
	} {
	}]
	t $p(Elizabeth) $p(Charles)
	t $p(Charles) $p(William)
	set result {}
	db enumerate d isParentOf {
	    dict lappend result \
		[lindex $people [dict get $d p1]] \
		[lindex $people [dict get $d p2]]
	}
	list [dict get $result Elizabeth] [dict get $result Charles]
    }
    -result {Charles William}
    -cleanup fini0
}

test datalog-1.2 {assert a fact with a free var and enumerate over it} {*}{
    -setup init0
    -body {
	proc t {parent} [bdd::datalog::compileProgram db {
	} {
	    isParentOf($parent, _).
	} {
	}]

	t $p(Elizabeth)
	set result {}
	foreach name $people {
	    dict set need $name {}
	}
	db enumerate d isParentOf {
	    set p1 [dict get $d p1]
	    set name1 [lindex $people $p1]
	    set p2 [dict get $d p2]
	    if {$p2 >= [llength $people]} {
		set name2 $p2
	    } else {
		set name2 [lindex $people $p2]
	    }
	    lappend result $name1 $name2
	    if {$name1 ne {Elizabeth}} {
		return -level 0 -code error "Spurious parent $name1"
	    } else {
		dict unset need $name2
	    }
	}
	set need
    }
    -result {}
    -cleanup fini0
}

test datalog-1.3 {assert two facts} {*}{
    -setup init0
    -body {
	proc t {parent} [bdd::datalog::compileProgram db {
	} {
	    isParentOf(31, $parent).
	    "isParentOf"($parent, 30).
	} {
	}]

	t $p(Elizabeth)
	set result {}
	set need {}
	dict set need 31 $p(Elizabeth) {}
	dict set need $p(Elizabeth) 30 {}
	db enumerate d isParentOf {
	    set p1 [dict get $d p1]
	    set p2 [dict get $d p2]
	    if {[dict exists $need $p1 $p2]} {
		dict unset need $p1 $p2
	    } else {
		return -code error -level 0 "Spurious: $p1 $p2"
................................................................................
	    dict for {p2 -} $d {
		return -code error -level 0 "Missing: $p1 $p2"
	    }
	}
	concat
    }
    -result {}
    -cleanup fini0
}

test datalog-2.1 {simple query} {*}{
    -setup init1
    -body {
	proc t {parent} [bdd::datalog::compileProgram db {
	    variable p
	    variable people
	    set p1 $p($parent)
	    set results {}
	} {
	    isParentOf($p1,p2)?
	} d {
	    lappend results [lindex $people [dict get $d p2]]
	} {
	    return [lsort $results]
	}]

	t Elizabeth
    }
    -cleanup fini1
    -result {Andrew Anne Charles Edward}
}

test datalog-3.1 {trivial rule} {
    -setup {
	init1
	db relation resultSet p2
    }
    -body {
	proc t {parent} [bdd::datalog::compileProgram db {
	    variable p
	    variable people
	    set p1 $p($parent)
	    set results {}
	} {
	    resultSet(p2) :- isParentOf($p1, p2).
	    resultSet(p2)?
	} d {
	    lappend results [lindex $people [dict get $d p2]]
	} {
	    lsort $results
	}]

	t Elizabeth
    }
    -cleanup fini1
    -result {Andrew Anne Charles Edward}
}

test datalog-3.2 {rule with inequality} {
    -setup {
	init1
	db relation isSiblingOf p1 p2
    }
    -body {
	proc t {} [bdd::datalog::compileProgram db {
	    variable p
	    variable people
	    set results {}
	} {
	    isSiblingOf(p1,p2) :- isParentOf(p3,p1), isParentOf(p3,p2), p1!=p2.
	    isSiblingOf(p1,p2)?
	} d {
	    lappend results \
		[lsort [list \
			    [lindex $people [dict get $d p1]] \
			    [lindex $people [dict get $d p2]]]]
	} {
	    lsort -unique $results
	}]
	t
    }
    -cleanup fini1
    -result {{Andrew Anne} {Andrew Charles} {Andrew Edward} {Anne Charles} {Anne Edward} {Beatrice Eugenie} {Charles Edward} {Harry William} {James Louise}}

}

test datalog-3.3 {rule with NOT} {*}{
    -setup {
	init1
	db relation hasParent p2
	db relation hasNoParent p2
    }
    -body {
	proc t {} [bdd::datalog::compileProgram db {
	    variable p
	    variable people
	    set results {}
	} {
	    hasParent(p2) :- isParentOf(_, p2).
	    hasNoParent(p2) :- !hasParent(p2).
	    hasNoParent(p2) ?
	} d {
	    set p2 [dict get $d p2]
	    if {$p2 < [llength $people]} {
		lappend result [lindex $people $p2]
	    }
	} {
	    lsort $result
	}]
	t
    }
    -cleanup fini1
    -result Elizabeth
}

test datalog-4.1 {simple recursion} {*}{
    -setup {
	init1
	db relation isAncestorOf p1 p2
    }
    -body {
	proc t {who} [bdd::datalog::compileProgram db {
	    variable p
	    variable people
	    set results {}
	    set p2 $p($who)
	} {
	    isAncestorOf(p1,p2) :- p1 = p2.
	    isAncestorOf(p1,p2) :- isParentOf(p1,p3), isAncestorOf(p3,p2).
	    isAncestorOf(p1, $p2) ?
	} d {
................................................................................
		lappend result [lindex $people $p1]
	    }
	} {
	    lsort $result
	}]
	t George
    }
    -cleanup fini1
    -result {Charles Elizabeth George William}
}

cleanupTests
return

# Local Variables:
# mode: tcl
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:







>
>
>
>
|












|








|







 







|






|




|

|



|
|
|



|
|




|



|

|



<
>
|

|




|

|


|











|



|

|




<
>
|


|
|







 







|



|

|
|
|





|


<
>
|

|





|



|
|
|









<
>
|

|





|



|
|
|











|
|
|
|






|




|
|
|












|
|
|
|





|




|
|







 







|











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
134
135
136
137
138
139
140
141
...
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169

170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194

195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
# Copyright (c) 2014 by Kevin B. Kenny.

package require tcltest 2
namespace import -force ::tcltest::test
loadTestedCommands
package require tclbdd::datalog

namespace eval test {
    namespace export init0 init1 fini0 fini1
}

proc test::init0 {} {
    variable people
    variable p
    set i 0
    set people {
	Andrew Anne Beatrice Charles Edward
	Elizabeth Eugenie George Harry
	James Louise William
    }
    foreach x $people {
	set p($x) $i
	incr i
    }	
    bdd::datalog::database create ::db \
	[bdd::fddd::interleave \
	     [bdd::fddd::domain p1 5 bigendian] \
	     [bdd::fddd::domain p2 5 bigendian] \
	     [bdd::fddd::domain p3 5 bigendian]]
    db relation isParentOf p1 p2
    db relation isGrandparentOf p1 p2
}

proc test::init1 {} {
    variable p
    init0
    interp alias {} loadIsParentOf {} {*}[db loader isParentOf]
    foreach {parent child} {
	Elizabeth Charles	Elizabeth Anne		Elizabeth Andrew
	Elizabeth Edward	Charles William		Charles Harry
	Andrew Beatrice		Andrew Eugenie		Edward Louise
................................................................................
	Edward James		William George
    } {
	loadIsParentOf $p($parent) $p($child)
    }
    rename loadIsParentOf {}
}

proc test::fini0 {} {
    variable people
    variable p
    db destroy
    catch {unset p}
    catch {unset people}
}
proc test::fini1 {} {
    fini0
}

test datalog-1.1 {assert a single fact and enumerate over it} {*}{
    -setup test::init0
    -body {
	db datalogMethod t {parent child} {
	} {
	    isParentOf($parent,$child).
	} {
	}
	db t $::test::p(Elizabeth) $::test::p(Charles)
	db t $::test::p(Charles) $::test::p(William)
	set result {}
	db enumerate d isParentOf {
	    dict lappend result \
		[lindex $::test::people [dict get $d p1]] \
		[lindex $::test::people [dict get $d p2]]
	}
	list [dict get $result Elizabeth] [dict get $result Charles]
    }
    -result {Charles William}
    -cleanup test::fini0
}

test datalog-1.2 {assert a fact with a free var and enumerate over it} {*}{
    -setup test::init0
    -body {
	db datalogMethod t {parent} {
	} {
	    isParentOf($parent, _).
	} {

	}
	db t $::test::p(Elizabeth)
	set result {}
	foreach name $::test::people {
	    dict set need $name {}
	}
	db enumerate d isParentOf {
	    set p1 [dict get $d p1]
	    set name1 [lindex $::test::people $p1]
	    set p2 [dict get $d p2]
	    if {$p2 >= [llength $::test::people]} {
		set name2 $p2
	    } else {
		set name2 [lindex $::test::people $p2]
	    }
	    lappend result $name1 $name2
	    if {$name1 ne {Elizabeth}} {
		return -level 0 -code error "Spurious parent $name1"
	    } else {
		dict unset need $name2
	    }
	}
	set need
    }
    -result {}
    -cleanup test::fini0
}

test datalog-1.3 {assert two facts} {*}{
    -setup test::init0
    -body {
	db datalogMethod t {parent} {
	} {
	    isParentOf(31, $parent).
	    "isParentOf"($parent, 30).
	} {

	}
	db t $::test::p(Elizabeth)
	set result {}
	set need {}
	dict set need 31 $::test::p(Elizabeth) {}
	dict set need $::test::p(Elizabeth) 30 {}
	db enumerate d isParentOf {
	    set p1 [dict get $d p1]
	    set p2 [dict get $d p2]
	    if {[dict exists $need $p1 $p2]} {
		dict unset need $p1 $p2
	    } else {
		return -code error -level 0 "Spurious: $p1 $p2"
................................................................................
	    dict for {p2 -} $d {
		return -code error -level 0 "Missing: $p1 $p2"
	    }
	}
	concat
    }
    -result {}
    -cleanup test::fini0
}

test datalog-2.1 {simple query} {*}{
    -setup test::init1
    -body {
	db datalogMethod t {parent} {
	    variable ::test::p
	    variable ::test::people
	    set p1 $p($parent)
	    set results {}
	} {
	    isParentOf($p1,p2)?
	} d {
	    lappend results [lindex $::test::people [dict get $d p2]]
	} {
	    return [lsort $results]

	}
	db t Elizabeth
    }
    -cleanup test::fini1
    -result {Andrew Anne Charles Edward}
}

test datalog-3.1 {trivial rule} {
    -setup {
	test::init1
	db relation resultSet p2
    }
    -body {
	db datalogMethod t {parent} {
	    variable ::test::p
	    variable ::test::people
	    set p1 $p($parent)
	    set results {}
	} {
	    resultSet(p2) :- isParentOf($p1, p2).
	    resultSet(p2)?
	} d {
	    lappend results [lindex $people [dict get $d p2]]
	} {
	    lsort $results

	}
	db t Elizabeth
    }
    -cleanup test::fini1
    -result {Andrew Anne Charles Edward}
}

test datalog-3.2 {rule with inequality} {
    -setup {
	test::init1
	db relation isSiblingOf p1 p2
    }
    -body {
	db datalogMethod t {} {
	    variable ::test::p
	    variable ::test::people
	    set results {}
	} {
	    isSiblingOf(p1,p2) :- isParentOf(p3,p1), isParentOf(p3,p2), p1!=p2.
	    isSiblingOf(p1,p2)?
	} d {
	    lappend results \
		[lsort [list \
			    [lindex $people [dict get $d p1]] \
			    [lindex $people [dict get $d p2]]]]
	} {
	    lsort -unique $results
	}
	db t
    }
    -cleanup test::fini1
    -result {{Andrew Anne} {Andrew Charles} {Andrew Edward} {Anne Charles} {Anne Edward} {Beatrice Eugenie} {Charles Edward} {Harry William} {James Louise}}

}

test datalog-3.3 {rule with NOT} {*}{
    -setup {
	test::init1
	db relation hasParent p2
	db relation hasNoParent p2
    }
    -body {
	db datalogMethod t {} {
	    variable ::test::p
	    variable ::test::people
	    set results {}
	} {
	    hasParent(p2) :- isParentOf(_, p2).
	    hasNoParent(p2) :- !hasParent(p2).
	    hasNoParent(p2) ?
	} d {
	    set p2 [dict get $d p2]
	    if {$p2 < [llength $people]} {
		lappend result [lindex $people $p2]
	    }
	} {
	    lsort $result
	}
	db t
    }
    -cleanup test::fini1
    -result Elizabeth
}

test datalog-4.1 {simple recursion} {*}{
    -setup {
	test::init1
	db relation isAncestorOf p1 p2
    }
    -body {
	proc t {who} [bdd::datalog::compileProgram db {
	    variable ::test::p
	    variable ::test::people
	    set results {}
	    set p2 $p($who)
	} {
	    isAncestorOf(p1,p2) :- p1 = p2.
	    isAncestorOf(p1,p2) :- isParentOf(p1,p3), isAncestorOf(p3,p2).
	    isAncestorOf(p1, $p2) ?
	} d {
................................................................................
		lappend result [lindex $people $p1]
	    }
	} {
	    lsort $result
	}]
	t George
    }
    -cleanup test::fini1
    -result {Charles Elizabeth George William}
}

cleanupTests
return

# Local Variables:
# mode: tcl
# c-basic-offset: 4
# indent-tabs-mode: nil
# End: