tclbdd

Check-in [aa0c89ccc1]
Login

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

Overview
Comment:Clean up packaging a little bit, again.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:aa0c89ccc18bd868fb86457585a97a48d91796dc
User & Date: kbk 2014-01-10 02:00:42
Context
2014-01-10
02:18
Try to make installer work check-in: ce07ff5188 user: kbk tags: trunk
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added examples/reach2.tcl.













































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
source loadscript.tcl

package require tclbdd::datalog

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]
set vnames [dict keys $vars]

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

proc reaching_defs {} [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(0, _).
    writes(st,v) :- writes0(st,v).
    seq(0, 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, st3, st2) :- flowspast(v, st3, st),
                             !writes(st, v),
                             flowspast(v, st, 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, 0, st).

    % A variable write that reaches nowhere else is dead code

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

}]

# Report which variable definitions reach statement $i
proc query1 {i} [bdd::datalog::compileProgram db {
    reaches(v, st, $i)?
} d {
    lappend ::flowsto [lindex $::vnames [dict get $d v]] [dict get $d st]
}]

# Report which variable uses flow from statement $i
proc query2 {i} [bdd::datalog::compileProgram db {
    reaches(v, $i, st)?
} d {
    lappend ::flowsfrom [lindex $::vnames [dict get $d v]] [dict get $d st]
}]
    
puts [info body reaching_defs]

reaching_defs
puts [format {%-16s %2s  %-32s %-16s} PRODUCERS {} INSTRUCTIONS CONSUMERS]
set i 0
foreach stmt $program {
    set flowsto {}
    query1 $i
    set flowsfrom {}
    query2 $i
    puts [format "%-16s %2d: %-32s %-16s" \
	      [lsort -stride 2 -index 0 -ascii \
		   [lsort -stride 2 -index 1 -integer $flowsto]] \
	      $i \
	      $stmt \
	      [lsort -stride 2 -index 0 -ascii \
		   [lsort -stride 2 -index 1 -integer $flowsfrom]]]
    incr i
}

Changes to library/datalog.tcl.

6
7
8
9
10
11
12
13
14
15
16


17
18
19
20
21
22
23
....
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
# Copyright (c) 2013 by Kevin B. Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

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

    }
    return $result

}

package provide tclbdd::datalog 0.1

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

if {![info exists ::argv0] || [string compare $::argv0 [info script]]} return

# TEMP - lexer stuff - maybe work out better unit tests!
if 0 {
namespace import bdd::datalog::lex

lassign [lex {
    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) :- writes(St, V), flowspast(V, St, St2), reads(St2, V).
}] types values
foreach t $types v $values {
    puts "$t: $v"
}

lassign [lex {
    reaches(V, $i, St2)?
}] types values
foreach t $types v $values {
    puts "$t: $v"
}
}

if 0 {
# TEMP parser stuff - need to do better unit testing!

set parseTree [$::bdd::datalog::parser parse {*}[bdd::datalog::lex {
 
    % 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).
}]]

puts $parseTree

set parseTree2 [$bdd::datalog::parser parse {*}[bdd::datalog::lex {
    reaches(v, $i, st2)?
}]]

puts $parseTree2


# Parse tree structure
# PROGRAM statements
# statement:
#   ASSERTION clause
#   RETRACTION clause
#   QUERY literal
# clause:
#   FACT literal
#   RULE Name subgoals
# subgoal:
#   literal
#   EQUALITY variable variable
# literal:
#   NOT literal
#   LITERAL Name terms
# term:
#   CONSTANT const
#   variable
# variable:
#   VARIABLE name

}

# TEMP printing stuff - needs to go somewhere...

proc bdd::datalog::prettyprint-plan {plan {indent 0}} {
    foreach step $plan {
	switch -exact [lindex $step 0] {
	    FACT {
		puts [format {%*sFACT %s.} $indent {} \
			  [prettyprint-literal [lindex $step 1]]]
	    }
	    LOOP {
		puts [format "%*sLOOP %s \{" $indent {} [lindex $step 1]]
		prettyprint-plan [lindex $step 2] [expr {$indent + 4}]
		puts [format "%*s\}" $indent {}]
	    }
	    RULE {
		puts [format {%*sRULE %s.} $indent {} \
			  [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]
set vnames [dict keys $vars]

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
# db relation induction v st

proc reaching_defs {} [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(0, _).
    writes(st,v) :- writes0(st,v).
    seq(0, 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, st3, st2) :- flowspast(v, st3, st),
                             !writes(st, v),
                             flowspast(v, st, 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, 0, st).

    % A variable write that reaches nowhere else is dead code

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

}]

# Report which variable definitions reach statement $i
proc query1 {i} [bdd::datalog::compileProgram db {
    reaches(v, st, $i)?
} d {
    lappend ::flowsto [lindex $::vnames [dict get $d v]] [dict get $d st]
}]

# Report which variable uses flow from statement $i
proc query2 {i} [bdd::datalog::compileProgram db {
    reaches(v, $i, st)?
} d {
    lappend ::flowsfrom [lindex $::vnames [dict get $d v]] [dict get $d st]
}]
    
puts [info body reaching_defs]

reaching_defs
puts [format {%-16s %2s  %-32s %-16s} PRODUCERS {} INSTRUCTIONS CONSUMERS]
set i 0
foreach stmt $program {
    set flowsto {}
    query1 $i
    set flowsfrom {}
    query2 $i
    puts [format "%-16s %2d: %-32s %-16s" \
	      [lsort -stride 2 -index 0 -ascii \
		   [lsort -stride 2 -index 1 -integer $flowsto]] \
	      $i \
	      $stmt \
	      [lsort -stride 2 -index 0 -ascii \
		   [lsort -stride 2 -index 1 -integer $flowsfrom]]]
    incr i
}







<
<
<

>
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
6
7
8
9
10
11
12



13
14
15
16
17
18
19
20
21
22
....
1555
1556
1557
1558
1559
1560
1561




































































































































































































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




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

namespace import coroutine::corovar::corovar

namespace eval bdd {
................................................................................

    }
    return $result

}

package provide tclbdd::datalog 0.1




































































































































































































Changes to loadscript.tcl.in.

1
2












3
4
5
6
7
8
9
10



# Script to define the local packages when testing against an uninstalled
# tclbdd













package ifneeded tclbdd @PACKAGE_VERSION@ {
    source [file join {@LIBRARY_SRCDIR@} tclbdd.tcl]
    load [file join . @PKG_LIB_FILE@] tclbdd
}
package ifneeded tclbdd::fddd @PACKAGE_VERSION@ {
    source [file join {@LIBRARY_SRCDIR@} tclfddd.tcl]
}





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








>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
# Script to define the local packages when testing against an uninstalled
# tclbdd

# TEMP - Two packages that really ought to be in the coroutine area of
#        tcllib

package ifneeded coroutine::corovar 1.0 {
    source [file join {@LIBRARY_SRCDIR@} coroutine_corovar.tcl]
}
package ifneeded coroutine::iterator 1.0 {
    source [file join {@LIBRARY_SRCDIR@} coroutine_iterator.tcl]
}

# Actual packages of tclbdd

package ifneeded tclbdd @PACKAGE_VERSION@ {
    source [file join {@LIBRARY_SRCDIR@} tclbdd.tcl]
    load [file join . @PKG_LIB_FILE@] tclbdd
}
package ifneeded tclbdd::fddd @PACKAGE_VERSION@ {
    source [file join {@LIBRARY_SRCDIR@} tclfddd.tcl]
}
package ifneeded tclbdd::datalog @PACKAGE_VERSION@ {
    source [file join {@LIBRARY_SRCDIR@} datalog.tcl]
}

Changes to pkgIndex.tcl.in.

1
2
3










4
5
6
7
8


#
# Tcl package index file
#










package ifneeded @PACKAGE_NAME@ @PACKAGE_VERSION@ \
    "[list source [file join $dir @PACKAGE_NAME@.tcl]]\;\
     [list load [file join $dir @PKG_LIB_FILE@] @PACKAGE_NAME@]"
package ifneeded @PACKAGE_NAME@::fddd @PACKAGE_VERSION@ \
    [list source [file join $dir tclfddd.tcl]]





>
>
>
>
>
>
>
>
>
>





>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
#
# Tcl package index file
#

# TEMP - Two packages that really ought to be in Tcllib's coroutine area

package ifneeded coroutine::corovar 1.0 \
    [list source [file join $dir coroutine_corovar.tcl]]
package ifneeded coroutine::iterator 1.0 \
    [list source [file join $dir coroutine_iterator.tcl]]

# Actual packages for this library

package ifneeded @PACKAGE_NAME@ @PACKAGE_VERSION@ \
    "[list source [file join $dir @PACKAGE_NAME@.tcl]]\;\
     [list load [file join $dir @PKG_LIB_FILE@] @PACKAGE_NAME@]"
package ifneeded @PACKAGE_NAME@::fddd @PACKAGE_VERSION@ \
    [list source [file join $dir tclfddd.tcl]]
package ifneeded @PACKAGE_NAME@::datalog @PACKAGE_VERSION@ \
    [list source [file join $dir datalog.tcl]]