;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Diploma Thesis:
;;; "Solving Bit-Vector Equations 
;;;  - A Decision Procedure for Hardware Verifikation"
;;;
;;; M. Oliver M"oller
;;; University of Ulm
;;; Faculty of Computer Science (Informatik)
;;; AI Department (Abteilung f"ur k"unstliche Intelligenz)
;;; Supervising Professor:  Friedrich W. von Henke
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ------------------------------------------------------------
;;; -              SOLVER FOR BITVECTOR-THEORIES
;;; ------------------------------------------------------------
;;; -      Oliver M"oller (moeller@ki.informatik.uni-ulm.de)   -
;;; ------------------------------------------------------------
;;; - File:     bvec_experiments.cl                            -
;;; - Purpose:  Testbed for 
;;; -            implemented decision procedures
;;; -           Measurement of run-time-performance
;;; - USES:     all files loaded with (lt) = load test
;;; ------------------------------------------------------------
;;; USAGE:
;;;  The functions   plot-mona   [requires Mona Tool installed]
;;;                  plot-fs     [Fixed Solver]
;;;                  plot-rc     [Reduced Chopper]   
;;;  perform measurements of several sets of equations. Look at them and
;;;  you know how to modify them.
;;;  The call will generate a pictex-file and (in the upper two cases)
;;;  a log-file (for verification of the result) as well.
;;;  You can embed this file with eg. \input{mona-plot-1}
;;;  in your latex document. However, you have to install PicTeX,
;;;  for a documentation refer eg. to
;;;   Helmut Kopka: Latex Ergänzungen (Volume 2)
;;; 
;;; NOTE:
;;;  I admit this file has been composed a bit sloppy, for example
;;;  when loading it the first time, you should get an error message,
;;;  for the structures are not yet loaded. But you can safely ignore
;;;  it and just call (lt)
;;;  (and all will turn out right, provided you got all the lisp files
;;;   in the actual directory)
;;;
;;; Allegro Common Lisp
;;; Begun:        October, 30 1997
;;; Last Changes: March, 26   1998
;;; Version 3.0

(in-package user)

;;; ******************************
;;; * Global Settings
;;; ******************************

(defconstant *break-on-error* t)
(defconstant *break-every-time* nil)
(defconstant *da-home-directory* "/home/hiwi/moeller/da/")

;;; ********************
;;; * Loading
;;; ********************

(defun l1 () 
  (load "./bvec_experiments.cl"))

(defun lt ()
  (load  "./bvec_structure.cl")
  (load  "./bvec_arith.cl")
  (load  "./check_via_mona.cl")
  (load  "./bvec_fixed_solver.cl")
  (load  "./bvec_bdd_solve.cl")
  (load  "./bvec_slicing.cl")
  (load  "./reduced_chopper.cl")
  (load  "./bvec_experiments.cl"))

(defun c()
  (compile-file "./bvec_experiments.cl")
  (load "./bvec_experiments.fasl"))

(defun ct ()
  (compile-file "./bvec_structure.cl")
  (compile-file "./bvec_arith.cl")
  (compile-file "./check_via_mona.cl")
  (compile-file "./bvec_fixed_solver.cl")
  (compile-file "./bvec_bdd_solve.cl")
  (compile-file "./bvec_slicing.cl")
  (compile-file  "./reduced_chopper.cl")
  (compile-file "./bvec_experiments.cl")
  
  (load  "./bvec_structure.fasl")
  (load  "./bvec_arith.fasl")
  (load  "./check_via_mona.fasl")
  (load  "./bvec_fixed_solver.fasl")
  (load  "./bvec_bdd_solve.fasl")
  (load  "./bvec_slicing.fasl")
  (load  "./reduced_chopper.fasl")
  (load  "./bvec_experiments.fasl"))

(defun lfs ()
  (load  "./bvec_fixed_solver.cl"))

(defun cfs ()
  (compile-file "./bvec_fixed_solver.cl")
  (load  "./bvec_fixed_solver.fasl"))

;;; ****************************************
;;;  Some Simple Examples (only core theory)
;;; ****************************************

(defconstant *simple-examples*
    (list

     '(bv-EQUAL (BV-COMPOSE (BV-VAR x 3) (BV-VAR y 3))
       (BV-COMPOSE (BV-VAR y 3) (BV-VAR x 3)))
     
    ;;'(bv-equal
    ;; (bv-extract (bv-var x 256) (TUPCONS 200 50))
    ;;  (BV-EXTRACT (bv-var x 256) (TUPCONS 190 40)))
    
    `(bv-equal
       (bv-compose (bv-var x 253) (bv-var x 253))
       (bv-compose (bv-var z 255) (bv-const 17 251)))

    `(bv-equal
      (bv-compose (bv-extract (bv-var x 10) (TUPCONS 9 5))
                  (bv-extract (bv-var x 10) (TUPCONS 9 8)))
      (bv-const ,(- (expt 2 7) 4) 7))
     
     `(BV-EQUAL
       (bv-compose (bv-var x 3) (bv-var x 3))
       (bv-compose (bv-const 2 3) (bv-var y 3)))
     `(BV-EQUAL
       (bv-compose (bv-var x 3) (bv-var x 3))
       (bv-compose (bv-const 2 3) (bv-const 4 3)))

     `(BV-EQUAL
       (bv-compose (bv-extract (bv-var x 4) (TUPCONS 2 0)) (bv-const 2 2))
       (bv-compose (bv-extract (bv-var y 5) (TUPCONS 3 1)) (bv-const 2 2)))
     `(bv-equal
       (bv-compose (bv-var x 3) (bv-var x 3))
       (bv-compose (bv-var z 5) (bv-const 0 1)))
     ))

(defconstant *simple-classic-examples*
    ;; The ones processed at the SRI
    (let* ((tt1
	    `(BV-COMPOSE (BV-VAR X 3)
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Y 4) (BV-VAR Z 5)) (TUPCONS 5 4))
		   (BV-CONST 0 4) (BV-VAR M 3)
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR H 4) (BV-VAR P 2)) (TUPCONS 2 0))
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 3 2))
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 2 0))
		   (BV-CONST 0 2)
		   (BV-EXTRACT
		    (BV-COMPOSE (BV-EXTRACT (BV-VAR W 16) (TUPCONS 15 15))
				(BV-EXTRACT (BV-VAR W 16) (TUPCONS 15 15))
				(BV-EXTRACT (BV-VAR E 7) (TUPCONS 2 0)) (BV-CONST 3 2)
				(BV-CONST 0 1) (BV-EXTRACT (BV-VAR G 4) (TUPCONS 3 0))
				(BV-EXTRACT (BV-VAR F 10) (TUPCONS 3 3))
				(BV-EXTRACT (BV-VAR W 16) (TUPCONS 15 15))
				(BV-EXTRACT (BV-VAR U 8) (TUPCONS 7 4))
				(BV-EXTRACT (BV-VAR V 8) (TUPCONS 3 0)) (BV-CONST 0 2)
				(BV-EXTRACT (BV-VAR W 16) (TUPCONS 7 0)))
		    (TUPCONS 31 0))))
	   (tt2
	    `(BV-COMPOSE
	      (BV-EXTRACT
	       (BV-COMPOSE
		(BV-EXTRACT
		 (BV-COMPOSE (BV-EXTRACT (BV-VAR Y 4) (TUPCONS 2 1)) (BV-VAR X 3))
		 (TUPCONS 4 0))
		(BV-VAR Z 5) (BV-VAR X 3))
	       (TUPCONS 10 2))
	      (BV-VAR S 2)
	      (BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 3 2))
	      (BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 1 0))
	      (BV-VAR T 1)
	      (BV-EXTRACT
	       (BV-COMPOSE
		(BV-EXTRACT
		 (BV-COMPOSE (BV-EXTRACT (BV-VAR H 4) (TUPCONS 2 1)) (BV-VAR M 3))
		 (TUPCONS 4 0))
		(BV-VAR P 2) (BV-VAR M 3))
	       (TUPCONS 7 2))
	      (BV-EXTRACT (BV-COMPOSE (BV-VAR E 7) (BV-CONST 31 5))
			  (TUPCONS 11 5))
	      (BV-EXTRACT (BV-VAR G 4) (TUPCONS 3 1))
	      (BV-EXTRACT (BV-VAR F 10) (TUPCONS 9 6))
	      (BV-EXTRACT (BV-VAR W 16) (TUPCONS 7 4))
	      (BV-EXTRACT (BV-VAR E 7) (TUPCONS 3 0))
	      (BV-EXTRACT (BV-VAR W 16) (TUPCONS 14 11)) (BV-CONST 3 2)
	      (BV-VAR G 4)))
	   (large1 (make-bv-composition-from-list
		    (list tt1 tt1 tt1 tt1 tt1 tt1 tt1 tt1)))
	   (large2 (make-bv-composition-from-list
		    (list tt2 tt2 tt2 tt2 tt2 tt2 tt2 tt2))))	    
    (list
     ;;ss0
     `(BV-EQUAL (BV-COMPOSE (BV-VAR X 3) (BV-VAR X 3))
		(BV-COMPOSE (BV-VAR Z 5) (BV-CONST 0 1)))
     ;;ss1
     `(BV-EQUAL
       (BV-COMPOSE (BV-VAR X 3)
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Y 4) (BV-VAR Z 5)) (TUPCONS 5 4))
		   (BV-CONST 0 4))
       (BV-EXTRACT
	(BV-COMPOSE
	 (BV-EXTRACT
	  (BV-COMPOSE (BV-EXTRACT (BV-VAR Y 4) (TUPCONS 2 1)) (BV-VAR X 3))
	  (TUPCONS 4 0))
	 (BV-VAR Z 5) (BV-VAR X 3))
	(TUPCONS 10 2)))

     ;;ss2
     `(BV-EQUAL
       (BV-COMPOSE (BV-VAR X 3)
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Y 4) (BV-VAR Z 5)) (TUPCONS 5 4))
		   (BV-CONST 0 4) (BV-VAR M 3)
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR H 4) (BV-VAR P 2)) (TUPCONS 2 0))
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 3 2))
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 2 0))
		   (BV-CONST 0 2))
       (BV-COMPOSE
	(BV-EXTRACT
	 (BV-COMPOSE
	  (BV-EXTRACT
	   (BV-COMPOSE (BV-EXTRACT (BV-VAR Y 4) (TUPCONS 2 1)) (BV-VAR X 3))
	   (TUPCONS 4 0))
	  (BV-VAR Z 5) (BV-VAR X 3))
	 (TUPCONS 10 2))
	(BV-VAR S 2)
	(BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 3 2))
	(BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 1 0))
	(BV-VAR T 1)
	(BV-EXTRACT
	 (BV-COMPOSE
	  (BV-EXTRACT
	   (BV-COMPOSE (BV-EXTRACT (BV-VAR H 4) (TUPCONS 2 1)) (BV-VAR M 3))
	   (TUPCONS 4 0))
	  (BV-VAR P 2) (BV-VAR M 3))
	 (TUPCONS 7 2))))

     ;; ss3
     `(BV-EQUAL
       ,large1
       ,large2)

     ;; ss3b
     `(BV-EQUAL
       ,tt1
       ,tt2)
          
     `(BV-EQUAL
       (BV-COMPOSE (BV-EXTRACT (BV-VAR GRID 64) (TUPCONS 61 0))
		   (BV-CONST 1 1) (BV-CONST 0 1))
       (BV-VAR GRID 64))
     
     `(BV-EQUAL
       (BV-COMPOSE (BV-EXTRACT (BV-VAR GRID 64) (TUPCONS 61 0))
		   (BV-VAR UNKNOWN 2))
       (BV-VAR GRID 64))
     
     `(BV-EQUAL (BV-VAR BLOB 64)
		(BV-COMPOSE (BV-VAR BOP 8) (BV-VAR FOB 32) (BV-VAR DOP 16)
			    (BV-VAR BOP 8)))
     
     `(BV-EQUAL
       (BV-COMPOSE (BV-EXTRACT (BV-VAR XX 32) (TUPCONS 15 0))
		   (BV-EXTRACT (BV-VAR YY 32) (TUPCONS 31 24))
		   (BV-EXTRACT (BV-VAR ZZ 16) (TUPCONS 7 0)) (BV-CONST 15 4))
       (BV-COMPOSE (BV-CONST 3 2) (BV-EXTRACT (BV-VAR YY 32) (TUPCONS 7 0))
		   (BV-CONST 0 6) (BV-EXTRACT (BV-VAR ZZ 16) (TUPCONS 3 0))
		   (BV-EXTRACT (BV-VAR XX 32) (TUPCONS 23 8))))
     
     `(BV-EQUAL
       (BV-COMPOSE (BV-VAR X 3)
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Y 4) (BV-VAR Z 5)) (TUPCONS 5 4))
		   (BV-CONST 0 4) (BV-VAR M 3)
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR H 4) (BV-VAR P 2)) (TUPCONS 2 0))
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 3 2))
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 2 0))
		   (BV-CONST 0 2)
		   (BV-EXTRACT
		    (BV-COMPOSE (BV-EXTRACT (BV-VAR W 16) (TUPCONS 15 15))
				(BV-EXTRACT (BV-VAR W 16) (TUPCONS 15 15))
				(BV-EXTRACT (BV-VAR E 7) (TUPCONS 2 0)) (BV-CONST 3 2)
				(BV-CONST 0 1) (BV-EXTRACT (BV-VAR G 4) (TUPCONS 3 0))
				(BV-EXTRACT (BV-VAR F 10) (TUPCONS 3 3))
				(BV-EXTRACT (BV-VAR W 16) (TUPCONS 15 15))
				(BV-EXTRACT (BV-VAR U 8) (TUPCONS 7 4))
				(BV-EXTRACT (BV-VAR V 8) (TUPCONS 3 0)) (BV-CONST 0 2)
				(BV-EXTRACT (BV-VAR W 16) (TUPCONS 7 0)))
		    (TUPCONS 31 0))
		   (BV-EXTRACT
		    (BV-COMPOSE
		     (BV-EXTRACT
		      (BV-COMPOSE (BV-EXTRACT (BV-VAR Y 4) (TUPCONS 2 1)) (BV-VAR X 3))
		      (TUPCONS 4 0))
		     (BV-VAR Z 5) (BV-VAR X 3))
		    (TUPCONS 10 2))
		   (BV-VAR S 2)
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 3 2))
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 1 0))
		   (BV-VAR T 1)
		   (BV-EXTRACT
		    (BV-COMPOSE
		     (BV-EXTRACT
		      (BV-COMPOSE (BV-EXTRACT (BV-VAR H 4) (TUPCONS 2 1)) (BV-VAR M 3))
		      (TUPCONS 4 0))
		     (BV-VAR P 2) (BV-VAR M 3))
		    (TUPCONS 7 2))
		   (BV-EXTRACT (BV-COMPOSE (BV-VAR E 7) (BV-CONST 31 5))
			       (TUPCONS 11 5))
		   (BV-EXTRACT (BV-VAR G 4) (TUPCONS 3 1))
		   (BV-EXTRACT (BV-VAR F 10) (TUPCONS 9 6))
		   (BV-EXTRACT (BV-VAR W 16) (TUPCONS 7 4))
		   (BV-EXTRACT (BV-VAR E 7) (TUPCONS 3 0))
		   (BV-EXTRACT (BV-VAR W 16) (TUPCONS 14 11)) (BV-CONST 3 2)
		   (BV-VAR G 4))
       (BV-COMPOSE
	(BV-EXTRACT
	 (BV-COMPOSE
	  (BV-EXTRACT
	   (BV-COMPOSE (BV-EXTRACT (BV-VAR Y 4) (TUPCONS 2 1)) (BV-VAR X 3))
	   (TUPCONS 4 0))
	  (BV-VAR Z 5) (BV-VAR X 3))
	 (TUPCONS 10 2))
	(BV-VAR S 2)
	(BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 3 2))
	(BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 1 0))
	(BV-VAR T 1)
	(BV-EXTRACT
	 (BV-COMPOSE
	  (BV-EXTRACT
	   (BV-COMPOSE (BV-EXTRACT (BV-VAR H 4) (TUPCONS 2 1)) (BV-VAR M 3))
	   (TUPCONS 4 0))
	  (BV-VAR P 2) (BV-VAR M 3))
	 (TUPCONS 7 2))
	(BV-EXTRACT (BV-COMPOSE (BV-VAR E 7) (BV-CONST 31 5))
		    (TUPCONS 11 5))
	(BV-EXTRACT (BV-VAR G 4) (TUPCONS 3 1))
	(BV-EXTRACT (BV-VAR F 10) (TUPCONS 9 6))
	(BV-EXTRACT (BV-VAR W 16) (TUPCONS 7 4))
	(BV-EXTRACT (BV-VAR E 7) (TUPCONS 3 0))
	(BV-EXTRACT (BV-VAR W 16) (TUPCONS 14 11)) (BV-CONST 3 2)
	(BV-VAR G 4) (BV-VAR X 3)
	(BV-EXTRACT (BV-COMPOSE (BV-VAR Y 4) (BV-VAR Z 5)) (TUPCONS 5 4))
	(BV-CONST 0 4) (BV-VAR M 3)
	(BV-EXTRACT (BV-COMPOSE (BV-VAR H 4) (BV-VAR P 2)) (TUPCONS 2 0))
	(BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 3 2))
	(BV-EXTRACT (BV-COMPOSE (BV-VAR Q 5) (BV-VAR R 4)) (TUPCONS 2 0))
	(BV-CONST 0 2)
	(BV-EXTRACT
	 (BV-COMPOSE (BV-EXTRACT (BV-VAR W 16) (TUPCONS 15 15))
		     (BV-EXTRACT (BV-VAR W 16) (TUPCONS 15 15))
		     (BV-EXTRACT (BV-VAR E 7) (TUPCONS 2 0)) (BV-CONST 3 2)
		     (BV-CONST 0 1) (BV-EXTRACT (BV-VAR G 4) (TUPCONS 3 0))
		     (BV-EXTRACT (BV-VAR F 10) (TUPCONS 3 3))
		     (BV-EXTRACT (BV-VAR W 16) (TUPCONS 15 15))
		     (BV-EXTRACT (BV-VAR U 8) (TUPCONS 7 4))
		     (BV-EXTRACT (BV-VAR V 8) (TUPCONS 3 0)) (BV-CONST 0 2)
		     (BV-EXTRACT (BV-VAR W 16) (TUPCONS 7 0)))
	 (TUPCONS 31 0))))

     ;;; ss9
     ;;; `(BV-EQUAL (BV-NOT (BV-VAR X 3)) (BV-VAR Y 3))
     
     `(BV-EQUAL (BV-COMPOSE (BV-VAR X 3) (BV-VAR Z 3))
		(BV-COMPOSE (BV-VAR Z 3) (BV-VAR Y 3)))
     
     `(BV-EQUAL (BV-COMPOSE (BV-CONST 0 3) (BV-CONST 0 2))
		(BV-COMPOSE (BV-VAR Z 3) (BV-CONST 3 2)))
     
     `(BV-EQUAL (BV-COMPOSE (BV-VAR X 3) (BV-VAR X 3) (BV-CONST 0 3))
		(BV-COMPOSE (BV-VAR Y 3) (BV-VAR Z 3) (BV-CONST 0 3)))

     ;;; ss13
     ;;`(BV-EQUAL
     ;;  (BV-COMPOSE
     ;; (BV-OR (BV-EXTRACT (BV-VAR X 7) (TUPCONS 5 2))
     ;;	       (BV-EXTRACT (BV-VAR X 7) (TUPCONS 3 0)))
     ;;	(BV-AND (BV-EXTRACT (BV-VAR Y 16) (TUPCONS 12 8))
     ;;		(BV-EXTRACT (BV-VAR Y 16) (TUPCONS 12 8))))
     ;;  (BV-COMPOSE (BV-EXTRACT (BV-VAR X 7) (TUPCONS 5 2))
     ;;		   (BV-EXTRACT (BV-VAR Y 16) (TUPCONS 7 3))))
     
     )))



(defconstant *simple-extraction-examples*
    ;; Just to test the csolve rules for the SAME variable
    (list
     `(BV-EQUAL
       (bv-extract (bv-var y 16) (TUPCONS 15 3))
       (bv-extract (bv-var y 16) (TUPCONS 12 0)))
     `(BV-EQUAL
       (bv-extract (bv-var x 10) (TUPCONS 8 3))
       (bv-extract (bv-var x 10) (TUPCONS 6 1)))
     `(BV-EQUAL
       (bv-extract (bv-var x 10) (TUPCONS 8 4))
       (bv-extract (bv-var x 10) (TUPCONS 5 1)))
     `(BV-EQUAL
       (bv-extract (bv-var x 10) (TUPCONS 8 7))
       (bv-extract (bv-var x 10) (TUPCONS 1 0)))
     ))

;;; ******************************
;;;  Advanced Examples
;;; ******************************

(defconstant *advanced-examples*
    (list
     ;; These two taken from [BP98]
     '(BV-EQUAL
       (bv-compose (bv-var y 3) (bv-var x 16) (bv-var x 16) (bv-var z 2))
       (bv-compose (bv-var x 16) (bv-var w 4) (bv-const 0 1) (bv-var x 16)))
     '(BV-EQUAL
       (bv-and (bv-var w 7) (bv-compose
			     (bv-var x 3)
			     (bv-extract (bv-var y 7) (TUPCONS 3 0))))
       (bv-or (bv-var y 7)
	      (bv-compose (bv-extract (bv-var w 7) (TUPCONS 2 0))
                          (bv-const 1 1)
	                  (bv-var x 3))))
     ;;; --------------------			     
     '(BV-EQUAL
       (bv-compose (bv-var x (nat-var n)) (bv-const 1 1))
       (bv-compose (bv-const 0 1) (bv-var (nat-var n))))
     ))

(defconstant *some-bdd-examples*
    (list
     '(bv-equal
       (bv-and (bv-var x 3)
	(bv-var y 3))
       (bv-const 1 3))
     '(bv-equal
       (bv-and (bv-var x 3)
	(bv-var y 3))
       (bv-var x 3))
     '(bv-equal
       (bv-compose (bv-var x 3)   (bv-and (bv-var x 3) (bv-var y 3)))
       (bv-compose (bv-const 0 3) (bv-const 7 3)))

     '(bv-equal
       (bv-and (bv-var x 3) (bv-var y 3))
       (bv-const 7 3))))
     

     
    


;;; --------------------
;;;  Terms to Canonize
;;; --------------------

;;; Core Theory

(defconstant *core-theory-terms*
    (list
     '(bv-compose (bv-extract (bv-var x 4) (TUPCONS 3 2))
       (bv-extract (bv-var x 4) (TUPCONS 1 0)))
     '(bv-extract (bv-compose
		   (bv-extract (bv-var w 16) (tupcons 15 15))
		   (bv-extract (bv-var w 16) (tupcons 15 15))
		   (bv-extract (bv-var e 7) (tupcons 2 0))
		   (bv-const 3 2)
		   (bv-const 0 1)
		   (bv-extract (bv-var g 4) (tupcons 3 0))
		   (bv-extract (bv-var f 10) (tupcons 3 3))
		   (bv-extract (bv-var w 16) (tupcons 15 15))
		   (bv-extract (bv-var u 8) (tupcons 7 4))
		   (bv-extract (bv-var v 8) (tupcons 3 0))
		   (bv-const 0 2)
		   (bv-extract (bv-var w 16) (tupcons 7 0)))
       (tupcons 31 0))
     ))



;;; ****************************************
;;;  Srivas Examples
;;; ****************************************
;;;
;;; They are general theorems (FORALL bv[n] and suchlike)
;;; and are only >solved< via solving a distinc instantiation

(defun instantiate (eq n)
  (assert (> n 2))
  (let ((alist (list (cons '(nat-var n) n)
		     (cons '(nat-var n-1) (1- n))
		     (cons '(nat-var n-2) (- n 2))))) 
    (labels ((traverse-term
		 (term match fun)
	       (cond
		((funcall match term) (funcall fun term))
		((consp term)
		 (mapcar #'(lambda (x) (traverse-term x match fun))
			 term))
		(t term)))
	     (inst (term)
	       (traverse-term
		term
		#'(lambda (x) (assoc x alist :TEST #'equal))
		#'(lambda (x) (cdr (assoc x alist :TEST #'equal)))))
	     (evl (term)
	       (traverse-term
		term
		#'(lambda (x) (and (consp x)
				   (member (car x) '(+ -))))
		#'(lambda (x) (eval x)))))
      
      `(bv-equal
	,(evl (inst (cadr eq)))
	,(evl (inst (caddr eq)))))))



;;;....................
;;;odd_even_bv: LEMMA FORALL (bv: bvec[m], n: posnat): 
;;;                       ishigh((bv + n)^0) = NOT ishigh((bv + (n-1))^0)

(defconstant odd_even_bv
    '(bv-equal
      (bv-extract (bv-addition (nat-var n) (bv-var x (nat-var n)) (bv-not (bv-var y (nat-var n))))
       (tupcons 0 0))
      (bv-not
       (bv-extract (bv-addition (nat-var n) (bv-var x (nat-var n)) (bv-not (bv-var y (nat-var n))) (bv-const 1 (nat-var n)))
	(tupcons 0 0)))))

;;;........................................
;;;  even_odd_bv: LEMMA FORALL (bv: bvec[m], n: posnat): 
;;;                       ishigh((bv + (-n))^0) = NOT ishigh((bv + (-n+1))^0)

(defconstant even_odd_bv
    '(bv-equal
      (bv-extract
       (bv-addition (nat-var n) (bv-var x (nat-var n)) (bv-not (bv-var nn (nat-var n))))
       (tupcons 0 0))
      (bv-not
       (bv-extract
	(bv-addition (nat-var n) (bv-var x (nat-var n)) (bv-not (bv-var nn (nat-var n))) (bv-const 1 (nat-var n)))
	(tupcons 0 0)))))

;;; ..............................
;;;  bv_negate: LEMMA FORALL (bv1: bvec[m]): (NOT (bv1)) = (-bv1) + (-1)  
;;;

(defconstant bv_negate
    '(bv-equal
      (bv-not (bv-var x (nat-var n)))
      (bv-addition (nat-var n)
       (bv-not
	(bv-addition (nat-var n)
	 (bv-var x (nat-var n))
	 (bv-not (bv-const 0 (nat-var n)))))
       (bv-not (bv-const 0 (nat-var n))))))

;;; ....................
;;;  caret_over_addition: LEMMA
;;;    FORALL (n: posnat, bvn:bvec[n], i1:int, n1: nat):
;;;      (n1<n) =>
;;;        ((bvn + i1)^(n1,0) = (bvn^(n1,0) + i1))

(defconstant caret_over_addition
    ;; instanciate with (nat-var n) and (nat-var n-1)    
    '(bv-equal
      (bv-extract
       (bv-addition (nat-var n)
	(bv-var x (nat-var n)) (bv-var i (nat-var n)))
       (tupcons (nat-var n-2) 0))
      (bv-addition (nat-var n-1)
       (bv-extract
	(bv-var x (nat-var n))
	(tupcons (nat-var n-2) 0))
       (bv-extract
	(bv-var i (nat-var n))
	(TUPCONS (nat-var n-2) 0)))))

;;;....................
;;;       caret_concat_over_addition_1: LEMMA
;;;    FORALL (n,m: posnat, bvn:bvec[n], bvm:bvec[m], i1:int, n1: nat):
;;;      (n1>=m & n1<m+n) =>
;;;        ((bvn o bvm + i1)^(n1,m) o (bvm + i1)) = (bvn^(n1-m,0) o bvm + i1) 

(defconstant  caret_concat_over_addition_1
    ;; instanciate with n, n-1[=n1], n-2[=m]
    '(bv-equal
      (bv-compose
       (bv-extract
	(bv-addition (+ (nat-var n) (nat-var n-2))
	 (bv-compose
	  (bv-var x (nat-var n))
	  (bv-var y (nat-var n-2)))
	 (bv-var i (+ (nat-var n) (nat-var n-2))))
	 (TUPCONS (nat-var n-1) (nat-var n-2)))
       (bv-addition (nat-var n-2)
	(bv-var y (nat-var n-2))
	(bv-extract
	 (bv-var i  (+ (nat-var n) (nat-var n-2)))
	 (TUPCONS (- (nat-var n-2) 1) 0))))
      (bv-addition  (+ (nat-var n-1) 1)
       (bv-compose
	(bv-extract
	 (bv-var x (nat-var n))
	 (TUPCONS (- (nat-var n-1) (nat-var n-2)) 0))
	(bv-var y (nat-var n-2)))
       (bv-extract
	(bv-var i (+ (nat-var n) (nat-var n-2)))
	(TUNPCONS (nat-var n-1) 0)))))
      
    
(defconstant *srivas-examples*
    (list
     odd_even_bv
     even_odd_bv)
  )


(defun ts (&optional (stream nil)) "Test Srivas' examples"
   (loop for e in *srivas-examples* do
	 (princ (format nil "Equation:~%~a" e) stream)
	 (terpri stream)
	 (start-time)
	 (princ (format nil "Results in ~a.~%"
			(bv-master-solve e))
		stream)
	 (stop-time)
	 (princ (format nil "Used Time: ~d ~%~%" *stopped-time*)
		stream)))


;;; ****************************************
;;;  Time Stopping
;;; ****************************************

(defvar *marked-time* 0)
(defvar *stopped-time* 0)
(defvar *marked-time-1* 0)
(defvar *stopped-time-1* 0)
(defvar *marked-time-2* 0)
(defvar *stopped-time-2* 0)
    

(defun start-time ()
  (setf *marked-time* (get-internal-real-time)))

(defun stop-time ()
  ;; result in seconds
  (setf *stopped-time*
    (float (/ (- (get-internal-real-time) *marked-time*)
	      1000))))

(defun clear-time ()
  (setf *stopped-time* 0.0))

;;; --

(defun start-time-1 ()
  (setf *marked-time-1* (get-internal-real-time)))

(defun stop-time-1 ()
  ;; result in seconds
  (setf *stopped-time-1*
    (float (/ (- (get-internal-real-time) *marked-time-1*)
	      1000))))

(defun clear-time-1 ()
  (setf *stopped-time-1* 0.0))

;;; --
(defun start-time-2 ()
  (setf *marked-time-2* (get-internal-real-time)))

(defun stop-time-2 ()
  ;; result in seconds
  (setf *stopped-time-2*
    (float (/ (- (get-internal-real-time) *marked-time-2*)
	      1000))))

(defun clear-time-2 ()
  (setf *stopped-time-2* 0.0))


;;; ************************************************************
;;;  Display Lace
;;; ************************************************************

(defun bv-term-to-ascii (term &key (ulm-notation nil))
  ;;; Also processes natural variables
  (flet ((make-string-from-op-list (op list)
	   (eval `(CLOS::string-append
		   "( "
		   ,@(loop for e in (butlast list) append
			   (list (bv-term-to-ascii e)
				 op))
		   ,(bv-term-to-ascii (car (last list)))
		   " )"))))
    (cond
     ((arrayp term) ;; Slicing Vector!
      (eval `(CLOS::string-append "["
				  ,@(loop for i in (reverse (slicing-to-chop-list term)) collect
					  (princ-to-string
					   (format nil " ~d" i)))
				  " ]")))
     ((atom term) (princ-to-string term))
   ;;; ---
   ;;;  Nat section
   ;;; ---
     ((rec-nat-var? term)
      (princ-to-string (nat-var-name term)))
     ((rec-addition? term)
      (make-string-from-op-list " + " (cdr term)))
     ((rec-subtraction? term)
      (make-string-from-op-list " - " (cdr term)))
     ((rec-multiplication? term)
      (CLOS::string-append
       (bv-term-to-ascii (cadr term))
       " * "
       (bv-term-to-ascii (caddr term))))
     ((rec-nat-max? term)
      (CLOS::string-append
       "MAX"
       (make-string-from-op-list " " (cdr term))))
     ((rec-nat-min? term)
      (CLOS::string-append
       "MIN"
       (make-string-from-op-list " " (cdr term))))
     ((rec-nat-between? term)
      (CLOS::string-append
       (bv-term-to-ascii (cadr term))
       " in { "
       (bv-term-to-ascii (caddr term))
       " , ... , "
       (bv-term-to-ascii (cadddr term))
       " }"))   
     
     ((rec-nat-leq? term)
      (CLOS::string-append
       (bv-term-to-ascii (cadr term))
       " <= "
       (bv-term-to-ascii (caddr term))))
     ((rec-nat-less? term)
      (CLOS::string-append
       (bv-term-to-ascii (cadr term))
       " < "
       (bv-term-to-ascii (caddr term))))
     ((rec-nat-equation? term)
      (CLOS::string-append
       (bv-term-to-ascii (cadr term))
       "  =[Nat] "
       (bv-term-to-ascii (caddr term))))
   ;;; ---
     
     ((rec-cs-info? term)
      (CLOS::string-append "CS: "
			   (bv-term-to-ascii (cadr term))
			   " -> "
			   (bv-term-to-ascii (caddr term))))
     ((rec-free-list? term)
      (eval `(CLOS::string-append "("
				  ,@(loop for x in (cdr term) collect
					(CLOS::string-append " "  (bv-term-to-ASCII x)))
				  " )")))
     ((and (consp term)
	   (eq (car term) 'BV-EQUAL))
      (CLOS::string-append (bv-term-to-ascii (cadr term))
			   "  =[bv]  "
			   (bv-term-to-ascii (caddr term))))
     ((rec-bv-const? term)
      (princ-to-string
       (format nil "~a{~a}" (bv-const-value term)
	       (bv-const-length term))))
     ((rec-bv-var? term)
      (princ-to-string
       (format nil "~a{~a}" (bv-var-name term) (bv-var-length term))))
     ((rec-bv-composition? term)
      (let ((con (bv-composition-content term)))
	(eval `(CLOS::string-append
		"( "
		,@(loop for i in (butlast con) append
			`(,(bv-term-to-ascii i) " o "))
		,(bv-term-to-ascii (car (last con)))
		" )"))))
     ((rec-bv-extraction? term)
      (if ulm-notation
	  (CLOS::string-append
	   "( "
	   (bv-term-to-ascii (bv-extraction-bv term))
	   ")^("
	   (bv-term-to-ascii (bv-extraction-left term))
	   ","
	   (bv-term-to-ascii (bv-extraction-right term))
	   ")")
	(CLOS::string-append
	 "( "
	 (bv-term-to-ascii (bv-extraction-bv term))
	 ")["
	 (bv-term-to-ascii (bv-extraction-right term))
	 ":"
	 (bv-term-to-ascii (bv-extraction-left term))
	 "]")))
     ((rec-bv-addition? term)
      (let ((width (bv-addition-modulo term))
	    (args (bv-addition-args term)))
	(eval `(CLOS::string-append
		"( "
		,@(loop for i in (butlast args) append
			`(,(bv-term-to-ascii i)
			  ,(princ-to-string (format nil " +[~d] " width))))
		,(bv-term-to-ascii (car (last args)))
		" )"))))
     ((rec-bv-bool? term)
      (case (bv-recognizer term)
	(bv-not (CLOS::string-append
		 "~( "
		 (bv-term-to-ascii (car (bv-bool-args term)))
		 " )"))
	(bv-and (CLOS::string-append
		 "( "
		 (bv-term-to-ascii (car (bv-bool-args term)))
		 " AND "
		 (bv-term-to-ascii (cadr (bv-bool-args term)))
		 " )"))
	(bv-or  (CLOS::string-append
		 "( "
		 (bv-term-to-ascii (car (bv-bool-args term)))
		 " OR "
		 (bv-term-to-ascii (cadr (bv-bool-args term)))
		 " )"))
	(bv-xor  (CLOS::string-append
		  "( "
		  (bv-term-to-ascii (car (bv-bool-args term)))
		  " XOR "
		  (bv-term-to-ascii (cadr (bv-bool-args term)))
		  " )"))
	(t (error-misc "bv-term-to-ascii [bool]" term "not caught."))))      
     (t (error-misc "bv-term-to-ascii" term "not caught.")))))


(defun bv-term-list-to-ascii (list)
  (if (listp list)
      (mapcar #'bv-term-to-ascii list)
    list))
		 
			 
(defun bv-term-to-tex (term)
  (cond
   ((rec-bv-const? term)
     (princ-to-string
      (format nil "\\BV{~a}{~a} " (bv-const-value term)
	      (bv-const-length term))))
   ((rec-bv-var? term)
    (princ-to-string
     (format nil "\\BV{~a}{~a}" (bv-var-name term) (bv-var-length term))))
   ((rec-bv-composition? term)
    (let ((con (bv-composition-content term)))
      (eval `(CLOS::string-append
	      "\\big( "
	      ,@(loop for i in (butlast con) append
		      `(,(bv-term-to-tex i) "\\,\\C\\,"))
	       ,(bv-term-to-tex (car (last con)))
	       " \\big)"))))
   ((rec-bv-extraction? term)
    (CLOS::string-append
     "\\big( "
     (bv-term-to-tex (bv-extraction-bv term))
     "\\big)\\E("
     (bv-term-to-tex (bv-extraction-left term))
     ","
     (bv-term-to-tex (bv-extraction-right term))
     ")"))		      
   ((rec-bv-addition? term)
    (let ((width (bv-addition-modulo term))
	  (args (bv-addition-args term)))
       (eval `(CLOS::string-append
	      "\\big(\\;"
	      ,@(loop for i in (butlast args) append
		      `(,(bv-term-to-tex i)
			 (princ-to-string (format nil "\\;+_{[~d]}\\;" width))))
	       (bv-term-to-tex (car (last args)))
	       "\\;\\big)"))))
   ((rec-bv-bool? term)
    (case (bv-recognizer term)
      (bv-not (CLOS::string-append
	       "\\lnot\\big(\\;"
	       (bv-term-to-tex (car (bv-bool-args term)))
	       " \\big)"))
      (bv-and (CLOS::string-append
	       "\\big( "
	       (bv-term-to-tex (car (bv-bool-args term)))
	       "\\;\\land\\;"
	       (bv-term-to-tex (cadr (bv-bool-args term)))
	       "\\;\\big)"))
      (bv-or  (CLOS::string-append
	       "\\big(\\;"
	       (bv-term-to-tex (car (bv-bool-args term)))
	       "\\;\\lor\\;"
	       (bv-term-to-tex (cadr (bv-bool-args term)))
	       "\\;\\big)"))
      (bv-xor  (CLOS::string-append
	       "\\big(\\;"
	       (bv-term-to-tex (car (bv-bool-args term)))
	       "\\;\\oplus\\;"
	       (bv-term-to-tex (cadr (bv-bool-args term)))
	       "\\;\\big)"))
      (t (error-misc "bv-term-to-tex [bool]" term "not caught."))))      
   (t (error-misc "bv-term-to-tex" term "not caught."))))
     

(defun create-output-from-list (list &key (stream nil) (first-word ""))
  (let ((offset (make-string (length first-word) :initial-element #\Space)))
    (princ (format nil "~a" first-word) stream)
    (cond
     ((null list)
      (princ (format nil "-~%") stream))
     ((atom list)
      (princ (format nil "~a~%" (princ-to-string list)) stream))
     (t	(loop for e in (butlast list) do
	      (princ (format nil "~a~%~a" e offset) stream))
	(princ (format nil "~a~%" (car (last list))) stream)))))
    

;;; ****************************************
;;;  Pigeon Hole Principle
;;; ****************************************

(defun make-phi1 (n &optional (width 1)) "Every Pigeon is in at least one hole"
  (make-bv-and-list
   (loop for i from 1 to (+ n 1) 
	 collect
	 (make-bv-or-list
	  (loop for j from 1 to n 
		collect
		`(BV-VAR
		  ,(CLOS::string-append
		    'm_
		    (princ-to-string i)
		    '_
		    (princ-to-string j))
		  ,width))))))

(defun make-phi2 (n &optional (width 1)) "In no hole there is more than one pigeon"
  `(bv-not
    ,(make-bv-or-list
      (loop for j from 1 to n 
	    append
	    (loop for k from 1 to n 
		  append
		  (loop for l from (+ k 1) to (+ n 1) 
			collect
			`(BV-AND
			  (BV-VAR ,(CLOS::string-append
				    'm_
				    (princ-to-string k)
				    '_
				    (princ-to-string j))
				  ,width)
			  (BV-VAR ,(CLOS::string-append
				    'm_
				    (princ-to-string l)
				    '_
				    (princ-to-string j))
				  ,width))))))))



(defun make-phi3 (n &optional (width 1)) "Every Pigeon in at most one hole"
   (if (= n 1)
       `(BV-CONST ,(1- (expt 2 width)) ,width) ;; TRUE
     (make-bv-and-list
      (loop for l from 1 to (1+ n)
	  collect
	    `(BV-NOT
	      ,(make-bv-or-list (loop for i from 1 to (1- n)
				    append
				      (loop for j from (1+ i) to n
					  collect
					    `(BV-AND
					      (BV-VAR ,(CLOS::string-append
							'm_
							(princ-to-string l)
							'_
							(princ-to-string i))
						      ,width)
					      (BV-VAR ,(CLOS::string-append
							'm_
							(princ-to-string l)
							'_
							(princ-to-string j))
						      ,width))))))))))

(defun plot-pigeon (&key (heuristic-level 99))
  ;;; Heuristic-Level 99 -> via Mona
  ;; -- Pigeon (a)
  (labels ((pig-heuristic ()
			  (case heuristic-level
			    (0 "None")
			    (1 "Melt weak")
			    (3 "Melt strong")
			    (5 "Melt extreme")
			    (7 "Melt identic")
			    (99 "MONA")
			    (t "?")))
	   (pigeon-1 ()
	     (princ (format nil "~%* Pigeon-Hole-1  at Heuristic ~d *~%" heuristic-level))
	     (let ((res nil))
	       (loop for i from 1 to 8 do
		     (princ (format nil "Measuring: ~d Pigeon, ~d Holes  " (1+ i) i))		   
		     (if (< i (case heuristic-level
				(0 7)
				(1 7)
				(3 7)
				(5 7)
				(7 7)
				(99 9)
				(t (break)))) ; i < 7
			 (let* ((eq `(BV-EQUAL (BV-AND ,(make-phi1 i)
						       (BV-AND ,(make-phi2 i)
							       ,(make-phi3 i)))
					       (BV-CONST 1 1)))
				(dummy (progn (init-bvec-bdd)
					      (gc)
					      (clear-time)
					      (start-time)))
				(erg (if (= heuristic-level 99)
					 (solve-via-mona eq
							 #'start-time
							 #'stop-time)
				       (fixed-bv-solve eq
						       :STREAM nil
						       :HEURISTIC-LEVEL heuristic-level))))
			   (unless (= 99 heuristic-level)
			     (stop-time))
			   (princ (format nil "[~a]~%" (if (= 99 heuristic-level)
							   erg
							 (car erg))))
			   (push (cons i (* 1000 *stopped-time*)) res))
		       (progn
			 (princ (format nil "[ABORTED]~%"))
			 (pushnew (cons i 'ABORT) res :TEST #'(lambda (x y) (equal (cdr x) (cdr y)))))))
	       (create-pigeon-plot res
				   :NAME (CLOS::string-append "pigeon-plot-1-[" (princ-to-string heuristic-level) "].tex")
				   :SUBSCRIPT (format nil "Pigeon Hole - Heuristic: ~a" (pig-heuristic))
				   :UPSCRIPT "$\\Phi_1\\land\\Phi_2\\land\\Phi_3\\Feq\\True$")))
	   ;; ==================================================
	   (pigeon-2 ()
	     (princ (format nil "~%* Pigeon-Hole-2  at Heuristic ~d *~%" heuristic-level))
	     (let ((res nil))
	       (loop for i from 1 to 8 do 
		     (princ (format nil "Measuring: ~d Pigeon, ~d Holes  " (1+ i) i))		   
		     (if (< i (case heuristic-level
				(0 8)
				(1 7)
				(3 7)
				(5 7)
				(7 7)
				(99 9)
				(t break))) ;; i < 8
			 (let* ((eq `(BV-EQUAL (BV-AND ,(make-phi1 i)
						       ,(make-phi2 i))
					       (BV-CONST 1 1)))
				(dummy (progn (init-bvec-bdd)
					      (gc)
					      (clear-time)
					      (start-time)))
				(erg (if (= heuristic-level 99)
					 (solve-via-mona eq
							 #'start-time
							 #'stop-time)
				       (fixed-bv-solve eq
						       :STREAM nil
						       :HEURISTIC-LEVEL heuristic-level))))
			   (unless (= 99 heuristic-level)
			     (stop-time))
			   (princ (format nil "[~a]~%" (if (= 99 heuristic-level)
							   erg
							 (car erg))))
			   (push (cons i (* 1000 *stopped-time*)) res))
		       (progn
			 (princ (format nil "[ABORTED]~%"))
			 (pushnew (cons i 'ABORT) res :TEST #'(lambda (x y) (equal (cdr x) (cdr y)))))))
	       (create-pigeon-plot res
				   :NAME (CLOS::string-append "pigeon-plot-2-[" (princ-to-string heuristic-level) "].tex")
				   :SUBSCRIPT (format nil "Pigeon Hole - Heuristic: ~a" (pig-heuristic))
				   :UPSCRIPT "$\\Phi_1\\land\\Phi_2\\Feq\\True$")))
	   ;; ------------------------------
	   (pigeon-3 ()
	     (princ (format nil "~%* Pigeon-Hole-3  at Heuristic ~d *~%" heuristic-level))
	     (let ((res nil))
	       (loop for i from 1 to 8 do 
		     (princ (format nil "Measuring: ~d Pigeon, ~d Holes  " (1+ i) i))
		     (if (< i (case heuristic-level
				(0 4)
				(1 7)
				(3 7)
				(5 7)
				(7 7)
				(99 9)
				(t (break)))) ;; for H=0 i < 4 | H=1,3: i < 8
			 (let* ((eq `(BV-EQUAL (bv-compose ,(make-phi1 i)
						           ,(make-phi2 i))
					       (BV-CONST 3 2)))
				(dummy (progn (init-bvec-bdd)
					      (gc)
					      (clear-time)
					      (start-time)))
				(erg (if (= heuristic-level 99)
					 (solve-via-mona eq
							 #'start-time
							 #'stop-time)
				       (fixed-bv-solve eq
						       :STREAM nil
						       :HEURISTIC-LEVEL heuristic-level))))
			   (unless (= 99 heuristic-level)
			     (stop-time))
			   (princ (format nil "[~a]~%" (if (= 99 heuristic-level)
							   erg
							 (car erg))))
			   (push (cons i (* 1000 *stopped-time*)) res))
		       (progn
			 (princ (format nil "[ABORTED]~%"))
			 (pushnew (cons i 'ABORT) res :TEST #'(lambda (x y) (equal (cdr x) (cdr y)))))))
	       (create-pigeon-plot res
				   :NAME (CLOS::string-append "pigeon-plot-3-[" (princ-to-string heuristic-level) "].tex")
				   :SUBSCRIPT (format nil "Pigeon Hole - Heuristic: ~a" (pig-heuristic))
				   :UPSCRIPT "$\\Phi_1\\C\\Phi_2\\Feq\\True\\C\\True$")))
	   ;--------------------
	    (pigeon-4 ()
	     (princ (format nil "~%* Pigeon-Hole-4  at Heuristic ~d *~%" heuristic-level))
	     (let ((res nil))
	       (loop for i from 1 to 8 do 
		     (princ (format nil "Measuring: ~d Pigeon, ~d Holes  " (1+ i) i))
		     (if (< i (case heuristic-level
				(0 4)
				(1 7)
				(3 7)
				(5 7)
				(7 7)
				(99 9)
				(t (break)))) ;; for H=0 i < 4 | H=1,3: i < 7
			 (let* ((eq `(BV-EQUAL (bv-compose ,(make-phi1 i)
						           ,(make-phi2 i)
							   ,(make-phi3 i))
					       (BV-CONST 7 3)))
				(dummy (progn (init-bvec-bdd)
					      (gc)
					      (clear-time)
					      (start-time)))
				(erg (if (= heuristic-level 99)
					 (solve-via-mona eq
							 #'start-time
							 #'stop-time)
				       (fixed-bv-solve eq
						       :STREAM nil
						       :HEURISTIC-LEVEL heuristic-level))))
			   (unless (= 99 heuristic-level)
			     (stop-time))
			   (princ (format nil "[~a]~%" (if (= 99 heuristic-level)
							   erg
							 (car erg))))
			   (push (cons i (* 1000 *stopped-time*)) res))
		       (progn
			 (princ (format nil "[ABORTED]~%"))
			 (pushnew (cons i 'ABORT) res :TEST #'(lambda (x y) (equal (cdr x) (cdr y)))))))
	       (create-pigeon-plot res
				   :NAME (CLOS::string-append "pigeon-plot-4-[" (princ-to-string heuristic-level) "].tex")
				   :SUBSCRIPT (format nil "Pigeon Hole - Heuristic: ~a" (pig-heuristic))
				   :UPSCRIPT "$\\Phi_1\\C\\Phi_2\\C\\Phi_3\\Feq\\True\\C\\True\\C\\True$"))))
  
    (pigeon-1)
    (pigeon-2)
    (pigeon-3)
    (pigeon-4)

    ))


(defun make-bv-and-list (l)
  (cond ((null l) nil)
	((equal (length l) 1) (car l))
	(t `(bv-and ,(car l) ,(make-bv-and-list (cdr l))))))

(defun make-bv-or-list (l)
  (cond ((null l) nil)
	((equal (length l) 1) (car l))
	(t `(bv-or ,(car l) ,(make-bv-or-list (cdr l))))))

     

;;; ****************************************
;;;  Testing Mona
;;; ****************************************

;;; The PLOT examples

(defconstant *mona-plot-1*
    (list
     '( "\\BV{const}{n} \\Feq \\BV{const}{n}"
        "[checking Tautology]"
        (4 8 16 32 64 128))
     ;;--------------------
     '(bv-equal
       (bv-const 7 4)
       (bv-const 7 4))  

      '(bv-equal
	(bv-const 77 8)
	(bv-const 77 8))  
       
       '(bv-equal
	 (bv-const 9999 16)
	 (bv-const 9999 16))  
	
	'(bv-equal
	  (bv-const 687637 32)
	  (bv-const 687637 32))  
	 
	 '(bv-equal
	    (bv-const 1376167 64)
	   (bv-const 1376167 64))

	  '(bv-equal
	    (bv-const 1376167268736 128)
	   (bv-const  1376167268736 128))

	  ))

(defconstant *mona-plot-2*
    (list
     '("\\BV{x}{n} \\Feq \\BV{x}{n}"
       "[checking Tautology]"
       (4 8 16 32 64 128))
     ;;--------------------
     '(bv-equal
       (bv-var x 4)
       (BV-VAR x 4))
     '(bv-equal
       (bv-var x 8)
       (BV-VAR x 8))
      '(bv-equal
       (bv-var x 16)
       (BV-VAR x 16))
      '(bv-equal
       (bv-var x 32)
       (BV-VAR x 32))
      '(bv-equal
       (bv-var x 64)
       (BV-VAR x 64))
      '(bv-equal
       (bv-var x 128)
       (BV-VAR x 128))))

(defconstant *mona-plot-3*
    (list
     '("\\BV{x}{\\frac{n}{2}}\\C\\BV{y}{\\frac{n}{2}} \\Feq \\BV{x}{\\frac{n}{2}}\\C\\BV{y}{\\frac{n}{2}}"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------

	'(bv-equal
	  (bv-compose
	   (bv-var x 2) (bv-var y 2))
	  (bv-compose
	   (bv-var x 2) (bv-var y 2)))
	'(bv-equal
	  (bv-compose
	   (bv-var x 4) (bv-var y 4))
	  (bv-compose
	   (bv-var x 4) (bv-var y 4)))
 	'(bv-equal
	  (bv-compose
	   (bv-var x 8) (bv-var y 8))
	  (bv-compose
	   (bv-var x 8) (bv-var y 8)))
 	'(bv-equal
	  (bv-compose
	   (bv-var x 16) (bv-var y 16))
	  (bv-compose
	   (bv-var x 16) (bv-var y 16)))
 	'(abort
	  (bv-compose
	   (bv-var x 32) (bv-var y 32))
	  (bv-compose
	   (bv-var x 32) (bv-var y 32)))
 	'(abort
	  (bv-compose
	   (bv-var x 64) (bv-var y 64))
	  (bv-compose
	   (bv-var x 64) (bv-var y 64)))))
       
(defconstant *mona-plot-4*
    (list
     '("\\BV{x}{\\frac{n}{2}}\\C\\BV{0}{1}\\C\\BV{y}{\\frac{n}{2}} \\Feq \\BV{x}{\\frac{n}{2}}\\C\\BV{0}{1}\\C\\BV{y}{\\frac{n}{2}}"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
	    (bv-compose
	     (bv-var x 2) (bv-const 0 1) (bv-var y 1) )
	    (bv-compose
	     (bv-var x 2) (bv-const 0 1) (bv-var y 1) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 4) (bv-const 0 1) (bv-var y 3) )
	    (bv-compose
	     (bv-var x 4) (bv-const 0 1) (bv-var y 3) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 8) (bv-const 0 1) (bv-var y 7) )
	    (bv-compose
	     (bv-var x 8) (bv-const 0 1) (bv-var y 7) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 16) (bv-const 0 1) (bv-var y 15) )
	    (bv-compose
	     (bv-var x 16) (bv-const 0 1) (bv-var y 15) ))

     '(abort
	    (bv-compose
	     (bv-var x 32) (bv-const 0 1) (bv-var y 31) )
	    (bv-compose
	     (bv-var x 32) (bv-const 0 1) (bv-var y 31) ))

     '(abort
	    (bv-compose
	     (bv-var x 64) (bv-const 0 1) (bv-var y 63) )
	    (bv-compose
	     (bv-var x 64) (bv-const 0 1) (bv-var y 63) ))))

      
(defconstant *mona-plot-5*
    (list
     '("$\\BV{x}{n}+_{[n]}\\BV{y}{n} \\Feq \\BV{x}{n}+_{n}\\BV{y}{n}$"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------
	'(bv-equal
	  (bv-addition 4 (bv-var x 4) (bv-var y 4))
	  (bv-addition 4 (bv-var y 4) (bv-var x 4)))
	'(bv-equal
	  (bv-addition 8 (bv-var x 8) (bv-var y 8))
	  (bv-addition 8 (bv-var y 8) (bv-var x 8)))
	'(bv-equal
	  (bv-addition 16 (bv-var x 16) (bv-var y 16))
	  (bv-addition 16 (bv-var y 16) (bv-var x 16)))
	'(bv-equal
	  (bv-addition 32 (bv-var x 32) (bv-var y 32))
	  (bv-addition 32 (bv-var y 32) (bv-var x 32)))
	'(bv-equal
	  (bv-addition 64 (bv-var x 64) (bv-var y 64))
	  (bv-addition 64 (bv-var y 64) (bv-var x 64)))
	'(bv-equal
	  (bv-addition 128 (bv-var x 128) (bv-var y 128))
	  (bv-addition 128 (bv-var y 128) (bv-var x 128)))))

(defconstant *mona-plot-6*
    (list
     '("$\\BV{x}{n}+_{[n]} \\BV{0}{n} \\Feq \\BV{x}{n}$"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------
      '(bv-equal
	(bv-addition 4 (bv-var x 4) (bv-const 0 4))
	(bv-var x 4))
      '(bv-equal
	(bv-addition 8 (bv-var x 8) (bv-const 0 8))
	(bv-var x 8))
      '(bv-equal
	(bv-addition 16 (bv-var x 16) (bv-const 0 16))
	(bv-var x 16))
      '(bv-equal
	(bv-addition 32 (bv-var x 32) (bv-const 0 32))
	(bv-var x 32))
      '(bv-equal
	(bv-addition 64 (bv-var x 64) (bv-const 0 64))
	(bv-var x 64))
      '(bv-equal
	(bv-addition 128 (bv-var x 128) (bv-const 0 128))
	(bv-var x 128))))

(defconstant *mona-plot-7*
    (list
     '("$\\BV{x}{n}+_{[n]} \\BV{c}{n} +_{[n]} \\BV{(1-c)}{n} \\Feq \\BV{1}{n} +_{[n]} \\BV{x}{n}$"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------
      '(bv-equal
	(bv-addition 4 (bv-const 7 4) (bv-const 10 4) (bv-var x 4))
	(bv-addition 4 (bv-const 1 4) (bv-var x 4)))
      '(bv-equal
	(bv-addition 8 (bv-const 561 8) (bv-const 464 8) (bv-var x 8))
	(bv-addition 8 (bv-const 1 8) (bv-var x 8)))
       '(bv-equal
	 (bv-addition 16 (bv-const 28218 16) (bv-const 37319 16) (bv-var x 16))
	 (bv-addition 16 (bv-const 1 16) (bv-var x 16)))
       '(bv-equal
	 (bv-addition 32 (bv-const 728329 32) (bv-const 4294238968 32) (bv-var x 32))
	 (bv-addition 32 (bv-const 1 32) (bv-var x 32)))
	'(bv-equal
	  (bv-addition 64 (bv-const 18446720196836865338  64) (bv-const 23876872686279 64) (bv-var x 64))
	  (bv-addition 64 (bv-const 1 64) (bv-var x 64))) 
	'(bv-equal
	  (bv-addition 128 (bv-const 23763786876827622836762876389  128) (bv-const 340282366897174676586546984595005335068 128) (bv-var x 128))
	  (bv-addition 128 (bv-const 1 128) (bv-var x 128))) ))
	 
(defconstant *mona-plot-8*
    (list
     '("$\\BV{x}{n}+_{[n]} \\BV{x}{n} \\Feq \\BV{x}{n}\\Ex{n-2}{0} \\C \\BV{0}{1}$"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------   
      '(bv-equal
	(bv-addition 4 (bv-var x 4) (bv-var x 4))
	(bv-compose
	 (bv-extract (bv-var x 4) (tupcons 2 0))
	 (bv-const 0 1)))

       '(bv-equal
	(bv-addition 8 (bv-var x 8) (bv-var x 8))
	(bv-compose
	 (bv-extract (bv-var x 8) (tupcons 6 0))
	 (bv-const 0 1)))
        
       '(bv-equal
	 (bv-addition 16 (bv-var x 16) (bv-var x 16))
	 (bv-compose
	  (bv-extract (bv-var x 16) (tupcons 14 0))
	  (bv-const 0 1)))
	
	'(bv-equal
	  (bv-addition 32 (bv-var x 32) (bv-var x 32))
	  (bv-compose
	   (bv-extract (bv-var x 32) (tupcons 30 0))
	   (bv-const 0 1)))
	 
	 '(bv-equal
	   (bv-addition 64 (bv-var x 64) (bv-var x 64))
	   (bv-compose
	    (bv-extract (bv-var x 64) (tupcons 62 0))
	    (bv-const 0 1)))

	  '(bv-equal
	    (bv-addition 128 (bv-var x 128) (bv-var x 128))
	    (bv-compose
	     (bv-extract (bv-var x 128) (tupcons 126 0))
	     (bv-const 0 1))) ))

(defconstant *mona-plot-9*
    (list
     '("$\\BV{x}{\\frac{n}{2}}\\C\\BV{x}{\\frac{n}{2}}\\Feq\\BV{0}{\\frac{n}{2}}\\C\\BV{1}{\\frac{n}{2}}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------   
     '(bv-equal
       (bv-compose (bv-var x 2) (bv-var x 2))
       (bv-compose (bv-const 0 2) (bv-const 1 2)))
     '(bv-equal
       (bv-compose (bv-var x 4) (bv-var x 4))
       (bv-compose (bv-const 0 4) (bv-const 1 4)))
     '(ABORT
       (bv-compose (bv-var x 8) (bv-var x 8))
       (bv-compose (bv-const 0 8) (bv-const 1 8)))
     '(ABORT
       (bv-compose (bv-var x 16) (bv-var x 16))
       (bv-compose (bv-const 0 16) (bv-const 1 16)))
     '(ABORT
       (bv-compose (bv-var x 32) (bv-var x 32))
       (bv-compose (bv-const 0 32) (bv-const 1 32)))
     '(ABORT
       (bv-compose (bv-var x 64) (bv-var x 64))
       (bv-compose (bv-const 0 64) (bv-const 1 64)))))
  
(defconstant *mona-plot-10*
    (list
     '("$\\BV{x}{n} \\Band \\Bnot\\BV{x}{n}\\Feq\\BV{1}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-and (bv-var x 4) (bv-not (bv-var x 4)))
       (bv-const 1 4))
     '(bv-equal
       (bv-and (bv-var x 8) (bv-not (bv-var x 8)))
       (bv-const 1 8))
     '(bv-equal
       (bv-and (bv-var x 16) (bv-not (bv-var x 16)))
       (bv-const 1 16))
     '(bv-equal
       (bv-and (bv-var x 32) (bv-not (bv-var x 32)))
       (bv-const 1 32))
     '(bv-equal
       (bv-and (bv-var x 64) (bv-not (bv-var x 64)))
       (bv-const 1 64))
     '(bv-equal
       (bv-and (bv-var x 128) (bv-not (bv-var x 128)))
       (bv-const 1 128))))
     
(defconstant *mona-plot-11*
    (list
     '("$\\BV{x}{n} \\Bor \\BV{1}{n} \\Feq\\BV{0}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-or (bv-var x 4) (bv-const 1 4))
       (bv-const 0 4))
     '(bv-equal
       (bv-or (bv-var x 8) (bv-const 1 8))
       (bv-const 0 8))
     '(bv-equal
       (bv-or (bv-var x 16) (bv-const 1 16))
       (bv-const 0 16))
     '(bv-equal
       (bv-or (bv-var x 32) (bv-const 1 32))
       (bv-const 0 32))
     '(bv-equal
       (bv-or (bv-var x 64) (bv-const 1 64))
       (bv-const 0 64))
     '(bv-equal
       (bv-or (bv-var x 128) (bv-const 1 128))
       (bv-const 0 128))))

(defconstant *mona-plot-12*
    (list
     '("$(\\BV{x}{\\frac{n}{2}} \\Band \\BV{y}{\\frac{n}{2}})\\C(\\BV{x}{\\frac{n}{2}} \\Band \\BV{y}{\\frac{n}{2}})\\Feq \\BV{(-1)}{n} \\C \\BV{0}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-and (bv-var x 2) (bv-var y 2))
	(bv-and (bv-var x 2) (bv-var y 2)))
       (bv-compose (bv-const 3 2) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-and (bv-var x 4) (bv-var y 4))
	(bv-and (bv-var x 4) (bv-var y 4)))
       (bv-compose (bv-const 15 4) (bv-const 0 4)))
     '(ABORT
       (bv-compose (bv-and (bv-var x 8) (bv-var y 8))
	(bv-and (bv-var x 8) (bv-var y 8)))
       (bv-compose (bv-const 255 8) (bv-const 0 8)))
     '(ABORT
       (bv-compose (bv-and (bv-var x 16) (bv-var y 16))
	(bv-and (bv-var x 16) (bv-var y 16)))
       (bv-compose (bv-const 65535 16) (bv-const 0 16)))
     '(ABORT
       (bv-compose (bv-and (bv-var x 32) (bv-var y 32))
	(bv-and (bv-var x 32) (bv-var y 32)))
       (bv-compose (bv-const 4294967295 32) (bv-const 0 32)))
     '(ABORT
       (bv-compose (bv-and (bv-var x 64) (bv-var y 64))
	(bv-and (bv-var x 64) (bv-var y 64)))
       (bv-compose (bv-const 18446744073709551615 64) (bv-const 0 64)))))


(defconstant *mona-plot-13*
    (list
     '("$\\BV{const}{n}+_{[n]}\\BV{const'}{n}\\Feq\\BV{0}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-addition 4 (bv-const 17 4) (bv-const 4 4))
       (bv-const 0 4))
     '(bv-equal
       (bv-addition 8 (bv-const 129 8) (bv-const 88 8))
       (bv-const 0 8))
     '(bv-equal
       (bv-addition 16 (bv-const 32423 16) (bv-const 2322 16))
       (bv-const 0 16))
     '(bv-equal
       (bv-addition 32 (bv-const 344342111 32) (bv-const 97874744 32))
       (bv-const 0 32))
     '(bv-equal
       (bv-addition 64 (bv-const 43263782687342 64) (bv-const 9874328932749 64))
       (bv-const 0 64))
     '(bv-equal
       (bv-addition 128 (bv-const 964978264324 128) (bv-const 4323652343254765576 128))
       (bv-const 0 128))))
     
          
(defconstant *mona-plot-14*
    (list
     '("$\\BV{x}{n}+_{[n]}\\BV{1}{n}\\Feq\\BV{x}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-addition 4 (bv-var x 4) (bv-const 1 4))
       (bv-var x 4))
     '(bv-equal
       (bv-addition 8 (bv-var x 8) (bv-const 1 8))
       (bv-var x 8))
     '(bv-equal
       (bv-addition 16 (bv-var x 16) (bv-const 1 16))
       (bv-var x 16))
     '(bv-equal
       (bv-addition 32 (bv-var x 32) (bv-const 1 32))
       (bv-var x 32))
     '(bv-equal
       (bv-addition 64 (bv-var x 64) (bv-const 1 64))
       (bv-var x 64))
     '(bv-equal
       (bv-addition 128 (bv-var x 128) (bv-const 1 128))
       (bv-var x 128))))     

(defconstant *mona-plot-15*
    (list
     '("$\\BV{x}{n}+_{[n]}\\BV{x}{n}\\Feq\\BV{1}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-addition 4 (bv-var x 4) (bv-var x 4))
       (bv-const 1 4))
     '(bv-equal
       (bv-addition 8 (bv-var x 8) (bv-var x 8))
       (bv-const 1 8))
     '(bv-equal
       (bv-addition 16 (bv-var x 16) (bv-var x 16))
       (bv-const 1 16))
     '(bv-equal
       (bv-addition 32 (bv-var x 32) (bv-var x 32))
       (bv-const 1 32))
     '(bv-equal
       (bv-addition 64 (bv-var x 64) (bv-var x 64))
       (bv-const 1 64))
     '(bv-equal
       (bv-addition 128 (bv-var x 128) (bv-var x 128))
       (bv-const 1 128))))


(defconstant *mona-plot-16*
    (list
     '("$\\BV{x}{n}\\Bxor\\BV{y}{n}\\Feq\\BV{x}{n}+_{[n]}\\BV{y}{n}+_{[n]}\\BV{1}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-xor (bv-var x 4) (bv-var y 4))
       (bv-addition 4 (bv-var x 4) (bv-var y 4) (bv-const 1 4)))
     '(bv-equal
       (bv-xor (bv-var x 8) (bv-var y 8))
       (bv-addition 8 (bv-var x 8) (bv-var y 8) (bv-const 1 8)))
     '(bv-equal
       (bv-xor (bv-var x 16) (bv-var y 16))
       (bv-addition 16 (bv-var x 16) (bv-var y 16) (bv-const 1 16)))
     '(bv-equal
       (bv-xor (bv-var x 32) (bv-var y 32))
       (bv-addition 32 (bv-var x 32) (bv-var y 32) (bv-const 1 32)))
     '(bv-equal
       (bv-xor (bv-var x 64) (bv-var y 64))
       (bv-addition 64 (bv-var x 64) (bv-var y 64) (bv-const 1 64)))
     '(bv-equal
       (bv-xor (bv-var x 128) (bv-var y 128))
       (bv-addition 128 (bv-var x 128) (bv-var y 128) (bv-const 1 128)))))	  

(defconstant *mona-plot-17*
    (list
     '("$\\BV{x}{2n}\\Ex{2n-1}{n}\\Feq\\BV{x}{2n}\\Ex{n-1}{0}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
     ;;--------------------
     '(bv-equal
       (bv-extract (bv-var x 8) (tupcons 7 4))
       (bv-extract (bv-var x 8) (tupcons 3 0)))
     '(bv-equal
       (bv-extract (bv-var x 16) (tupcons 15 8))
       (bv-extract (bv-var x 16) (tupcons 7 0)))
     '(bv-equal ;; ABORT
       (bv-extract (bv-var x 32) (tupcons 31 16))
       (bv-extract (bv-var x 32) (tupcons 15 0)))
     '(bv-equal ;; ABORT
       (bv-extract (bv-var x 64) (tupcons 63 32))
       (bv-extract (bv-var x 64) (tupcons 31 0)))
     '(ABORT
       (bv-extract (bv-var x 128) (tupcons 127 64))
       (bv-extract (bv-var x 128) (tupcons 63 0)))
     '(ABORT
       (bv-extract (bv-var x 256) (tupcons 255 128))
       (bv-extract (bv-var x 256) (tupcons 127 0)))))
     
     
     

(defconstant *mona-plot-18*
    (list
     '("$\\BV{x}{\\frac{n}{2}}\\C\\BV{y}{\\frac{n}{2}}\\Feq\\BV{y}{\\frac{n}{2}}\\C\\BV{z}{\\frac{n}{2}}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-var x 2) (bv-var y 2))
       (bv-compose (bv-var y 2) (bv-var z 2)))
     '(bv-equal
       (bv-compose (bv-var x 4) (bv-var y 4))
       (bv-compose (bv-var y 4) (bv-var z 4)))
     '(ABORT
       (bv-compose (bv-var x 8) (bv-var y 8))
       (bv-compose (bv-var y 8) (bv-var z 8)))
     '(ABORT
       (bv-compose (bv-var x 16) (bv-var y 16))
       (bv-compose (bv-var y 16) (bv-var z 16)))
     '(ABORT
       (bv-compose (bv-var x 32) (bv-var y 32))
       (bv-compose (bv-var y 32) (bv-var z 32)))
     '(ABORT
       (bv-compose (bv-var x 128) (bv-var y 128))
       (bv-compose (bv-var y 128) (bv-var z 128)))))


(defconstant *mona-plot-19*
    (list
     '("$\\BV{0}{2}\\C\\BV{x}{n-2}\\Feq\\BV{x}{n-2}\\C\\BV{0}{2}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 2))
       (bv-compose (bv-var x 2) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 6))
       (bv-compose (bv-var x 6) (bv-const 0 2)))
     '(bv-equal ;; ABORT
       (bv-compose (bv-const 0 2) (bv-var x 14))
       (bv-compose (bv-var x 14) (bv-const 0 2)))
     '(bv-equal ;; ABORT
       (bv-compose (bv-const 0 2) (bv-var x 30))
       (bv-compose (bv-var x 30) (bv-const 0 2)))
     '(ABORT
       (bv-compose (bv-const 0 2) (bv-var x 62))
       (bv-compose (bv-var x 62) (bv-const 0 2)))
     '(ABORT
       (bv-compose (bv-const 0 2) (bv-var x 126))
       (bv-compose (bv-var x 126) (bv-const 0 2)))))
     
     
(defconstant *mona-plot-20*
    (list
     '("$\\BV{x}{n}\\Ex{n\\Hy 2}{m}\\C\\BV{x}{n}\\Ex{m+1}{1}\\Feq\\BV{y}{n}\\Ex{m}{0}\\C\\BV{y}{n}\\Ex{n\\Hy 3}{m\\Hy 1}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 4) (TUPCONS 2 1))
	           (bv-extract (bv-var x 4) (TUPCONS 2 1)))
       (bv-compose (bv-extract (bv-var y 4) (TUPCONS 1 0))
	           (bv-extract (bv-var y 4) (TUPCONS 1 0))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 8) (TUPCONS 6 3))
	           (bv-extract (bv-var x 8) (TUPCONS 4 1)))
       (bv-compose (bv-extract (bv-var y 8) (TUPCONS 3 0))
	           (bv-extract (bv-var y 8) (TUPCONS 5 2))))
     '(ABORT
       (bv-compose (bv-extract (bv-var x 16) (TUPCONS 14 9))
	           (bv-extract (bv-var x 16) (TUPCONS 10 1)))
       (bv-compose (bv-extract (bv-var y 16) (TUPCONS 9 0))
	           (bv-extract (bv-var y 16) (TUPCONS 13 8))))
     '(ABORT
       (bv-compose (bv-extract (bv-var x 32) (TUPCONS 30 16))
	           (bv-extract (bv-var x 32) (TUPCONS 17 1)))
       (bv-compose (bv-extract (bv-var y 32) (TUPCONS 16 0))
	           (bv-extract (bv-var y 32) (TUPCONS 29 15))))
     '(ABORT
       (bv-compose (bv-extract (bv-var x 64) (TUPCONS 62 41))
	           (bv-extract (bv-var x 64) (TUPCONS 42 1)))
       (bv-compose (bv-extract (bv-var y 64) (TUPCONS 41 0))
	           (bv-extract (bv-var y 64) (TUPCONS 61 40))))
     '(ABORT
       (bv-compose (bv-extract (bv-var x 128) (TUPCONS 126 98))
	           (bv-extract (bv-var x 128) (TUPCONS 99 1)))
       (bv-compose (bv-extract (bv-var y 128) (TUPCONS 98 0))
	           (bv-extract (bv-var y 128) (TUPCONS 125 97))))))

(defconstant *mona-plot-21*
    (list
     '("$\\BV{x}{n}\\Bor\\BV{y}{n}\\Feq\\BV{0}{n}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-or (bv-var x 4) (bv-var y 4))
       (bv-const 0 4))
     '(bv-equal
       (bv-or (bv-var x 8) (bv-var y 8))
       (bv-const 0 8))
     '(bv-equal
       (bv-or (bv-var x 16) (bv-var y 16))
       (bv-const 0 16))
     '(bv-equal
       (bv-or (bv-var x 32) (bv-var y 32))
       (bv-const 0 32))
     '(bv-equal
       (bv-or (bv-var x 64) (bv-var y 64))
       (bv-const 0 64))
     '(bv-equal
       (bv-or (bv-var x 128) (bv-var y 128))
       (bv-const 0 128))  ))

(defconstant *mona-plot-22*
    (list
     '("$\\BV{x}{n}\\Band\\BV{y}{n}\\Feq\\BV{z}{n}\\Bxor(\\Bnot\\BV{x}{n})$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-and (bv-var x 4) (bv-var y 4))
       (bv-xor (bv-var z 4) (bv-not (bv-var x 4))))
     '(bv-equal
       (bv-and (bv-var x 8) (bv-var y 8))
       (bv-xor (bv-var z 8) (bv-not (bv-var x 8))))
     '(bv-equal
       (bv-and (bv-var x 16) (bv-var y 16))
       (bv-xor (bv-var z 16) (bv-not (bv-var x 16))))
     '(bv-equal
       (bv-and (bv-var x 32) (bv-var y 32))
       (bv-xor (bv-var z 32) (bv-not (bv-var x 32))))
     '(bv-equal
       (bv-and (bv-var x 64) (bv-var y 64))
       (bv-xor (bv-var z 64) (bv-not (bv-var x 64))))
     '(bv-equal
       (bv-and (bv-var x 128) (bv-var y 128))
       (bv-xor (bv-var z 128) (bv-not (bv-var x 128))))))

(defconstant *mona-plot-23*
    (list
     '("$\\BV{x}{n}+_{[n]}\\BV{y}{n}\\Feq\\BV{0}{n}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-addition 4 (bv-var x 4) (bv-var y 4))
       (bv-const 0 4))
     '(bv-equal
       (bv-addition 8 (bv-var x 8) (bv-var y 8))
       (bv-const 0 8))
     '(bv-equal
       (bv-addition 16 (bv-var x 16) (bv-var y 16))
       (bv-const 0 16))
     '(bv-equal
       (bv-addition 32 (bv-var x 32) (bv-var y 32))
       (bv-const 0 32))
     '(bv-equal
       (bv-addition 64 (bv-var x 64) (bv-var y 64))
       (bv-const 0 64))
     '(bv-equal
       (bv-addition 128 (bv-var x 128) (bv-var y 128))
       (bv-const 0 128))))

(defconstant *mona-plot-24*
    (list
     '("$\\BV{x}{n}+_{[n]}\\BV{y}{n}\\Feq\\BV{x}{n}\\Bxor\\BV{y}{n}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-addition 4 (bv-var x 4) (bv-var y 4))
       (bv-xor (bv-var x 4) (bv-var y 4)))
     '(bv-equal
       (bv-addition 8 (bv-var x 8) (bv-var y 8))
       (bv-xor (bv-var x 8) (bv-var y 8)))
     '(bv-equal
       (bv-addition 16 (bv-var x 16) (bv-var y 16))
       (bv-xor (bv-var x 16) (bv-var y 16)))
     '(bv-equal
       (bv-addition 32 (bv-var x 32) (bv-var y 32))
       (bv-xor (bv-var x 32) (bv-var y 32)))
     '(bv-equal
       (bv-addition 64 (bv-var x 64) (bv-var y 64))
       (bv-xor (bv-var x 64) (bv-var y 64)))
     '(bv-equal
       (bv-addition 128 (bv-var x 128) (bv-var y 128))
       (bv-xor (bv-var x 128) (bv-var y 128)))))
     


(defconstant *mona-plot-26*
    (list
     '("$\\BV{x}{n}\\Band(\\BF{1}\\C\\BV{x}{n}\\Ex{n-2}{0})\\Feq(\\BT{1}\\C\\BF{1})^{\\frac{n}{2}}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
     ;;--------------------
      `(bv-equal
	(bv-and (bv-var x 4)
	      (bv-compose (bv-extract (bv-var x 4) (TUPCONS 2 0))
			  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 4) collect
				      (if (evenp i) (expt 2 i) 0)))
			4))
       `(bv-equal
	(bv-and (bv-var x 8)
	      (bv-compose 
	                  (bv-extract (bv-var x 8) (TUPCONS 6 0))
	                  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 8) collect
				      (if (evenp i) (expt 2 i) 0))) 8))
       `(bv-equal
	(bv-and (bv-var x 16)
	      (bv-compose 
	                  (bv-extract (bv-var x 16) (TUPCONS 14 0))
	                  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 16) collect
				      (if (evenp i) (expt 2 i) 0))) 16))
       `(bv-equal
	(bv-and (bv-var x 32)
	      (bv-compose 
	                  (bv-extract (bv-var x 32) (TUPCONS 30 0))
	                  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 32) collect
				      (if (evenp i) (expt 2 i) 0))) 32))
       `(bv-equal
	(bv-and (bv-var x 64)
	      (bv-compose 
	                  (bv-extract (bv-var x 64) (TUPCONS 62 0))
	                  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 64) collect
				      (if (evenp i) (expt 2 i) 0)))  64))
       `(bv-equal
	(bv-and (bv-var x 128)
	      (bv-compose 
	                  (bv-extract (bv-var x 128) (TUPCONS 126 0))
	                  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 128) collect
				      (if (evenp i) (expt 2 i) 0)))  128))))
       	                  
	 
;;; ----------------------------------------

(defun plot-mona ()
    (loop for e in
	  (list
	   (list "mona-plot-1" *mona-plot-1*)
	   (list "mona-plot-2" *mona-plot-2*)
	   (list "mona-plot-3" *mona-plot-3*)
	   (list "mona-plot-4" *mona-plot-4*)
	   (list "mona-plot-5" *mona-plot-5*)
	   (list "mona-plot-6" *mona-plot-6*)
	   (list "mona-plot-7" *mona-plot-7*)
	   (list "mona-plot-8" *mona-plot-8*)
	   (list "mona-plot-9" *mona-plot-9*)
	   (list "mona-plot-10" *mona-plot-10*)
	   (list "mona-plot-11" *mona-plot-11*)
	   (list "mona-plot-12" *mona-plot-12*)
	   (list "mona-plot-13" *mona-plot-13*)
	   (list "mona-plot-14" *mona-plot-14*)
	   (list "mona-plot-15" *mona-plot-15*)
	   (list "mona-plot-16" *mona-plot-16*)
	   (list "mona-plot-17" *mona-plot-17*)
	   (list "mona-plot-18" *mona-plot-18*)
	   (list "mona-plot-19" *mona-plot-19*)
	   (list "mona-plot-20" *mona-plot-20*)
	   (list "mona-plot-21" *mona-plot-21*)
	   (list "mona-plot-22" *mona-plot-22*)
	   (list "mona-plot-23" *mona-plot-23*)
	   (list "mona-plot-24" *mona-plot-24*)
	   ;;;-------
	   (list "mona-plot-26" *mona-plot-26*)
	   )
	  do
	  (princ (format nil "~%Processing: ~a~%" (first e)))
	  (create-mona-plot
	   (second e)
	   :plot-file (CLOS::string-append (first e) ".tex")
	   :log-file  (CLOS::string-append (first e) ".txt"))))


;;; ==============================
;;;  Testing fixed-solver
;;; ==============================

(defconstant *fixed-solver-plot-1*
    (list
     '( "$\\BV{const}{n} \\Feq \\BV{const}{n}$"
        "[checking Tautology]"
        (4 8 16 32 64 128))
     ;;--------------------
     '(bv-equal
       (bv-const 7 4)
       (bv-const 7 4))  

      '(bv-equal
	(bv-const 77 8)
	(bv-const 77 8))  
       
       '(bv-equal
	 (bv-const 9999 16)
	 (bv-const 9999 16))  
	
	'(bv-equal
	  (bv-const 687637 32)
	  (bv-const 687637 32))  
	 
	 '(bv-equal
	    (bv-const 1376167 64)
	   (bv-const 1376167 64))

	  '(bv-equal
	    (bv-const 1376167268736 128)
	   (bv-const  1376167268736 128))

	  ))

(defconstant *fixed-solver-plot-2*
    (list
     '("\\BV{x}{n} \\Feq \\BV{x}{n}"
       "[checking Tautology]"
       (4 8 16 32 64 128))
     ;;--------------------
     '(bv-equal
       (bv-var x 4)
       (BV-VAR x 4))
     '(bv-equal
       (bv-var x 8)
       (BV-VAR x 8))
      '(bv-equal
       (bv-var x 16)
       (BV-VAR x 16))
      '(bv-equal
       (bv-var x 32)
       (BV-VAR x 32))
      '(bv-equal
       (bv-var x 64)
       (BV-VAR x 64))
      '(bv-equal
       (bv-var x 128)
       (BV-VAR x 128))))

(defconstant *fixed-solver-plot-3*
    (list
     '("\\BV{x}{\\frac{n}{2}}\\C\\BV{y}{\\frac{n}{2}} \\Feq \\BV{x}{\\frac{n}{2}}\\C\\BV{y}{\\frac{n}{2}}"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------

	'(bv-equal
	  (bv-compose
	   (bv-var x 2) (bv-var y 2))
	  (bv-compose
	   (bv-var x 2) (bv-var y 2)))
	'(bv-equal
	  (bv-compose
	   (bv-var x 4) (bv-var y 4))
	  (bv-compose
	   (bv-var x 4) (bv-var y 4)))
 	'(bv-equal
	  (bv-compose
	   (bv-var x 8) (bv-var y 8))
	  (bv-compose
	   (bv-var x 8) (bv-var y 8)))
 	'(bv-equal
	  (bv-compose
	   (bv-var x 16) (bv-var y 16))
	  (bv-compose
	   (bv-var x 16) (bv-var y 16)))
 	'(bv-equal
	  (bv-compose
	   (bv-var x 32) (bv-var y 32))
	  (bv-compose
	   (bv-var x 32) (bv-var y 32)))
 	'(bv-equal
	  (bv-compose
	   (bv-var x 64) (bv-var y 64))
	  (bv-compose
	   (bv-var x 64) (bv-var y 64)))))
       
(defconstant *fixed-solver-plot-4*
    (list
     '("\\BV{x}{\\frac{n}{2}}\\C\\BV{0}{1}\\C\\BV{y}{\\frac{n}{2}} \\Feq \\BV{x}{\\frac{n}{2}}\\C\\BV{0}{1}\\C\\BV{y}{\\frac{n}{2}}"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
	    (bv-compose
	     (bv-var x 2) (bv-const 0 1) (bv-var y 1) )
	    (bv-compose
	     (bv-var x 2) (bv-const 0 1) (bv-var y 1) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 4) (bv-const 0 1) (bv-var y 3) )
	    (bv-compose
	     (bv-var x 4) (bv-const 0 1) (bv-var y 3) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 8) (bv-const 0 1) (bv-var y 7) )
	    (bv-compose
	     (bv-var x 8) (bv-const 0 1) (bv-var y 7) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 16) (bv-const 0 1) (bv-var y 15) )
	    (bv-compose
	     (bv-var x 16) (bv-const 0 1) (bv-var y 15) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 32) (bv-const 0 1) (bv-var y 31) )
	    (bv-compose
	     (bv-var x 32) (bv-const 0 1) (bv-var y 31) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 64) (bv-const 0 1) (bv-var y 63) )
	    (bv-compose
	     (bv-var x 64) (bv-const 0 1) (bv-var y 63) ))))

(defconstant *fixed-solver-plot-5*
    (list
     '("$\\BV{x}{n}+_{[n]}\\BV{y}{n} \\Feq \\BV{x}{n}+_{n}\\BV{y}{n}$"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------
	'(bv-equal
	  (bv-addition 4 (bv-var x 4) (bv-var y 4))
	  (bv-addition 4 (bv-var y 4) (bv-var x 4)))
	'(bv-equal
	  (bv-addition 8 (bv-var x 8) (bv-var y 8))
	  (bv-addition 8 (bv-var y 8) (bv-var x 8)))
	'(bv-equal
	  (bv-addition 16 (bv-var x 16) (bv-var y 16))
	  (bv-addition 16 (bv-var y 16) (bv-var x 16)))
	'(bv-equal
	  (bv-addition 32 (bv-var x 32) (bv-var y 32))
	  (bv-addition 32 (bv-var y 32) (bv-var x 32)))
	'(bv-equal
	  (bv-addition 64 (bv-var x 64) (bv-var y 64))
	  (bv-addition 64 (bv-var y 64) (bv-var x 64)))
	'(bv-equal
	  (bv-addition 128 (bv-var x 128) (bv-var y 128))
	  (bv-addition 128 (bv-var y 128) (bv-var x 128)))))


(defconstant *fixed-solver-plot-6*
    (list
     '("$\\BV{x}{n}+_{[n]} \\BV{0}{n} \\Feq \\BV{x}{n}$"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------
      '(bv-equal
	(bv-addition 4 (bv-var x 4) (bv-const 0 4))
	(bv-var x 4))
      '(bv-equal
	(bv-addition 8 (bv-var x 8) (bv-const 0 8))
	(bv-var x 8))
      '(bv-equal
	(bv-addition 16 (bv-var x 16) (bv-const 0 16))
	(bv-var x 16))
      '(bv-equal
	(bv-addition 32 (bv-var x 32) (bv-const 0 32))
	(bv-var x 32))
      '(bv-equal
	(bv-addition 64 (bv-var x 64) (bv-const 0 64))
	(bv-var x 64))
      '(bv-equal
	(bv-addition 128 (bv-var x 128) (bv-const 0 128))
	(bv-var x 128))))

(defconstant *fixed-solver-plot-7*
    (list
     '("$\\BV{x}{n}+_{[n]} \\BV{c}{n} +_{[n]} \\BV{(1-c)}{n} \\Feq \\BV{1}{n} +_{[n]} \\BV{x}{n}$"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------
      '(bv-equal
	(bv-addition 4 (bv-const 7 4) (bv-const 10 4) (bv-var x 4))
	(bv-addition 4 (bv-const 1 4) (bv-var x 4)))
      '(bv-equal
	(bv-addition 8 (bv-const 561 8) (bv-const 464 8) (bv-var x 8))
	(bv-addition 8 (bv-const 1 8) (bv-var x 8)))
       '(bv-equal
	 (bv-addition 16 (bv-const 28218 16) (bv-const 37319 16) (bv-var x 16))
	 (bv-addition 16 (bv-const 1 16) (bv-var x 16)))
       '(bv-equal
	 (bv-addition 32 (bv-const 728329 32) (bv-const 4294238968 32) (bv-var x 32))
	 (bv-addition 32 (bv-const 1 32) (bv-var x 32)))
	'(bv-equal
	  (bv-addition 64 (bv-const 18446720196836865338  64) (bv-const 23876872686279 64) (bv-var x 64))
	  (bv-addition 64 (bv-const 1 64) (bv-var x 64))) 
	'(bv-equal
	  (bv-addition 128 (bv-const 23763786876827622836762876389  128) (bv-const 340282366897174676586546984595005335068 128) (bv-var x 128))
	  (bv-addition 128 (bv-const 1 128) (bv-var x 128))) ))
	 
    (defconstant *fixed-solver-plot-8*
    (list
     '("$\\BV{x}{n}+_{[n]} \\BV{x}{n} \\Feq \\BV{x}{n}\\Ex{n-2}{0} \\C \\BV{0}{1}$"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------   
      '(bv-equal
	(bv-addition 4 (bv-var x 4) (bv-var x 4))
	(bv-compose
	 (bv-extract (bv-var x 4) (tupcons 2 0))
	 (bv-const 0 1)))

       '(bv-equal
	(bv-addition 8 (bv-var x 8) (bv-var x 8))
	(bv-compose
	 (bv-extract (bv-var x 8) (tupcons 6 0))
	 (bv-const 0 1)))
        
       '(bv-equal
	 (bv-addition 16 (bv-var x 16) (bv-var x 16))
	 (bv-compose
	  (bv-extract (bv-var x 16) (tupcons 14 0))
	  (bv-const 0 1)))
	
	'(bv-equal
	  (bv-addition 32 (bv-var x 32) (bv-var x 32))
	  (bv-compose
	   (bv-extract (bv-var x 32) (tupcons 30 0))
	   (bv-const 0 1)))
	 
	 '(bv-equal
	   (bv-addition 64 (bv-var x 64) (bv-var x 64))
	   (bv-compose
	    (bv-extract (bv-var x 64) (tupcons 62 0))
	    (bv-const 0 1)))

	  '(bv-equal
	    (bv-addition 128 (bv-var x 128) (bv-var x 128))
	    (bv-compose
	     (bv-extract (bv-var x 128) (tupcons 126 0))
	     (bv-const 0 1))) ))

(defconstant *fixed-solver-plot-9*
    (list
     '("$\\BV{x}{\\frac{n}{2}}\\C\\BV{x}{\\frac{n}{2}}\\Feq\\BV{0}{\\frac{n}{2}}\\C\\BV{1}{\\frac{n}{2}}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------   
     '(bv-equal
       (bv-compose (bv-var x 2) (bv-var x 2))
       (bv-compose (bv-const 0 2) (bv-const 1 2)))
     '(bv-equal
       (bv-compose (bv-var x 4) (bv-var x 4))
       (bv-compose (bv-const 0 4) (bv-const 1 4)))
     '(bv-equal
       (bv-compose (bv-var x 8) (bv-var x 8))
       (bv-compose (bv-const 0 8) (bv-const 1 8)))
     '(bv-equal
       (bv-compose (bv-var x 16) (bv-var x 16))
       (bv-compose (bv-const 0 16) (bv-const 1 16)))
     '(bv-equal
       (bv-compose (bv-var x 32) (bv-var x 32))
       (bv-compose (bv-const 0 32) (bv-const 1 32)))
     '(bv-equal
       (bv-compose (bv-var x 64) (bv-var x 64))
       (bv-compose (bv-const 0 64) (bv-const 1 64)))))
  
(defconstant *fixed-solver-plot-10*
    (list
     '("$\\BV{x}{n} \\Band \\Bnot\\BV{x}{n}\\Feq\\BV{1}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-and (bv-var x 4) (bv-not (bv-var x 4)))
       (bv-const 1 4))
     '(bv-equal
       (bv-and (bv-var x 8) (bv-not (bv-var x 8)))
       (bv-const 1 8))
     '(bv-equal
       (bv-and (bv-var x 16) (bv-not (bv-var x 16)))
       (bv-const 1 16))
     '(bv-equal
       (bv-and (bv-var x 32) (bv-not (bv-var x 32)))
       (bv-const 1 32))
     '(bv-equal
       (bv-and (bv-var x 64) (bv-not (bv-var x 64)))
       (bv-const 1 64))
     '(bv-equal
       (bv-and (bv-var x 128) (bv-not (bv-var x 128)))
       (bv-const 1 128))))
     
(defconstant *fixed-solver-plot-11*
    (list
     '("$\\BV{x}{n} \\Bor \\BV{1}{n} \\Feq\\BV{0}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-or (bv-var x 4) (bv-const 1 4))
       (bv-const 0 4))
     '(bv-equal
       (bv-or (bv-var x 8) (bv-const 1 8))
       (bv-const 0 8))
     '(bv-equal
       (bv-or (bv-var x 16) (bv-const 1 16))
       (bv-const 0 16))
     '(bv-equal
       (bv-or (bv-var x 32) (bv-const 1 32))
       (bv-const 0 32))
     '(bv-equal
       (bv-or (bv-var x 64) (bv-const 1 64))
       (bv-const 0 64))
     '(bv-equal
       (bv-or (bv-var x 128) (bv-const 1 128))
       (bv-const 0 128))))

(defconstant *fixed-solver-plot-12*
    (list
     '("$(\\BV{x}{\\frac{n}{2}} \\Band \\BV{y}{\\frac{n}{2}})\\C(\\BV{x}{\\frac{n}{2}} \\Band \\BV{y}{\\frac{n}{2}})\\Feq \\BV{(-1)}{n} \\C \\BV{0}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-and (bv-var x 2) (bv-var y 2))
	(bv-and (bv-var x 2) (bv-var y 2)))
       (bv-compose (bv-const 3 2) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-and (bv-var x 4) (bv-var y 4))
	(bv-and (bv-var x 4) (bv-var y 4)))
       (bv-compose (bv-const 15 4) (bv-const 0 4)))
     '(bv-equal
       (bv-compose (bv-and (bv-var x 8) (bv-var y 8))
	(bv-and (bv-var x 8) (bv-var y 8)))
       (bv-compose (bv-const 255 8) (bv-const 0 8)))
     '(bv-equal
       (bv-compose (bv-and (bv-var x 16) (bv-var y 16))
	(bv-and (bv-var x 16) (bv-var y 16)))
       (bv-compose (bv-const 65535 16) (bv-const 0 16)))
     '(bv-equal
       (bv-compose (bv-and (bv-var x 32) (bv-var y 32))
	(bv-and (bv-var x 32) (bv-var y 32)))
       (bv-compose (bv-const 4294967295 32) (bv-const 0 32)))
     '(bv-equal
       (bv-compose (bv-and (bv-var x 64) (bv-var y 64))
	(bv-and (bv-var x 64) (bv-var y 64)))
       (bv-compose (bv-const 18446744073709551615 64) (bv-const 0 64)))))


(defconstant *fixed-solver-plot-13*
    (list
     '("$\\BV{const}{n}+_{[n]}\\BV{const'}{n}\\Feq\\BV{0}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-addition 4 (bv-const 17 4) (bv-const 4 4))
       (bv-const 0 4))
     '(bv-equal
       (bv-addition 8 (bv-const 129 8) (bv-const 88 8))
       (bv-const 0 8))
     '(bv-equal
       (bv-addition 16 (bv-const 32423 16) (bv-const 2322 16))
       (bv-const 0 16))
     '(bv-equal
       (bv-addition 32 (bv-const 344342111 32) (bv-const 97874744 32))
       (bv-const 0 32))
     '(bv-equal
       (bv-addition 64 (bv-const 43263782687342 64) (bv-const 9874328932749 64))
       (bv-const 0 64))
     '(bv-equal
       (bv-addition 128 (bv-const 964978264324 128) (bv-const 4323652343254765576 128))
       (bv-const 0 128))))
     
          
(defconstant *fixed-solver-plot-14*
    (list
     '("$\\BV{x}{n}+_{[n]}\\BV{1}{n}\\Feq\\BV{x}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-addition 4 (bv-var x 4) (bv-const 1 4))
       (bv-var x 4))
     '(bv-equal
       (bv-addition 8 (bv-var x 8) (bv-const 1 8))
       (bv-var x 8))
     '(bv-equal
       (bv-addition 16 (bv-var x 16) (bv-const 1 16))
       (bv-var x 16))
     '(bv-equal
       (bv-addition 32 (bv-var x 32) (bv-const 1 32))
       (bv-var x 32))
     '(bv-equal
       (bv-addition 64 (bv-var x 64) (bv-const 1 64))
       (bv-var x 64))
     '(bv-equal
       (bv-addition 128 (bv-var x 128) (bv-const 1 128))
       (bv-var x 128))))     

(defconstant *fixed-solver-plot-15*
    (list
     '("$\\BV{x}{n}+_{[n]}\\BV{x}{n}\\Feq\\BV{1}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-addition 4 (bv-var x 4) (bv-var x 4))
       (bv-const 1 4))
     '(bv-equal
       (bv-addition 8 (bv-var x 8) (bv-var x 8))
       (bv-const 1 8))
     '(bv-equal
       (bv-addition 16 (bv-var x 16) (bv-var x 16))
       (bv-const 1 16))
     '(bv-equal
       (bv-addition 32 (bv-var x 32) (bv-var x 32))
       (bv-const 1 32))
     '(bv-equal
       (bv-addition 64 (bv-var x 64) (bv-var x 64))
       (bv-const 1 64))
     '(bv-equal
       (bv-addition 128 (bv-var x 128) (bv-var x 128))
       (bv-const 1 128))))


(defconstant *fixed-solver-plot-16*
    (list
     '("$\\BV{x}{n}\\Bxor\\BV{y}{n}\\Feq\\BV{x}{n}+_{[n]}\\BV{y}{n}+_{[n]}\\BV{1}{n}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-xor (bv-var x 4) (bv-var y 4))
       (bv-addition 4 (bv-var x 4) (bv-var y 4) (bv-const 1 4)))
     '(bv-equal
       (bv-xor (bv-var x 8) (bv-var y 8))
       (bv-addition 8 (bv-var x 8) (bv-var y 8) (bv-const 1 8)))
     '(bv-equal
       (bv-xor (bv-var x 16) (bv-var y 16))
       (bv-addition 16 (bv-var x 16) (bv-var y 16) (bv-const 1 16)))
     '(bv-equal
       (bv-xor (bv-var x 32) (bv-var y 32))
       (bv-addition 32 (bv-var x 32) (bv-var y 32) (bv-const 1 32)))
     '(bv-equal
       (bv-xor (bv-var x 64) (bv-var y 64))
       (bv-addition 64 (bv-var x 64) (bv-var y 64) (bv-const 1 64)))
     '(bv-equal
       (bv-xor (bv-var x 128) (bv-var y 128))
       (bv-addition 128 (bv-var x 128) (bv-var y 128) (bv-const 1 128)))))	  

(defconstant *fixed-solver-plot-17*
    (list
     '("$\\BV{x}{2n}\\Ex{2n-1}{n}\\Feq\\BV{x}{2n}\\Ex{n-1}{0}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
     ;;--------------------
     '(bv-equal
       (bv-extract (bv-var x 8) (tupcons 7 4))
       (bv-extract (bv-var x 8) (tupcons 3 0)))
     '(bv-equal
       (bv-extract (bv-var x 16) (tupcons 15 8))
       (bv-extract (bv-var x 16) (tupcons 7 0)))
     '(bv-equal
       (bv-extract (bv-var x 32) (tupcons 31 16))
       (bv-extract (bv-var x 32) (tupcons 15 0)))
     '(bv-equal
       (bv-extract (bv-var x 64) (tupcons 63 32))
       (bv-extract (bv-var x 64) (tupcons 31 0)))
     '(bv-equal
       (bv-extract (bv-var x 128) (tupcons 127 64))
       (bv-extract (bv-var x 128) (tupcons 63 0)))
     '(bv-equal
       (bv-extract (bv-var x 256) (tupcons 255 128))
       (bv-extract (bv-var x 256) (tupcons 127 0)))))
     
     
     

(defconstant *fixed-solver-plot-18*
    (list
     '("$\\BV{x}{\\frac{n}{2}}\\C\\BV{y}{\\frac{n}{2}}\\Feq\\BV{y}{\\frac{n}{2}}\\C\\BV{z}{\\frac{n}{2}}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-var x 2) (bv-var y 2))
       (bv-compose (bv-var y 2) (bv-var z 2)))
     '(bv-equal
       (bv-compose (bv-var x 4) (bv-var y 4))
       (bv-compose (bv-var y 4) (bv-var z 4)))
     '(bv-equal
       (bv-compose (bv-var x 8) (bv-var y 8))
       (bv-compose (bv-var y 8) (bv-var z 8)))
     '(bv-equal
       (bv-compose (bv-var x 16) (bv-var y 16))
       (bv-compose (bv-var y 16) (bv-var z 16)))
     '(bv-equal
       (bv-compose (bv-var x 32) (bv-var y 32))
       (bv-compose (bv-var y 32) (bv-var z 32)))
     '(bv-equal
       (bv-compose (bv-var x 128) (bv-var y 128))
       (bv-compose (bv-var y 128) (bv-var z 128)))))


(defconstant *fixed-solver-plot-19*
    (list
     '("$\\BV{0}{2}\\C\\BV{x}{n-2}\\Feq\\BV{x}{n-2}\\C\\BV{0}{2}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 2))
       (bv-compose (bv-var x 2) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 6))
       (bv-compose (bv-var x 6) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 14))
       (bv-compose (bv-var x 14) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 30))
       (bv-compose (bv-var x 30) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 62))
       (bv-compose (bv-var x 62) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 126))
       (bv-compose (bv-var x 126) (bv-const 0 2)))))
     
     
(defconstant *fixed-solver-plot-20*
    (list
     '("$\\BV{x}{n}\\Ex{n\\Hy 2}{m}\\C\\BV{x}{n}\\Ex{m+1}{1}\\Feq\\BV{y}{n}\\Ex{m}{0}\\C\\BV{y}{n}\\Ex{n\\Hy 3}{m\\Hy 1}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 4) (TUPCONS 2 1))
	           (bv-extract (bv-var x 4) (TUPCONS 2 1)))
       (bv-compose (bv-extract (bv-var y 4) (TUPCONS 1 0))
	           (bv-extract (bv-var y 4) (TUPCONS 1 0))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 8) (TUPCONS 6 3))
	           (bv-extract (bv-var x 8) (TUPCONS 4 1)))
       (bv-compose (bv-extract (bv-var y 8) (TUPCONS 3 0))
	           (bv-extract (bv-var y 8) (TUPCONS 5 2))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 16) (TUPCONS 14 9))
	           (bv-extract (bv-var x 16) (TUPCONS 10 1)))
       (bv-compose (bv-extract (bv-var y 16) (TUPCONS 9 0))
	           (bv-extract (bv-var y 16) (TUPCONS 13 8))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 32) (TUPCONS 30 16))
	           (bv-extract (bv-var x 32) (TUPCONS 17 1)))
       (bv-compose (bv-extract (bv-var y 32) (TUPCONS 16 0))
	           (bv-extract (bv-var y 32) (TUPCONS 29 15))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 64) (TUPCONS 62 41))
	           (bv-extract (bv-var x 64) (TUPCONS 42 1)))
       (bv-compose (bv-extract (bv-var y 64) (TUPCONS 41 0))
	           (bv-extract (bv-var y 64) (TUPCONS 61 40))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 128) (TUPCONS 126 98))
	           (bv-extract (bv-var x 128) (TUPCONS 99 1)))
       (bv-compose (bv-extract (bv-var y 128) (TUPCONS 98 0))
	           (bv-extract (bv-var y 128) (TUPCONS 125 97))))))

(defconstant *fixed-solver-plot-21*
    (list
     '("$\\BV{x}{n}\\Bor\\BV{y}{n}\\Feq\\BV{0}{n}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-or (bv-var x 4) (bv-var y 4))
       (bv-const 0 4))
     '(bv-equal
       (bv-or (bv-var x 8) (bv-var y 8))
       (bv-const 0 8))
     '(bv-equal
       (bv-or (bv-var x 16) (bv-var y 16))
       (bv-const 0 16))
     '(bv-equal
       (bv-or (bv-var x 32) (bv-var y 32))
       (bv-const 0 32))
     '(bv-equal
       (bv-or (bv-var x 64) (bv-var y 64))
       (bv-const 0 64))
     '(bv-equal
       (bv-or (bv-var x 128) (bv-var y 128))
       (bv-const 0 128))  ))

(defconstant *fixed-solver-plot-22*
    (list
     '("$\\BV{x}{n}\\Band\\BV{y}{n}\\Feq\\BV{z}{n}\\Bxor(\\Bnot\\BV{x}{n})$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-and (bv-var x 4) (bv-var y 4))
       (bv-xor (bv-var z 4) (bv-not (bv-var x 4))))
     '(bv-equal
       (bv-and (bv-var x 8) (bv-var y 8))
       (bv-xor (bv-var z 8) (bv-not (bv-var x 8))))
     '(bv-equal
       (bv-and (bv-var x 16) (bv-var y 16))
       (bv-xor (bv-var z 16) (bv-not (bv-var x 16))))
     '(bv-equal
       (bv-and (bv-var x 32) (bv-var y 32))
       (bv-xor (bv-var z 32) (bv-not (bv-var x 32))))
     '(bv-equal
       (bv-and (bv-var x 64) (bv-var y 64))
       (bv-xor (bv-var z 64) (bv-not (bv-var x 64))))
     '(bv-equal
       (bv-and (bv-var x 128) (bv-var y 128))
       (bv-xor (bv-var z 128) (bv-not (bv-var x 128))))))

(defconstant *fixed-solver-plot-23*
    (list
     '("$\\BV{x}{n}+_{[n]}\\BV{y}{n}\\Feq\\BV{0}{n}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-addition 4 (bv-var x 4) (bv-var y 4))
       (bv-const 0 4))
     '(ABORT
       (bv-addition 8 (bv-var x 8) (bv-var y 8))
       (bv-const 0 8))
     '(ABORT
       (bv-addition 16 (bv-var x 16) (bv-var y 16))
       (bv-const 0 16))
     '(ABORT
       (bv-addition 32 (bv-var x 32) (bv-var y 32))
       (bv-const 0 32))
     '(ABORT
       (bv-addition 64 (bv-var x 64) (bv-var y 64))
       (bv-const 0 64))
     '(ABORT
       (bv-addition 128 (bv-var x 128) (bv-var y 128))
       (bv-const 0 128))))

(defconstant *fixed-solver-plot-24*
    (list
     '("$\\BV{x}{n}+_{[n]}\\BV{y}{n}\\Feq\\BV{x}{n}\\Bxor\\BV{y}{n}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-addition 4 (bv-var x 4) (bv-var y 4))
       (bv-xor (bv-var x 4) (bv-var y 4)))
     '(ABORT
       (bv-addition 8 (bv-var x 8) (bv-var y 8))
       (bv-xor (bv-var x 8) (bv-var y 8)))
     '(ABORT
       (bv-addition 16 (bv-var x 16) (bv-var y 16))
       (bv-xor (bv-var x 16) (bv-var y 16)))
     '(ABORT
       (bv-addition 32 (bv-var x 32) (bv-var y 32))
       (bv-xor (bv-var x 32) (bv-var y 32)))
     '(ABORT
       (bv-addition 64 (bv-var x 64) (bv-var y 64))
       (bv-xor (bv-var x 64) (bv-var y 64)))
     '(ABORT
       (bv-addition 128 (bv-var x 128) (bv-var y 128))
       (bv-xor (bv-var x 128) (bv-var y 128)))))
     
(defconstant *fixed-solver-plot-26*
    (list
     '("$\\BV{x}{n}\\Band(\\BF{1}\\C\\BV{x}{n}\\Ex{n-2}{0})\\Feq(\\BT{1}\\C\\BF{1})^{\\frac{n}{2}}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
     ;;--------------------
      `(bv-equal
	(bv-and (bv-var x 4)
	      (bv-compose (bv-extract (bv-var x 4) (TUPCONS 2 0))
			  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 4) collect
				      (if (evenp i) (expt 2 i) 0)))
			4))
       `(bv-equal
	(bv-and (bv-var x 8)
	      (bv-compose 
	                  (bv-extract (bv-var x 8) (TUPCONS 6 0))
	                  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 8) collect
				      (if (evenp i) (expt 2 i) 0))) 8))
       `(bv-equal
	(bv-and (bv-var x 16)
	      (bv-compose 
	                  (bv-extract (bv-var x 16) (TUPCONS 14 0))
	                  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 16) collect
				      (if (evenp i) (expt 2 i) 0))) 16))
       `(bv-equal
	(bv-and (bv-var x 32)
	      (bv-compose 
	                  (bv-extract (bv-var x 32) (TUPCONS 30 0))
	                  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 32) collect
				      (if (evenp i) (expt 2 i) 0))) 32))
       `(bv-equal
	(bv-and (bv-var x 64)
	      (bv-compose 
	                  (bv-extract (bv-var x 64) (TUPCONS 62 0))
	                  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 64) collect
				      (if (evenp i) (expt 2 i) 0)))  64))
       `(bv-equal
	(bv-and (bv-var x 128)
	      (bv-compose 
	                  (bv-extract (bv-var x 128) (TUPCONS 126 0))
	                  (bv-const 0 1)))
	      (bv-const ,(apply #'+
				(loop for i from 0 to (1- 128) collect
				      (if (evenp i) (expt 2 i) 0)))  128))))
       	                  
;     `(bv-equal
;       (bv-compose (bv-addition 2 (bv-var x 2) (bv-var y 2))
;	           (bv-and (bv-extract (bv-var x 2) (TUPCONS 0 0))
;		           (bv-extract (bv-var y 2) (TUPCONS 0 0))))
;       (bv-const ,(1- (expt 2 (1+ 2))) ,(1+ 2)))
;     `(bv-equal
;       (bv-compose (bv-addition 4 (bv-var x 4) (bv-var y 4))
;	           (bv-and (bv-extract (bv-var x 4) (TUPCONS 0 0))
;		           (bv-extract (bv-var y 4) (TUPCONS 0 0))))
;       (bv-const ,(1- (expt 2 (1+ 4))) ,(1+ 4)))
;      `(bv-equal
;	(bv-compose (bv-addition 8 (bv-var x 8) (bv-var y 8))
;		    (bv-and (bv-extract (bv-var x 8) (TUPCONS 0 0))
;			    (bv-extract (bv-var y 8) (TUPCONS 0 0))))
;	(bv-const ,(1- (expt 2 (1+ 8))) ,(1+ 8)))
;      `(ABORT
;       (bv-compose (bv-addition 16 (bv-var x 16) (bv-var y 16))
;	           (bv-and (bv-extract (bv-var x 16) (TUPCONS 0 0))
;		           (bv-extract (bv-var y 16) (TUPCONS 0 0))))
;       (bv-const ,(1- (expt 2 (1+ 16))) ,(1+ 16)))
;      `(ABORT
;	(bv-compose (bv-addition 32 (bv-var x 32) (bv-var y 32))
;		    (bv-and (bv-extract (bv-var x 32) (TUPCONS 0 0))
;			    (bv-extract (bv-var y 32) (TUPCONS 0 0))))
;	(bv-const ,(1- (expt 2 (1+ 32))) ,(1+ 32)))
;      `(ABORT
;	(bv-compose (bv-addition 64 (bv-var x 64) (bv-var y 64))
;	           (bv-and (bv-extract (bv-var x 64) (TUPCONS 0 0))
;		           (bv-extract (bv-var y 64) (TUPCONS 0 0))))
;	(bv-const ,(1- (expt 2 (1+ 64))) ,(1+ 64)))))

;;; ----------------------------------------
;;; ----------------------------------------

(defun plot-fs (&key (heuristic-level 9)
		     (surpress-result nil)
		     (e-list
  (list
      (list "fixed-solver-plot-1" *fixed-solver-plot-1*)
      (list "fixed-solver-plot-2" *fixed-solver-plot-2*)
      (list "fixed-solver-plot-3" *fixed-solver-plot-3*)
      (list "fixed-solver-plot-4" *fixed-solver-plot-4*)
      (list "fixed-solver-plot-5" *fixed-solver-plot-5*)
      (list "fixed-solver-plot-6" *fixed-solver-plot-6*)
      (list "fixed-solver-plot-7" *fixed-solver-plot-7*)
      (list "fixed-solver-plot-8" *fixed-solver-plot-8*)
      (list "fixed-solver-plot-9" *fixed-solver-plot-9*)
      (list "fixed-solver-plot-10" *fixed-solver-plot-10*)
      (list "fixed-solver-plot-11" *fixed-solver-plot-11*)
      (list "fixed-solver-plot-12" *fixed-solver-plot-12*)
      (list "fixed-solver-plot-13" *fixed-solver-plot-13*)
      (list "fixed-solver-plot-14" *fixed-solver-plot-14*)
      (list "fixed-solver-plot-15" *fixed-solver-plot-15*)
      (list "fixed-solver-plot-16" *fixed-solver-plot-16*)
      (list "fixed-solver-plot-17" *fixed-solver-plot-17*)
      (list "fixed-solver-plot-18" *fixed-solver-plot-18*)
      (list "fixed-solver-plot-19" *fixed-solver-plot-19*)
      (list "fixed-solver-plot-20" *fixed-solver-plot-20*)
      (list "fixed-solver-plot-21" *fixed-solver-plot-21*)
      (list "fixed-solver-plot-22" *fixed-solver-plot-22*)
      (list "fixed-solver-plot-23" *fixed-solver-plot-23*)
      (list "fixed-solver-plot-24" *fixed-solver-plot-24*)
      ;;;---------
      (list "fixed-solver-plot-26" *fixed-solver-plot-26*)
	   )))
  (loop for e in e-list do
	(princ (format nil "~%Processing: ~a~%" (first e)))
	(create-fixed-solver-plot
	 (second e)
	   :heuristic-level heuristic-level
	   :plot-file (CLOS::string-append (first e)
					   "-["
					   (princ-to-string heuristic-level)
					   "].tex")
	   :log-file  (CLOS::string-append (first e)
					   "-["
					   (princ-to-string heuristic-level)
					   "].txt")
	   :SURPRESS-RESULT surpress-result
	   :INCLUDE-CANON-TIME t
	   )))
;;; ----------------------------------------
;;; ----------------------------------------

;;; ==============================
;;;  Testing Reduced Chopper
;;; ==============================

(defconstant *reduced-chopper-plot-1*
    (list
     '( "$\\BV{const}{n} \\Feq \\BV{const}{n}$"
        "[checking Tautology]"
        (4 8 16 32 64 128))
     ;;--------------------
     '(bv-equal
       (bv-const 7 4)
       (bv-const 7 4))  

      '(bv-equal
	(bv-const 77 8)
	(bv-const 77 8))  
       
       '(bv-equal
	 (bv-const 9999 16)
	 (bv-const 9999 16))  
	
	'(bv-equal
	  (bv-const 687637 32)
	  (bv-const 687637 32))  
	 
	 '(bv-equal
	    (bv-const 1376167 64)
	   (bv-const 1376167 64))

	  '(bv-equal
	    (bv-const 1376167268736 128)
	   (bv-const  1376167268736 128))

	  ))

(defconstant *reduced-chopper-plot-2*
    (list
     '("\\BV{x}{n} \\Feq \\BV{x}{n}"
       "[checking Tautology]"
       (4 8 16 32 64 128))
     ;;--------------------
     '(bv-equal
       (bv-var x 4)
       (BV-VAR x 4))
     '(bv-equal
       (bv-var x 8)
       (BV-VAR x 8))
      '(bv-equal
       (bv-var x 16)
       (BV-VAR x 16))
      '(bv-equal
       (bv-var x 32)
       (BV-VAR x 32))
      '(bv-equal
       (bv-var x 64)
       (BV-VAR x 64))
      '(bv-equal
       (bv-var x 128)
       (BV-VAR x 128))))

(defconstant *reduced-chopper-plot-3*
    (list
     '("\\BV{x}{\\frac{n}{2}}\\C\\BV{y}{\\frac{n}{2}} \\Feq \\BV{x}{\\frac{n}{2}}\\C\\BV{y}{\\frac{n}{2}}"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------

	'(bv-equal
	  (bv-compose
	   (bv-var x 2) (bv-var y 2))
	  (bv-compose
	   (bv-var x 2) (bv-var y 2)))
	'(bv-equal
	  (bv-compose
	   (bv-var x 4) (bv-var y 4))
	  (bv-compose
	   (bv-var x 4) (bv-var y 4)))
 	'(bv-equal
	  (bv-compose
	   (bv-var x 8) (bv-var y 8))
	  (bv-compose
	   (bv-var x 8) (bv-var y 8)))
 	'(bv-equal
	  (bv-compose
	   (bv-var x 16) (bv-var y 16))
	  (bv-compose
	   (bv-var x 16) (bv-var y 16)))
 	'(bv-equal
	  (bv-compose
	   (bv-var x 32) (bv-var y 32))
	  (bv-compose
	   (bv-var x 32) (bv-var y 32)))
 	'(bv-equal
	  (bv-compose
	   (bv-var x 64) (bv-var y 64))
	  (bv-compose
	   (bv-var x 64) (bv-var y 64)))))
       
(defconstant *reduced-chopper-plot-4*
    (list
     '("\\BV{x}{\\frac{n}{2}}\\C\\BV{0}{1}\\C\\BV{y}{\\frac{n}{2}} \\Feq \\BV{x}{\\frac{n}{2}}\\C\\BV{0}{1}\\C\\BV{y}{\\frac{n}{2}}"
       "[checking Tautology]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
	    (bv-compose
	     (bv-var x 2) (bv-const 0 1) (bv-var y 1) )
	    (bv-compose
	     (bv-var x 2) (bv-const 0 1) (bv-var y 1) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 4) (bv-const 0 1) (bv-var y 3) )
	    (bv-compose
	     (bv-var x 4) (bv-const 0 1) (bv-var y 3) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 8) (bv-const 0 1) (bv-var y 7) )
	    (bv-compose
	     (bv-var x 8) (bv-const 0 1) (bv-var y 7) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 16) (bv-const 0 1) (bv-var y 15) )
	    (bv-compose
	     (bv-var x 16) (bv-const 0 1) (bv-var y 15) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 32) (bv-const 0 1) (bv-var y 31) )
	    (bv-compose
	     (bv-var x 32) (bv-const 0 1) (bv-var y 31) ))

     '(bv-equal
	    (bv-compose
	     (bv-var x 64) (bv-const 0 1) (bv-var y 63) )
	    (bv-compose
	     (bv-var x 64) (bv-const 0 1) (bv-var y 63) ))))

(defconstant *reduced-chopper-plot-9*
    (list
     '("$\\BV{x}{\\frac{n}{2}}\\C\\BV{x}{\\frac{n}{2}}\\Feq\\BV{0}{\\frac{n}{2}}\\C\\BV{1}{\\frac{n}{2}}$"
       "[checking Unsatifiability]"
       (4 8 16 32 64 128))
      ;;--------------------   
     '(bv-equal
       (bv-compose (bv-var x 2) (bv-var x 2))
       (bv-compose (bv-const 0 2) (bv-const 1 2)))
     '(bv-equal
       (bv-compose (bv-var x 4) (bv-var x 4))
       (bv-compose (bv-const 0 4) (bv-const 1 4)))
     '(bv-equal
       (bv-compose (bv-var x 8) (bv-var x 8))
       (bv-compose (bv-const 0 8) (bv-const 1 8)))
     '(bv-equal
       (bv-compose (bv-var x 16) (bv-var x 16))
       (bv-compose (bv-const 0 16) (bv-const 1 16)))
     '(bv-equal
       (bv-compose (bv-var x 32) (bv-var x 32))
       (bv-compose (bv-const 0 32) (bv-const 1 32)))
     '(bv-equal
       (bv-compose (bv-var x 64) (bv-var x 64))
       (bv-compose (bv-const 0 64) (bv-const 1 64)))))
  
(defconstant *reduced-chopper-plot-17*
    (list
     '("$\\BV{x}{2n}\\Ex{2n-1}{n}\\Feq\\BV{x}{2n}\\Ex{n-1}{0}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
     ;;--------------------
     '(bv-equal
       (bv-extract (bv-var x 8) (tupcons 7 4))
       (bv-extract (bv-var x 8) (tupcons 3 0)))
     '(bv-equal
       (bv-extract (bv-var x 16) (tupcons 15 8))
       (bv-extract (bv-var x 16) (tupcons 7 0)))
     '(bv-equal
       (bv-extract (bv-var x 32) (tupcons 31 16))
       (bv-extract (bv-var x 32) (tupcons 15 0)))
     '(bv-equal
       (bv-extract (bv-var x 64) (tupcons 63 32))
       (bv-extract (bv-var x 64) (tupcons 31 0)))
     '(bv-equal
       (bv-extract (bv-var x 128) (tupcons 127 64))
       (bv-extract (bv-var x 128) (tupcons 63 0)))
     '(bv-equal
       (bv-extract (bv-var x 256) (tupcons 255 128))
       (bv-extract (bv-var x 256) (tupcons 127 0)))))
     
     
     

(defconstant *reduced-chopper-plot-18*
    (list
     '("$\\BV{x}{\\frac{n}{2}}\\C\\BV{y}{\\frac{n}{2}}\\Feq\\BV{y}{\\frac{n}{2}}\\C\\BV{z}{\\frac{n}{2}}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-var x 2) (bv-var y 2))
       (bv-compose (bv-var y 2) (bv-var z 2)))
     '(bv-equal
       (bv-compose (bv-var x 4) (bv-var y 4))
       (bv-compose (bv-var y 4) (bv-var z 4)))
     '(bv-equal
       (bv-compose (bv-var x 8) (bv-var y 8))
       (bv-compose (bv-var y 8) (bv-var z 8)))
     '(bv-equal
       (bv-compose (bv-var x 16) (bv-var y 16))
       (bv-compose (bv-var y 16) (bv-var z 16)))
     '(bv-equal
       (bv-compose (bv-var x 32) (bv-var y 32))
       (bv-compose (bv-var y 32) (bv-var z 32)))
     '(bv-equal
       (bv-compose (bv-var x 128) (bv-var y 128))
       (bv-compose (bv-var y 128) (bv-var z 128)))))


(defconstant *reduced-chopper-plot-19*
    (list
     '("$\\BV{0}{2}\\C\\BV{x}{n-2}\\Feq\\BV{x}{n-2}\\C\\BV{0}{2}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 2))
       (bv-compose (bv-var x 2) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 6))
       (bv-compose (bv-var x 6) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 14))
       (bv-compose (bv-var x 14) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 30))
       (bv-compose (bv-var x 30) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 62))
       (bv-compose (bv-var x 62) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 126))
       (bv-compose (bv-var x 126) (bv-const 0 2)))))
     
     
(defconstant *reduced-chopper-plot-20*
    (list
     '("$\\BV{x}{n}\\Ex{n\\Hy 2}{m}\\C\\BV{x}{n}\\Ex{m+1}{1}\\Feq\\BV{y}{n}\\Ex{m}{0}\\C\\BV{y}{n}\\Ex{n\\Hy 3}{m\\Hy 1}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 4) (TUPCONS 2 1))
	           (bv-extract (bv-var x 4) (TUPCONS 2 1)))
       (bv-compose (bv-extract (bv-var y 4) (TUPCONS 1 0))
	           (bv-extract (bv-var y 4) (TUPCONS 1 0))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 8) (TUPCONS 6 3))
	           (bv-extract (bv-var x 8) (TUPCONS 4 1)))
       (bv-compose (bv-extract (bv-var y 8) (TUPCONS 3 0))
	           (bv-extract (bv-var y 8) (TUPCONS 5 2))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 16) (TUPCONS 14 9))
	           (bv-extract (bv-var x 16) (TUPCONS 10 1)))
       (bv-compose (bv-extract (bv-var y 16) (TUPCONS 9 0))
	           (bv-extract (bv-var y 16) (TUPCONS 13 8))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 32) (TUPCONS 30 16))
	           (bv-extract (bv-var x 32) (TUPCONS 17 1)))
       (bv-compose (bv-extract (bv-var y 32) (TUPCONS 16 0))
	           (bv-extract (bv-var y 32) (TUPCONS 29 15))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 64) (TUPCONS 62 41))
	           (bv-extract (bv-var x 64) (TUPCONS 42 1)))
       (bv-compose (bv-extract (bv-var y 64) (TUPCONS 41 0))
	           (bv-extract (bv-var y 64) (TUPCONS 61 40))))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 128) (TUPCONS 126 98))
	           (bv-extract (bv-var x 128) (TUPCONS 99 1)))
       (bv-compose (bv-extract (bv-var y 128) (TUPCONS 98 0))
	           (bv-extract (bv-var y 128) (TUPCONS 125 97))))))

(defconstant *reduced-chopper-plot-25*
    ;; like -19, but aborts early
    (list
     '("$\\BV{0}{2}\\C\\BV{x}{n-2}\\Feq\\BV{x}{n-2}\\C\\BV{0}{2}$"
       "[checking Satifiability]"
       (4 8 16 32 64 128))
      ;;--------------------
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 2))
       (bv-compose (bv-var x 2) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 6))
       (bv-compose (bv-var x 6) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 14))
       (bv-compose (bv-var x 14) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 30))
       (bv-compose (bv-var x 30) (bv-const 0 2)))
     '(bv-equal
       (bv-compose (bv-const 0 2) (bv-var x 62))
       (bv-compose (bv-var x 62) (bv-const 0 2)))
     '(ABORT
       (bv-compose (bv-const 0 2) (bv-var x 126))
       (bv-compose (bv-var x 126) (bv-const 0 2)))))
     
     
;;; ----------------------------------------
;;; ----------------------------------------

(defun plot-rc ()
    (loop for e in
	  (list
	   (list "reduced-chopper-plot-1" *reduced-chopper-plot-1*)
	   (list "reduced-chopper-plot-2" *reduced-chopper-plot-2*)
	   (list "reduced-chopper-plot-3" *reduced-chopper-plot-3*)
	   (list "reduced-chopper-plot-4" *reduced-chopper-plot-4*)
	   (list "reduced-chopper-plot-9" *reduced-chopper-plot-9*)
	   (list "reduced-chopper-plot-17" *reduced-chopper-plot-17*)
	   (list "reduced-chopper-plot-18" *reduced-chopper-plot-18*)
	   (list "reduced-chopper-plot-19" *reduced-chopper-plot-19*)
	   (list "reduced-chopper-plot-20" *reduced-chopper-plot-20*)
	   (list "reduced-chopper-plot-25" *reduced-chopper-plot-25*)
	   )
	  do
	  (princ (format nil "~%Processing: ~a~%" (first e)))
	  (create-reduced-chopper-plot
	   (second e)
	   :plot-file (CLOS::string-append (first e) ".tex")
	   :log-file  (CLOS::string-append (first e) ".txt"))))
;;; ----------------------------------------
;;; ----------------------------------------





(defconstant *mona-examples-a-1*
   (cons "simple composition tautologies, width ~4 "	 
	 (list
	  '(bv-equal
	    (bv-const 77 4)
	    (bv-const 77 4))
	  '(bv-equal
	    (bv-var x 4)
	    (BV-VAR x 4))
	  '(bv-equal
	    (bv-compose
	     (bv-var x 2) (bv-var y 2))
	    (bv-compose
	     (bv-var x 2) (bv-var y 2)))
	  '(bv-equal
	    (bv-compose
	     (bv-var x 2) (bv-const 0 1) (bv-var y 1) )
	    (bv-compose
	     (bv-var x 2) (bv-const 0 1) (bv-var y 1) )))))

(defconstant *mona-examples-a-2*
   (cons "simple composition tautologies, width 16"	 
	 (list
	  '(bv-equal
	    (bv-const 7 16)
	    (bv-const 7 16))
	  '(bv-equal
	    (bv-var x 16)
	    (BV-VAR x 16))
	  '(bv-equal
	    (bv-compose
	     (bv-var x 8) (bv-var y 8))
	    (bv-compose
	     (bv-var x 8) (bv-var y 8)))
	  '(ABORT
	    (bv-compose
	     (bv-var x 4) (bv-const 99 8) (bv-var y 4) )
	    (bv-compose
	     (bv-var x 4) (bv-const 99 8) (bv-var y 4) ))
	  )))

(defconstant *mona-examples-a-3*
   (cons "simple composition tautologies, large width"	 
	 (list
	  '(bv-equal
	    (bv-const 1376167 64)
	    (bv-const 1376167 64))
	  '(bv-equal
	    (bv-var x 64)
	    (BV-VAR x 64))
	  '(ABORT
	    (bv-compose
	     (bv-var x 32) (bv-var y 32))
	    (bv-compose
	     (bv-var x 32) (bv-var y 32)))
	  '(ABORT
	    (bv-compose
	     (bv-var x 32) (bv-const 997788 16) (bv-var y 16) )
	    (bv-compose
	     (bv-var x 32) (bv-const 997788 16) (bv-var y 16) )))))


(defconstant *mona-examples-b-1*
    (cons "Tautologies involving addition, length ~4"
    (list
     '(bv-equal
       (bv-addition 4 (bv-var x 4) (bv-var y 4))
       (bv-addition 4 (bv-var y 4) (bv-var x 4)))
      '(bv-equal
	(bv-addition 4 (bv-var x 4) (bv-const 0 1))
	(bv-var x 4))
      '(bv-equal
	(bv-addition 4 (bv-const 7 4) (bv-const 10 4) (bv-var x 4))
	(bv-addition 4 (bv-const 1 4) (bv-var x 4)))
      '(bv-equal
	(bv-addition 4 (bv-var x 4) (bv-var x 4))
	(bv-compose
	 (bv-extract (bv-var x 4) (tupcons 2 0))
	 (bv-const 0 1))))))

(defconstant *mona-examples-b-2*
    (cons "Tautologies involving addition, length ~16"
    (list
     '(bv-equal
       (bv-addition 16 (bv-var x 16) (bv-var y 16))
       (bv-addition 16 (bv-var y 16) (bv-var x 16)))
      '(bv-equal
	(bv-addition 16 (bv-var x 16) (bv-const 0 1))
	(bv-var x 16))
      '(bv-equal
	(bv-addition 16 (bv-const 28218 16) (bv-const 37319 16) (bv-var x 16))
	(bv-addition 16 (bv-const 1 16) (bv-var x 16)))
      '(bv-equal
	(bv-addition 16 (bv-var x 16) (bv-var x 16))
	(bv-compose
	 (bv-extract (bv-var x 16) (tupcons 14 0))
	 (bv-const 0 1))))))

(defconstant *mona-examples-b-3*
    (cons "Tautologies involving addition, length ~64"
    (list
     '(bv-equal
       (bv-addition 64 (bv-var x 64) (bv-var y 64))
       (bv-addition 64 (bv-var y 64) (bv-var x 64)))
      '(bv-equal
	(bv-addition 64 (bv-var x 64) (bv-const 0 1))
	(bv-var x 64))
      '(bv-equal
	(bv-addition 64 (bv-const 18446720196836865338  64) (bv-const 23876872686279 64) (bv-var x 64))
	(bv-addition 64 (bv-const 1 64) (bv-var x 64)))
      '(bv-equal
	(bv-addition 64 (bv-var x 64) (bv-var x 64))
	(bv-compose
	 (bv-extract (bv-var x 64) (tupcons 62 0))
	 (bv-const 0 1))))))


(defconstant *mona-examples-c-1*
    (cons "Tautologies involving addition and logic, length ~4"
	  (list
	   '(bv-equal
	     (bv-xor (bv-var x 4) (bv-var x 4))
	     (bv-const 0 4))
	   '(bv-equal
	     (bv-and (bv-var x 4) (bv-or (bv-var x 4) (bv-const 0 4)))
	     (bv-var x 4))
	    '(bv-equal
	      (bv-or (bv-compose (bv-var x 3) (bv-const 0 1))
	             (bv-const 1 4))
	      (bv-addition 4 (bv-compose (bv-var x 3) (bv-const 0 1))
	              (bv-const 1 4)))
	     '(bv-equal
	       (bv-or (bv-and (bv-var x 4) (bv-not (bv-var x 4)))
		      (bv-var y 4))
	       (bv-var y 4)))))

(defconstant *mona-examples-c-2*
    (cons "Tautologies involving addition and logic, length ~16"
	  (list
	   '(bv-equal
	     (bv-xor (bv-var x 16) (bv-var x 16))
	     (bv-const 0 16))
	   '(bv-equal
	     (bv-and (bv-var x 16) (bv-or (bv-var x 16) (bv-const 0 16)))
	     (bv-var x 16))
	    '(bv-equal
	      (bv-or (bv-compose (bv-var x 15) (bv-const 0 1))
	             (bv-const 1 16))
	      (bv-addition 16 (bv-compose (bv-var x 15) (bv-const 0 1))
	              (bv-const 1 16)))
	     '(bv-equal
	       (bv-or (bv-and (bv-var x 16) (bv-not (bv-var x 16)))
		      (bv-var y 16))
	       (bv-var y 16)))))

(defconstant *mona-examples-c-3*
    (cons "Tautologies involving addition and logic, length ~64"
	  (list
	   '(bv-equal
	     (bv-xor (bv-var x 64) (bv-var x 64))
	     (bv-const 0 64))
	   '(bv-equal
	     (bv-and (bv-var x 64) (bv-or (bv-var x 64) (bv-const 0 64)))
	     (bv-var x 64))
	    '(bv-equal
	      (bv-or (bv-compose (bv-var x 63) (bv-const 0 1))
	             (bv-const 1 64))
	      (bv-addition 64 (bv-compose (bv-var x 63) (bv-const 0 1))
	              (bv-const 1 64)))
	     '(bv-equal
	       (bv-or (bv-and (bv-var x 64) (bv-not (bv-var x 64)))
		      (bv-var y 64))
	       (bv-var y 64)))))

(defconstant *mona-examples-d-1*
    (cons "Tautologies with complex boolean constructs width 1"
	(list
	 `(bv-equal
	   (bv-and ,(make-phi1 1 )
		   ,(make-phi2 1 ))
	   (bv-const 0 1))
	 `(bv-equal
	   ,(make-bv-and-list
	     (list (make-phi1 2 ) (make-phi2 2 ) (make-phi3 2 )))
	    (bv-const 0 1))
	 `(bv-equal
	   ,(make-bv-and-list
	     (list (make-phi1 3 ) (make-phi2 3 ) (make-phi3 3)))
	    (bv-const 0 1))
	 `(bv-equal
	   ,(make-bv-and-list
	     (list (make-phi1 4 ) (make-phi2 4 ) (make-phi3 4 )))
	    (bv-const 0 1))
	  )))
	  

(defconstant *mona-examples-d-2*
    (cons "Tautologies with complex boolean constructs width 4"
	(list
	 `(bv-equal
	   (bv-and ,(make-phi1 1 4)
		   ,(make-phi2 1 4))
	   (bv-const 0 4))
	 `(bv-equal
	   ,(make-bv-and-list
	     (list (make-phi1 2 4) (make-phi2 2 4) (make-phi3 2 4)))
	    (bv-const 0 4))
	 `(bv-equal
	   ,(make-bv-and-list
	     (list (make-phi1 3 4) (make-phi2 3 4) (make-phi3 3 4)))
	    (bv-const 0 4))
	 `(bv-equal
	   ,(make-bv-and-list
	     (list (make-phi1 4 4) (make-phi2 4 4) (make-phi3 4 4)))
	    (bv-const 0 4))
	  )))

(defconstant *mona-examples-d-3*
    (cons "Tautologies with complex boolean constructs width 16"
	(list
	 `(bv-equal
	   (bv-and ,(make-phi1 1 16)
		   ,(make-phi2 1 16))
	   (bv-const 0 16))
	 `(bv-equal
	   ,(make-bv-and-list
	     (list (make-phi1 2 16) (make-phi2 2 16) (make-phi3 2 16)))
	    (bv-const 0 16))
	 `(bv-equal
	   ,(make-bv-and-list
	     (list (make-phi1 3 16) (make-phi2 3 16) (make-phi3 3 16)))
	    (bv-const 0 16))
	 `(bv-equal
	   ,(make-bv-and-list
	     (list (make-phi1 4 16) (make-phi2 4 16) (make-phi3 4 16)))
	    (bv-const 0 16))
	  )))

;;;  ---

(defconstant *mona-examples-e-1*
    (cons "Unsatisfiable Formulas, width ~4"
	  (list
	   '(bv-equal
	     (bv-compose
	      (bv-var x 4) (bv-const 0 1))
	     (bv-compose
	      (bv-const 1 1) (bv-var x 4)))
	    '(bv-equal
	      (bv-addition 4 (bv-var x 4) (bv-const 1 4))
	      (bv-var x 4))
	     '(bv-equal
	       (bv-compose
		(bv-var x 2) (bv-var x 2))
	       (bv-compose
		(bv-var y 2) (bv-not (bv-var y 2))))
	      '(bv-equal
		(bv-compose (bv-var x 2) (bv-var y 1) (bv-var x 2))
		(bv-compose (bv-var y 1) (bv-var x 2) (bv-const 1 2))))))	

(defconstant *mona-examples-e-2*
    (cons "Unsatisfiable Formulas, width ~16"
	  (list
	   '(bv-equal
	     (bv-compose
	      (bv-var x 8) (bv-const 0 1))
	     (bv-compose
	      (bv-const 1 1) (bv-var x 8)))
	    '(bv-equal
	      (bv-addition 16 (bv-var x 16) (bv-const 1 16))
	      (bv-var x 16))
	     '(bv-equal
	       (bv-compose
		(bv-var x 8) (bv-var x 8))
	       (bv-compose
		(bv-var y 8) (bv-not (bv-var y 8))))
	      '(bv-equal
		(bv-compose (bv-var x 7) (bv-var y 1) (bv-var x 7))
		(bv-compose (bv-var y 1) (bv-var x 7) (bv-const 1 7))))))

(defconstant *mona-examples-e-3*
    (cons "Unsatisfiable Formulas, width ~64"
	  (list
	   '(abort
	     (bv-compose
	      (bv-var x 63) (bv-const 0 1))
	     (bv-compose
	      (bv-const 1 1) (bv-var x 63)))
	    '(bv-equal
	      (bv-addition 64 (bv-var x 64) (bv-const 1 64))
	      (bv-var x 64))
	     '(abort
	       (bv-compose
		(bv-var x 32) (bv-var x 32))
	       (bv-compose
		(bv-var y 32) (bv-not (bv-var y 32))))
	      '(abort
		(bv-compose (bv-var x 31) (bv-var y 1) (bv-var x 31))
		(bv-compose (bv-var y 1) (bv-var x 31) (bv-const 1 31))))))	       
(defconstant *mona-examples-f-1*
    (cons "Simple Terms that are satisfiable and falsifiable, width ~4"
	  (list
	   '(bv-equal
	     (bv-compose (bv-var x 3) (bv-const 1 1))
	     (bv-compose (bv-const 1 1) (bv-var x 3)))
	    '(bv-equal
	      (bv-addition 4 (bv-var x 4) (bv-var y 4))
	      (bv-const 13 4))
	     '(bv-equal
	       (bv-xor (bv-var x 4) (bv-var y 4))
	       (bv-or  (bv-var x 4) (bv-var y 4)))
	      '(bv-equal
		(bv-not (bv-addition 4 (bv-var x 4) (bv-var x 4)))
		(bv-compose (bv-var y 3) (bv-const 1 1))))))


(defconstant *mona-examples-f-2*
    (cons "Simple Terms that are satisfiable and falsifiable, width ~16"
	  (list
	   '(bv-equal
	     (bv-compose (bv-var x 15) (bv-const 1 1))
	     (bv-compose (bv-const 1 1) (bv-var x 15)))
	    '(bv-equal
	      (bv-addition 16 (bv-var x 16) (bv-var y 16))
	      (bv-const 1313 16))
	     '(bv-equal
	       (bv-xor (bv-var x 16) (bv-var y 16))
	       (bv-or  (bv-var x 16) (bv-var y 16)))
	      '(bv-equal
		(bv-not (bv-addition 16 (bv-var x 16) (bv-var x 16)))
		(bv-compose (bv-var y 15) (bv-const 1 1))))))

(defconstant *mona-examples-f-3*
    (cons "Simple Terms that are satisfiable and falsifiable, width ~64"
	  (list
	   '(abort
	     (bv-compose (bv-var x 63) (bv-const 1 1))
	     (bv-compose (bv-const 1 1) (bv-var x 63)))
	    '(bv-equal
	      (bv-addition 64 (bv-var x 64) (bv-var y 64))
	      (bv-const 682762786313 4))
	     '(bv-equal
	       (bv-xor (bv-var x 64) (bv-var y 64))
	       (bv-or  (bv-var x 64) (bv-var y 64)))
	      '(bv-equal
		(bv-not (bv-addition 64 (bv-var x 64) (bv-var x 64)))
		(bv-compose (bv-var y 63) (bv-const 1 1))))))


(defconstant *etc*
    (list
	  '(bv-equal
	    (bv-compose (bv-var x 5) (bv-const 1 1))
	    (bv-compose (bv-const 0 1) (bv-var x 5)))
     '(bv-equal
       (bv-addition 4
	(bv-compose
	 (bv-extract (bv-var x 4) (tupcons 2 0))
	 (bv-const 0 1))
	(bv-const 1 4)
	(bv-const 0 4)
	(bv-const 0 4))
       (bv-compose (bv-extract (bv-var x 4) (tupcons 2 0))
	(bv-const 1 1)))
     '(bv-equal
       (bv-addition 2
	(bv-extract (bv-var x 4) (tupcons 2 1))
	(bv-compose (bv-var y 1) (bv-const 0 1)))
       (bv-const 0 2))
     '(bv-equal
       (bv-compose (bv-extract (bv-var x 7) (tupcons 0 0))
	(bv-extract (bv-var x 7) (tupcons 6 1)))
       (bv-var x 7))
     '(bv-equal
       (bv-extract (bv-or  (bv-compose (bv-var x 4) (bv-const 0 1))
		    (bv-const 1 5))
	(tupcons 3 0))
       (bv-addition 4
	(bv-var x 4)
	(bv-var x 4)
	(bv-const 1 4)))
     '(bv-equal
       (bv-addition 4 (bv-var x 4) (bv-var x 4))
       (bv-compose
	(bv-extract (bv-var x 4) (tupcons 2 0))
	(bv-const 0 1)))
   '(bv-equal
     (bv-extract (bv-or  (bv-compose (bv-var x 4) (bv-const 0 1))
		  (bv-const 0 5))
      (tupcons 3 0))
     (bv-addition 4
      (bv-var x 4)
      (bv-var x 4)
      (bv-const 0 4)))
   '(bv-equal
     (bv-var x 10)
     (bv-not (bv-var x 10)))
   '(bv-equal
     (bv-compose (bv-var x 7) (bv-const 0 5))
     (bv-compose (bv-var x 7) (bv-const 1 5)))
   '(bv-equal
     (bv-addition 3 (bv-var x 3) (bv-var y 3))
     (bv-const 3 3))
   '(bv-equal
     (bv-compose (bv-var x 3) (bv-const 1 1))
     (bv-compose (bv-const 1 1) (bv-var x 3)))
   ))

(defconstant *mona-first-block*
    (list   *mona-examples-a-1*
	    *mona-examples-a-2*
	    *mona-examples-a-3*
	    *mona-examples-b-1*
	    *mona-examples-b-2*
	    *mona-examples-b-3*
	    *mona-examples-c-1*
	    *mona-examples-c-2*
	    *mona-examples-c-3*
	    *mona-examples-d-1*
	    *mona-examples-d-2*
	    *mona-examples-d-3*
	     ))

(defconstant *mona-second-block*
    (list
     *mona-examples-e-1*
     *mona-examples-e-2*
     *mona-examples-e-3*
     *mona-examples-f-1*
     *mona-examples-f-2*
     *mona-examples-f-3*
     ))
    

(defconstant *mona-third-block*
    (labels ((inst (n)
	       (cons (princ-to-string
		      (format nil "Some Examples from Srivas, instantiated with length ~d" n))
		     (mapcar #'(lambda (x) (instantiate x n))
			     (list odd_even_bv
				   even_odd_bv
				   ;;bv_negate
				   caret_over_addition
				   caret_concat_over_addition_1)))))
      (list
       (inst 4)
       (inst 8)
       (inst 16)
       (inst 64)
       )))



(defconstant *mona-examples*
    (append
      ;;*mona-first-block*
      ;;*mona-second-block*
      *mona-third-block*
     ))

(defun tm (&optional (transform #'bv-term-to-ascii) (stream nil))
  (format stream "Testing examples via MONA~%")
  (loop for ex in *mona-examples* do
	(princ (format nil "~%-----------------------------------------------~%") stream)
	(princ (format nil "~a~%" (car ex)) stream)
	(princ (format nil "-----------------------------------------------~%~%") stream)
(loop for e in (cdr ex) do
	      (princ (format nil "~a  =  ~a"
			     (funcall transform (cadr e))
			     (funcall transform (caddr e))) stream)
	      (terpri stream)
	      (clear-time-1)
	      (clear-time-2)
	      (start-time)
	      (let ((res
		     (if (eq (car e) 'abort) 'ABORTED!
		       
		       (solve-via-mona e
				       #'start-time-1
				       #'stop-time-1
				       ))))
		(princ (format nil "Results in ~a.~%" res) stream)
		(stop-time)
		(if (and *break-on-error*
			 (eq res 'ERROR))
		    (break)))
	      (if *break-every-time* (break))
	      (princ (format nil "Used Time:  ~6,3f [sec]~%" *stopped-time*)
		     stream)
	      (princ (format nil "MONA Time:  ~6,3f [sec]~%~%" *stopped-time-1*) stream)
	      ;;(princ (format nil "           +~6,3f [sec]~%~%" *stopped-time-2*) stream)
	      )))
		      
	      

(defun tm-file (&optional (file-name "log.txt"))
  (with-open-file (stream file-name
		   :direction :output
		   :if-does-not-exist :create
		   :if-exists :supersede)
    (tm #'bv-term-to-ascii stream)))


;;; --------------------
;;;  Fixed Solver
;;; --------------------

(defun tfs (&key (examples *simple-classic-examples*)
		 (stream nil)
		 (heuristic-level 0)
		 (print-result t))
  (loop for e in examples do
	(princ (format nil "~%-----------------------------------------------~%") stream)
	(princ (format nil " Solve Fixed: ~a~%" (bv-term-to-ascii e)) stream)
	(princ (format nil "-----------------------------------------------~%") stream)
	(init-bvec-bdd)
	(gc)
	(start-time)
	(let ((res (fixed-bv-solve e :STREAM stream :HEURISTIC-LEVEL heuristic-level)))
	  (stop-time)
	  (if print-result
	      (create-output-from-list (mapcar #'bv-term-to-ascii res)
				       :STREAM stream :FIRST-WORD "Results in: "))
	  (princ (format nil "Used Time: ~6,3f [sec]~%~%" *stopped-time*) stream))))

(defun tfs-log (&key (name "/home/hiwi/moeller/SRI/l.txt")
		     (examples *simple-classic-examples*)
		     (heuristic-level 0))
  (with-open-file (stream name
		   :direction :output
		   :if-does-not-exist :create
		   :if-exists :supersede)
    (tfs :EXAMPLES examples
	 :STREAM stream
	 :HEURISTIC-LEVEL heuristic-level)))



;;; **************************************************
;;;  Creating Plots
;;; **************************************************

(defun create-mona-plot (plot &key (plot-file "plot.tex")
				   (log-file "log.txt")
				   (forcetop nil))
 (let* ((header (car plot))
	   (data (cdr plot))
	   (upscript (car header))
	   (subscript (cadr header))
	   (xvals (caddr header))
	   (yvals nil))
   (with-open-file (stream log-file
		   :direction :output
		   :if-does-not-exist :create
		   :if-exists :supersede)
     (assert (= (length xvals) (length data)))
     (princ (format nil "~%-----------------------------------------------~%") stream)
     (princ (format nil "~a: ~a~%" subscript upscript ) stream)
     (princ (format nil "-----------------------------------------------~%~%") stream)
     (loop for e in data do
	   (princ (format nil "Measuring: ~a = ~a  "
			  (bv-term-to-ascii (cadr e))
			  (bv-term-to-ascii (caddr e))))
	   
	   (princ (format nil "~a  =  ~a~%"
			  (bv-term-to-ascii (cadr e))
			  (bv-term-to-ascii (caddr e))) stream)
	   (gc)
	   (clear-time-1)
	   (clear-time-2)
	   (start-time)
	   (let ((res
		  (if (eq (car e) 'abort) 'ABORT
		    
		    (solve-via-mona e
				    #'start-time-1
				    #'stop-time-1
				    ))))
	     (princ (format nil "[~a]~%" res))
	     (princ (format nil "Results in ~a.~%" res) stream)
	     (stop-time)
	     (if (and *break-on-error*
		      (eq res 'ERROR))
		 (break))
	     (case res
	       (ABORT (setf yvals (append yvals  '(abort))))
	       (ERROR (setf yvals (append yvals  '(error))))
	       (t (setf yvals (nconc yvals (list (* 1000 *stopped-time-1*)))))))
	   
	   
	   
	   (if *break-every-time* (break))
	   (princ (format nil "Used Time:  ~6,3f [sec]~%" *stopped-time*)
		  stream)
	   (princ (format nil "MONA Time:  ~6,3f [sec]~%~%" *stopped-time-1*) stream)
	      ;;(princ (format nil "           +~6,3f [sec]~%~%" *stopped-time-2*) stream)
	   )
     (princ (format nil "COMMAND:~%(create-plot '~a ~%  :NAME ~s~%  :subscript ~s~%  :upscript ~s~%  :forcetop ~a~%)" (pairlis-pad xvals yvals) plot-file subscript upscript forcetop) stream)
     (princ (format nil "* Measure DONE *~%")))
      ;;; --------------------
      ;;; Now create the plot
      ;;; --------------------
   (create-plot (pairlis xvals yvals)
		:name plot-file
		:subscript subscript
		:upscript upscript
		:forcetop forcetop)))


(defun create-fixed-solver-plot (plot &key (plot-file "plot.tex")
					   (log-file "log.txt")
					   (forcetop nil)
					   (heuristic-level 0)
					   (surpress-result nil)
					   (include-canon-time nil))
 (let* ((header (car plot))
	(data (cdr plot))
	(upscript (car header))
	(subscript (cadr header))
	(xvals (caddr header))
	(yvals nil)
	(canon-time-list nil))
   (with-open-file (stream log-file
		   :direction :output
		   :if-does-not-exist :create
		   :if-exists :supersede)
     (assert (= (length xvals) (length data)))
     (princ (format nil "~%-----------------------------------------------~%") stream)
     (princ (format nil "~a: ~a~%" subscript upscript ) stream)
     (princ (format nil "-----------------------------------------------~%~%") stream)
     (loop for e in data do
	   (princ (format nil "Measuring: ~a = ~a~%"
			  (bv-term-to-ascii (cadr e))
			  (bv-term-to-ascii (caddr e))))
	   
	   (princ (format nil "~a  =  ~a~%"
			  (bv-term-to-ascii (cadr e))
			  (bv-term-to-ascii (caddr e))) stream)
	   (clear-time)
	   (clear-time-1)
	   (clear-time-2)
	   (init-bvec-bdd)
	   (gc)
	   (start-time)
	   (start-time-2)
	   (let* ((res
		   (if (eq (car e) 'abort)
		       'ABORT
		    (fixed-bv-solve e :STREAM stream
				    :HEURISTIC-LEVEL  heuristic-level
				    :CALL-AFTER-CANON #'stop-time-2
				    )))
		  (dummy (stop-time)))
	     (cond
	      ((eq res 'abort)
	       (princ (format nil "Results in:  *ABORTED*~%") stream))
	      (surpress-result
	       (princ (format nil "* Result surpressed *~%") stream))
	      (t
	       (create-output-from-list (mapcar #'bv-term-to-ascii res)
					:STREAM stream
					:FIRST-WORD "Results in: ")))
	     (if (and *break-on-error*
		      (eq res 'ERROR))
		 (break))
	     (cond
	       ((eq res 'ABORT) (setf yvals (append yvals  '(abort))
				      canon-time-list (append canon-time-list '(abort))))
	       ((eq res 'ERROR) (setf yvals (append yvals  '(error))
				      canon-time-list (append canon-time-list '(abort))))
	       (t (setf canon-time-list
		              (nconc canon-time-list
				     (list (* 1000
					      (case *stopped-time-2*
						(0.0 0.001)
						(t  *stopped-time-2*))))))
		  (setf yvals (nconc yvals (list (* 1000
						    (case *stopped-time*
						      (0.0 0.001)
						      (t  *stopped-time*)))))))))
	   
	   (if *break-every-time* (break))
	   (princ (format nil "Used Time:  ~6,3f [sec]~%~%" *stopped-time*)
		  stream)
	   )
     (princ (format nil "COMMAND:~%(create-plot '~a ~%  :NAME ~s~%  :subscript ~s~%  :upscript ~s~%  :forcetop ~a~%  :include-canon-time ~a~%)" (pairlis-pad xvals yvals) plot-file subscript upscript forcetop (if include-canon-time (pairlis xvals canon-time-list))) stream)
     (princ (format nil "* Measure DONE *~%")))
      ;;; --------------------
      ;;; Now create the plot
      ;;; --------------------
   (create-plot (pairlis xvals yvals)
		:name plot-file
		:subscript subscript
		:upscript upscript
		:forcetop forcetop
		:include-canon-time (if include-canon-time
					(pairlis xvals canon-time-list)))))

(defun create-reduced-chopper-plot (plot &key (plot-file "plot.tex")
					      (log-file "log.txt")
					      (forcetop nil))
 (let* ((header (car plot))
	(data (cdr plot))
	(upscript (car header))
	(subscript (cadr header))
	(xvals (caddr header))
	(yvals nil))
   (with-open-file (stream log-file
		   :direction :output
		   :if-does-not-exist :create
		   :if-exists :supersede)
     (assert (= (length xvals) (length data)))
     (princ (format nil "~%-----------------------------------------------~%") stream)
     (princ (format nil "~a: ~a~%" subscript upscript ) stream)
     (princ (format nil "-----------------------------------------------~%~%") stream)
     (loop for e in data do
	   (princ (format nil "Measuring: ~a = ~a~%"
			  (bv-term-to-ascii (cadr e))
			  (bv-term-to-ascii (caddr e))))
	   
	   (princ (format nil "~a  =  ~a~%"
			  (bv-term-to-ascii (cadr e))
			  (bv-term-to-ascii (caddr e))) stream)
	   (gc)
	   (start-time)
	   (let ((res
		  (if (eq (car e) 'abort)
		      'ABORT
		    (start-reduced-chopper e
			  :STREAM     stream
			  :START-TIME #'start-time
			  :STOP-TIME  #'stop-time))))
	     (if (and *break-on-error*
		      (eq res 'ERROR))
		 (break))
	     (cond
	       ((eq res 'ABORT) (setf yvals (append yvals  '(abort))))
	       ((eq res 'ERROR) (setf yvals (append yvals  '(error))))
	       (t (setf yvals (nconc yvals (list (* 1000 *stopped-time*)))))))		
	   
	   (if *break-every-time* (break))
	   (princ (format nil "Used Time:  ~6,3f [sec]~%~%" *stopped-time*)
		  stream)
	   )
     (princ (format nil "COMMAND:~%(create-plot '~a ~%  :NAME ~s~%  :subscript ~s~%  :upscript ~s~%  :forcetop ~a~%)" (pairlis-pad xvals yvals) plot-file subscript upscript forcetop) stream)
     (princ (format nil "* Measure DONE *~%")))
      ;;; --------------------
      ;;; Now create the plot
      ;;; --------------------
   (create-plot (pairlis xvals yvals)
		:name plot-file
		:subscript subscript
		:upscript upscript
		:forcetop forcetop )))



(defun create-plot (data-list &key (name "plot.tex")
				   (subscript " ")
				   (upscript " ")
				   (forcetop nil)
				   (include-canon-time nil))
  ;; input: in ms
  (flet ((upround (x &optional (to 10))
	   (* to (ceiling (/ x to))))
	 (to-real (x)
	   (float
	    (/ (floor (* 100000 x))
	       100000))))
    (let* ((ymax (apply #'max (remove-if-not #'numberp (mapcar #'cdr data-list))))
	   (scale (cond
		   ((<= ymax 1000) 3)
		   ((<= ymax 10000) 2)
		   ((<= ymax 100000) 1)
		   (t 0)))
	   (top
	    (to-real
	     (/ (cond
		 (forcetop forcetop)
		 ((> ymax 5000000) (upround ymax 10000000))
		 ((> ymax 500000) (upround ymax 1000000))
		 ((> ymax 50000) (upround ymax 100000))
		 ((> ymax 5000) (upround ymax 10000))
		 ((> ymax 500) (upround ymax 1000))
		 ((> ymax 50) (upround ymax 100))
		 (t (upround ymax)))
		1000)))
	   (yunit (to-real (/ 50 top)))
	   (plot-list (loop for e in (remove-if #'(lambda (x) (not (numberp (cdr x))))
						      data-list) append
				(list (car e)
				      (to-real (/ (cdr e) 1000))))))
      (flet ((real-to-string (x &key (scale scale))
	       (case scale
		 (0 (princ-to-string (round x)))
		 (1 (princ-to-string (format nil "~10,1f" x)))
		 (2 (princ-to-string (format nil "~10,2f" x)))
		 (3 (princ-to-string (format nil "~10,3f" x)))
		 (5 (princ-to-string (format nil "~12,5f" x)))
		 (t (break)))))
	(with-open-file (pstream name
			 :direction :output
			 :if-does-not-exist :create
			 :if-exists :supersede)
;;;;	  
;;;;	  (princ (format nil "[ymax: ~f]~%[scale: ~d]~%" ymax scale))
(princ (format nil "%% Highest: melted ~d node equations to ~d node(s).~%" *heuristic-node-prior* *heuristic-node-post*) pstream)
(princ (format nil "\\beginpicture \\small~%") pstream)
(princ (format nil "\\setcoordinatesystem units <0.5mm,~10,3fmm>~%" (to-real yunit)) pstream)
(princ (format nil "\\setplotarea x from 0 to 128 , y from 0 to ~a~%" (real-to-string top)) pstream)
(princ (format nil "\\axis bottom ticks andacross~%") pstream)
(princ (format nil "     width <0.2pt>~%") pstream)
(princ (format nil "     numbered from 0 to 128 by 16 /~%") pstream)
(princ (format nil "\\axis bottom ticks~%") pstream)
(princ (format nil "     width <0.1pt>~%") pstream)
(princ (format nil "      short unlabeled from 0 to 128 by 4 /~%") pstream)
(princ (format nil "\\axis left ticks andacross~%") pstream)
(princ (format nil "     width <0.2pt>~%") pstream)
(princ (format nil "      numbered from 0 to ~a by ~a /~%" (real-to-string top) (real-to-string (/ top 5))) pstream)
(princ (format nil "\\axis left ticks~%") pstream)
(princ (format nil "     width <0.1pt>~%") pstream)
(princ (format nil "      short unlabeled from 0 to ~a by ~a /~%" (real-to-string top :SCALE 5) (real-to-string (/ top 20) :SCALE 5)) pstream)
(princ (format nil "\\axis right /~%") pstream)
(princ (format nil "%\\axis top label {~a} /~%" upscript) pstream)
(princ (format nil "\\setlinear~%") pstream)
(unless (< (length plot-list) 4)
  (princ (format nil "\\plot ") pstream)
  (loop for d in plot-list do
	(princ (format nil "~d " d) pstream))
  (princ (format nil " /~%") pstream))
(loop for d in data-list do
      (case (cdr d)
	(abort (princ (format nil "\\put {\\frame <1mm> {\\stack {a,b,o,r,t,e,d}}} at ~d ~a~%" (car d) (real-to-string (/ top 2) :SCALE 3)) pstream))
	(error (princ (format nil "\\put {\\frame <1mm> {\\stack {e,r,r,o,r}}} at ~d ~a~%" (car d) (real-to-string (/ top 2) :SCALE 3)) pstream))
	(t (princ (format nil "\\put {$\\otimes$} at ~d ~d~%" (car d) (to-real (/ (cdr d) 1000))) pstream))))
(if include-canon-time
    (loop for d in include-canon-time do
	  (if (numberp (cdr d))
	      (progn
	      (princ (format nil "\\put {$\\scriptstyle\\boxtimes$} at ~d ~10,4F~%"
			     (car d) 
			     (to-real (/ (cdr d) 1000))
			     ) pstream)))))
(princ (format nil "\\setdimensionmode~%") pstream)
(princ (format nil "%\\put {~a} at  32mm -10mm ~%" subscript) pstream)
(princ (format nil "\\put {[s]} at -1mm 54mm ~%") pstream)
(princ (format nil "\\put {[n]} at 69mm -4mm ~%") pstream)
(princ (format nil "\\setcoordinatemode~%") pstream)

(princ (format nil "\\endpicture~%") pstream)
nil
)))))

(defun create-pigeon-plot (data-list &key (name "plot.tex")
					  (subscript " ")
					  (upscript " ")
					  (forcetop nil))
  ;; input: in ms
  (flet ((upround (x &optional (to 10))
	   (* to (ceiling (/ x to))))
	 (to-real (x)
	   (float
	    (/ (floor (* 100000 x))
	       100000))))
    (let* ((ymax (apply #'max (remove-if-not #'numberp (mapcar #'cdr data-list))))
	   (scale (cond
		   ((<= ymax 1000) 3)
		   ((<= ymax 10000) 2)
		   ((<= ymax 100000) 1)
		   (t 0)))
	   (top (cond
		 (forcetop (upround (log forcetop 10) 1))
		 (t (upround (log (/ ymax 1000) 10) 1))))
	   (top (if (< top 2) 2 top))
	   (yunit (to-real (/ 50 top)))
	   (plot-list (loop for e in (remove-if #'(lambda (x) (not (numberp (cdr x))))
						      data-list) append
				(list (car e)
				      (to-real (/ (cdr e) 1000))))))
      (flet ((real-to-string (x &key (scale scale))
	       (case scale
		 (0 (princ-to-string (round x)))
		 (1 (princ-to-string (format nil "~10,1f" x)))
		 (2 (princ-to-string (format nil "~10,2f" x)))
		 (3 (princ-to-string (format nil "~10,3f" x)))
		 (5 (princ-to-string (format nil "~12,5f" x)))
		 (t (break))))
	     (save-log (arg &optional (basis 10))
	       (if (< arg 1)
		   0
		 (log arg basis))))
	
	(with-open-file (pstream name
			 :direction :output
			 :if-does-not-exist :create
			 :if-exists :supersede)
;;;;	  
;;;;	  (princ (format nil "[ymax: ~f]~%[scale: ~d]~%" ymax scale))
(princ (format nil "%% ~a~%%% Highest: melted ~d node equations to ~d node(s).~%" subscript *heuristic-node-prior* *heuristic-node-post*) pstream)
(princ (format nil "\\beginpicture \\small~%") pstream)
(princ (format nil "\\setcoordinatesystem units <8.0mm,~10,3fmm>~%" (to-real yunit)) pstream)
(princ (format nil "\\setplotarea x from 0 to 8 , y from 0 to ~a~%" (real-to-string top)) pstream)
(princ (format nil "\\axis bottom ticks andacross~%") pstream)
(princ (format nil "     width <0.2pt>~%") pstream)
(princ (format nil "     numbered from 0 to 7 by 1 /~%") pstream)
;(princ (format nil "\\axis bottom ticks~%") pstream)
;(princ (format nil "     width <0.1pt>~%") pstream)
;(princ (format nil "      short unlabeled from 0 to 128 by 4 /~%") pstream)
(princ (format nil "\\axis left ticks logged andacross~%") pstream)
(princ (format nil "     width <0.2pt>~%") pstream)
(princ (format nil "      numbered at ~a ~a ~a ~a ~a ~a ~a / /~%" 0 2 5 10 100 (expt 10 (1- top)) (expt 10 top)) pstream)
(princ (format nil "\\axis left invisible ticks logged andacross~%") pstream)
(princ (format nil "     width <0.1pt>~%") pstream)
(princ (format nil "      short unlabeled from 0 to ~a by ~a  short unlabeled from 0 to ~a by ~a  length <0pt> /~%" (real-to-string (expt 10 top) :SCALE 5) (real-to-string (expt 10 (1- top)) :SCALE 5) (real-to-string (expt 10 (1- top)) :SCALE 5) (real-to-string (expt 10 (- top 2)) :SCALE 5)   ) pstream)
(princ (format nil "\\axis right /~%") pstream)
(princ (format nil "\\axis top label {~a} /~%" upscript) pstream)
(princ (format nil "\\setlinear~%") pstream)
(unless (< (length plot-list) 4)
  (princ (format nil "\\plot ") pstream)
  (let ((logar nil))
    (loop for d in plot-list do
	  (princ (format nil "~a " (if logar (real-to-string (save-log d 10) :SCALE 3) (real-to-string d :SCALE 3))) pstream)
	  (setf logar (not logar))))
  (princ (format nil " /~%") pstream))
(loop for d in data-list do
      (case (cdr d)
	(abort (princ (format nil "\\put {\\frame <1mm> {\\stack {a,b,o,r,t,e,d}}} at ~d ~a~%" (car d) (real-to-string (/ top 2) :SCALE 3) ) pstream))
	(error (princ (format nil "\\put {\\frame <1mm> {\\stack {e,r,r,o,r}}} at ~d ~a~%" (car d) (real-to-string (/ top 2) :SCALE 3)) pstream))
	(t (princ (format nil "\\put {$\\otimes$} at ~d ~d~%" (car d) (to-real (save-log (/ (cdr d) 1000)))) pstream))))
(princ (format nil "\\setdimensionmode~%") pstream)
(princ (format nil "\\put {~a} at  32mm -10mm ~%" subscript) pstream)
(princ (format nil "\\put {[s]} at -1mm 54mm ~%") pstream)
(princ (format nil "\\put {[\\#Holes]} at 65mm -4mm ~%") pstream)
(princ (format nil "\\setcoordinatemode~%") pstream)

(princ (format nil "\\endpicture~%") pstream)
nil
)))))
	       
    