tclbdd

Check-in [ba20005fb0]
Login

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

Overview
Comment:Major code cleanup and commentary in tclfddd.tcl.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:ba20005fb0529ce9ac108dd56fbbb8d7a4e65707
User & Date: kbk 2013-12-23 03:18:47
Context
2013-12-28
05:06
Added the Datalog compiler (under construction - only the parser and the stratification pass are implemented so far). check-in: a24b8ef7c3 user: kbk tags: trunk
2013-12-23
03:18
Major code cleanup and commentary in tclfddd.tcl. check-in: ba20005fb0 user: kbk tags: trunk
2013-12-21
21:51
Regularize and streamling FDDD database API. Begin commenting the FDDD database methods. check-in: baa39949c5 user: kbk tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to library/tclfddd.tcl.

256
257
258
259
260
261
262













































































263
264
265
266
267
268
269
...
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
...
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
383
384
385
386
387
388
389
390
391
392
393


394
395
396
397
398
399
400
...
420
421
422
423
424
425
426


427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
...
467
468
469
470
471
472
473







































































474
475
476
477
478
479
480
481
482
483
484
485
486


487
488
489
490
491
492
493
...
503
504
505
506
507
508
509


510
511
512
513
514
515
516
...
527
528
529
530
531
532
533

534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557

558
559
560
561
562
563
564
565
566

567

568
569
570
571
572
573
574
...
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
...
606
607
608
609
610
611
612

613
614
615
616

617
618
619






620
621
622
623
624



625




























626
627
628
629
630
631
632
633
634
635
636
637
638
639

640
641
642
643
644
645






































































































































646
647
648
649
650
651
652
...
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
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
	set m_relcolumns {}

	# Create the underlying system of BDD's in the current object's
	# namespace.

	bdd::system create [namespace current]::sys
    }














































































    # Private method: Varlist
    #	
    #	Enumerates the BDD variables that make up a relation.
    #
    # Usage:
    #	$db Varlist $relation
................................................................................
    #
    # This method does not perform the test directly: it generates
    # code to perform the test.
    #
    # The test executes in constant time.

    method === {rel1 rel2} {
	if {![dict exists $m_relcolumns $rel1]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $rel1] \
		"relation \"$rel1\" is not defined in this database"
	}
	if {![dict exists $m_relcolumns $rel2]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $rel2] \
		"relation \"$rel2\" is not defined in this database"
	}
	if {[dict get $m_relcolumns $rel1]
	    ne [dict get $m_relcolumns $rel2]} {
	    return -code error \
		-errorcode [list FDDD WrongColumns $rel1 $rel2] \
		"relations \"$rel1\" and \"$rel2\" have different columns"
	}
	return [list [namespace which sys] === $rel1 $rel2]
    }
    export ===

    # Method: antijoin
    #
    #	Generates code to antijoin a pair of relations
................................................................................
    # relation. This is well defined for any two relations: if either
    # relation contains excess columns, the other relation is presumed
    # to contain tuples with every possible value in those columns.
    # Of course, the excess columns may be projected away before or
    # after the antijoin. Most commonly, the columns of $source2 will
    # all appear in $source1.
    #

    # The result will have the union of the columns of the two inputs.
    #
    # This method does not perform the copy directly: it generates
    # code to perform the copy.
    #
    # The antijoin executes in time proportional to the size of the
    # source1 BDD.

    method antijoin {dest source1 source2} {
	if {![dict exists $m_relcolumns $dest]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $dest] \
		"relation \"$dest\" is not defined in this database"
	}
	if {![dict exists $m_relcolumns $source1]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $source1] \
		"relation \"$source1\" is not defined in this database"
	}
	if {![dict exists $m_relcolumns $source2]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $source2] \
		"relation \"$source2\" is not defined in this database"
	}

	set destcolumns [dict get $m_relcolumns $source1]
	lappend destcolumns {*}[dict get $m_relcolumns $source2]
	set destcolumns [lsort -ascii -unique $destcolumns]
	set destcolumns_sb [dict get $m_relcolumns $dest]
	if {$destcolumns ne $destcolumns_sb} {
	    return -code error \
		-errorcode [list FDDD BadJoin $destcolumns $destcolumns_sb] \
		"result of the antijoin has columns $destcolumns but the\
                 target relation has columns $destcolumns_sb"

	}


	return [list [namespace which sys] > $dest $source1 $source2]
    }

    # Method: columns
    #
    #	Enumerates all columns in the database
    #
    # Usage:
    #	$db columns
    #
    # Results:
    #	Returns a list of the column names that are known to the databsae.



    method columns {} {
	return [dict keys $m_columns]
    }

    # Method: enumerate
    #
................................................................................
    # If evaluating the script causes an error, the iteration is terminated.
    # If the script performs a return, the return has its natural meaning.
    # If the script performs a break or continue, the iteration is
    # terminated (for a break) or recommences with the next tuple
    # (for a continue).
    # [return -code 6] is synonymous with [break]
    # Any other nonstandard status code terminates the iteration.



    method enumerate {dictvar relation script} {
	upvar 1 $dictvar valdict

	# Make sure the relation exists
	if {![dict exists $m_relcolumns $relation]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $relation] \
		"relation \"$relation\" is not defined in this database"
	}

	# Iterate over the relation, getting SAT terms. Iterate over
	# the variable assignments that satisfy the terms.
	sys foreach_sat satterm $relation {
	    bdd::foreach_fullsat vars [my Varlist $relation] $satterm {

		# Iterate over the columns and populate the dictionary
................................................................................
		} on continue {} {
		    continue
		}
	    }
	}
	return
    }








































































    # Method: forget
    #
    #	Removes relations from the database
    #
    # Usage:
    #	db forget ?relation...?
    #
    # Parameters:
    #	relation... - Names of relations to remove
    #
    # Results:
    #	None.



    method forget_relation {args} {
	foreach name $args {
	    sys unset $name
	    dict unset m_relcolumns $name
	}
	return
................................................................................
    # Results:
    #	Returns the number of beads in the BDD system after garbage collection
    #
    # This method should not ordinarily be called; the incremental garbage
    # collector is faster than the mark and sweep done by this call. This call
    # exists for leak checking, making sure that all beads are reclaimed after
    # a unit test.



    method gc {} {
	return [sys gc]
    }

    # Method: join
    #
................................................................................
    # relation. This is well defined for any two relations: if either
    # relation contains excess columns, the other relation is presumed
    # to contain tuples with every possible value in those columns.
    # Of course, the excess columns may be projected away before or
    # after the join. Most commonly, the columns of $source2 will
    # all appear in $source1.
    #

    # The result will have the union of the columns of the two inputs.
    #
    # This method does not perform the copy directly: it generates
    # code to perform the copy.
    #
    # The join executes in time proportional to the size of the
    # source1 BDD.

    method join {dest source1 source2} {
	if {![dict exists $m_relcolumns $dest]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $dest] \
		"relation \"$dest\" is not defined in this database"
	}
	if {![dict exists $m_relcolumns $source1]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $source1] \
		"relation \"$source1\" is not defined in this database"
	}
	if {![dict exists $m_relcolumns $source2]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $source2] \
		"relation \"$source2\" is not defined in this database"
	}

	set destcolumns [dict get $m_relcolumns $source1]
	lappend destcolumns {*}[dict get $m_relcolumns $source2]
	set destcolumns [lsort -ascii -unique $destcolumns]
	set destcolumns_sb [dict get $m_relcolumns $dest]
	if {$destcolumns ne $destcolumns_sb} {
	    return -code error \
		-errorcode [list FDDD BadJoin $destcolumns $destcolumns_sb] \
		"result of the join has columns $destcolumns but the\
                 target relation has columns $destcolumns_sb"

	}

	return [list [namespace which sys] & $dest $source1 $source2]
    }

    # Method: loader
    #
    #	Generates code to call the BDD engine to construct a term 
    #   corresponding to a tuple in a finite domain.
................................................................................
    #   relation - Name of the relation being loaded
    #
    # Results:
    #	Returns a command prefix for a command that will add a tuple
    #	to the given relation.
    #
    # To the prefix should be appended the values of the columns,
    # in [lsort -ascii] order by the colun names.

    method loader {relation} {
	if {![dict exists $m_relcolumns $relation]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $relation] \
		"relation \"$relation\" is not defined in this database"
	}
	set i 0
	foreach column [dict get $m_relcolumns $relation] {
	    dict set cmdpos $column $i
	    incr i
	}
	set result {}
	set p 0
................................................................................
	    }
	    incr p
	}
	set cmd [list [namespace which sys] load $relation $result]
	return $cmd
    }



    method project {dest source} {
	# columns to project away are determined by dest and source
	if {![dict exists $m_relcolumns $dest]} {

	    return -code error \
		-errorcode [list FDDD RelationNotDefined $dest] \
		"relation \"$dest\" is not defined in this database"






	}
	if {![dict exists $m_relcolumns $source]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $source] \
		"relation \"$source\" is not defined in this database"



	}




























	set discards {}
	foreach col [dict get $m_relcolumns $dest] {
	    dict set want $col {}
	}
	foreach col [dict get $m_relcolumns $source] {
	    if {![dict exists $want $col]} {
		lappend discards {*}[dict get $m_columns $col]
	    } else {
		dict unset want $col
	    }
	}
	if {[dict size $want] != 0} {
	    return -code error \
		-errorcode [list FDDD ProjectColumnMissing {*}[dict keys $want]]\

		"columns missing from source relation: [dict keys $want]"
	}
	return [list [namespace which sys] project $dest \
		    [lsort -integer $discards] $source]
	return
    }







































































































































    # Method: set
    #
    #	Generates code to copy one relation to another
    #
    # Usage:
    #	$db set $dest $source
................................................................................
    #
    # This method does not perform the copy directly: it generates
    # code to perform the copy.
    #
    # The copy executes in constant time.

    method set {dest source} {
	if {![dict exists $m_relcolumns $dest]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $dest] \
		"relation \"$dest\" is not defined in this database"
	}
	if {$source eq {}} {
	    set source 0
	} elseif {$source eq {_}} {
	    set source 1
	} else {
	    if {![dict exists $m_relcolumns $source]} {
		return -code error \
		    -errorcode [list FDDD RelationNotDefined $source] \
		    "relation \"$source\" is not defined in this database"
	    }
	    if {[dict get $m_relcolumns $dest]
		ne [dict get $m_relcolumns $source]} {
		return -code error \
		    -errorcode [list FDDD WrongColumns $dest $source] \
		    "relations \"$dest\" and \"$source\" have different columns"
	    }
	}
	return [list [namespace which sys] := $dest $source]
    }

    method equate {dest col1 col2} {
	if {![dict exists $m_columns $col1]} {
	    return -code error -errorcode [list FDDD NoSuchColumn $col1] \
		"no such column: \"$col1\""
	}
	if {![dict exists $m_columns $col2]} {
	    return -code error -errorcode [list FDDD NoSuchColumn $col2] \
		"no such column: \"$col2\""
	}
	set vars1 [dict get $m_columns $col1]
	set vars2 [dict get $m_columns $col2]
	if {[llength $vars1] != [llength $vars2]} {
	    return -code error \
		-errorcode [list FDDD EquateWrongDomains $col1 $col2] \
		"cannot equate domains \"$col1\" and \"$col2\":\
                 sizes do not match"
	}
	# TODO - Typecheck $dest and sort one list in decreasing order by var#
	sys := $dest 1
	foreach v $vars1 v2 $vars2 {
	    sys nthvar _a $v
	    sys nthvar _b $v2
	    sys == temp _a _b
	    sys & $dest $dest temp
	}
	sys unset temp _a _b
    }

    method load {name list} {
	if {![dict exists $m_relcolumns $name]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $name] \
		"relation \"$name\" is not defined in this database"
	}
	set nColumns [llength [dict get $m_relcolumns $name]]
	if {[llength $list] % $nColumns != 0} {
	    return -code error \
		-errorcode [list FDDD WrongListLength $nColumns] \
		"list must have a multiple of $nColumns values"
	}
	set reader [my loader $name]
................................................................................
	set nCM1 [expr {$nColumns - 1}]
	while {[llength $list] > 0} {
	    {*}$reader {*}[lrange $list 0 $nCM1]
	    set list [lreplace ${list}[set list {}] 0 $nCM1]
	}
	return
    }

    method profile {relation} {
	if {![dict exists $m_relcolumns $relation]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $relation] \
		"relation \"$relation\" is not defined in this database"
	}
	sys profile $relation
    }

    method relation {name args} {
	if {[dict exists $m_relcolumns $name]} {
	    return -code error \
		-errorcode [list FDDD RelationAlreadyDefined $name] \
		"relation \"$name\" is already defined in this database"
	}
	set havecol {}
	foreach col $args {
	    if {[dict exists $havecol $col]} {
		return -code error -errorcode [list FDDD DuplicateColumn $col] \
		    "column $col is duplicated in the column list"
	    }
	    if {![dict exists $m_columns $col]} {
		return -code error -errorcode [list FDDD NoSuchColumn $col] \
		    "no such column: \"$col\""
	    }
	    dict set $havecol $col {}
	}
	dict set m_relcolumns $name [lsort -ascii $args]
	return $name
    }

    method replace {dest source args} {
	if {![dict exists $m_relcolumns $dest]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $dest] \
		"relation \"$dest\" is not defined in this database"
	}
	if {![dict exists $m_relcolumns $source]} {
	    return -code error \
		-errorcode [list FDDD RelationNotDefined $source] \
		"relation \"$source\" is not defined in this database"
	}
	set sourcecols {}
	foreach col [dict get $m_relcolumns $source] {
	    dict set sourcecols $col {}
	}
	set destcols {}
	foreach col [dict get $m_relcolumns $dest] {
	    dict set destcols $col {}
	}
	set colsAdded {}
	foreach {to from} $args {
	    if {[dict exists $colsAdded $to]} {
		return -code error \
		    -errorcode [list FDDD DuplicateProjectOutput $to] \
		    "attempt to rename two input columns to \"$to\""
	    }
	    if {![dict exists $sourcecols $from]} {
		return -code error \
		    -errorcode [list FDDD BadProjectInput $from] \
		    "attempt to rename an input column \"from\" that\
		     does not exist or has already been renamed"
	    }
	    if {![dict exists $destcols $to]} {
		return -code error \
		    -errorcode [list FDDD BadProjectOutput $to] \
		    "attempt to rename an input column to \"$to\",
                     which does not exist in \"$dest\""
	    }
	    dict unset sourcecols $from
	    dict set colsAdded $to {}
	}
	foreach {to from} $args {
	    if {[dict exists $sourcecols $to]} {
		return -code error \
		    -errorcode [list FDDD ProjectOutputOverInput $to] \
		    "attempt to rename an input column to \"$to\",
                     but another input column already has that name."
	    }
	    dict set sourcecols $to {}
	}
	if {[lsort [dict keys $sourcecols]] ne [dict get $m_relcolumns $dest]} {
	    return -code error \
		-errorcode [list FDDD ProjectWrongColumns \
				[dict keys $sourcecols] \
				[dict get $m_relcolumns $dest]] \
		"replacement yields columns [dict keys $sourcecols]\
                 but target relation has columns\
                 [dict get $m_relcolumns $dest]"
	}
	set fromvars {}
	set tovars {}
	foreach {to from} $args {
	    set tv [dict get $m_columns $to]
	    set fv [dict get $m_columns $from]
	    if {[llength $tv] < [llength $fv]} {
		return -code error \
		    -errorcode [list FDDD ProjectColumnTooNarrow $from $to] \
		    "replacement column \"$to\" is to narrow to hold values\
                     from column \"$from\""
	    }
	    lappend fromvars {*}$fv
	    lappend tovars {*}[lrange $tv 0 [expr {[llength $fv] - 1}]]
	}
	return [list [namespace which sys] replace $dest $fromvars $tovars $source]
    }
	    

    method union {dest source1 source2} {
	# TODO typecheck
	return [list [namespace which sys] | $dest $source1 $source2]
    }
}

package provide tclbdd::fddd 0.1







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







 







|
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
|








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


|
<
<
<
<
<
<
>
|
<
>












>
>







 







>
>




|
<
<
<
<
<







 







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













>
>







 







>
>







 







>
|








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


|
<
<
<
<
<
<
>
|
>







 







|


|
<
<
<
<







 







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













|
>






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







 







|
<
<
<
<





|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
<
<
<
<







 







|
<
<
<
<
<
|
<
|

<
<
<
<
<
|
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
...
378
379
380
381
382
383
384
385
386
387













388
389
390
391
392
393
394
...
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423

424










425
426
427
428






429
430

431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485





486
487
488
489
490
491
492
...
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
...
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
...
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670

671










672
673
674
675






676
677
678
679
680
681
682
683
684
685
...
692
693
694
695
696
697
698
699
700
701
702




703
704
705
706
707
708
709
...
713
714
715
716
717
718
719
720
721

722

723
724
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
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
...
940
941
942
943
944
945
946
947




948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
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
	set m_relcolumns {}

	# Create the underlying system of BDD's in the current object's
	# namespace.

	bdd::system create [namespace current]::sys
    }

    # Private method: ColumnsMustBe
    #
    #	Makes sure that a relation has the correct set of columns
    #
    # Usage:
    #	my ColumnsMustBe $rel $cols
    #
    # Parameters:
    #	rel - Name of the relation
    #   cols - Names of the columns that the relation must have, in
    #          dictionary order
    #
    # Results:
    #	Returns an empty result if the column set of the relation is correct.
    #   Causes the caller to return an error if it is different.

    method ColumnsMustBe {rel cols} {
	if {[dict get $m_relcolumns $rel] ne $cols} {
	    return -level 2 -code error \
		-errorcode [list FDDD WrongColumns $rel \
				[dict get $m_relcolumns $rel] $cols] \
		"relation \"$rel\" has columns\
                 [join [dict get $m_relcolumns $rel] {, }] but should have\
                 columns [join $cols {, }]"
	}
	return
    }

    # Private method: ColumnsMustBeSame
    #
    #	Makes sure that two relations span the same sets of columns
    #
    # Usage:
    #	my ColumnsMustBeSame $rel1 $rel2
    #
    # Parameters:
    #	rel1 - Name of the first relation
    #   rel2 - Name of the second relation
    #
    # Results:
    #	Returns an empty result if the column sets of the two relations
    #   are the same. Causes the caller to return an error if they are 
    #   different.

    method ColumnsMustBeSame {rel1 rel2} {
	if {[dict get $m_relcolumns $rel1]
	    ne [dict get $m_relcolumns $rel2]} {
	    return -level 2 -code error \
		-errorcode [list FDDD DifferentColumns $rel1 $rel2] \
		"relations \"$rel1\" and \"$rel2\" have different columns"
	}
	return
    }

    # Private method: RelationMustExist
    #
    #	Makes sure that a given relation exists in the database
    #
    # Usage:
    #	my RelationMustExist $name
    #
    # Parameters:
    #	name - Name of a relation
    #
    # Results:
    #	Returns an empty result if the relation exists. Causes the caller
    #	to return an error if the relation is not found.

    method RelationMustExist {name} {
	if {![dict exists $m_relcolumns $name]} {
	    return -level 2 -code error \
		-errorcode [list FDDD RelationNotDefined $name] \
		"relation \"$name\" is not defined in this database"
	}
	return
    }

    # Private method: Varlist
    #	
    #	Enumerates the BDD variables that make up a relation.
    #
    # Usage:
    #	$db Varlist $relation
................................................................................
    #
    # This method does not perform the test directly: it generates
    # code to perform the test.
    #
    # The test executes in constant time.

    method === {rel1 rel2} {
	my RelationMustExist $rel1
	my RelationMustExist $rel2
	my ColumnsMustBeSame $rel1 $rel2













	return [list [namespace which sys] === $rel1 $rel2]
    }
    export ===

    # Method: antijoin
    #
    #	Generates code to antijoin a pair of relations
................................................................................
    # relation. This is well defined for any two relations: if either
    # relation contains excess columns, the other relation is presumed
    # to contain tuples with every possible value in those columns.
    # Of course, the excess columns may be projected away before or
    # after the antijoin. Most commonly, the columns of $source2 will
    # all appear in $source1.
    #
    # The columns of the result relation must be the union of the
    # columns of the two inputs.
    #
    # This method does not perform the copy directly: it generates
    # code to perform the copy.
    #
    # The antijoin executes in time proportional to the size of the
    # source1 BDD.

    method antijoin {dest source1 source2} {
	my RelationMustExist $dest
	my RelationMustExist $source1
	my RelationMustExist $source2












	# Determine the columns in the joined relations
	set destcolumns [dict get $m_relcolumns $source1]
	lappend destcolumns {*}[dict get $m_relcolumns $source2]
	set destcolumns [lsort -dictionary -unique $destcolumns]






	my ColumnsMustBe $dest $destcolumns


	# Make code to do the antijoin
	return [list [namespace which sys] > $dest $source1 $source2]
    }

    # Method: columns
    #
    #	Enumerates all columns in the database
    #
    # Usage:
    #	$db columns
    #
    # Results:
    #	Returns a list of the column names that are known to the databsae.
    #
    # This method executes directly, rather than returning a code fragment

    method columns {} {
	return [dict keys $m_columns]
    }

    # Method: enumerate
    #
................................................................................
    # If evaluating the script causes an error, the iteration is terminated.
    # If the script performs a return, the return has its natural meaning.
    # If the script performs a break or continue, the iteration is
    # terminated (for a break) or recommences with the next tuple
    # (for a continue).
    # [return -code 6] is synonymous with [break]
    # Any other nonstandard status code terminates the iteration.
    #
    # This method executes directly, rather than returning a code fragment

    method enumerate {dictvar relation script} {
	upvar 1 $dictvar valdict

	my RelationMustExist $relation






	# Iterate over the relation, getting SAT terms. Iterate over
	# the variable assignments that satisfy the terms.
	sys foreach_sat satterm $relation {
	    bdd::foreach_fullsat vars [my Varlist $relation] $satterm {

		# Iterate over the columns and populate the dictionary
................................................................................
		} on continue {} {
		    continue
		}
	    }
	}
	return
    }

    # Method: equate
    #
    #	Generates code for an equality constraint (which is a partial
    #	implementation of a self join).
    #
    # Usage:
    #	db equate dest col1 col2
    #
    # Parameters:
    #	dest - Name of a relation that will contain one row for each
    #          value in its domain that has col1 == col2
    #   col1 - Name of the first column to equate
    #   col2 - Name of the second column to equate
    #
    # Results:
    #	Returns a fragment of code that creates the given relation.
    #
    # The destination relation must contain both col1 and col2 as columns.
    # The domains of col1 and col2 must have the same size.
    #
    # This method does not create the equality relation; it returns a fragment
    # of code that does it.
    #
    # The time taken to create the equality is highly variable. In the case
    # where the two columns' variables are interleaved, the time is linear
    # in the number of bits of the domains. In the case where they are
    # concatenated, both time and space are exponential in the number of
    # variables. Other orderings will give results between these two extremes.

    method equate {dest col1 col2} {
	my RelationMustExist $dest
	set destcolumns [dict get $m_relcolumns $dest]
	if {![dict exists $m_columns $col1] 
	    | [lsearch -exact $destcolumns $col1] == -1} {
	    return -code error -errorcode [list FDDD NoSuchColumn $col1] \
		"no such column: \"$col1\""
	}
	if {![dict exists $m_columns $col2]
	    | [lsearch -exact $destcolumns $col2] == -1} {
	    return -code error -errorcode [list FDDD NoSuchColumn $col2] \
		"no such column: \"$col2\""
	}
	set vars1 [dict get $m_columns $col1]
	set vars2 [dict get $m_columns $col2]
	if {[llength $vars1] != [llength $vars2]} {
	    return -code error \
		-errorcode [list FDDD EquateWrongDomains $col1 $col2] \
		"cannot equate domains \"$col1\" and \"$col2\":\
                 sizes do not match"
	}

	# Sort the variables in descending order by the first column's
	# positions. This will keep them ordered well for the rename in
	# the easy cases.

	set vlist {}
	foreach v $vars1 v2 $vars2 {
	    lappend vlist $v $v2
	}
	set vlist [lsort -stride 2 -integer -index 0 -decreasing $vlist]
	set code [list sys := $dest 1]
	foreach {v v2} $vlist {
	    append code \; [list sys nthvar :a $v]
	    append code \; [list sys nthvar :b $v2]
	    append code \; [list sys == :t :a :b]
	    append code \; [list sys & $dest $dest :t]
	}
	append code \; [list sys unset :a :b :t]
	return $code
    }

    # Method: forget
    #
    #	Removes relations from the database
    #
    # Usage:
    #	db forget ?relation...?
    #
    # Parameters:
    #	relation... - Names of relations to remove
    #
    # Results:
    #	None.
    #
    # This method executes directly, rather than returning a code fragment.

    method forget_relation {args} {
	foreach name $args {
	    sys unset $name
	    dict unset m_relcolumns $name
	}
	return
................................................................................
    # Results:
    #	Returns the number of beads in the BDD system after garbage collection
    #
    # This method should not ordinarily be called; the incremental garbage
    # collector is faster than the mark and sweep done by this call. This call
    # exists for leak checking, making sure that all beads are reclaimed after
    # a unit test.
    #
    # This method executes directly, rather than returning a code fragment

    method gc {} {
	return [sys gc]
    }

    # Method: join
    #
................................................................................
    # relation. This is well defined for any two relations: if either
    # relation contains excess columns, the other relation is presumed
    # to contain tuples with every possible value in those columns.
    # Of course, the excess columns may be projected away before or
    # after the join. Most commonly, the columns of $source2 will
    # all appear in $source1.
    #
    # The columns of the result relation must be the union of the
    # columns of the two inputs.
    #
    # This method does not perform the copy directly: it generates
    # code to perform the copy.
    #
    # The join executes in time proportional to the size of the
    # source1 BDD.

    method join {dest source1 source2} {
	my RelationMustExist $dest
	my RelationMustExist $source1
	my RelationMustExist $source2












	# Determine the columns in the joined relations
	set destcolumns [dict get $m_relcolumns $source1]
	lappend destcolumns {*}[dict get $m_relcolumns $source2]
	set destcolumns [lsort -dictionary -unique $destcolumns]






	my ColumnsMustBe $dest $destcolumns

	# Make code to do the join
	return [list [namespace which sys] & $dest $source1 $source2]
    }

    # Method: loader
    #
    #	Generates code to call the BDD engine to construct a term 
    #   corresponding to a tuple in a finite domain.
................................................................................
    #   relation - Name of the relation being loaded
    #
    # Results:
    #	Returns a command prefix for a command that will add a tuple
    #	to the given relation.
    #
    # To the prefix should be appended the values of the columns,
    # in dictonary order by the column names.

    method loader {relation} {
	my RelationMustExist $relation




	set i 0
	foreach column [dict get $m_relcolumns $relation] {
	    dict set cmdpos $column $i
	    incr i
	}
	set result {}
	set p 0
................................................................................
	    }
	    incr p
	}
	set cmd [list [namespace which sys] load $relation $result]
	return $cmd
    }

    # Method: profile
    #

    #	Determines the number of BDD beads in use for each variable.

    #
    # Parameters:
    #	relation - Relation to profile

    #
    # Results:
    #	Returns a list ordered by variable level giving the number of
    #	beads at each level
    #
    # This method executes directly, rather than returning a codeburst.





    method profile {relation} {
	my RelationMustExist $relation
	sys profile $relation
    }

    # Method: project
    #
    #	Uses existential quantification to project a relation onto
    #	a smaller domain.
    #
    # Usage:
    #	$db project $dest $source
    #
    # Parameters:
    #	dest   - Name of the output relation
    #	source - name of the input relation
    #
    # Results:
    #	Returns a fragment of code that will perform the projection
    #
    # All columns of the result relation must be present in the source.
    #
    # This method does not perform the projection directly: it generates
    # code to perform the projection.
    #
    # The projection executes in time proportional to the size of the
    # source BDD.

    method project {dest source} {
	# columns to project away are determined by dest and source
	my RelationMustExist $dest
	my RelationMustExist $source
	set discards {}
	foreach col [dict get $m_relcolumns $dest] {
	    dict set want $col {}
	}
	foreach col [dict get $m_relcolumns $source] {
	    if {![dict exists $want $col]} {
		lappend discards {*}[dict get $m_columns $col]
	    } else {
		dict unset want $col
	    }
	}
	if {[dict size $want] != 0} {
	    return -code error \
		-errorcode [list FDDD ProjectColumnMissing \
				{*}[dict keys $want]]\
		"columns missing from source relation: [dict keys $want]"
	}
	return [list [namespace which sys] project $dest \
		    [lsort -integer $discards] $source]
	return
    }

    # Method: relation
    #
    #	Defines a relation in the database
    #
    # Usage:
    #	$db relation $name ?column...?
    #
    # Parameters:
    #	name      - Name of the relation
    #	column... - Set of columns that the relation constrains
    #
    # Results:
    #	None.
    #
    # Side effects:
    #	The given relation is defined. Its content in the database
    #	is left undefined. It must either be loaded or populated by
    #	a rule such as 'join' or 'union' prior to being used.

    method relation {name args} {
	if {[dict exists $m_relcolumns $name]} {
	    return -code error \
		-errorcode [list FDDD RelationAlreadyDefined $name] \
		"relation \"$name\" is already defined in this database"
	}
	set havecol {}
	foreach col $args {
	    if {[dict exists $havecol $col]} {
		return -code error -errorcode [list FDDD DuplicateColumn $col] \
		    "column $col is duplicated in the column list"
	    }
	    if {![dict exists $m_columns $col]} {
		return -code error -errorcode [list FDDD NoSuchColumn $col] \
		    "no such column: \"$col\""
	    }
	    dict set $havecol $col {}
	}
	dict set m_relcolumns $name [lsort -dictionary $args]
	return $name
    }

    # Method: replace
    #
    #	Generates code to reassign physical domains in a relation
    #
    # Usage:
    #	$db replace dest source ?outcol incol?...
    #
    # Parameters:
    #	dest   - Name of the output relation
    #   source - Name of the input relation
    #	outcol, incol - List of pairs of the name of a column of the
    #                   output relation and the name of the corresponding
    #                   column of the input.
    #
    # Results:
    #	Returns a fragment of code that performs the replacement.
    #
    # The destination relation must have the correct set of columns
    # defined after the replacement. All columns are replaced simultaneously.
    #
    # This method does not perform the replacement; it returns a fragment
    # of code that does it.
    #
    # The time taken for the replacement is highly variable. In the case
    # where all the BDD variables of the replacement columns are in
    # the same order as those of the input columns (RECOMMENDED), it
    # is linear in the size of the input BDD. In the worst case of variable
    # reordering, it may be exponential in the size of the input BDD.
    # This will happen, for instance, if an equality over an interleaved
    # pair of columns is replaced with an equality over a concatenated pair.

    method replace {dest source args} {
	my RelationMustExist $dest
	my RelationMustExist $source
	set sourcecols {}
	foreach col [dict get $m_relcolumns $source] {
	    dict set sourcecols $col {}
	}
	set destcols {}
	foreach col [dict get $m_relcolumns $dest] {
	    dict set destcols $col {}
	}
	set colsAdded {}
	foreach {to from} $args {
	    if {[dict exists $colsAdded $to]} {
		return -code error \
		    -errorcode [list FDDD DuplicateReplaceOutput $to] \
		    "attempt to rename two input columns to \"$to\""
	    }
	    if {![dict exists $sourcecols $from]} {
		return -code error \
		    -errorcode [list FDDD BadReplaceInput $from] \
		    "attempt to rename an input column \"from\" that\
		     does not exist or has already been renamed"
	    }
	    if {![dict exists $destcols $to]} {
		return -code error \
		    -errorcode [list FDDD BadReplaceOutput $to] \
		    "attempt to rename an input column to \"$to\",
                     which does not exist in \"$dest\""
	    }
	    dict unset sourcecols $from
	    dict set colsAdded $to {}
	}
	foreach {to from} $args {
	    if {[dict exists $sourcecols $to]} {
		return -code error \
		    -errorcode [list FDDD ReplaceOutputOverInput $to] \
		    "attempt to rename an input column to \"$to\",
                     but another input column already has that name."
	    }
	    dict set sourcecols $to {}
	}
	my ColumnsMustBe $dest [lsort -dictionary [dict keys $sourcecols]]

	set fromvars {}
	set tovars {}
	foreach {to from} $args {
	    set tv [dict get $m_columns $to]
	    set fv [dict get $m_columns $from]
	    if {[llength $tv] < [llength $fv]} {
		return -code error \
		    -errorcode [list FDDD ReplaceColumnTooNarrow $from $to] \
		    "replacement column \"$to\" is to narrow to hold values\
                     from column \"$from\""
	    }
	    lappend fromvars {*}$fv
	    lappend tovars {*}[lrange $tv 0 [expr {[llength $fv] - 1}]]
	}

	return [list [namespace which sys] replace $dest $fromvars $tovars $source]
    }

    # Method: set
    #
    #	Generates code to copy one relation to another
    #
    # Usage:
    #	$db set $dest $source
................................................................................
    #
    # This method does not perform the copy directly: it generates
    # code to perform the copy.
    #
    # The copy executes in constant time.

    method set {dest source} {
	my RelationMustExist $dest




	if {$source eq {}} {
	    set source 0
	} elseif {$source eq {_}} {
	    set source 1
	} else {
	    my RelationMustExist $source
	    my ColumnsMustBeSame $dest $source
	}
	return [list [namespace which sys] := $dest $source]
    }

    # Method: union
    #
    #	Generates code to compute the union of two relations
    #
    # Usage:
    #	$db union $dest $source1 $source2
    #
    # Parameters:
    #	dest    - Name of the relation that will receive the union
    #   source1 - Name of the first input relation
    #   source2 - Name of the second input relation
    #
    # Results:
    #	Returns a burst of code that computes the union of the two
    #   relations
    #
    # All three relations must contain the same set of columns.
    #
    # This method does not compute the union; it returns a fragment
    # of code that computes it.
    #
    # The time taken to compute the union is linear in the sum of the
    # sizes of the two BDD's.

    method union {dest source1 source2} {
	my RelationMustExist $dest
	my RelationMustExist $source1
	my RelationMustExist $source2
	my ColumnsMustBeSame $dest $source1
	my ColumnsMustBeSame $dest $source2
	return [list [namespace which sys] | $dest $source1 $source2]
    }

if 0 {
    # deprecate this for now.
    method load {name list} {
	my RelationMustExist $name






	set nColumns [llength [dict get $m_relcolumns $name]]
	if {[llength $list] % $nColumns != 0} {
	    return -code error \
		-errorcode [list FDDD WrongListLength $nColumns] \
		"list must have a multiple of $nColumns values"
	}
	set reader [my loader $name]
................................................................................
	set nCM1 [expr {$nColumns - 1}]
	while {[llength $list] > 0} {
	    {*}$reader {*}[lrange $list 0 $nCM1]
	    set list [lreplace ${list}[set list {}] 0 $nCM1]
	}
	return
    }
}














}



































































































package provide tclbdd::fddd 0.1