tclbdd

Check-in [7636e8a432]
Login

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

Overview
Comment:More compiler development - part of the procedures to translate Datalog to relational algebra.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:7636e8a43230541b48d3c1e8e3e74da42ab43155
User & Date: kbk 2014-01-06 12:17:22
Context
2014-01-08
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
2014-01-03
22:09
Fix several packaging errors. Refactor some of the FDDD type checking. Continue Datalog development; including replacing 'condition' with 'subgoal' in commentary. check-in: 53105db3b1 user: kbk tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to examples/reach.tcl.






1
2
3
4
5
6
7





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

proc profile! {db var} {
    puts "$var: [$db profile $var]"
}

interp alias {} profile {} profile!
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
# TEMP : setup to run uninstalled

source [file join [file dirname [info script]] .. library tclbdd.tcl]
load ./libtclbdd0.1.so
source [file join [file dirname [info script]] .. library tclfddd.tcl]
source [file join [file dirname [info script]] loadProgram.tcl]

proc profile! {db var} {
    puts "$var: [$db profile $var]"
}

interp alias {} profile {} profile!

Changes to library/datalog.tcl.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
...
336
337
338
339
340
341
342



343
344
345
346
347
348
349
350


351
352
353
354
355
356
357
358
359
360
361













362
363
364
365
366
367
368
...
711
712
713
714
715
716
717

























































































































































718
719
720
721
722
723
724
...
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
...
917
918
919
920
921
922
923
924





925
926
927
928
929
930
931
....
1033
1034
1035
1036
1037
1038
1039











1040
1041
1042
1043
1044
1045
1046
1047
....
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080




1081



# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

source [file dirname [info script]]/coroutine_iterator.tcl; # TEMP
source [file dirname [info script]]/coroutine_corovar.tcl; # TEMP
source [file dirname [info script]]/tclbdd.tcl;		   # TEMP
source [file dirname [info script]]/tclfddd.tcl;	   # TEMP

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

namespace import coroutine::corovar::corovar

namespace eval bdd {
    namespace eval datalog {
	namespace export lex parse compile
    }
................................................................................
    #         (if any)
    # 'executionPlan' gives the eventual order of execution of the facts
    #                 and rules. It is a list of tuples:
    #                     RULE literal subgoal subgoal ...
    #		          FACT literal
    #		          LOOP predicate executionPlan
    #                 possibly having 'QUERY literal' at the end.




    variable \
	rules \
	rulesForPredicate \
	factsForPredicate \
	outEdgesForPredicate \
	query \
	executionPlan



    # Constructor -
    #
    #	Creates an empty program.

    constructor {} {
	set rules {}
	set rulesForPredicate {}
	set factsForPredicate {}
	set outEdgesForPredicate {}
	set executionPlan {}













    }

    # assertRule -
    #
    #	Semantic action called from the parser when a rule is being asserted
    #
    # Parameters:
................................................................................
		    return 1
		} else {
		    return 0
		}
	    }
	}
    }


























































































































































    method getRule {ruleNo} {
	return [lindex $rules $ruleNo]
    }

    method getRules {} {
	return $rules
................................................................................
	}
	yield $component

    }
    return
}

proc bdd::datalog::compileProgram {programText} {

    variable parser

    try {

	set program [bdd::datalog::program new]

................................................................................
	set parseTree [$parser parse $tokens $values $program]
	
	# Extract the facts, rules, and edges joining the rules from the parse
	set facts [$program getFacts]
	set rules [$program getRules]
	set outedges [$program getEdges]
	
	set result [$program planExecution]






    } finally {

	$program destroy

    }
    return $result
................................................................................
	    }
	}
    }
}

# Try compiling a program












bdd::datalog::prettyprint-plan [bdd::datalog::compileProgram {
 
    % 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.

    writes($startNode, _).
    writes(st,v) :- writes0(st,v).
................................................................................

    % A variable write that reaches nowhere else is dead code

    deadWrite(st, v) :- writes(st, v), !reaches(v, st, _).

    % Also do the bddbddb example. Only 1 stratum, but 2 loops in the larger SCC

    vP(v, h) :- vP0(v,h).
    vP(v1,h) :- assign(v1,v2), vP(v2,h).
    hP(h1,f,h2) :- store(v1,f,v2), vP(v1,h1), vP(v2,h2).
    vP(v2,h2) :- load(v1,f,v2), vP(v1,h1), hP(h1,f,h2).





}]










<
<





<
<







 







>
>
>







|
>
>











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







 







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







 







|







 







|
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
|







 







|
|
|
|

>
>
>
>
|
>
>
>
8
9
10
11
12
13
14


15
16
17
18
19


20
21
22
23
24
25
26
...
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
...
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
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
775
776
777
778
779
780
781
782
783
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
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
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
885
886
887
888
889
890
891
....
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
....
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
....
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
....
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

source [file dirname [info script]]/coroutine_iterator.tcl; # TEMP
source [file dirname [info script]]/coroutine_corovar.tcl; # TEMP



package require Tcl 8.6
package require coroutine::corovar 1.0
package require coroutine::iterator 1.0
package require grammar::aycock 1.0



namespace import coroutine::corovar::corovar

namespace eval bdd {
    namespace eval datalog {
	namespace export lex parse compile
    }
................................................................................
    #         (if any)
    # 'executionPlan' gives the eventual order of execution of the facts
    #                 and rules. It is a list of tuples:
    #                     RULE literal subgoal subgoal ...
    #		          FACT literal
    #		          LOOP predicate executionPlan
    #                 possibly having 'QUERY literal' at the end.
    # 'intcode' is the execution plan translated to an intermediate code
    #           that expresses the work to be done in terms of relational
    #	        algebra.

    variable \
	rules \
	rulesForPredicate \
	factsForPredicate \
	outEdgesForPredicate \
	query \
	executionPlan \
	intcode \
	gensym

    # Constructor -
    #
    #	Creates an empty program.

    constructor {} {
	set rules {}
	set rulesForPredicate {}
	set factsForPredicate {}
	set outEdgesForPredicate {}
	set executionPlan {}
	set intcode {}
	set gensym 0
    }

    # gensym -
    #
    #	Generate a unique symbol
    #
    # Results:
    #	Returns a generated symbol

    method gensym {{prefix G}} {
	return ${prefix}[incr gensym]
    }

    # assertRule -
    #
    #	Semantic action called from the parser when a rule is being asserted
    #
    # Parameters:
................................................................................
		    return 1
		} else {
		    return 0
		}
	    }
	}
    }

    method translateExecutionPlan {db plan} {
	foreach step $plan {
	    switch -exact -- [lindex $step 0] {
		FACT {
		    my translateFact $db [lindex $step 1]
		}
		LOOP {
		    my translateLoop $db [lindex $step 1] [lindex $step 2]
		} 
		QUERY {
		    my translateQuery $db [lindex $step 1] [lindex $step 2]
		}
		RULE {
		    my translateRule $db [lindex $step 1]
		}
		default {
		    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
		    lappend probeValues $term
		}
		VARIABLE {
		    if {[lindex $term 1] ne {_}} {
			set ppfact [bdd::datalog::prettyprint-literal $fact]
			puts stderr "warning: unused variable [lindex $term 1]\
                                     in fact $ppfact."
		    }
		    lappend dontCareColumns $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
	}
	my translateRuleHead $db [lindex $rule 0] $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]
	
    }

    method getRule {ruleNo} {
	return [lindex $rules $ruleNo]
    }

    method getRules {} {
	return $rules
................................................................................
	}
	yield $component

    }
    return
}

proc bdd::datalog::compileProgram {db programText} {

    variable parser

    try {

	set program [bdd::datalog::program new]

................................................................................
	set parseTree [$parser parse $tokens $values $program]
	
	# Extract the facts, rules, and edges joining the rules from the parse
	set facts [$program getFacts]
	set rules [$program getRules]
	set outedges [$program getEdges]
	
	set plan [$program planExecution]

	# TODO - need to clear executionPlan?
	set result [$program translateExecutionPlan $db $plan]

	# TODO - This sequence needs refactoring

    } finally {

	$program destroy

    }
    return $result
................................................................................
	    }
	}
    }
}

# 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.

    writes($startNode, _).
    writes(st,v) :- writes0(st,v).
................................................................................

    % A variable write that reaches nowhere else is dead code

    deadWrite(st, v) :- writes(st, v), !reaches(v, st, _).

    % Also do the bddbddb example. Only 1 stratum, but 2 loops in the larger SCC

    % vP(v, h) :- vP0(v,h).
    % vP(v1,h) :- assign(v1,v2), vP(v2,h).
    % hP(h1,f,h2) :- store(v1,f,v2), vP(v1,h1), vP(v2,h2).
    % vP(v2,h2) :- load(v1,f,v2), vP(v1,h1), hP(h1,f,h2).

    % Compile dead code query

    deadWrite(st, v)?

}] {
    puts "$i: $step"
    incr i
}

Changes to library/tclfddd.tcl.

831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
	    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]
	$db set $name {}
	return $name
    }

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







|







831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
	    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
    #