tclbdd

Check-in [bd10382cec]
Login

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

Overview
Comment:Finished an initial whack at the compiler. It works well enough to do the 'reaching definitions' example.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:bd10382cec6411856940a9cc05b0add2386db7fa
User & Date: kbk 2014-01-09 01:34:44
Context
2014-01-10
02:00
Clean up packaging a little bit, again. check-in: aa0c89ccc1 user: kbk tags: trunk
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
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to library/datalog.tcl.

    18     18   package require coroutine::iterator 1.0
    19     19   package require grammar::aycock 1.0
    20     20   
    21     21   namespace import coroutine::corovar::corovar
    22     22   
    23     23   namespace eval bdd {
    24     24       namespace eval datalog {
    25         -	namespace export lex parse compile
           25  +	variable gensym 0
           26  +	namespace export compileProgram
    26     27       }
    27     28   }
    28     29   
    29     30   # bdd::datalog::lex --
    30     31   #
    31     32   #	Lexical analysis for the Datalog compiler.
    32     33   #
................................................................................
   343    344       variable \
   344    345   	rules \
   345    346   	rulesForPredicate \
   346    347   	factsForPredicate \
   347    348   	outEdgesForPredicate \
   348    349   	query \
   349    350   	executionPlan \
   350         -	intcode \
   351         -	gensym
          351  +	intcode
   352    352   
   353    353       # Constructor -
   354    354       #
   355    355       #	Creates an empty program.
   356    356   
   357    357       constructor {} {
   358    358   	set rules {}
   359    359   	set rulesForPredicate {}
   360    360   	set factsForPredicate {}
   361    361   	set outEdgesForPredicate {}
   362    362   	set executionPlan {}
   363    363   	set intcode {}
   364         -	set gensym 0
   365    364       }
   366    365   
   367    366       # gensym -
   368    367       #
   369    368       #	Generate a unique symbol
   370    369       #
   371    370       # Results:
   372    371       #	Returns a generated symbol
   373    372   
   374    373       method gensym {{prefix G}} {
   375         -	return ${prefix}[incr gensym]
          374  +	return ${prefix}[incr ::bdd::datalog::gensym]
   376    375       }
   377    376   
   378    377       # assertRule -
   379    378       #
   380    379       #	Semantic action called from the parser when a rule is being asserted
   381    380       #
   382    381       # Parameters:
................................................................................
   535    534   
   536    535   	# Iterate through the components, in dependency order, and
   537    536   	# plan their execution individually.
   538    537   	
   539    538   	foreach component [lreverse $components] {
   540    539   	    my planExecutionForComponent $component
   541    540   	}
          541  +
          542  +	# Tack on the query at the end
          543  +
          544  +	if {[info exists query]} {
          545  +	    lappend executionPlan [list QUERY $query]
          546  +	}
   542    547   
   543    548   	return $executionPlan
   544    549   
   545    550       }
   546    551   
   547    552       # Method: planExecutionForComponent
   548    553       #
................................................................................
   579    584   		    }
   580    585   		    1 {
   581    586   			lappend loops $rule
   582    587   		    }
   583    588   		    0 {
   584    589   			lappend executionPlan [list RULE $rule]
   585    590   		    }
          591  +		    default {
          592  +			error "in planExecutionForComponent: can't happen"
          593  +		    }
   586    594   		}
   587    595   	    }
   588    596   	}
   589    597   	if {[llength $loops] != 0} {
   590    598   	    lappend executionPlan [my planIteration $component $loops]
   591    599   	}
   592    600       }
................................................................................
   607    615       method planIteration {component loops} {
   608    616   	# As a heuristic, iterate over the predicate whose in-degree
   609    617   	# most exceeds its out-degree. This is the predicate whose deletion
   610    618   	# will remove the most edges from the dependency graph
   611    619   
   612    620   	# Score the predicates according to the degrees of the dependency
   613    621   	# graph.
   614         -	foreach rule $loops {
   615         -	    set lhPredicate [lindex $rule 0 1]
   616         -	    foreach subgoal [lrange $rule 1 end] {
   617         -		switch -exact -- [lindex $subgoal 0] {
   618         -		    EQUALITY {	# does not introduce a dependency
   619         -			continue
   620         -		    }
   621         -		    NOT {
   622         -			set rhPredicate [lindex $subgoal 1 1]
   623         -		    }
   624         -		    LITERAL {
   625         -			set rhPredicate [lindex $subgoal 1]
   626         -		    }
   627         -		    default {
   628         -			error "in [info level 0]: can't happen."
   629         -		    }
   630         -		}
   631         -		if {[lsearch -exact $component $rhPredicate] >= 0} {
   632         -		    dict incr delta $lhPredicate 1; # edge into lhPredicate
   633         -		    dict incr delta $rhPredicate -1; # edge out of rhPredicate
   634         -		}
   635         -	    }
   636         -	}
          622  +	set delta [my rankComponentMembers $component $loops]
   637    623   
   638    624   	# Find the predicate with the high score
   639    625   	set maxDelta -Inf
   640    626   	dict for {pred d} $delta {
   641    627   	    if {$d > $maxDelta} {
   642    628   		set maxDelta $d
   643    629   		set toRemove $pred
................................................................................
   666    652   	} finally {
   667    653   	    $loopBody destroy
   668    654   	}
   669    655   
   670    656   	return [list LOOP $toRemove $bodyCode]
   671    657   		    
   672    658       }
          659  +
          660  +    # Method: rankComponentMemebers
          661  +    #
          662  +    #	Ranks members of a connected component in the predicate dependency
          663  +    #   graph for selection of loop headers.
          664  +    #
          665  +    # Parameters:
          666  +    #	components - Set of predicates in the connected component
          667  +    #	loops - Set of rules in the connected component that must be iterated.
          668  +    #
          669  +    # Results:
          670  +    #	Returns a dictionary whose keys are predicates and whose values are
          671  +    #	scores. The high-scoring predicate is the one that will be removed.
          672  +    #
          673  +    # The heuristic in play is from TODO: [citation needed]. It is to
          674  +    # compare the in-degree and out-degree of the predicate in the
          675  +    # dependency graph. The one with the highest (in-out) is the one
          676  +    # that will remove the most edges from the component if the
          677  +    # loop is broken there, and hence is likely to simplify the graph.
          678  +    # (The paper quantifies how close the result is to optimum.)
          679  +
          680  +    method rankComponentMembers {component loops} {
          681  +	set delta {}
          682  +	foreach rule $loops {
          683  +	    set lhPredicate [lindex $rule 0 1]
          684  +	    foreach subgoal [lrange $rule 1 end] {
          685  +		switch -exact -- [lindex $subgoal 0] {
          686  +		    EQUALITY {	# does not introduce a dependency
          687  +			continue
          688  +		    }
          689  +		    NOT {
          690  +			set rhPredicate [lindex $subgoal 1 1]
          691  +		    }
          692  +		    LITERAL {
          693  +			set rhPredicate [lindex $subgoal 1]
          694  +		    }
          695  +		    default {
          696  +			error "in [info level 0]: can't happen."
          697  +		    }
          698  +		}
          699  +		if {[lsearch -exact $component $rhPredicate] >= 0} {
          700  +		    dict incr delta $lhPredicate 1; # edge into lhPredicate
          701  +		    dict incr delta $rhPredicate -1; # edge out of rhPredicate
          702  +		}
          703  +	    }
          704  +	}
          705  +	return $delta
          706  +    }
          707  +    
   673    708   
   674    709       # Method: ruleDependsOn
   675    710       #
   676    711       #	Tests if a rule depends on one or more of a set of predicates.
   677    712       #
   678    713       # Parameters:
   679    714       #	rule - Parse tree of the rule
................................................................................
   707    742       #	Returns 2 if the rule depends on one of the predicates in negated
   708    743       #   form, 1, if the rule depends on one of the predicates only in
   709    744       #   non-negated form, 0 if the rule has no dependency on the predicates
   710    745   
   711    746       method subgoalDependsOn {subgoal predicates} {
   712    747   	switch -exact -- [lindex $subgoal 0] {
   713    748   	    EQUALITY {
   714         -		return false
          749  +		return 0
   715    750   	    }
   716    751   	    NOT {
   717    752   		if {[my subgoalDependsOn [lindex $subgoal 1] $predicates]} {
   718    753   		    return 2
   719    754   		} else {
   720    755   		    return 0
   721    756   		}
................................................................................
   726    761   		} else {
   727    762   		    return 0
   728    763   		}
   729    764   	    }
   730    765   	}
   731    766       }
   732    767   
          768  +    # Method: translateExecutionPlan
          769  +    #
          770  +    #	Once an execution plan has been constructed, translates it to
          771  +    #	three-address code.
          772  +    #
          773  +    # Parameters:
          774  +    #	db - Database on which the plan will be executed. The input and
          775  +    #	     output relations, and all columns appearing in the code,
          776  +    #	     must be defined.
          777  +    #	plan - Execution plan, a list of FACT, RULE, LOOP, and QUERY
          778  +    #	       subplans, as returned from 'planExecution'
          779  +    #
          780  +    # Results:
          781  +    #	Returns a list of three-address instructions.
          782  +
   733    783       method translateExecutionPlan {db plan} {
   734    784   	foreach step $plan {
   735    785   	    switch -exact -- [lindex $step 0] {
   736    786   		FACT {
   737    787   		    my translateFact $db [lindex $step 1]
   738    788   		}
   739    789   		LOOP {
   740    790   		    my translateLoop $db [lindex $step 1] [lindex $step 2]
   741    791   		} 
   742    792   		QUERY {
   743         -		    my translateQuery $db [lindex $step 1] [lindex $step 2]
          793  +		    my translateQuery $db [lindex $step 1]
   744    794   		}
   745    795   		RULE {
   746    796   		    my translateRule $db [lindex $step 1]
   747    797   		}
   748    798   		default {
   749    799   		    error "in translateExecutionPlan: can't happen"
   750    800   		}
   751    801   	    }
   752    802   	}
   753    803   	return $intcode
   754    804       }
   755    805   
          806  +    # Method: translateFact
          807  +    #
          808  +    #	Translates a fact in the execution plan to three-address code
          809  +    #
          810  +    # Parameters:
          811  +    #	db - Database on which the plan will be executed. The input and
          812  +    #	     output relations, and all columns appearing in the code,
          813  +    #	     must be defined.
          814  +    #	fact - Literal representing the fact to be translated.
          815  +    #	cols - If supplied, list of names of the columns of the
          816  +    #	       relation representing $fact's predicate.
          817  +    #
          818  +    # Results:
          819  +    #	None.
          820  +    #
          821  +    # Side effects:
          822  +    #	Appends three-addres instructions to 'intcode'
          823  +
   756    824       method translateFact {db fact {cols {}}} {
   757         -	lappend intcode "# [bdd::datalog::prettyprint-literal $fact]"
          825  +
   758    826   	set predicate [lindex $fact 1]
          827  +
          828  +	# Retrieve the set of columns in the output relation if not supplied
          829  +	# by the caller.
          830  +
   759    831   	if {$cols eq {}} {
   760    832   	    db relationMustExist $predicate
   761    833   	    set cols [$db columns $predicate]
   762    834   	    if {[llength $cols] != [llength $fact]-2} {
   763    835   		set ppfact [bdd::datalog::prettyprint-literal $fact]
   764    836   		return -code error \
   765    837   		    -errorCode [list DATALOG wrongColumns $predicate $ppfact] \
   766    838   		    "$predicate has a different number of columns from $ppfact"
   767    839   	    }
   768    840   	}
          841  +
          842  +	# Examine the terms of the literal, and extract the list of
          843  +	# columns for which specific vales have been supplied, and the
          844  +	# list of columns that have 'don't care' values: unbound variables
          845  +	# or _.
          846  +
   769    847   	set probeColumns {}
          848  +	set probeValues {}
   770    849   	set dontCareColumns {}
   771    850   	foreach term [lrange $fact 2 end] col $cols {
   772    851   	    switch -exact [lindex $term 0] {
   773    852   		CONSTANT {
   774    853   		    lappend probeColumns $col
   775         -		    lappend probeValues $term
          854  +		    lappend probeValues [lindex $term 1]
   776    855   		}
   777    856   		VARIABLE {
   778    857   		    if {[lindex $term 1] ne {_}} {
   779    858   			set ppfact [bdd::datalog::prettyprint-literal $fact]
   780    859   			puts stderr "warning: unused variable [lindex $term 1]\
   781    860                                        in fact $ppfact."
   782    861   		    }
   783    862   		    lappend dontCareColumns $col
   784    863   		}
   785    864   	    }
   786    865   	}
          866  +
          867  +	# Complain if no variables in the literal are bound.
          868  +
   787    869   	if {$probeColumns eq {}} {
   788    870   	    set ppfact [bdd::datalog::prettyprint-literal $fact]
   789    871   	    puts stderr "warning: fact $ppfact. asserts the universal set"
   790    872   	    lappend intcode \
   791    873   		[list SET $predicate _]
   792    874   	} else {
          875  +
          876  +	    # If there are 'don't cares', then make a relation for the
          877  +	    # bound values, a universal relation for the 'don't cares',
          878  +	    # join the two, and then union the result into the relation
          879  +	    # under construction.
          880  +
   793    881   	    if {$dontCareColumns ne {}} {
   794    882   		set probeRelation [my gensym #T]
   795    883   		set dontCareRelation [my gensym #T]
   796    884   		set joinedRelation [my gensym #T]
   797    885   		lappend intcode \
   798         -		    [list RELATION $probeRelation $probeColumns]
   799         -		lappend intcode \
   800         -		    [list LOAD $probeRelation $probeValues]
   801         -		lappend intcode \
   802         -		    [list RELATION $dontCareRelation $dontCareColumns]
   803         -		lappend intcode \
   804         -		    [list SET $dontCareRelation _]
   805         -		lappend intcode \
   806         -		    [list RELATION $joinedRelation $cols]
   807         -		lappend intcode \
   808         -		    [list JOIN $joinedRelation $probeRelation $dontCareRelation]
   809         -		lappend intcode \
          886  +		    [list RELATION $probeRelation $probeColumns] \
          887  +		    [list LOAD $probeRelation $probeValues] \
          888  +		    [list RELATION $dontCareRelation $dontCareColumns] \
          889  +		    [list SET $dontCareRelation _] \
          890  +		    [list RELATION $joinedRelation $cols] \
          891  +		    [list JOIN $joinedRelation \
          892  +			 $probeRelation $dontCareRelation] \
   810    893   		    [list UNION $predicate $predicate $joinedRelation]
   811    894   	    } else {
          895  +
          896  +		# If there are no 'don't cares', then load the literal
          897  +		# directly into the relation under construction.
          898  +
   812    899   		lappend intcode \
   813    900   		    [list LOAD $predicate $probeValues]
   814    901   	    }
   815    902   	}
   816    903       }
   817    904   
          905  +    # Method: translateLoop
          906  +    #
          907  +    #	Generates three-address code for rules with a cyclic dependency,
          908  +    #	iterating to a fixed point.
          909  +    #
          910  +    # Parameters:
          911  +    #	db - Database on which the plan will be executed. The input and
          912  +    #	     output relations, and all columns appearing in the code,
          913  +    #	     must be defined.
          914  +    #   predicate - Predicate to test for a fixed point.
          915  +    #	body - Execution plan for the loop body.
          916  +    #
          917  +    # Results:
          918  +    #	None.
          919  +    #
          920  +    # Side effects:
          921  +    #	Appends three-address instructions to 'intcode'
          922  +
   818    923       method translateLoop {db predicate body} {
   819         -	# TODO - Incrementalization?
   820         -	set comparison [my gensym #T]
          924  +
   821    925   	db relationMustExist $predicate
   822    926   	set cols [$db columns $predicate]
          927  +	set comparison [my gensym #T]
          928  +
          929  +	# Create a temporary relation to record the old value of
          930  +	# predicate for convergence testing.
   823    931   	lappend intcode [list RELATION $comparison $cols]
          932  +
          933  +	# Mark the top of the loop
   824    934   	set where [llength $intcode]
   825    935   	lappend intcode BEGINLOOP
          936  +
          937  +	# Save the value of the relation being iterated
   826    938   	lappend intcode [list SET $comparison $predicate]
          939  +
          940  +	# Translate the loop body
   827    941   	my translateExecutionPlan $db $body
          942  +
          943  +	# Translate the loop footer.
   828    944   	lappend intcode [list ENDLOOP $comparison $predicate $where]
   829    945       }
   830    946   
   831    947       method translateQuery {db query} {
   832         -	# TODO: Destub
          948  +	lassign [my translateSubgoal $db $query {} {}] tempRelation tempColumns
          949  +	lappend intcode [list RESULT $tempRelation $tempColumns]
          950  +	
   833    951       }
   834    952   
   835    953       method translateRule {db rule} {
   836         -	lappend intcode "# [::bdd::datalog::prettyprint-rule $rule]"
   837    954   	set tempRelation {}
   838    955   	set tempColumns {}
   839    956   	foreach subgoal [lrange $rule 1 end] {
   840    957   	    lassign [my translateSubgoal \
   841    958   			 $db $subgoal $tempRelation $tempColumns] \
   842    959   		tempRelation tempColumns
   843    960   	}
................................................................................
   851    968   		    [my translateLiteral $db \
   852    969   			 [lindex $subgoal 1] $dataSoFar $columnsSoFar] \
   853    970   		    subgoalRelation subgoalColumns
   854    971   		tailcall my translateSubgoalEnd $db ANTIJOIN \
   855    972   		    $dataSoFar $columnsSoFar $subgoalRelation $subgoalColumns
   856    973   	    }
   857    974   	    EQUALITY {
   858         -		# TODO - what to do here?
          975  +		tailcall my translateEquality $db \
          976  +		    [lindex $subgoal 1] [lindex $subgoal 2] \
          977  +		    $dataSoFar $columnsSoFar
   859    978   	    }
   860    979   	    LITERAL {
   861    980   		lassign \
   862    981   		    [my translateLiteral \
   863    982   			 $db $subgoal $dataSoFar $columnsSoFar] \
   864    983   		    subgoalRelation subgoalColumns
   865    984   		tailcall my translateSubgoalEnd $db JOIN \
................................................................................
   866    985   		    $dataSoFar $columnsSoFar $subgoalRelation $subgoalColumns
   867    986   	    }
   868    987   	    default {
   869    988   		error "in translateSubgoal: can't happen"
   870    989   	    }
   871    990   	}
   872    991       }
          992  +
          993  +    method translateEquality {db var1 var2 dataSoFar columnsSoFar} {
          994  +	set col1 [lindex $var1 1]
          995  +	set col2 [lindex $var2 1]
          996  +	set equality [my gensym #T]
          997  +	lappend intcode \
          998  +	    [list RELATION $equality [list $col1 $col2]] \
          999  +	    [list EQUALITY $equality $col1 $col2]
         1000  +	if {$dataSoFar eq {}} {
         1001  +	    return [list $equality [list $col1 $col2]]
         1002  +	} else {
         1003  +	    set joined [my gensym #T]
         1004  +	    lappend columnsSoFar $col1 $col2
         1005  +	    set columnsSoFar [lsort -dictionary -unique $columnsSoFar]
         1006  +	    lappend intcode \
         1007  +		[list RELATION $joined $columnsSoFar] \
         1008  +		[list JOIN $joined $dataSoFar $equality]
         1009  +	    return [list $joined $columnsSoFar]
         1010  +	}
         1011  +    }
   873   1012   
   874   1013       method translateLiteral {db literal dataSoFar columnsSoFar} {
   875   1014   	set predicate [lindex $literal 1]
   876   1015   	db relationMustExist $predicate
   877   1016   	set cols [db columns $predicate]
   878   1017   	if {[llength $cols] != [llength $literal]-2} {
   879   1018   	    set pplit [bdd::datalog::prettyprint-literal $literal]
................................................................................
   891   1030   	set renamedFrom {}
   892   1031   	set renamedTo {}
   893   1032   	foreach term [lrange $literal 2 end] col $cols {
   894   1033   	    switch -exact -- [lindex $term 0] {
   895   1034   		CONSTANT {
   896   1035   		    lappend selectLiteral $term
   897   1036   		    set needSelect 1
         1037  +		    set needProject 1
   898   1038   		}
   899   1039   		VARIABLE {
   900   1040   		    set varName [lindex $term 1]
   901   1041   		    lappend selectLiteral {VARIABLE _}
   902   1042   		    if {$varName eq {_}} {
   903   1043   			set needProject 1
   904   1044    		    } else {
................................................................................
   910   1050   			    lappend renamedFrom $col
   911   1051   			    lappend renamedTo $varName
   912   1052   			}
   913   1053   		    }
   914   1054   		}
   915   1055   	    }
   916   1056   	}
         1057  +
   917   1058   	if {$needSelect} {
   918   1059   	    lappend intcode [list RELATION $selector $cols]
   919   1060   	    my translateFact $db $selectLiteral $cols
   920   1061   	    lappend intcode [list JOIN $selector $selector $predicate]
   921   1062   	    set projectSource $selector
   922   1063   	} else {
   923   1064   	    set projectSource $predicate
   924   1065   	}
   925   1066   	if {$needProject} {
   926         -	    lappend intcode [list RELATION $projector $projectColumns]
   927         -	    lappend intcode [list PROJECT $projector $projectSource]
         1067  +	    lappend intcode \
         1068  +		[list RELATION $projector $projectColumns] \
         1069  +		[list PROJECT $projector $projectSource]
   928   1070   	    set renameSource $projector
   929   1071   	} else {
   930   1072   	    set renameSource $projectSource
   931   1073   	}
   932   1074   	if {[llength $renamedFrom] > 0} {
   933   1075   	    lappend intcode [list RELATION $renamed $renamedColumns]
   934   1076   	    set renameCommand [list RENAME $renamed $renameSource]
................................................................................
   953   1095   	    set resultRelation $dataThisOp
   954   1096   	    set resultColumns $columnsThisOp
   955   1097   	} else {
   956   1098   	    set resultColumns $columnsSoFar
   957   1099   	    lappend resultColumns {*}$columnsThisOp
   958   1100   	    set resultColumns [lsort -unique -dictionary $resultColumns]
   959   1101   	    set resultRelation [my gensym #T]
   960         -	    lappend intcode [list RELATION $resultRelation $resultColumns]
   961         -	    lappend intcode [list $operation $resultRelation \
   962         -				 $dataSoFar $dataThisOp]
         1102  +	    lappend intcode \
         1103  +		[list RELATION $resultRelation $resultColumns] \
         1104  +		[list $operation $resultRelation $dataSoFar $dataThisOp]
   963   1105   	}
   964   1106   	return [list $resultRelation $resultColumns]
   965   1107       }
   966   1108   
   967   1109       method translateRuleHead {db literal sourceRelation sourceColumns} {
   968   1110   	set predicate [lindex $literal 1]
   969   1111   	db relationMustExist $predicate
................................................................................
  1023   1165   	    if {[dict exists $destColumn $col]} {
  1024   1166   		lappend projectColumns $col
  1025   1167   	    } else {
  1026   1168   		set needProject 1
  1027   1169   	    }
  1028   1170   	}
  1029   1171   	if {$needProject} {
  1030         -	    lappend intcode [list RELATION $projector $projectColumns]
  1031         -	    lappend intcode [list PROJECT $projector $sourceRelation]
         1172  +	    lappend intcode \
         1173  +		[list RELATION $projector $projectColumns] \
         1174  +		[list PROJECT $projector $sourceRelation]
  1032   1175   	    set renameSource $projector
  1033   1176   	} else {
  1034   1177   	    set renameSource $sourceRelation
  1035   1178   	}
  1036   1179   
  1037   1180   	# Rename columns from literal to destination.
  1038   1181   	if {[llength $renamedFrom] > 0} {
         1182  +	    set renamed [my gensym \#T]
  1039   1183   	    lappend intcode [list RELATION $renamed $renamedColumns]
  1040   1184   	    set renameCommand [list RENAME $renamed $renameSource]
  1041   1185   	    foreach to $renamedTo from $renamedFrom {
  1042   1186   		lappend renameCommand $to $from
  1043   1187   	    }
  1044   1188   	    lappend intcode $renameCommand
  1045   1189   	    set joinSource $renamed
................................................................................
  1051   1195   
  1052   1196   	set joinColumns $renamedColumns
  1053   1197   	if {[llength $constantColumns] > 0} {
  1054   1198   	    lappend intcode [list RELATION $constant $constantColumns]
  1055   1199   	    my translateFact $db $constantLiteral $constantColumns
  1056   1200   	    lappend joinColumns {*}$constantColumns
  1057   1201   	    set joined [my gensym #T]
  1058         -	    lappend intcode [list RELATION $joined $joinColumns]
  1059         -	    lappend intcode [list JOIN $joined $joinSource $constant]
         1202  +	    lappend intcode \
         1203  +		[list RELATION $joined $joinColumns] \
         1204  +		[list JOIN $joined $joinSource $constant]
  1060   1205   	    set joinSource $joined
  1061   1206   	}
  1062   1207   
  1063   1208   	# Join with any don't-cares
  1064   1209   
  1065   1210   	if {[llength $dontCareColumns] > 0} {
  1066   1211   	    set dontCareRelation [my gensym #T]
  1067         -	    lappend intcode [list RELATION $dontCareRelation $dontCareColumns]
  1068         -	    lappend intcode [list SET $dontCareRelation _]
         1212  +	    lappend intcode \
         1213  +		[list RELATION $dontCareRelation $dontCareColumns] \
         1214  +		[list SET $dontCareRelation _]
  1069   1215   	    lappend joinColumns {*}$dontCareColumns
  1070   1216   	    set joined [my gensym #T]
  1071         -	    lappend intcode [list RELATION $joined $joinColumns]
  1072         -	    lappend intcode [list JOIN $joined $joinSource $dontCareRelation]
         1217  +	    lappend intcode \
         1218  +		[list RELATION $joined $joinColumns] \
         1219  +		[list JOIN $joined $joinSource $dontCareRelation]
  1073   1220   	    set joinSource $joined
  1074   1221   
  1075   1222   	}
  1076   1223   
  1077   1224   	# Union the result into the destination
  1078   1225   	lappend intcode [list UNION $predicate $predicate $joinSource]
  1079   1226   	
         1227  +    }
         1228  +
         1229  +    method generateCode {db icode args} {
         1230  +
         1231  +	set loaders {}
         1232  +
         1233  +	set prologue \n
         1234  +	set body \n
         1235  +	set epilogue \n
         1236  +
         1237  +	set ind0 {    }
         1238  +	set ind {    }
         1239  +
         1240  +	#append body $ind {puts {Start evaluation!}} \n
         1241  +	foreach instr $icode {
         1242  +	    # append body $ind [list puts $instr] \n
         1243  +	    switch -exact -- [lindex $instr 0] {
         1244  +		RELATION {
         1245  +		    $db relation [lindex $instr 1] {*}[lindex $instr 2]
         1246  +		    append prologue $ind0 [$db set [lindex $instr 1] {}] \n
         1247  +		    append epilogue $ind0 [$db set [lindex $instr 1] {}] \n
         1248  +		}
         1249  +		
         1250  +		ANTIJOIN {
         1251  +		    append body $ind \
         1252  +			[$db antijoin {*}[lrange $instr 1 end]] \n
         1253  +		}
         1254  +		BEGINLOOP {
         1255  +		    append body $ind "while 1 \{\n"
         1256  +		    set ind "$ind    "
         1257  +		}
         1258  +		ENDLOOP {
         1259  +		    set command [$db === [lindex $instr 1] [lindex $instr 2]]
         1260  +		    append body \
         1261  +			$ind if { } \{ \[ $command \] \} { } break \n
         1262  +		    set ind [string replace $ind end-3 end]
         1263  +		    append body $ind "\}" \n
         1264  +		}
         1265  +		EQUALITY {
         1266  +		    append body $ind \
         1267  +			[$db equate {*}[lrange $instr 1 end]] \n
         1268  +		}
         1269  +		JOIN {
         1270  +		    append body $ind \
         1271  +			[$db join {*}[lrange $instr 1 end]] \n
         1272  +		}
         1273  +		LOAD {
         1274  +		    # append body $ind # $instr \n
         1275  +		    set relation [lindex $instr 1]
         1276  +		    if {![dict exists $loaders $relation]} {
         1277  +			dict set loaders $relation [$db loader $relation]
         1278  +		    }
         1279  +		    append body $ind \
         1280  +			[dict get $loaders $relation]
         1281  +		    foreach val [lindex $instr 2] {
         1282  +			switch -exact -- [lindex $val 0] {
         1283  +			    INTEGER {
         1284  +				append body { } [lindex $val 1]
         1285  +			    }
         1286  +			    TCLVAR {
         1287  +				append body { } \$ [lindex $val 1]
         1288  +			    }
         1289  +			    default {
         1290  +				error "in generateCode: can't happen"
         1291  +			    }
         1292  +			}
         1293  +		    }
         1294  +		    append body \n
         1295  +		}
         1296  +		NEGATE {
         1297  +		    append body $ind \
         1298  +			[$db negate {*}[lrange $instr 1 end]] \n
         1299  +		}
         1300  +		PROJECT {
         1301  +		    append body $ind \
         1302  +			[$db project {*}[lrange $instr 1 end]] \n
         1303  +		}
         1304  +		RENAME {
         1305  +		    append body $ind \
         1306  +			[$db replace {*}[lrange $instr 1 end]] \n
         1307  +		}
         1308  +		SET {
         1309  +		    append body $ind \
         1310  +			[$db set {*}[lrange $instr 1 end]] \n
         1311  +		}
         1312  +		UNION {
         1313  +		    append body $ind \
         1314  +			[$db union {*}[lrange $instr 1 end]] \n
         1315  +		}
         1316  +
         1317  +		RESULT {
         1318  +		    if {[llength $args] != 2} {
         1319  +			error "wrong # args"; # TODO - better reporting
         1320  +		    }
         1321  +		    append body \
         1322  +			[list $db enumerate [lindex $args 0] \
         1323  +			     [lindex $instr 1] \
         1324  +			     [lindex $args 1]] \n
         1325  +		}
         1326  +
         1327  +		default {
         1328  +		    error "in generateCode: can't happen"
         1329  +		}
         1330  +	    }
         1331  +
         1332  +	}
         1333  +	return $prologue$body$epilogue
         1334  +
  1080   1335       }
  1081   1336   
  1082   1337       method getRule {ruleNo} {
  1083   1338   	return [lindex $rules $ruleNo]
  1084   1339       }
  1085   1340   
  1086   1341       method getRules {} {
................................................................................
  1261   1516   	}
  1262   1517   	yield $component
  1263   1518   
  1264   1519       }
  1265   1520       return
  1266   1521   }
  1267   1522   
  1268         -proc bdd::datalog::compileProgram {db programText} {
         1523  +proc bdd::datalog::compileProgram {db programText args} {
  1269   1524   
  1270   1525       variable parser
  1271   1526   
  1272   1527       try {
  1273   1528   
  1274   1529   	set program [bdd::datalog::program new]
  1275   1530   
................................................................................
  1276   1531   	# Do lexical analysis of the program
  1277   1532   	lassign [lex $programText] tokens values
  1278   1533   	
  1279   1534   	# Parse the program
  1280   1535   	set parseTree [$parser parse $tokens $values $program]
  1281   1536   	
  1282   1537   	# Extract the facts, rules, and edges joining the rules from the parse
  1283         -	set facts [$program getFacts]
  1284         -	set rules [$program getRules]
  1285         -	set outedges [$program getEdges]
         1538  +	if 0 {
         1539  +	    set facts [$program getFacts]
         1540  +	    set rules [$program getRules]
         1541  +	    set outedges [$program getEdges]
         1542  +	}
  1286   1543   	
  1287   1544   	set plan [$program planExecution]
  1288   1545   
  1289         -	# TODO - need to clear executionPlan?
  1290         -	set result [$program translateExecutionPlan $db $plan]
         1546  +	set intcode [$program translateExecutionPlan $db $plan]
  1291   1547   
  1292         -	# TODO - This sequence needs refactoring
         1548  +	# TODO: Here is where optimization should happen. And optimization
         1549  +	#       can be helped with Datalog?
         1550  +
         1551  +	set result [$program generateCode $db $intcode {*}$args]
  1293   1552   
  1294   1553       } finally {
  1295   1554   
  1296   1555   	$program destroy
  1297   1556   
  1298   1557       }
  1299   1558       return $result
................................................................................
  1414   1673   source [file join [file dirname [info script]] tclbdd.tcl]
  1415   1674   load [file join $buildDir libtclbdd0.1.so]
  1416   1675   source [file join [file dirname [info script]] tclfddd.tcl]
  1417   1676   source [file join [file dirname [info script]] .. examples loadProgram.tcl]
  1418   1677   source [file join [file dirname [info script]] .. examples program1.tcl]
  1419   1678   
  1420   1679   set vars [analyzeProgram $program db]
         1680  +set vnames [dict keys $vars]
  1421   1681   
  1422   1682   db relation seq st st2
  1423   1683   db relation writes st v
  1424   1684   db relation flowspast v st st2
  1425   1685   db relation reaches v st st2
  1426   1686   db relation uninitRead st v
  1427   1687   db relation deadWrite st v
         1688  +# db relation induction v st
  1428   1689   
  1429         -set i 0
  1430         -foreach step [bdd::datalog::compileProgram db {
         1690  +proc reaching_defs {} [bdd::datalog::compileProgram db {
  1431   1691    
  1432   1692       % A false entry node (node 0) sets every variable and flows
  1433   1693       % to node 1. If any of its variables are reachable, those are
  1434   1694       % variables possibly used uninitialized in the program.
  1435   1695   
  1436         -    writes($startNode, _).
         1696  +    writes(0, _).
  1437   1697       writes(st,v) :- writes0(st,v).
  1438         -    seq($startNode, 1).
         1698  +    seq(0, 1).
  1439   1699       seq(st,st2) :- seq0(st,st2).
  1440   1700   
  1441   1701       % flowspast(v,st,st2) means that control passes from the exit of st
  1442   1702       % to the entry of st2 without altering the value of v
  1443   1703   
  1444   1704       flowspast(_, st, st2) :- seq(st, st2).
  1445         -    flowspast(v, st, st2) :- flowspast(v, st, st3),
  1446         -                             !writes(st3, v),
  1447         -                             flowspast(v, st3, st2).
         1705  +    flowspast(v, st3, st2) :- flowspast(v, st3, st),
         1706  +                             !writes(st, v),
         1707  +                             flowspast(v, st, st2).
  1448   1708   
  1449   1709       % reaches(v,st,st2) means that st assigns a value to v, which
  1450   1710       % reaches st2, which reads the value of v : that is, st is a
  1451   1711       % reaching definition for the use of v at st2.
  1452   1712   
  1453   1713       reaches(v, st, st2) :- writes(st, v), flowspast(v, st, st2), reads(st2, v).
  1454   1714   
  1455   1715       % A variable read that is reachable from the entry is a read of a
  1456   1716       % possibly uninitialized variable
  1457   1717   
  1458         -    uninitRead(st, v) :- reaches(v, $startNode, st).
  1459         -
  1460         -    % The following statement is nonsense, but tests a constant in the head.
  1461         -
  1462         -    uninitRead(st, $ENV) :- reads(st, $ENV).
         1718  +    uninitRead(st, v) :- reaches(v, 0, st).
  1463   1719   
  1464   1720       % A variable write that reaches nowhere else is dead code
  1465   1721   
  1466   1722       deadWrite(st, v) :- writes(st, v), !reaches(v, st, _).
  1467   1723   
  1468         -    % Also do the bddbddb example. Only 1 stratum, but 2 loops in the larger SCC
         1724  +}]
         1725  +
         1726  +# Report which variable definitions reach statement $i
         1727  +proc query1 {i} [bdd::datalog::compileProgram db {
         1728  +    reaches(v, st, $i)?
         1729  +} d {
         1730  +    lappend ::flowsto [lindex $::vnames [dict get $d v]] [dict get $d st]
         1731  +}]
  1469   1732   
  1470         -    % vP(v, h) :- vP0(v,h).
  1471         -    % vP(v1,h) :- assign(v1,v2), vP(v2,h).
  1472         -    % hP(h1,f,h2) :- store(v1,f,v2), vP(v1,h1), vP(v2,h2).
  1473         -    % vP(v2,h2) :- load(v1,f,v2), vP(v1,h1), hP(h1,f,h2).
         1733  +# Report which variable uses flow from statement $i
         1734  +proc query2 {i} [bdd::datalog::compileProgram db {
         1735  +    reaches(v, $i, st)?
         1736  +} d {
         1737  +    lappend ::flowsfrom [lindex $::vnames [dict get $d v]] [dict get $d st]
         1738  +}]
         1739  +    
         1740  +puts [info body reaching_defs]
  1474   1741   
  1475         -    % Compile dead code query
  1476         -
  1477         -    deadWrite(st, v)?
  1478         -
  1479         -}] {
  1480         -    puts "$i: $step"
         1742  +reaching_defs
         1743  +puts [format {%-16s %2s  %-32s %-16s} PRODUCERS {} INSTRUCTIONS CONSUMERS]
         1744  +set i 0
         1745  +foreach stmt $program {
         1746  +    set flowsto {}
         1747  +    query1 $i
         1748  +    set flowsfrom {}
         1749  +    query2 $i
         1750  +    puts [format "%-16s %2d: %-32s %-16s" \
         1751  +	      [lsort -stride 2 -index 0 -ascii \
         1752  +		   [lsort -stride 2 -index 1 -integer $flowsto]] \
         1753  +	      $i \
         1754  +	      $stmt \
         1755  +	      [lsort -stride 2 -index 0 -ascii \
         1756  +		   [lsort -stride 2 -index 1 -integer $flowsfrom]]]
  1481   1757       incr i
  1482   1758   }

Changes to library/tclfddd.tcl.

   726    726   		lappend result $p [dict get $cmdpos $column] $bit
   727    727   	    }
   728    728   	    incr p
   729    729   	}
   730    730   	set cmd [list [namespace which sys] load $relation $result]
   731    731   	return $cmd
   732    732       }
          733  +
          734  +    # Method: negate
          735  +    #
          736  +    #	Generates code to compute the complement of a relation. All
          737  +    #	tuples over the relation's domain will be in the output relation
          738  +    #	if they are not in the input
          739  +    #
          740  +    # Usage:
          741  +    #	$db union $dest $source
          742  +    #
          743  +    # Parameters:
          744  +    #	dest    - Name of the relation that will receive the complement
          745  +    #   source1 - Name of the input relation
          746  +    #
          747  +    # Results:
          748  +    #	Returns a burst of code that computes the complement of the
          749  +    #   relation
          750  +    #
          751  +    # Both relations must contain the same set of columns.
          752  +    #
          753  +    # This method does not compute the complement; it returns a fragment
          754  +    # of code that computes it.
          755  +    #
          756  +    # The time taken to compute the complement is linear in the 
          757  +    # size of the BDD.
          758  +
          759  +    method negate {dest source} {
          760  +	my relationMustExist $dest
          761  +	my relationMustExist $source
          762  +	my ColumnsMustBeSame $dest $source
          763  +	return [list [namespace which sys] ~ $dest $source]
          764  +    }
   733    765   
   734    766       # Method: profile
   735    767       #
   736    768       #	Determines the number of BDD beads in use for each variable.
   737    769       #
   738    770       # Parameters:
   739    771       #	relation - Relation to profile