tclbdd

Check-in [824a0d10b3]
Login

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

Overview
Comment:more compiler development, most of the way through doing intermediate code for rules
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:824a0d10b303710f7d30e3b14462e35c3f5d2860
User & Date: kbk 2014-01-08 03:10:00
Context
2014-01-08
03:47
more compiler development, most of the way through doing intermediate code for rules check-in: f935c63420 user: kbk tags: trunk
03:10
more compiler development, most of the way through doing intermediate code for rules check-in: 824a0d10b3 user: kbk tags: trunk
2014-01-06
12:17
More compiler development - part of the procedures to translate Datalog to relational algebra. check-in: 7636e8a432 user: kbk tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to examples/loadProgram.tcl.

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
	     [bdd::fddd::domain v $vbits bigendian] \
	     [bdd::fddd::interleave \
		  [bdd::fddd::domain st  $stbits bigendian] \
		  [bdd::fddd::domain st2 $stbits bigendian] \
		  [bdd::fddd::domain st3 $stbits bigendian]]]
    
    $db relation reads st v
    $db relation writes st v
    $db relation seq st st2

    interp alias {} loadReads {} {*}[$db loader reads]
    interp alias {} loadWrites {} {*}[$db loader writes]
    interp alias {} loadSeq {} {*}[$db loader seq]

    # pass 2 - discover 'reads', 'writes', 'seq' relations
    pass2 db $program $vars $labels

    # Return the variable dictionary, since it is not readily recoverable

    return $vars
}







|
|


|
|








87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
	     [bdd::fddd::domain v $vbits bigendian] \
	     [bdd::fddd::interleave \
		  [bdd::fddd::domain st  $stbits bigendian] \
		  [bdd::fddd::domain st2 $stbits bigendian] \
		  [bdd::fddd::domain st3 $stbits bigendian]]]
    
    $db relation reads st v
    $db relation writes0 st v
    $db relation seq0 st st2

    interp alias {} loadReads {} {*}[$db loader reads]
    interp alias {} loadWrites {} {*}[$db loader writes0]
    interp alias {} loadSeq {} {*}[$db loader seq0]

    # pass 2 - discover 'reads', 'writes', 'seq' relations
    pass2 db $program $vars $labels

    # Return the variable dictionary, since it is not readily recoverable

    return $vars
}

Changes to examples/reach.tcl.

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
# proc profile args {}

source [file join [file dirname [info script]] program1.tcl]

set vars [analyzeProgram $program db]

profile db reads
profile db writes
profile db seq

#############################################################################

# PROPOSED OBJECT CODE OF A DATALOG PROGRAM

# flowspast(v,st,st2) means: Control may pass from the end of
# instruction 'st1' to the start of instruction 'st2' without
# assigning to the variable 'v'.  Note how the induction case
# recurses twice into 'flowspast' rather than using 'seq'. This
# means that the path length of the 'flowpast' relation can
# roughly double on each pass, meaning that the number of passes
# in the iteration-to-convergence is only logarithmic in the
# length of the longest loop in the program.

# reach(v,st,st2) means: "The use of variable v at instruction st2
# might see the assignment to variable v at instruction st1"

# Reachability: relation definitions that might be generated by a Datalog
# compiler.

db relation t10 v;		# The universal set of variables
db relation t11 v st3;		# writes(v, st3)
db relation t12 v st st3;	# flowspast(v, st, st3)
db relation t13 v st st3;	# flowspast(v, st, st3),!writes(st3,v)
db relation t14 v st2 st3;	# flowspast(v, st3, st2)
db relation t15 v st st2 st3;	# flowspast(v, st, st3),
				# !writes(st3,v),
				# flowspast(v, st3, st2)
db relation t16 v st st2;	# project{v,st,st2}(t15)
db relation t17 v st st2;	# writes(st,v),flowspast(v,st,st2)
db relation t18 v st2;		# reads(st2,v)

db relation flowspast v st st2
db relation flowspast' v st st2
db relation reaches v st st2

# Reachability: code that might be generated by a Datalog compiler

proc reachability {} [subst {

    ### input: reads(st,v)
    ### input: writes(st,v)
    ### input: seq(st,st2)
    ### output: flowspast(v,st,st2)
    ### output: reaches(v,st,st2)

    ### flowspast(v,st,st2) :- seq(st,st2)
    
    [db set t10 _]
    [db join flowspast seq t10]; 		profile db flowspast

    ### flowspast(v,st,st2) :- flowspast(v,st,st3),
    ###                        !writes(st3,v),
    ###                        flowspast(v,st3,st2)

    [db replace t11 writes st3 st]; # invariant code hoisted out of loop
    [db set flowspast' {}]
    while {!\[[db === flowspast flowspast']\]} {
	[db set flowspast' flowspast]
	[db replace t12 flowspast st3 st2];	profile db t12
	[db antijoin t13 t12 t11]; 		profile db t13
	[db replace t14 flowspast st3 st];	profile db t14
	[db join t15 t13 t14];			profile db t15
	[db project t16 t15];			profile db t16
	[db union flowspast flowspast' t16];	profile db flowspast
    }

    ### reaches(v,st,st2) :- writes(st,v),
    ###                      flowspast(v,st,st2),
    ###                      reads(st2,v)

    [db join t17 writes flowspast]; 		profile db t17
    [db replace t18 reads st2 st]; 		profile db t18
    [db join reaches t17 t18];			profile db reaches

}]

#############################################################################








|
|








|












|

|


|


|











|
|



|


|


|


|











|



|







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
# proc profile args {}

source [file join [file dirname [info script]] program1.tcl]

set vars [analyzeProgram $program db]

profile db reads
profile db writes0
profile db seq0

#############################################################################

# PROPOSED OBJECT CODE OF A DATALOG PROGRAM

# flowspast(v,st,st2) means: Control may pass from the end of
# instruction 'st1' to the start of instruction 'st2' without
# assigning to the variable 'v'.  Note how the induction case
# recurses twice into 'flowspast' rather than using 'seq0'. This
# means that the path length of the 'flowpast' relation can
# roughly double on each pass, meaning that the number of passes
# in the iteration-to-convergence is only logarithmic in the
# length of the longest loop in the program.

# reach(v,st,st2) means: "The use of variable v at instruction st2
# might see the assignment to variable v at instruction st1"

# Reachability: relation definitions that might be generated by a Datalog
# compiler.

db relation t10 v;		# The universal set of variables
db relation t11 v st3;		# writes0(v, st3)
db relation t12 v st st3;	# flowspast(v, st, st3)
db relation t13 v st st3;	# flowspast(v, st, st3),!writes0(st3,v)
db relation t14 v st2 st3;	# flowspast(v, st3, st2)
db relation t15 v st st2 st3;	# flowspast(v, st, st3),
				# !writes0(st3,v),
				# flowspast(v, st3, st2)
db relation t16 v st st2;	# project{v,st,st2}(t15)
db relation t17 v st st2;	# writes0(st,v),flowspast(v,st,st2)
db relation t18 v st2;		# reads(st2,v)

db relation flowspast v st st2
db relation flowspast' v st st2
db relation reaches v st st2

# Reachability: code that might be generated by a Datalog compiler

proc reachability {} [subst {

    ### input: reads(st,v)
    ### input: writes0(st,v)
    ### input: seq0(st,st2)
    ### output: flowspast(v,st,st2)
    ### output: reaches(v,st,st2)

    ### flowspast(v,st,st2) :- seq0(st,st2)
    
    [db set t10 _]
    [db join flowspast seq0 t10]; 		profile db flowspast

    ### flowspast(v,st,st2) :- flowspast(v,st,st3),
    ###                        !writes0(st3,v),
    ###                        flowspast(v,st3,st2)

    [db replace t11 writes0 st3 st]; # invariant code hoisted out of loop
    [db set flowspast' {}]
    while {!\[[db === flowspast flowspast']\]} {
	[db set flowspast' flowspast]
	[db replace t12 flowspast st3 st2];	profile db t12
	[db antijoin t13 t12 t11]; 		profile db t13
	[db replace t14 flowspast st3 st];	profile db t14
	[db join t15 t13 t14];			profile db t15
	[db project t16 t15];			profile db t16
	[db union flowspast flowspast' t16];	profile db flowspast
    }

    ### reaches(v,st,st2) :- writes0(st,v),
    ###                      flowspast(v,st,st2),
    ###                      reads(st2,v)

    [db join t17 writes0 flowspast]; 		profile db t17
    [db replace t18 reads st2 st]; 		profile db t18
    [db join reaches t17 t18];			profile db reaches

}]

#############################################################################

Changes to library/datalog.tcl.

749
750
751
752
753
754
755
756

757

758
759
760
761
762
763
764

765
766
767
768
769
770
771
...
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801


802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830

831
832
833
834
835
836
837
...
841
842
843
844
845
846
847
848
849
850
851



852
853
854
855
856
857
858
...
860
861
862
863
864
865
866
867
868

869





870
















871















































872
873
874
875












876
877



878
879
880
881
882
883
884
....
1204
1205
1206
1207
1208
1209
1210
1211






1212
1213

1214
1215
1216
1217
1218
1219


1220



1221
1222
1223
1224
1225
1226
1227
		    error "in translateExecutionPlan: can't happen"
		}
	    }
	}
	return $intcode
    }

    method translateFact {db fact} {

	set predicate [lindex $fact 1]

	db relationMustExist $predicate
	set cols [$db columns $predicate]
	if {[llength $cols] != [llength $fact]-2} {
	    set ppfact [bdd::datalog::prettyprint-literal $fact]
	    return -code error \
		-errorCode [list DATALOG wrongColumns $predicate $ppfact] \
		"$predicate has a different number of columns from $ppfact"

	}
	set probeColumns {}
	set dontCareColumns {}
	foreach term [lrange $fact 2 end] col $cols {
	    switch -exact [lindex $term 0] {
		CONSTANT {
		    lappend probeColumns $col
................................................................................
	if {$probeColumns eq {}} {
	    set ppfact [bdd::datalog::prettyprint-literal $fact]
	    puts stderr "warning: fact $ppfact. asserts the universal set"
	    lappend intcode \
		[list SET $predicate _]
	} else {
	    if {$dontCareColumns ne {}} {
		set probeRelation [my gensym \#T]
		set dontCareRelation [my gensym \#T]
		set joinedRelation [my gensym \#T]
		lappend intcode \
		    [list RELATION $probeRelation $probeColumns]
		lappend intcode \
		    [list LOAD $probeRelation $probeValues]
		lappend intcode \
		    [list RELATION $dontCareRelation $dontCareColumns]
		lappend intcode \
		    [list SET $dontCareRelation _]


		lappend intcode \
		    [list JOIN $joinedRelation $probeRelation $dontCareRelation]
		lappend intcode \
		    [list UNION $predicate $predicate $joinedRelation]
	    } else {
		lappend intcode \
		    [list LOAD $predicate $probeValues]
	    }
	}
    }

    method translateLoop {db predicate body} {
	# TODO - Incrementalization?
	set comparison [my gensym \#T]
	db relationMustExist $predicate
	set cols [$db columns $predicate]
	lappend intcode [list RELATION $comparison $cols]
	set where [llength $intcode]
	lappend intcode LOOPHEAD
	lappend intcode [list SET $comparison $predicate]
	my translateExecutionPlan $db $body
	lappend intcode [list IFNOT=== $where $comparison $predicate]
    }

    method translateQuery {db query} {
	# TODO: Destub
    }

    method translateRule {db rule} {

	set tempRelation {}
	set tempColumns {}
	foreach subgoal [lrange $rule 1 end] {
	    lassign [my translateSubgoal \
			 $db $subgoal $tempRelation $tempColumns] \
		tempRelation tempColumns
	}
................................................................................
    method translateSubgoal {db subgoal dataSoFar columnsSoFar} {
	switch -exact [lindex $subgoal 0] {
	    NOT {
		lassign \
		    [my translateLiteral $db \
			 [lindex $subgoal 1] $dataSoFar $columnsSoFar] \
		    subgoalRelation subgoalColumns
		lappend intcode [list NEGATE $subgoalRelation $subgoalRelation]
		tailcall my translateSubgoalEnd $db ANTIJOIN \
		    $dataSoFar $columnsSoFar $subgoalRelation $subgoalColumns
	    }



	    LITERAL {
		lassign \
		    [my translateLiteral \
			 $db $subgoal $dataSoFar $columnsSoFar] \
		    subgoalRelation subgoalColumns
		tailcall my translateSubgoalEnd $db JOIN \
		    $dataSoFar $columnsSoFar $subgoalRelation $subgoalColumns
................................................................................
	    default {
		error "in translateSubgoal: can't happen"
	    }
	}
    }

    method translateLiteral {db literal dataSoFar columnsSoFar} {
	# TODO: Destub
	lappend intcode [list IDONTKNOW SELECTFROM [lindex $literal 1]]

	return [list IDONTKNOW-SELECTFROM-[lindex $literal 1] $columnsSoFar]





    }
































































    method translateSubgoalEnd {db operation 
				dataSoFar columnsSoFar
				dataThisOp columnsThisOp} {
	# TODO: Destub












	lappend intcode [list IDONTKNOW JOINWITH $dataSoFar]
	return [list IDONTKNOW-JOINWITH-$dataSoFar $columnsSoFar]



    }

    method translateRuleHead {db headLiteral sourceRelation sourceColumns} {
	# TODO: Destub
	lappend intcode [list IDONTKNOW UNIONTO [lindex $headLiteral 1] $sourceRelation]
	
    }
................................................................................
			  [prettyprint-rule [lindex $step 1]]]
	    }
	}
    }
}

# Try compiling a program







source [file join [file dirname [info script]] tclbdd.tcl]
load ../penelope-sys/libtclbdd0.1.so

source [file join [file dirname [info script]] tclfddd.tcl]
source [file join [file dirname [info script]] .. examples loadProgram.tcl]
source [file join [file dirname [info script]] .. examples program1.tcl]

set vars [analyzeProgram $program db]



db relation flowspast v st st2




set i 0
foreach step [bdd::datalog::compileProgram db {
 
    % A false entry node (node 0) sets every variable and flows
    % to node 1. If any of its variables are reachable, those are
    % variables possibly used uninitialized in the program.







|
>

>
|
|
|
|
|
|
|
>







 







|
|
|








>
>













|




|


|







>







 







<



>
>
>







 







<
|
>
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



<
>
>
>
>
>
>
>
>
>
>
>
>
|
<
>
>
>







 








>
>
>
>
>
>

<
>






>
>

>
>
>







749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
...
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
...
847
848
849
850
851
852
853

854
855
856
857
858
859
860
861
862
863
864
865
866
...
868
869
870
871
872
873
874

875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950

951
952
953
954
955
956
957
958
959
960
961
962
963

964
965
966
967
968
969
970
971
972
973
....
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307

1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
		    error "in translateExecutionPlan: can't happen"
		}
	    }
	}
	return $intcode
    }

    method translateFact {db fact {cols {}}} {
	lappend intcode "# [bdd::datalog::prettyprint-literal $fact]"
	set predicate [lindex $fact 1]
	if {$cols eq {}} {
	    db relationMustExist $predicate
	    set cols [$db columns $predicate]
	    if {[llength $cols] != [llength $fact]-2} {
		set ppfact [bdd::datalog::prettyprint-literal $fact]
		return -code error \
		    -errorCode [list DATALOG wrongColumns $predicate $ppfact] \
		    "$predicate has a different number of columns from $ppfact"
	    }
	}
	set probeColumns {}
	set dontCareColumns {}
	foreach term [lrange $fact 2 end] col $cols {
	    switch -exact [lindex $term 0] {
		CONSTANT {
		    lappend probeColumns $col
................................................................................
	if {$probeColumns eq {}} {
	    set ppfact [bdd::datalog::prettyprint-literal $fact]
	    puts stderr "warning: fact $ppfact. asserts the universal set"
	    lappend intcode \
		[list SET $predicate _]
	} else {
	    if {$dontCareColumns ne {}} {
		set probeRelation [my gensym #T]
		set dontCareRelation [my gensym #T]
		set joinedRelation [my gensym #T]
		lappend intcode \
		    [list RELATION $probeRelation $probeColumns]
		lappend intcode \
		    [list LOAD $probeRelation $probeValues]
		lappend intcode \
		    [list RELATION $dontCareRelation $dontCareColumns]
		lappend intcode \
		    [list SET $dontCareRelation _]
		lappend intcode \
		    [list RELATION $joinedRelation $cols]
		lappend intcode \
		    [list JOIN $joinedRelation $probeRelation $dontCareRelation]
		lappend intcode \
		    [list UNION $predicate $predicate $joinedRelation]
	    } else {
		lappend intcode \
		    [list LOAD $predicate $probeValues]
	    }
	}
    }

    method translateLoop {db predicate body} {
	# TODO - Incrementalization?
	set comparison [my gensym #T]
	db relationMustExist $predicate
	set cols [$db columns $predicate]
	lappend intcode [list RELATION $comparison $cols]
	set where [llength $intcode]
	lappend intcode BEGINLOOP
	lappend intcode [list SET $comparison $predicate]
	my translateExecutionPlan $db $body
	lappend intcode [list ENDLOOP $comparison $predicate $where]
    }

    method translateQuery {db query} {
	# TODO: Destub
    }

    method translateRule {db rule} {
	lappend intcode "# [::bdd::datalog::prettyprint-rule $rule]"
	set tempRelation {}
	set tempColumns {}
	foreach subgoal [lrange $rule 1 end] {
	    lassign [my translateSubgoal \
			 $db $subgoal $tempRelation $tempColumns] \
		tempRelation tempColumns
	}
................................................................................
    method translateSubgoal {db subgoal dataSoFar columnsSoFar} {
	switch -exact [lindex $subgoal 0] {
	    NOT {
		lassign \
		    [my translateLiteral $db \
			 [lindex $subgoal 1] $dataSoFar $columnsSoFar] \
		    subgoalRelation subgoalColumns

		tailcall my translateSubgoalEnd $db ANTIJOIN \
		    $dataSoFar $columnsSoFar $subgoalRelation $subgoalColumns
	    }
	    EQUALITY {
		# TODO - what to do here?
	    }
	    LITERAL {
		lassign \
		    [my translateLiteral \
			 $db $subgoal $dataSoFar $columnsSoFar] \
		    subgoalRelation subgoalColumns
		tailcall my translateSubgoalEnd $db JOIN \
		    $dataSoFar $columnsSoFar $subgoalRelation $subgoalColumns
................................................................................
	    default {
		error "in translateSubgoal: can't happen"
	    }
	}
    }

    method translateLiteral {db literal dataSoFar columnsSoFar} {

	set predicate [lindex $literal 1]
	db relationMustExist $predicate
	set cols [db columns $predicate]
	if {[llength $cols] != [llength $literal]-2} {
	    set pplit [bdd::datalog::prettyprint-literal $literal]
	    return -code error \
		-errorCode [list DATALOG wrongColumns $predicate $pplit] \
		"$predicate has a different number of columns from $pplit"
	}
	puts "translate [bdd::datalog::prettyprint-literal $literal]"
	set selector [my gensym #T]
	set selectLiteral [list LITERAL $selector]
	set needSelect 0
	set needProject 0
	set projector [my gensym #T]
	set projectColumns {}
	set renamed [my gensym #T]
	set renamedFrom {}
	set renamedTo {}
	foreach term [lrange $literal 2 end] col $cols {
	    puts "unify database column '$col' with term '$term'"
	    switch -exact -- [lindex $term 0] {
		CONSTANT {
		    lappend selectLiteral $term
		    set needSelect 1
		}
		VARIABLE {
		    set varName [lindex $term 1]
		    lappend selectLiteral {VARIABLE _}
		    if {$varName eq {_}} {
			set needProject 1
 		    } else {
			lappend projectColumns $col
			lappend renamedColumns $varName
			if {$varName eq $col} {
			    # no rename needed
			} else {
			    lappend renamedFrom $col
			    lappend renamedTo $varName
			}
		    }
		}
	    }
	}
	if {$needSelect} {
	    lappend intcode [list RELATION $selector $cols]
	    my translateFact $db $selectLiteral $cols
	    lappend intcode [list JOIN $selector $selector $predicate]
	    set projectSource $selector
	} else {
	    set projectSource $predicate
	}
	if {$needProject} {
	    lappend intcode [list RELATION $projector $projectColumns]
	    lappend intcode [list PROJECT $projector $projectSource]
	    set renameSource $projector
	} else {
	    set renameSource $projectSource
	}
	if {[llength $renamedFrom] > 0} {
	    lappend intcode [list RELATION $renamed $renamedColumns]
	    set renameCommand [list RENAME $renamed $renameSource]
	    foreach to $renamedTo from $renamedFrom {
		lappend renameCommand $to $from
	    }
	    lappend intcode $renameCommand
	    set result $renamed
	} else {
	    set result $renameSource
	}
	return [list $result $renamedColumns]
    }

    method translateSubgoalEnd {db operation 
				dataSoFar columnsSoFar
				dataThisOp columnsThisOp} {

	if {$dataSoFar eq {}} {
	    if {$operation eq {ANTIJOIN}} {
		lappend intcode [list NEGATE $dataThisOp $dataThisOp]
	    }
	    set resultRelation $dataThisOp
	    set resultColumns $columnsThisOp
	} else {
	    set resultColumns $columnsSoFar
	    lappend resultColumns {*}$columnsThisOp
	    set resultColumns [lsort -unique -dictionary $resultColumns]
	    set resultRelation [my gensym #T]
	    lappend intcode [list RELATION $resultRelation $resultColumns]
	    lappend intcode [list $operation $resultRelation \

				 $dataSoFar $dataThisOp]
	}
	return [list $resultRelation $resultColumns]
    }

    method translateRuleHead {db headLiteral sourceRelation sourceColumns} {
	# TODO: Destub
	lappend intcode [list IDONTKNOW UNIONTO [lindex $headLiteral 1] $sourceRelation]
	
    }
................................................................................
			  [prettyprint-rule [lindex $step 1]]]
	    }
	}
    }
}

# Try compiling a program

if {[info exists ::env(BUILD_DIR)]} {
    set buildDir $::env(BUILD_DIR)
} else {
    set buildDir .
}

source [file join [file dirname [info script]] tclbdd.tcl]

load [file join $buildDir libtclbdd0.1.so]
source [file join [file dirname [info script]] tclfddd.tcl]
source [file join [file dirname [info script]] .. examples loadProgram.tcl]
source [file join [file dirname [info script]] .. examples program1.tcl]

set vars [analyzeProgram $program db]

db relation seq st st2
db relation writes st v
db relation flowspast v st st2
db relation reaches v st st2
db relation uninitRead st v
db relation deadWrite st v

set i 0
foreach step [bdd::datalog::compileProgram db {
 
    % A false entry node (node 0) sets every variable and flows
    % to node 1. If any of its variables are reachable, those are
    % variables possibly used uninitialized in the program.

Changes to library/tclfddd.tcl.

274
275
276
277
278
279
280
281

282
283
284
285
286
287
288
...
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
...
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
...
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
    #          dictionary order
    #
    # Results:
    #	Returns an empty result if the column set of the relation is correct.
    #   Causes the caller to return an error if it is different.

    method ColumnsMustBe {rel cols} {
	if {[dict get $m_relcolumns $rel] ne $cols} {

	    return -level 2 -code error \
		-errorcode [list FDDD WrongColumns $rel \
				[dict get $m_relcolumns $rel] $cols] \
		"relation \"$rel\" has columns\
                 [join [dict get $m_relcolumns $rel] {, }] but should have\
                 columns [join $cols {, }]"
	}
................................................................................
    #
    # Results:
    #	Returns an empty result if the column sets of the two relations
    #   are the same. Causes the caller to return an error if they are 
    #   different.

    method ColumnsMustBeSame {rel1 rel2} {
	if {[dict get $m_relcolumns $rel1]
	    ne [dict get $m_relcolumns $rel2]} {
	    return -level 2 -code error \
		-errorcode [list FDDD DifferentColumns $rel1 $rel2] \
		"relations \"$rel1\" and \"$rel2\" have different columns"
	}
	return
    }

................................................................................
    #   db - Name of the database
    #   relation - Name of the relation being loaded
    #
    # Results:
    #	Returns a command prefix for a command that will add a tuple
    #	to the given relation.
    #
    # To the prefix should be appended the values of the columns,
    # in dictonary order by the column names.

    method loader {relation} {
	my relationMustExist $relation
	set i 0
	foreach column [dict get $m_relcolumns $relation] {
	    dict set cmdpos $column $i
	    incr i
................................................................................
	    my columnMustExist $col
	    if {[dict exists $havecol $col]} {
		return -code error -errorcode [list FDDD DuplicateColumn $col] \
		    "column $col is duplicated in the column list"
	    }
	    dict set $havecol $col {}
	}
	dict set m_relcolumns $name [lsort -dictionary $args]
	{*}[my set $name {}]
	return $name
    }

    # Method: relationMustExist
    #
    #	Makes sure that a given relation exists in the database







|
>







 







|
|







 







|
<







 







|







274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
...
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
...
706
707
708
709
710
711
712
713

714
715
716
717
718
719
720
...
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
    #          dictionary order
    #
    # Results:
    #	Returns an empty result if the column set of the relation is correct.
    #   Causes the caller to return an error if it is different.

    method ColumnsMustBe {rel cols} {
	if {[lsort -dictionary [dict get $m_relcolumns $rel]]
	    ne [lsort -dictionary $cols]} {
	    return -level 2 -code error \
		-errorcode [list FDDD WrongColumns $rel \
				[dict get $m_relcolumns $rel] $cols] \
		"relation \"$rel\" has columns\
                 [join [dict get $m_relcolumns $rel] {, }] but should have\
                 columns [join $cols {, }]"
	}
................................................................................
    #
    # Results:
    #	Returns an empty result if the column sets of the two relations
    #   are the same. Causes the caller to return an error if they are 
    #   different.

    method ColumnsMustBeSame {rel1 rel2} {
	if {[lsort -dictionary [dict get $m_relcolumns $rel1]]
	    ne [lsort -dictionary [dict get $m_relcolumns $rel2]]} {
	    return -level 2 -code error \
		-errorcode [list FDDD DifferentColumns $rel1 $rel2] \
		"relations \"$rel1\" and \"$rel2\" have different columns"
	}
	return
    }

................................................................................
    #   db - Name of the database
    #   relation - Name of the relation being loaded
    #
    # Results:
    #	Returns a command prefix for a command that will add a tuple
    #	to the given relation.
    #
    # To the prefix should be appended the values of the columns


    method loader {relation} {
	my relationMustExist $relation
	set i 0
	foreach column [dict get $m_relcolumns $relation] {
	    dict set cmdpos $column $i
	    incr i
................................................................................
	    my columnMustExist $col
	    if {[dict exists $havecol $col]} {
		return -code error -errorcode [list FDDD DuplicateColumn $col] \
		    "column $col is duplicated in the column list"
	    }
	    dict set $havecol $col {}
	}
	dict set m_relcolumns $name $args
	{*}[my set $name {}]
	return $name
    }

    # Method: relationMustExist
    #
    #	Makes sure that a given relation exists in the database