tclbdd

Check-in [e19d9e2146]
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:e19d9e214692ef634940862a4ed796f33746b248
User & Date: kbk 2014-01-08 04:57:46
Context
2014-01-09
01:34
Finished an initial whack at the compiler. It works well enough to do the 'reaching definitions' example. check-in: bd10382cec user: kbk tags: trunk
2014-01-08
04:57
more compiler development, most of the way through doing intermediate code for rules check-in: e19d9e2146 user: kbk tags: trunk
03:47
more compiler development, most of the way through doing intermediate code for rules check-in: f935c63420 user: kbk tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to library/datalog.tcl.

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
...
972
973
974
975
976
977
978
979
980
981

982

983
984











985
























986
987
988
989
990
991

992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005





1006
























1007










1008
1009
1010
1011
1012
1013
1014
....
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387




1388
1389
1390
1391
1392
1393
1394
	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]
................................................................................
	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"
	}
	set destColumns [lrange $literal 2 end]

	# Project away unused columns in sourceColumns.

	# Warn about columns in literal that are not in sourceColumns.

	# Rename columns from literal to destination.
	# Join with any don't-cares




































	set needProject 0
	set projector [my gensym #T]
	set projectColumns {}
	puts "Project $sourceColumns into $destColumns"
	foreach col $sourceColumns {
	    if {[lsearch -exact $destColumns $col] >= 0} {

		lappend projectColumns {}
	    } else {
		set needProject 1
	    }
	}
	if {$needProject} {
	    lappend intcode [list RELATION $projector $projectColumns]
	    lappend intcode [list PROJECT $projector $sourceRelation]
	    set renameSource $projector
	} else {
	    set renameSource $sourceRelation
	}

	# TODO: Destub






























	lappend intcode [list IDONTKNOW UNIONTO [lindex $literal 1] $sourceRelation]










	
    }

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

................................................................................
    writes(st,v) :- writes0(st,v).
    seq($startNode, 1).
    seq(st,st2) :- seq0(st,st2).

    % flowspast(v,st,st2) means that control passes from the exit of st
    % to the entry of st2 without altering the value of v

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

    % reaches(v,st,st2) means that st assigns a value to v, which
    % reaches st2, which reads the value of v : that is, st is a
    % reaching definition for the use of v at st2.

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

    % A variable read that is reachable from the entry is a read of a
    % possibly uninitialized variable

    uninitRead(st, v) :- reaches(v, $startNode, st).





    % 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








<










<







 







<

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



<

<
>
|












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







 







|


|











>
>
>
>







877
878
879
880
881
882
883

884
885
886
887
888
889
890
891
892
893

894
895
896
897
898
899
900
...
970
971
972
973
974
975
976

977

978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021

1022

1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
....
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
	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"
	}

	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 {

	    switch -exact -- [lindex $term 0] {
		CONSTANT {
		    lappend selectLiteral $term
		    set needSelect 1
		}
		VARIABLE {
		    set varName [lindex $term 1]
................................................................................
	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"
	}



	# Analyze the head of the rule
	# Complain about columns in literal that are not in sourceColumns.

	set pplit [bdd::datalog::prettyprint-literal $literal]
	set destColumn {}
	set dontCareColumns {}
	set renamedFrom {}
	set renamedTo {}
	set constant [my gensym #T]
	set constantColumns {}
	set constantLiteral [list LITERAL $constant]
	foreach destTerm [lrange $literal 2 end] col $cols {
	    switch -exact -- [lindex $destTerm 0] {
		CONSTANT {
		    lappend constantColumns $col
		    lappend constantLiteral $destTerm
		}
		VARIABLE {
		    set vname [lindex $destTerm 1]
		    if {$vname eq {_}} {
			lappend dontCareColumns $col
		    } else {
			if {$col ne $vname} {
			    lappend renamedFrom $vname
			    lappend renamedTo $col
			}
			if {[lsearch -exact $sourceColumns $vname] < 0} {
			    return -code error \
				-errorCode \
				[list DATALOG MissingVariable $vname $pplit] \
				"variable $vname appears in the head $pplit\
                                 but not in the body $sourceColumns"
			}
			dict set destColumn $vname {}
			lappend renamedColumns $col
		    }
		}
	    }
	}

	# Project away unused columns in sourceColumns.
	set needProject 0
	set projector [my gensym #T]
	set projectColumns {}

	foreach col $sourceColumns {

	    if {[dict exists $destColumn $col]} {
		lappend projectColumns $col
	    } else {
		set needProject 1
	    }
	}
	if {$needProject} {
	    lappend intcode [list RELATION $projector $projectColumns]
	    lappend intcode [list PROJECT $projector $sourceRelation]
	    set renameSource $projector
	} else {
	    set renameSource $sourceRelation
	}

	# Rename columns from literal to destination.
	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 joinSource $renamed
	} else {
	    set joinSource $renameSource
	}

	# Join with any constants

	set joinColumns $renamedColumns
	if {[llength $constantColumns] > 0} {
	    lappend intcode [list RELATION $constant $constantColumns]
	    my translateFact $db $constantLiteral $constantColumns
	    lappend joinColumns {*}$constantColumns
	    set joined [my gensym #T]
	    lappend intcode [list RELATION $joined $joinColumns]
	    lappend intcode [list JOIN $joined $joinSource $constant]
	    set joinSource $joined
	}

	# Join with any don't-cares

	if {[llength $dontCareColumns] > 0} {
	    set dontCareRelation [my gensym #T]
	    lappend intcode [list RELATION $dontCareRelation $dontCareColumns]
	    lappend intcode [list SET $dontCareRelation _]
	    lappend joinColumns {*}$dontCareColumns
	    set joined [my gensym #T]
	    lappend intcode [list RELATION $joined $joinColumns]
	    lappend intcode [list JOIN $joined $joinSource $dontCareRelation]
	    set joinSource $joined

	}

	# Union the result into the destination
	lappend intcode [list UNION $predicate $predicate $joinSource]
	
    }

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

................................................................................
    writes(st,v) :- writes0(st,v).
    seq($startNode, 1).
    seq(st,st2) :- seq0(st,st2).

    % flowspast(v,st,st2) means that control passes from the exit of st
    % to the entry of st2 without altering the value of v

    flowspast(_, st, st2) :- seq(st, st2).
    flowspast(v, st, st2) :- flowspast(v, st, st3),
                             !writes(st3, v),
                             flowspast(v, st3, st2).

    % reaches(v,st,st2) means that st assigns a value to v, which
    % reaches st2, which reads the value of v : that is, st is a
    % reaching definition for the use of v at st2.

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

    % A variable read that is reachable from the entry is a read of a
    % possibly uninitialized variable

    uninitRead(st, v) :- reaches(v, $startNode, st).

    % The following statement is nonsense, but tests a constant in the head.

    uninitRead(st, $ENV) :- reads(st, $ENV).

    % 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