SQLite

sqlite3_analyzer$(TEXE): sqlite3_analyzer.c
	$(LTLINK) sqlite3_analyzer.c -o $@ $(LIBTCL) $(TLIBS)

sqlite3_expert$(TEXE): $(TOP)/ext/expert/sqlite3expert.h $(TOP)/ext/expert/sqlite3expert.c $(TOP)/ext/expert/expert.c sqlite3.c
	$(LTLINK)	$(TOP)/ext/expert/sqlite3expert.h $(TOP)/ext/expert/sqlite3expert.c $(TOP)/ext/expert/expert.c sqlite3.c -o sqlite3_expert $(TLIBS)

sqlite3_schemalint.c: sqlite3.c $(TOP)/src/tclsqlite.c $(TOP)/tool/schemalint.tcl
	echo "#define TCLSH 2" > $@
	echo "#define SQLITE_ENABLE_DBSTAT_VTAB 1" >> $@
	cat sqlite3.c $(TOP)/src/tclsqlite.c >> $@
	echo "static const char *tclsh_main_loop(void){" >> $@
	echo "static const char *zMainloop = " >> $@
	$(TCLSH_CMD) $(TOP)/tool/tostr.tcl $(TOP)/tool/schemalint.tcl >> $@
	echo "; return zMainloop; }" >> $@

sqlite3_schemalint$(TEXE): $(TESTSRC) sqlite3_schemalint.c
	$(LTLINK) $(TCL_FLAGS) $(TESTFIXTURE_FLAGS)                  \
		sqlite3_schemalint.c $(TESTSRC)               \
		-o sqlite3_schemalint$(EXE) $(LIBTCL) $(TLIBS)

dbdump$(TEXE): $(TOP)/ext/misc/dbdump.c sqlite3.lo
	$(LTLINK) -DDBDUMP_STANDALONE -o $@ \
           $(TOP)/ext/misc/dbdump.c sqlite3.lo $(TLIBS)

showdb$(TEXE):	$(TOP)/tool/showdb.c sqlite3.lo
	$(LTLINK) -o $@ $(TOP)/tool/showdb.c sqlite3.lo $(TLIBS)

sqlite3_analyzer.exe:	sqlite3_analyzer.c $(LIBRESOBJS)
	$(LTLINK) $(NO_WARN) -DBUILD_sqlite -I$(TCLINCDIR) sqlite3_analyzer.c \
		/link $(LDFLAGS) $(LTLINKOPTS) $(LTLIBPATHS) $(LIBRESOBJS) $(LTLIBS) $(TLIBS)

sqlite3_expert.exe: $(SQLITE3C) $(TOP)\ext\expert\sqlite3expert.h $(TOP)\ext\expert\sqlite3expert.c $(TOP)\ext\expert\expert.c
	$(LTLINK) $(NO_WARN)	$(TOP)\ext\expert\sqlite3expert.c $(TOP)\ext\expert\expert.c $(SQLITE3C) $(TLIBS)

sqlite3_schemalint.c: $(SQLITE3C) $(SQLITE3H) $(TOP)\src\tclsqlite.c $(TOP)\tool\schemalint.tcl $(SQLITE_TCL_DEP)
	echo "#define TCLSH 2" > $@
	echo "#define SQLITE_ENABLE_DBSTAT_VTAB 1" >> $@
	copy $@ + $(SQLITE3C) + $(TOP)\src\tclsqlite.c >> $@
	echo "static const char *tclsh_main_loop(void){" >> $@
	echo "static const char *zMainloop = " >> $@
	$(TCLSH_CMD) $(TOP)\tool\tostr.tcl $(TOP)\tool\schemalint.tcl >> $@
	echo "; return zMainloop; }" >> $@

sqlite3_schemalint.exe: $(TESTSRC) sqlite3_schemalint.c
	$(LTLINK) $(NO_WARN) -DBUILD_sqlite -I$(TCLINCDIR) sqlite3_schemalint.c \
		/link $(LDFLAGS) $(LTLINKOPTS) $(LTLIBPATHS) $(LIBRESOBJS) $(LTLIBS) $(TLIBS)

dbdump.exe:	$(TOP)\ext\misc\dbdump.c $(SQLITE3C) $(SQLITE3H)
	$(LTLINK) $(NO_WARN) -DDBDUMP_STANDALONE $(TOP)\ext\misc\dbdump.c $(SQLITE3C) \
		/link $(LDFLAGS) $(LTLINKOPTS) $(LTLIBPATHS) $(LIBRESOBJS) $(LTLIBS)

testloadext.lo:	$(TOP)\src\test_loadext.c
	$(LTCOMPILE) $(NO_WARN) -c $(TOP)\src\test_loadext.c

sqlite3_analyzer$(EXE): sqlite3_analyzer.c
	$(TCCX) $(TCL_FLAGS) sqlite3_analyzer.c -o $@ $(LIBTCL) $(THREADLIB) 

sqlite3_expert$(EXE): $(TOP)/ext/expert/sqlite3expert.h $(TOP)/ext/expert/sqlite3expert.c $(TOP)/ext/expert/expert.c sqlite3.c
	$(TCCX) $(TOP)/ext/expert/sqlite3expert.h $(TOP)/ext/expert/sqlite3expert.c $(TOP)/ext/expert/expert.c sqlite3.c -o sqlite3_expert $(THREADLIB)

sqlite3_schemalint.c: sqlite3.c $(TOP)/src/tclsqlite.c $(TOP)/tool/schemalint.tcl
	echo "#define TCLSH 2" > $@
	echo "#define SQLITE_ENABLE_DBSTAT_VTAB 1" >> $@
	cat sqlite3.c $(TOP)/src/tclsqlite.c >> $@
	echo "static const char *tclsh_main_loop(void){" >> $@
	echo "static const char *zMainloop = " >> $@
	tclsh $(TOP)/tool/tostr.tcl $(TOP)/tool/schemalint.tcl >> $@
	echo "; return zMainloop; }" >> $@

sqlite3_schemalint$(EXE): $(TESTSRC) sqlite3_schemalint.c $(TOP)/ext/session/test_session.c
	$(TCCX) $(TCL_FLAGS) $(TESTFIXTURE_FLAGS)                  \
		sqlite3_schemalint.c $(TESTSRC) $(TOP)/ext/session/test_session.c  \
		-o sqlite3_schemalint$(EXE) $(LIBTCL) $(THREADLIB)

dbdump$(EXE):	$(TOP)/ext/misc/dbdump.c sqlite3.o
	$(TCCX) -DDBDUMP_STANDALONE -o dbdump$(EXE) \
            $(TOP)/ext/misc/dbdump.c sqlite3.o $(THREADLIB)

# Rules to build the 'testfixture' application.
#
TESTFIXTURE_FLAGS  = -DSQLITE_TEST=1 -DSQLITE_CRASH_TEST=1

if {[catch {

set ::VERBOSE 0

proc usage {} {
  puts stderr "Usage: $::argv0 ?SWITCHES? DATABASE/SCHEMA"
  puts stderr "  Switches are:"
  puts stderr "  -select SQL     (recommend indexes for SQL statement)"
  puts stderr "  -verbose        (increase verbosity of output)"
  puts stderr "  -test           (run internal tests and then exit)"
  puts stderr ""
  exit
}

# Return the quoted version of identfier $id. Quotes are only added if 
# they are required by SQLite.
#
# This command currently assumes that quotes are required if the 
# identifier contains any ASCII-range characters that are not 
# alpha-numeric or underscores.
#
proc quote {id} {
  if {[requires_quote $id]} {
    set x [string map {\" \"\"} $id]
    return "\"$x\""
  }
  return $id
}
proc requires_quote {id} {
  foreach c [split $id {}] {
    if {[string is alnum $c]==0 && $c!="_"} {
      return 1
    }
  }
  return 0
}

# The argument passed to this command is a Tcl list of identifiers. The
# value returned is the same list, except with each item quoted and the
# elements comma-separated.
#
proc list_to_sql {L} {
  set ret [list]
  foreach l $L {
    lappend ret [quote $l]
  }
  join $ret ", "
}

proc readfile {zFile} {
  set fd [open $zFile]
  set data [read $fd]
  close $fd
  return $data
}

proc process_cmdline_args {ctxvar argv} {
  upvar $ctxvar G
  set nArg [llength $argv]
  set G(database) [lindex $argv end]

  for {set i 0} {$i < [llength $argv]-1} {incr i} {
    set k [lindex $argv $i]
    switch -- $k {
      -select {
        incr i
        if {$i>=[llength $argv]-1} usage
        set zSelect [lindex $argv $i]
        if {[file readable $zSelect]} {
          lappend G(lSelect) [readfile $zSelect]
        } else {
          lappend G(lSelect) $zSelect
        }
      }
      -verbose {
        set ::VERBOSE 1
      }
      -test {
        sqlidx_internal_tests
      }
      default {
        usage
      }
    }
  }

  if {$G(database)=="-test"} {
    sqlidx_internal_tests
  }
}

proc open_database {ctxvar} {
  upvar $ctxvar G
  sqlite3 db ""

  # Check if the "database" file is really an SQLite database. If so, copy
  # it into the temp db just opened. Otherwise, assume that it is an SQL
  # schema and execute it directly.
  set fd [open $G(database)]
  set hdr [read $fd 16]
  if {$hdr == "SQLite format 3\000"} {
    close $fd
    sqlite3 db2 $G(database)
    sqlite3_backup B db main db2 main
    B step 2000000000
    set rc [B finish]
    db2 close
    if {$rc != "SQLITE_OK"} { error "Failed to load database $G(database)" }
  } else {
    append hdr [read $fd]
    db eval $hdr
    close $fd
  }
}

proc analyze_selects {ctxvar} {
  upvar $ctxvar G
  set G(trace) ""

  # Collect a line of xTrace output for each loop in the set of SELECT
  # statements.
  proc xTrace {zMsg} { 
    upvar G G
    lappend G(trace) $zMsg 
  }
  db trace xTrace
  foreach s $G(lSelect) {
    set stmt [sqlite3_prepare_v2 db $s -1 dummy]
    set rc [sqlite3_finalize $stmt]
    if {$rc!="SQLITE_OK"} {
      error "Failed to compile SQL: [sqlite3_errmsg db]"
    }
  }

  db trace ""
  if {$::VERBOSE} {
    foreach t $G(trace) { puts "trace: $t" }
  }

  # puts $G(trace)
}

# The argument is a list of the form:
#
#    key1 {value1.1 value1.2} key2 {value2.1 value 2.2...}
#
# Values lists may be of any length greater than zero. This function returns
# a list of lists created by pivoting on each values list. i.e. a list
# consisting of the elements:
#
#   {{key1 value1.1} {key2 value2.1}}
#   {{key1 value1.2} {key2 value2.1}}
#   {{key1 value1.1} {key2 value2.2}}
#   {{key1 value1.2} {key2 value2.2}}
#
proc expand_eq_list {L} {
  set ll [list {}]
  for {set i 0} {$i < [llength $L]} {incr i 2} {
    set key [lindex $L $i]
    set new [list]
    foreach piv [lindex $L $i+1] {
      foreach l $ll {
        lappend new [concat $l [list [list $key $piv]]]
      }
    }
    set ll $new
  }

  return $ll
}

#--------------------------------------------------------------------------
# Formulate a CREATE INDEX statement that creates an index on table $tname.
#
proc eqset_to_index {ctxvar aCollVar tname eqset {range {}}} {
  upvar $ctxvar G
  upvar $aCollVar aColl

  set rangeset [list]
  foreach e [lsort $eqset] {
    lappend rangeset [lindex $e 0] [lindex $e 1] ASC
  }
  set rangeset [concat $rangeset $range]

  set lCols [list]
  set idxname $tname

  foreach {c collate dir} $rangeset {
    append idxname "_$c"
    set coldef [quote $c]

    if {[string compare -nocase $collate $aColl($c)]!=0} {
      append idxname [string tolower $collate]
      append coldef " COLLATE [quote $collate]"
    }

    if {$dir=="DESC"} {
      append coldef " DESC"
      append idxname "desc"
    }
    lappend lCols $coldef
  }

  set create_index "CREATE INDEX [quote $idxname] ON [quote $tname]("
  append create_index [join $lCols ", "]
  append create_index ");"

  set G(trial.$idxname) $create_index
}

proc expand_or_cons {L} {
  set lRet [list [list]]
  foreach elem $L {
    set type [lindex $elem 0]
    if {$type=="eq" || $type=="range"} {
      set lNew [list]
      for {set i 0} {$i < [llength $lRet]} {incr i} {
        lappend lNew [concat [lindex $lRet $i] [list $elem]]
      }
      set lRet $lNew
    } elseif {$type=="or"} {
      set lNew [list]
      foreach branch [lrange $elem 1 end] {
        foreach b [expand_or_cons $branch] {
          for {set i 0} {$i < [llength $lRet]} {incr i} {
            lappend lNew [concat [lindex $lRet $i] $b]
          }
        }
      }
      set lRet $lNew
    } 
  }
  return $lRet
}

#--------------------------------------------------------------------------
# Argument $tname is the name of a table in the main database opened by
# database handle [db]. $arrayvar is the name of an array variable in the
# caller's context. This command populates the array with an entry mapping 
# from column name to default collation sequence for each column of table
# $tname. For example, if a table is declared:
#
#   CREATE TABLE t1(a COLLATE nocase, b, c COLLATE binary)
#
# the mapping is populated with:
#
#   map(a) -> "nocase"
#   map(b) -> "binary"
#   map(c) -> "binary"
#
proc sqlidx_get_coll_map {tname arrayvar} {
  upvar $arrayvar aColl
  set colnames [list]
  set qname [quote $tname]
  db eval "PRAGMA table_info = $qname" x { lappend colnames $x(name) }
  db eval "CREATE INDEX schemalint_test ON ${qname}([list_to_sql $colnames])"
  db eval "PRAGMA index_xinfo = schemalint_test" x { 
    set aColl($x(name)) $x(coll)
  }
  db eval "DROP INDEX schemalint_test"
}

proc find_trial_indexes {ctxvar} {
  upvar $ctxvar G
  foreach t $G(trace) {
    set tname [lindex $t 0]
    catch { array unset mask }

    # Invoke "PRAGMA table_info" on the table. Use the results to create
    # an array mapping from column name to collation sequence. Store the
    # array in local variable aColl.
    #
    sqlidx_get_coll_map $tname aColl

    set orderby [list]
    if {[lindex $t end 0]=="orderby"} {
      set orderby [lrange [lindex $t end] 1 end]
    }

    foreach lCons [expand_or_cons [lrange $t 2 end]] {

      # Populate the array mask() so that it contains an entry for each
      # combination of prerequisite scans that may lead to distinct sets
      # of constraints being usable.
      #
      catch { array unset mask }
      set mask(0) 1
      foreach a $lCons {
        set type [lindex $a 0]
        if {$type=="eq" || $type=="range"} {
          set m [lindex $a 3]
          foreach k [array names mask] { set mask([expr ($k & $m)]) 1 }
          set mask($m) 1
        }
      }

      # Loop once for each distinct prerequisite scan mask identified in
      # the previous block.
      #
      foreach k [array names mask] {

        # Identify the constraints available for prerequisite mask $k. For
        # each == constraint, set an entry in the eq() array as follows:
        # 
        #   set eq(<col>) <collation>
        #
        # If there is more than one == constraint for a column, and they use
        # different collation sequences, <collation> is replaced with a list
        # of the possible collation sequences. For example, for:
        #
        #   SELECT * FROM t1 WHERE a=? COLLATE BINARY AND a=? COLLATE NOCASE
        #
        # Set the following entry in the eq() array:
        #
        #   set eq(a) {binary nocase}
        #
        # For each range constraint found an entry is appended to the $ranges
        # list. The entry is itself a list of the form {<col> <collation>}.
        #
        catch {array unset eq}
        set ranges [list]
        foreach a $lCons {
          set type [lindex $a 0]
          if {$type=="eq" || $type=="range"} {
            foreach {type col collate m} $a {
              if {($m & $k)==$m} {
                if {$type=="eq"} {
                  lappend eq($col) $collate
                } else {
                  lappend ranges [list $col $collate ASC]
                }
              }
            }
          }
        }
        set ranges [lsort -unique $ranges]
        if {$orderby != ""} {
          lappend ranges $orderby
        }

        foreach eqset [expand_eq_list [array get eq]] {
          if {$eqset != ""} {
            eqset_to_index G aColl $tname $eqset
          }

          foreach r $ranges {
            set tail [list]
            foreach {c collate dir} $r {
              set bSeen 0
              foreach e $eqset {
                if {[lindex $e 0] == $c} {
                  set bSeen 1
                  break
                }
              }
              if {$bSeen==0} { lappend tail {*}$r }
            }
            if {[llength $tail]} {
              eqset_to_index G aColl $tname $eqset $r
            }
          }
        }
      }
    }
  }

  if {$::VERBOSE} {
    foreach k [array names G trial.*] { puts "index: $G($k)" }
  }
}

proc run_trials {ctxvar} {
  upvar $ctxvar G
  set ret [list]

  foreach k [array names G trial.*] {
    set idxname [lindex [split $k .] 1]
    db eval $G($k)
    set pgno [db one {SELECT rootpage FROM sqlite_master WHERE name = $idxname}]
    set IDX($pgno) $idxname
  }
  db eval ANALYZE

  catch { array unset used }
  foreach s $G(lSelect) {
    db eval "EXPLAIN $s" x {
      if {($x(opcode)=="OpenRead" || $x(opcode)=="ReopenIdx")} {
        if {[info exists IDX($x(p2))]} { set used($IDX($x(p2))) 1 }
      }
    }
    foreach idx [array names used] {
      lappend ret $G(trial.$idx)
    }
  }

  set ret
}

proc sqlidx_init_context {varname} {
  upvar $varname G
  set G(lSelect)  [list]           ;# List of SELECT statements to analyze
  set G(database) ""               ;# Name of database or SQL schema file
  set G(trace)    [list]           ;# List of data from xTrace()
}

#-------------------------------------------------------------------------
# The following is test code only.
#
proc sqlidx_one_test {tn schema select expected} {
#  if {$tn!=2} return
  sqlidx_init_context C

  sqlite3 db ""
  db collate "a b c" [list string compare]
  db eval $schema
  lappend C(lSelect) $select
  analyze_selects C
  find_trial_indexes C

  set idxlist [run_trials C]
  if {$idxlist != [list {*}$expected]} {
    puts stderr "Test $tn failed"
    puts stderr "Expected: $expected"
    puts stderr "Got: $idxlist"
    exit -1
  }

  db close

  upvar nTest nTest
  incr nTest
}

proc sqlidx_internal_tests {} {
  set nTest 0


  # No indexes for a query with no constraints.
  sqlidx_one_test 0 {
    CREATE TABLE t1(a, b, c);
  } {
    SELECT * FROM t1;
  } {
  }

  sqlidx_one_test 1 {
    CREATE TABLE t1(a, b, c);
    CREATE TABLE t2(x, y, z);
  } {
    SELECT a FROM t1, t2 WHERE a=? AND x=c
  } {
    {CREATE INDEX t2_x ON t2(x);}
    {CREATE INDEX t1_a_c ON t1(a, c);}
  }

  sqlidx_one_test 2 {
    CREATE TABLE t1(a, b, c);
  } {
    SELECT * FROM t1 WHERE b>?;
  } {
    {CREATE INDEX t1_b ON t1(b);}
  }

  sqlidx_one_test 3 {
    CREATE TABLE t1(a, b, c);
  } {
    SELECT * FROM t1 WHERE b COLLATE nocase BETWEEN ? AND ?
  } {
    {CREATE INDEX t1_bnocase ON t1(b COLLATE NOCASE);}
  }

  sqlidx_one_test 4 {
    CREATE TABLE t1(a, b, c);
  } {
    SELECT a FROM t1 ORDER BY b;
  } {
    {CREATE INDEX t1_b ON t1(b);}
  }

  sqlidx_one_test 5 {
    CREATE TABLE t1(a, b, c);
  } {
    SELECT a FROM t1 WHERE a=? ORDER BY b;
  } {
    {CREATE INDEX t1_a_b ON t1(a, b);}
  }

  sqlidx_one_test 5 {
    CREATE TABLE t1(a, b, c);
  } {
    SELECT min(a) FROM t1
  } {
    {CREATE INDEX t1_a ON t1(a);}
  }

  sqlidx_one_test 6 {
    CREATE TABLE t1(a, b, c);
  } {
    SELECT * FROM t1 ORDER BY a ASC, b COLLATE nocase DESC, c ASC;
  } {
    {CREATE INDEX t1_a_bnocasedesc_c ON t1(a, b COLLATE NOCASE DESC, c);}
  }

  sqlidx_one_test 7 {
    CREATE TABLE t1(a COLLATE NOCase, b, c);
  } {
    SELECT * FROM t1 WHERE a=?
  } {
    {CREATE INDEX t1_a ON t1(a);}
  }

  # Tables with names that require quotes.
  #
  sqlidx_one_test 8.1 {
    CREATE TABLE "t t"(a, b, c);
  } {
    SELECT * FROM "t t" WHERE a=?
  } {
    {CREATE INDEX "t t_a" ON "t t"(a);}
  }
  sqlidx_one_test 8.2 {
    CREATE TABLE "t t"(a, b, c);
  } {
    SELECT * FROM "t t" WHERE b BETWEEN ? AND ?
  } {
    {CREATE INDEX "t t_b" ON "t t"(b);}
  }
  
  # Columns with names that require quotes.
  #
  sqlidx_one_test 9.1 {
    CREATE TABLE t3(a, "b b", c);
  } {
    SELECT * FROM t3 WHERE "b b" = ?
  } {
    {CREATE INDEX "t3_b b" ON t3("b b");}
  }
  sqlidx_one_test 9.2 {
    CREATE TABLE t3(a, "b b", c);
  } {
    SELECT * FROM t3 ORDER BY "b b"
  } {
    {CREATE INDEX "t3_b b" ON t3("b b");}
  }

  # Collations with names that require quotes.
  #
  sqlidx_one_test 10.1 {
    CREATE TABLE t4(a, b, c);
  } {
    SELECT * FROM t4 ORDER BY c COLLATE "a b c"
  } {
    {CREATE INDEX "t4_ca b c" ON t4(c COLLATE "a b c");}
  }
  sqlidx_one_test 10.2 {
    CREATE TABLE t4(a, b, c);
  } {
    SELECT * FROM t4 WHERE c = ? COLLATE "a b c"
  } {
    {CREATE INDEX "t4_ca b c" ON t4(c COLLATE "a b c");}
  }

  # Transitive constraints
  #
  sqlidx_one_test 11.1 {
    CREATE TABLE t5(a, b);
    CREATE TABLE t6(c, d);
  } {
    SELECT * FROM t5, t6 WHERE a=? AND b=c AND c=?
  } {
    {CREATE INDEX t6_c ON t6(c);} 
    {CREATE INDEX t5_a_b ON t5(a, b);}
  }

  puts "All $nTest tests passed"
  exit
}
# End of internal test code.
#-------------------------------------------------------------------------

if {[info exists ::argv0]==0} { set ::argv0 [info nameofexec] }
if {[info exists ::argv]==0} usage
sqlidx_init_context D
process_cmdline_args D $::argv
open_database D
analyze_selects D
find_trial_indexes D
foreach idx [run_trials D] { puts $idx }

} err]} {
  puts "ERROR: $err"
  puts $errorInfo
  exit 1
}