├── .gitignore ├── dune-project ├── Makefile ├── lib ├── dune ├── parser.mly ├── lexer.mll ├── prop.ml ├── bench_prop.ml ├── bdd.mli └── bdd.ml ├── bdd.opam ├── test ├── dune ├── bench_prop_cli.ml ├── quant_elim.ml ├── dimacs.ml ├── bdd_sat.ml ├── tiling.ml ├── queen.ml ├── path.ml ├── test.ml └── check.ml ├── README.md ├── CHANGES └── LICENSE /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *merlin 3 | *.install 4 | *~ -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | (name bdd) 3 | (using menhir 2.0) 4 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | build: 2 | dune build @all 3 | 4 | doc: 5 | dune build @doc 6 | 7 | clean: 8 | dune clean 9 | 10 | test: 11 | dune runtest --force 12 | 13 | install: 14 | dune build @install 15 | dune install 16 | 17 | uninstall: 18 | dune uninstall 19 | 20 | .PHONY: test 21 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name bdd) 3 | (modules bdd) 4 | (public_name bdd) 5 | (libraries stdlib-shims)) 6 | 7 | (library 8 | (name prop) 9 | (modules prop parser lexer bench_prop) 10 | (libraries bdd) 11 | ; we should wrap it or change the name of the modules as they're quite generic 12 | (wrapped false)) 13 | 14 | (ocamllex 15 | (modules lexer)) 16 | 17 | (menhir 18 | (modules parser)) 19 | -------------------------------------------------------------------------------- /bdd.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | synopsis: "Implementation of BDD" 3 | maintainer: "Jean-Christophe.Filliatre@cnrs.fr" 4 | authors: "Jean-Christophe Filliâtre" 5 | license: "LGPL-2.1-only" 6 | homepage: "https://github.com/backtracking/ocaml-bdd" 7 | bug-reports: "https://github.com/backtracking/ocaml-bdd/issues" 8 | depends: [ 9 | "dune" {build} 10 | "stdlib-shims" 11 | ] 12 | build: [ 13 | ["dune" "subst"] {pinned} 14 | ["dune" "build" "@install" "-p" name "-j" jobs] 15 | [with-doc "dune" "build" "@doc" "-p" name] 16 | [with-test "dune" "runtest" "-p" name] 17 | ] 18 | dev-repo: "git://github.com/backtracking/ocaml-bdd.git" 19 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name check) 3 | (modules check) 4 | (libraries bdd prop)) 5 | 6 | (executable 7 | (name test) 8 | (modules test) 9 | (libraries bdd prop)) 10 | 11 | (executable 12 | (name queen) 13 | (modules queen) 14 | (libraries bdd)) 15 | 16 | (executable 17 | (name tiling) 18 | (modules tiling) 19 | (libraries bdd)) 20 | 21 | (executable 22 | (name path) 23 | (modules path) 24 | (libraries bdd)) 25 | 26 | (executable 27 | (name bdd_sat) 28 | (modules bdd_sat) 29 | (libraries prop unix)) 30 | 31 | (test 32 | (name quant_elim) 33 | (modules quant_elim) 34 | (libraries bdd)) 35 | 36 | (executable 37 | (name bench_prop_cli) 38 | (modules bench_prop_cli) 39 | (libraries prop)) 40 | 41 | (executable 42 | (name dimacs) 43 | (modules dimacs) 44 | (libraries bdd)) 45 | -------------------------------------------------------------------------------- /test/bench_prop_cli.ml: -------------------------------------------------------------------------------- 1 | open Prop 2 | open Bench_prop 3 | 4 | type bench = De_bruijn_p | De_bruijn_n | Pigeon_p | Equiv_p 5 | 6 | let bench = ref De_bruijn_p 7 | let n = ref 10 8 | 9 | let _ = 10 | 11 | Arg.parse [ 12 | "-de-bruijn-p", Arg.Unit (fun () -> bench := De_bruijn_p), ""; 13 | "-de-bruijn-n", Arg.Unit (fun () -> bench := De_bruijn_n), ""; 14 | "-pigeon-p", Arg.Unit (fun () -> bench := Pigeon_p), ""; 15 | "-equiv-p", Arg.Unit (fun () -> bench := Equiv_p), "" 16 | ] (fun x -> n := int_of_string x) ""; 17 | 18 | match !bench with 19 | | De_bruijn_p -> 20 | Format.printf "# de_bruijn_p n=%d@\n%a@." !n print (de_bruijn_p !n) 21 | | De_bruijn_n -> 22 | Format.printf "# de_bruijn_n n=%d@\n%a@." !n print (de_bruijn_n !n) 23 | | Pigeon_p -> 24 | Format.printf "# pigeon_p n=%d@\n%a@." !n print (pigeon_p !n) 25 | | Equiv_p -> 26 | Format.printf "# equiv_p n=%d@\n%a@." !n print (equiv_p !n) 27 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ocaml-bdd 2 | 3 | This is a simple implementation of a BDD library for OCaml, 4 | mostly for teaching and quick experiment purposes. 5 | 6 | ## Build 7 | 8 | You need `dune` on your system. If you don't have it, install `opam` then try `opam install dune`. 9 | 10 | To build everything: 11 | 12 | ```sh 13 | make 14 | ``` 15 | 16 | It will build these libraries: 17 | 18 | - `bdd`: the main library - `lib/bdd.mli` should be self-explanatory 19 | - `prop`: propositional logic, with a parser, used to test the main library - see `check` for example 20 | - `bench_prop`: various ways of generating valid propositional formulae 21 | 22 | Many executables: 23 | 24 | - `test`: tests producing graphical output - you'll need the `graphviz` and `gv` packages from your distribution 25 | - `tiling` 26 | - `bdd_sat`: a propositional tautology checker using `bdd` 27 | - `quant_elim`: simple tests for quantifier elimination 28 | - `queen`: computes the number of solutions to the n-queens problem, using a propositional formula (this is not an efficient way to solve this problem, simply another way to test the `bdd` library) 29 | - `path` 30 | - `check`: a quick check 31 | - `bench_prop_cli`: generate valide propositional formulae from command line 32 | 33 | To run any of them, let's say `check`, do: 34 | 35 | ```sh 36 | dune exec test/check.exe 37 | ``` 38 | 39 | You can combine some of them, e.g.: 40 | 41 | ```sh 42 | dune exec test/bench_prop_cli -pigeon-p 7 | dune exec test/bdd_sat.exe 43 | ``` 44 | 45 | ## Test 46 | 47 | You can run tests using: 48 | 49 | ```sh 50 | make test 51 | ``` 52 | 53 | ## Install 54 | 55 | ```sh 56 | make install 57 | ``` 58 | -------------------------------------------------------------------------------- /lib/parser.mly: -------------------------------------------------------------------------------- 1 | /**************************************************************************/ 2 | /* */ 3 | /* Copyright (C) Jean-Christophe Filliatre */ 4 | /* */ 5 | /* This software is free software; you can redistribute it and/or */ 6 | /* modify it under the terms of the GNU Lesser General Public */ 7 | /* License version 2.1, with the special exception on linking */ 8 | /* described in file LICENSE. */ 9 | /* */ 10 | /* This software is distributed in the hope that it will be useful, */ 11 | /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ 12 | /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. */ 13 | /**************************************************************************/ 14 | 15 | %{ 16 | open Prop 17 | %} 18 | 19 | %token IDENT 20 | %token AND OR 21 | %token IMP EQUIV 22 | %token NOT 23 | %token LPAR RPAR 24 | %token EOF 25 | 26 | %right IMP EQUIV 27 | %left AND OR 28 | %right NOT 29 | 30 | %start file 31 | %type file 32 | 33 | %% 34 | 35 | file: 36 | | formulas EOF { List.rev $1} 37 | ; 38 | 39 | formulas: 40 | | { [] } 41 | | formulas formula { $2 :: $1 } 42 | 43 | formula: 44 | | IDENT { Pvar $1 } 45 | | formula IMP formula { Pimp($1,$3) } 46 | | formula EQUIV formula { Piff($1,$3) } 47 | | formula AND formula { Pand($1,$3) } 48 | | formula OR formula { Por($1,$3) } 49 | | NOT formula { Pnot($2) } 50 | | LPAR formula RPAR { $2 } 51 | ; 52 | -------------------------------------------------------------------------------- /test/quant_elim.ml: -------------------------------------------------------------------------------- 1 | 2 | let x = 1 3 | let y = 2 4 | let z = 3 5 | 6 | let print_var fmt x = 7 | match x with 8 | | 1 -> Format.fprintf fmt "x" 9 | | 2 -> Format.fprintf fmt "y" 10 | | 3 -> Format.fprintf fmt "z" 11 | | _ -> Format.fprintf fmt "b%d" x 12 | 13 | module B = Bdd.Make(struct 14 | let print_var = print_var 15 | let size = 7001 16 | let max_var = 100 17 | end) 18 | 19 | open Format 20 | 21 | let () = 22 | (* x /\ y *) 23 | let andxy = B.mk_and (B.mk_var x) (B.mk_var y) in 24 | (* x \/ y *) 25 | let orxy = B.mk_or (B.mk_var x) (B.mk_var y) in 26 | (* y /\ z *) 27 | let andyz = B.mk_and (B.mk_var y) (B.mk_var z) in 28 | (* y \/ z *) 29 | let oryz = B.mk_or (B.mk_var y) (B.mk_var z) in 30 | let b = B.mk_exist ((==) y) andxy in 31 | printf "exists y. x /\\ y ===> @[%a@]@." B.print b; 32 | assert (b == B.mk_var x); 33 | let b = B.mk_exist ((==) y) orxy in 34 | printf "exists y. x \\/ y ===> @[%a@]@." B.print b; 35 | assert (b == B.one); 36 | let b = B.mk_exist ((==) y) andyz in 37 | printf "exists y. y /\\ z ===> @[%a@]@." B.print b; 38 | assert (b == B.mk_var z); 39 | let b = B.mk_exist ((==) y) oryz in 40 | printf "exists y. y \\/ z ===> @[%a@]@." B.print b; 41 | assert (b == B.one); 42 | let b = B.mk_forall ((==) y) andxy in 43 | printf "forall y. x /\\ y ===> @[%a@]@." B.print b; 44 | assert (b == B.zero); 45 | let b = B.mk_forall ((==) y) orxy in 46 | printf "forall y. x \\/ y ===> @[%a@]@." B.print b; 47 | assert (b == B.mk_var x); 48 | let b = B.mk_forall ((==) y) andyz in 49 | printf "forall y. y /\\ z ===> @[%a@]@." B.print b; 50 | assert (b == B.zero); 51 | let b = B.mk_forall ((==) y) oryz in 52 | printf "forall y. y \\/ z ===> @[%a@]@." B.print b; 53 | assert (b == B.mk_var z); 54 | () 55 | -------------------------------------------------------------------------------- /CHANGES: -------------------------------------------------------------------------------- 1 | 2 | May 20, 2025 (version 0.5) 3 | -------------------------- 4 | o new function `print_dimacs` to print a bdd in DIMACS format 5 | o new function `cnf_size` to compute the number of clauses of a 6 | conjunctive normal form, that is the number of lines printed 7 | by `print_dimacs` 8 | o new function `nb_nodes` to compute the interbal size of a bdd 9 | o new function `print_dot` to print in DOT format 10 | (functions`to_dot` and `print_to_dot` are deprecated) 11 | o test/dimacs.ml: builds a BDD from a DIMACS file 12 | o new functions `mk_exists` and `mk_forall` for quantifier elimination 13 | o new function `print` to print a BDD as nested "if..then..else" 14 | o new function `print_compact` to print a BDD in a compact form using 15 | conjunction and disjunction when possible, and falling back to 16 | "if..then..else" otherwise 17 | o new function `extract_known_values` to retrieve from a bdd the set of 18 | variables whose Boolean value is entailed by the bdd. 19 | o new function `count_sat_int` 20 | 21 | November 13, 2018 (version 0.4) 22 | ------------------------------- 23 | o no more set_max_var -> a functor Make and a function 'make' instead 24 | o new function restrict 25 | o new functions constrain and restriction 26 | o extend print_to_dot and display with optional print_var argument 27 | All this contributed by Timothy Bourke (tbrk@github) 28 | 29 | February 2, 2010 (version 0.3) 30 | ------------------------------ 31 | o new function random_sat 32 | o new example in tiling.ml (tiling the 8x8 chessboard with 2x1 dominoes *) 33 | o init removed and subsumed by set_max_var 34 | o improved efficiency (one node table for each variable) 35 | 36 | July 16, 2009 (version 0.2) 37 | --------------------------- 38 | o fixed bug in count_sat (unused variables below the top variable where not 39 | taken into account) 40 | 41 | June 7, 2008 (version 0.1) 42 | -------------------------- 43 | o LGPL license, with special exception for linking (see LICENSE) 44 | -------------------------------------------------------------------------------- /test/dimacs.ml: -------------------------------------------------------------------------------- 1 | 2 | (* Build the BDD of a CNF formula in DIMACS format, 3 | then prints whether it is SAT (with a truth assignment) or UNSAT. 4 | 5 | Note: The DIMACS parser below is minimal and not robust at all 6 | (to a liberal use of spaces, in particular). 7 | *) 8 | 9 | let file = 10 | let file = ref None in 11 | Arg.parse [] (fun s -> file := Some s) ""; 12 | match !file with 13 | | None -> Format.eprintf "%s dimacs-file@." Sys.argv.(0); exit 1 14 | | Some f -> f 15 | 16 | let nv, cnf = 17 | let c = open_in file in 18 | let rec read_p () = 19 | let s = input_line c in 20 | if s = "" || s.[0] = 'c' then read_p () else 21 | Scanf.sscanf s "p cnf %d %d" (fun nv nc -> nv, nc) in 22 | let nv, nc = read_p () in 23 | let rec read_c cl b = 24 | let l = Scanf.bscanf b " %d" (fun i -> i) in 25 | if l = 0 then List.rev cl else read_c (l :: cl) b in 26 | let cnf = ref [] in 27 | for _ = 1 to nc do 28 | let b = Scanf.Scanning.from_string (input_line c) in 29 | cnf := read_c [] b :: !cnf 30 | done; 31 | nv, List.rev !cnf 32 | 33 | let () = 34 | Format.printf "%d variables, %d clauses@." nv (List.length cnf) 35 | 36 | open Bdd 37 | 38 | module B = (val make nv) 39 | 40 | let clause cl = 41 | let rec build bdd = function 42 | | [] -> bdd 43 | | v :: cl -> 44 | let lit = if v > 0 then B.mk_var v else B.mk_not (B.mk_var (-v)) in 45 | build (B.mk_or bdd lit) cl 46 | in 47 | build B.zero cl 48 | 49 | let bdd = 50 | let rec build bdd = function 51 | | [] -> bdd 52 | | cl :: cll -> build (B.mk_and bdd (clause cl)) cll in 53 | build B.one cnf 54 | 55 | let () = Format.printf "BDD size = %d@." (B.nb_nodes bdd) 56 | 57 | open Format 58 | 59 | let () = match B.any_sat bdd with 60 | | exception Not_found -> 61 | printf "UNSAT@." 62 | | vl -> 63 | printf "SAT@."; 64 | List.iter (fun (v, b) -> printf "%d " (if b then v else -v)) vl; 65 | printf "0@."; 66 | printf "#SAT = %d@." (B.count_sat_int bdd) 67 | -------------------------------------------------------------------------------- /test/bdd_sat.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | open Format 16 | open Prop 17 | open Bdd 18 | 19 | module Time = struct 20 | 21 | open Unix 22 | 23 | let utime f x = 24 | let u = (times()).tms_utime in 25 | let y = f x in 26 | let ut = (times()).tms_utime -. u in 27 | (y,ut) 28 | 29 | let print_utime f x = 30 | let (y,ut) = utime f x in 31 | printf "user time: %2.2f@." ut; 32 | y 33 | 34 | end 35 | 36 | let print_stats (module B : BDD) = 37 | Array.iter 38 | (fun (l,n,s,b1,b2,b3) -> 39 | printf "table length: %d / nb. entries: %d / sum of bucket length: %d@." 40 | l n s; 41 | printf "smallest bucket: %d / median bucket: %d / biggest bucket: %d@." 42 | b1 b2 b3) 43 | (B.stats ()) 44 | 45 | let nb = ref 0 46 | 47 | let sat_unsat f = 48 | incr nb; 49 | let nbvar, f = bdd_formula f in 50 | let module B = (val make nbvar) in 51 | let b = B.build f in 52 | printf "%d: %s " !nb (if B.tautology b then "valid" else "invalid"); 53 | print_stats (module B) 54 | 55 | let check = Time.print_utime sat_unsat 56 | 57 | let () = 58 | let lb = Lexing.from_channel stdin in 59 | let fl = Parser.file Lexer.token lb in 60 | List.iter check fl 61 | -------------------------------------------------------------------------------- /lib/lexer.mll: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | { 16 | open Lexing 17 | open Parser 18 | 19 | exception Lexical_error of string 20 | 21 | let newline lexbuf = 22 | let pos = lexbuf.lex_curr_p in 23 | lexbuf.lex_curr_p <- 24 | { pos with pos_lnum = pos.pos_lnum + 1; pos_bol = pos.pos_cnum; 25 | pos_cnum=0 } 26 | 27 | } 28 | 29 | let space = [' ' '\t' '\r']+ 30 | let ident = ['a'-'z' 'A'-'Z'] ['a'-'z' 'A'-'Z' '0'-'9' ':' '_']* 31 | let number = ['0' - '9']+ 32 | 33 | rule token = parse 34 | | '\n' 35 | { newline lexbuf; token lexbuf } 36 | | space 37 | { token lexbuf } 38 | | '#' [^'\n']* ('\n' | eof) 39 | { newline lexbuf; token lexbuf } 40 | | '(' 41 | { LPAR } 42 | | ')' 43 | { RPAR } 44 | | '~' 45 | { NOT } 46 | | "->" 47 | { IMP } 48 | | "<->" 49 | { EQUIV } 50 | | "/\\" | '&' 51 | { AND } 52 | | "\\/" | 'v' 53 | { OR } 54 | | ident 55 | { IDENT (lexeme lexbuf) } 56 | | _ 57 | { raise (Lexical_error ("illegal character: " ^ lexeme lexbuf)) } 58 | | eof 59 | { EOF } 60 | 61 | { 62 | let formula_of_string s = 63 | let lb = Lexing.from_string s in 64 | match Parser.file token lb with 65 | | f :: _ -> f 66 | | _ -> assert false 67 | } 68 | 69 | -------------------------------------------------------------------------------- /lib/prop.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | (** Propositional formulas with named variables 16 | (contrary to [Bdd.formula] where variables are integers). *) 17 | 18 | type t = 19 | | Pvar of string 20 | | Pnot of t 21 | | Pand of t * t 22 | | Por of t * t 23 | | Pimp of t * t 24 | | Piff of t * t 25 | | Ptrue 26 | | Pfalse 27 | 28 | open Format 29 | 30 | let print fmt p = 31 | let rec pr fmt = function 32 | | Pvar s -> fprintf fmt "%s" s 33 | | Pnot f -> fprintf fmt "(~%a)" pr f 34 | | Pand (f1, f2) -> fprintf fmt "(%a &@ %a)" pr f1 pr f2 35 | | Por (f1, f2) -> fprintf fmt "(%a v@ %a)" pr f1 pr f2 36 | | Pimp (f1, f2) -> fprintf fmt "(%a ->@ %a)" pr f1 pr f2 37 | | Piff (f1, f2) -> fprintf fmt "(%a <->@ %a)" pr f1 pr f2 38 | | Ptrue -> fprintf fmt "true" 39 | | Pfalse -> fprintf fmt "false" 40 | in 41 | fprintf fmt "@[%a@]" pr p 42 | 43 | open Bdd 44 | 45 | let bdd_formula f = 46 | let nbvar = ref 0 in 47 | let vars = Hashtbl.create 17 in 48 | let rec trans = function 49 | | Pvar s -> 50 | Fvar 51 | (try Hashtbl.find vars s 52 | with Not_found -> incr nbvar; Hashtbl.add vars s !nbvar; !nbvar) 53 | | Pnot f -> Fnot (trans f) 54 | | Pand (f1, f2) -> Fand (trans f1, trans f2) 55 | | Por (f1, f2) -> For (trans f1, trans f2) 56 | | Pimp (f1, f2) -> Fimp (trans f1, trans f2) 57 | | Piff (f1, f2) -> Fiff (trans f1, trans f2) 58 | | Ptrue -> Ftrue 59 | | Pfalse -> Ffalse 60 | in 61 | let f = trans f in 62 | !nbvar, f 63 | -------------------------------------------------------------------------------- /test/tiling.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | (* Tiling the 8x8 chessboard with 2x1 dominoes 16 | (cf TAOCP vol 4, Section 7.1.4, page 49) *) 17 | 18 | (* there are 2x7x8 = 112 variables *) 19 | let n = 112 20 | include (val Bdd.make n) 21 | let var i = mk_var (1+i) 22 | 23 | (* m[i,j] tells whether domino i occupies cell j *) 24 | let m = Array.make_matrix n 64 false 25 | 26 | let () = 27 | let v = ref 0 in 28 | for l = 0 to 7 do for c = 0 to 7 do 29 | (* cell (l,c) of the chessboard is j = 8*l + c *) 30 | let j = 8 * l + c in 31 | (* horizontal domino *) 32 | if c < 7 then begin 33 | m.(!v).(j) <- true; m.(!v).(j+1) <- true; 34 | incr v; 35 | end; 36 | (* vertical domino *) 37 | if l < 7 then begin 38 | m.(!v).(j) <- true; m.(!v).(j+8) <- true; 39 | incr v; 40 | end; 41 | done done 42 | 43 | (* col j is the list of all i such that m[i,j]=true *) 44 | let col j = 45 | let rec make acc i = 46 | if i = n then acc else make (if m.(i).(j) then i::acc else acc) (i+1) 47 | in 48 | make [] 0 49 | 50 | let bdd = 51 | let rec make bdd j = 52 | if j = 64 then 53 | bdd 54 | else 55 | let cell_j = 56 | let cj = col j in 57 | List.fold_left 58 | (fun f i -> 59 | mk_or f 60 | (List.fold_left 61 | (fun f i' -> 62 | if i' <> i then mk_and f (mk_not (var i')) else f) 63 | (var i) 64 | cj)) 65 | zero cj 66 | in 67 | make (mk_and bdd cell_j) (j+1) 68 | in 69 | make one 0 70 | 71 | open Format 72 | 73 | let () = 74 | printf "%Ld solutions@." (count_sat bdd) 75 | 76 | (* 12988816 solutions *) 77 | 78 | let () = 79 | let s = random_sat bdd in 80 | List.iter 81 | (fun (v,b) -> 82 | let i = v-1 in 83 | if b then begin 84 | Array.iteri (fun j mij -> if mij then printf "%d " j) m.(i); 85 | printf "@." 86 | end) 87 | s 88 | -------------------------------------------------------------------------------- /lib/bench_prop.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | open Prop 16 | 17 | let pand p1 p2 = match p1, p2 with 18 | | Ptrue, p2 -> p2 19 | | p1, Ptrue -> p1 20 | | _ -> Pand (p1, p2) 21 | 22 | let pands i j f = 23 | let rec mk k = if k > j then Ptrue else pand (f k) (mk (k+1)) in 24 | mk i 25 | 26 | let piff p1 p2 = match p1, p2 with 27 | | Ptrue, p2 -> p2 28 | | p1, Ptrue -> p1 29 | | _ -> Piff (p1, p2) 30 | 31 | let piffs i j f = 32 | let rec mk k = if k > j then Ptrue else piff (f k) (mk (k+1)) in 33 | mk i 34 | 35 | let por p1 p2 = match p1, p2 with 36 | | Pfalse, p2 -> p2 37 | | p1, Pfalse -> p1 38 | | _ -> Por (p1, p2) 39 | 40 | let pors i j f = 41 | let rec mk k = if k > j then Pfalse else por (f k) (mk (k+1)) in 42 | mk i 43 | 44 | (* de bruijn *) 45 | 46 | let var i = Pvar ("p" ^ string_of_int i) 47 | 48 | let iff p1 p2 = Pand (Pimp (p1, p2), Pimp (p2, p1)) 49 | 50 | (** 51 | de_bruijn_p(n) == LHS(2*n+1) -> RHS(2*n+1) 52 | de_bruijn_n(n) == LHS(2*n) -> (p0 v RHS(2*n) v ~p0) 53 | 54 | RHS(m) = &&_{i=1..m} p(i) 55 | LHS(m) = &&_{i=1..m} ((p(i)<->p(i+1)) -> c(n)) 56 | where addition is computed modulo m. 57 | ***) 58 | 59 | let lhs m = 60 | pands 1 m (fun i -> Pnot (iff (var i) (var (if i=m then 1 else i+1)))) 61 | 62 | let de_bruijn_p n = Pnot (lhs (2*n+1)) 63 | let de_bruijn_n n = Pnot (lhs (2*n)) 64 | 65 | (* pigeons 66 | 67 | ph_p(n) =def left(n) -> right(n) 68 | 69 | left(n) =def &&_{p=1..n+1} (vv_{j=1,..n} occ(i,j) ) 70 | right(n) =def vv_{h=1..n, p1=1..{n+1}, p2={p1+1}..{n+1}} s(i1,i2,j) 71 | s(p1,p2,h) =def occ(p1,h) & occ(p2,h) 72 | 73 | *) 74 | 75 | let occ i j = Pvar ("occ_" ^ string_of_int i ^ "_" ^ string_of_int j) 76 | 77 | let left n = pands 1 (n+1) (fun i -> pors 1 n (fun j -> occ i j)) 78 | let right n = 79 | pors 1 n (fun h -> 80 | pors 1 (n+1) (fun p1 -> 81 | pors (p1+1) (n+1) (fun p2 -> Pand (occ p1 h, 82 | occ p2 h)))) 83 | 84 | let pigeon_p n = Pimp (left n, right n) 85 | 86 | let pigeon_n _ = assert false 87 | 88 | let equiv_p n = 89 | let f = ref (var n) in 90 | for i = 1 to n-1 do f := Piff (var (n-i), !f) done; 91 | for i = 1 to n do f := Piff (var (n+1-i), !f) done; 92 | !f 93 | -------------------------------------------------------------------------------- /test/queen.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | open Format 16 | 17 | let _ = if Array.length Sys.argv <> 2 then failwith ("usage: " ^ Sys.argv.(0) ^ " ") 18 | 19 | let n = match int_of_string Sys.argv.(1) with 20 | | exception _ -> failwith "size should be a number" 21 | | n when n <= 0 -> failwith "size should be greater than 0" 22 | | n -> n 23 | 24 | include (val Bdd.make ~size:60000 (n * n)) 25 | 26 | let fold_and i j f = 27 | let rec mk k = if k > j then one else mk_and (f k) (mk (k+1)) in 28 | mk i 29 | 30 | let fold_or i j f = 31 | let rec mk k = if k > j then zero else mk_or (f k) (mk (k+1)) in 32 | mk i 33 | 34 | let fold_for i j f = 35 | let rec fold k acc = if k > j then acc else fold (k+1) (f k acc) in 36 | fold i 37 | 38 | let fold_for_rev i j f = 39 | let rec fold k acc = if k < j then acc else fold (k-1) (f k acc) in 40 | fold i 41 | 42 | (* 0..n-1 x 0..n-1 -> 1..n x n *) 43 | let vars = 44 | Array.init n (fun i -> Array.init n (fun j -> mk_var (1 + n * i + j))) 45 | let var i j = vars.(i).(j) 46 | 47 | let queens_s i j = 48 | let var i j = mk_var (1 + i * n + j) in 49 | fold_for_rev (n-1) 0 (fun row bdd -> 50 | if i = row then 51 | fold_for_rev (n-1) 0 (fun col bdd -> 52 | if j = col then 53 | mk_and bdd (var row col) 54 | else 55 | mk_and bdd (mk_not (var row col)) 56 | ) bdd 57 | else 58 | let d = abs (i - row) in 59 | let bdd = if j + d < n then 60 | mk_and bdd (mk_not (var row (j + d))) else bdd in 61 | let bdd = mk_and bdd (mk_not (var row j)) in 62 | if d <= j then 63 | mk_and bdd (mk_not (var row (j - d))) else bdd 64 | ) one 65 | let queens_r i = 66 | fold_for 0 (n-1) (fun j bdd -> mk_or bdd (queens_s i j)) zero 67 | let bdd = 68 | fold_for 0 (n-1) (fun i bdd -> mk_and bdd (queens_r i)) one 69 | 70 | let () = printf "There are %d solutions@." (count_sat_int bdd) 71 | 72 | let () = exit 0 73 | let () = 74 | let print v (tl, e, sum, smallest, median, biggest) = 75 | printf "v=%d: size=%d #entries=%d sum=%d small/med/big=%d/%d/%d@." 76 | v tl e sum smallest median biggest in 77 | Array.iteri print (stats ()) 78 | -------------------------------------------------------------------------------- /test/path.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | open Format 16 | 17 | let _ = 18 | if Array.length Sys.argv <> 3 then failwith ("usage: " ^ Sys.argv.(0) ^ " ") 19 | 20 | let w, h = match int_of_string Sys.argv.(1), int_of_string Sys.argv.(2) with 21 | | exception _ -> failwith "weight and height should be numbers" 22 | | w, h when w > 0 && h > 0 -> w, h 23 | | _ -> failwith "weight and height should be greater than 0" 24 | 25 | let edges = ref [] 26 | 27 | let add_edge v1 v2 = edges := (v1, v2) :: !edges 28 | 29 | let () = 30 | for i = 0 to w do for j = 0 to h do 31 | if i < w then add_edge (i,j) (i+1,j); (* right *) 32 | if j < h then add_edge (i,j) (i,j+1); (* down *) 33 | done done 34 | 35 | let edges = Array.of_list !edges 36 | 37 | let n_edges = Array.length edges 38 | let () = printf "%d edges@." n_edges 39 | 40 | include (val Bdd.make n_edges) 41 | 42 | let adj = Hashtbl.create 17 43 | 44 | let () = 45 | for i = 0 to n_edges - 1 do 46 | let e = i+1 in 47 | let v1,v2 = edges.(i) in 48 | Hashtbl.add adj v1 e; 49 | Hashtbl.add adj v2 e 50 | done 51 | 52 | let rec iter_pairs f = function 53 | | [] | [_] -> 54 | () 55 | | x :: l -> 56 | List.iter (f x) l; 57 | iter_pairs f l 58 | 59 | let exactly_two_neighbors v = 60 | let adj_v = Hashtbl.find_all adj v in 61 | let b = ref zero in 62 | iter_pairs 63 | (fun e1 e2 -> (* e1 <> e2 *) 64 | (* we have edges e1 and e2 *) 65 | let b1 = ref (mk_and (mk_var e1) (mk_var e2)) in 66 | (* and no other edge for v *) 67 | List.iter 68 | (fun e -> 69 | if e <> e1 && e <> e2 then 70 | b1 := mk_and !b1 (mk_not (mk_var e))) 71 | adj_v; 72 | b := mk_or !b !b1) 73 | adj_v; 74 | !b 75 | 76 | let () = 77 | printf "creating the bdd...@."; 78 | let bdd = ref one in 79 | for i = 0 to w do for j = 0 to h do 80 | printf "%d,%d @?" i j; 81 | let v = i,j in 82 | bdd := mk_and !bdd (exactly_two_neighbors v) 83 | done done; 84 | (* display !bdd; *) 85 | printf "counting...@."; 86 | printf "%Ld paths@." (count_sat !bdd); 87 | (* List.iter *) 88 | (* (fun ta -> *) 89 | (* List.iter *) 90 | (* (fun (e,b) -> *) 91 | (* if b then *) 92 | (* let (i1,j1),(i2,j2) = edges.(e-1) in *) 93 | (* printf "%d,%d -- %d,%d " i1 j1 i2 j2) *) 94 | (* ta; *) 95 | (* printf "---@." *) 96 | (* ) *) 97 | (* (all_sat !bdd); *) 98 | () 99 | 100 | (* 101 | Local Variables: 102 | compile-command: "make path.opt" 103 | End: 104 | *) 105 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | open Bdd 16 | open Prop 17 | 18 | let p s = 19 | let lb = Lexing.from_string s in 20 | match Parser.file Lexer.token lb with 21 | | f :: _ -> f 22 | | _ -> assert false 23 | 24 | module B = (val make 42) 25 | 26 | let of_formula s = 27 | let nv, f = bdd_formula (p s) in assert (nv <= 42); B.build f 28 | let test s = B.display (of_formula s) 29 | let count s = B.count_sat (of_formula s) 30 | 31 | let display b = 32 | B.print_to_dot b ~file:"test.dot"; 33 | ignore (Sys.command "dot -Tpdf test.dot > test.pdf"); 34 | ignore (Sys.command "evince test.pdf") 35 | 36 | let test2 s = let b = of_formula s in display b 37 | 38 | let _ = test2 "(A -> B) -> (B -> A)" 39 | 40 | let _ = test "(a1<->a2)<->(a2<->a1)" 41 | let _ = test "A \\/ ~A" 42 | let _ = test "A -> ~~A" 43 | let _ = test "A -> A" 44 | let _ = test "((A -> B) -> A) -> A" 45 | let _ = test "(A -> B)-> (~B -> ~ A)" 46 | let _ = test "((A -> B) /\\ A) -> B" 47 | let _ = test "((A -> B) /\\ ~ B) -> ~ A" 48 | let _ = test "((A -> B) /\\ (B -> C)) -> (A -> C)" 49 | let _ = test "(A /\\ (B \\/ C)) -> ((A /\\ B) \\/ (A /\\ C))" 50 | let _ = test "((A /\\ B) \\/ (A /\\ C)) -> (A /\\ (B \\/ C))" 51 | let _ = test "(A \\/ (B /\\ C)) -> ((A \\/ B) /\\ (A \\/ C))" 52 | let _ = test "((A \\/ B) /\\ (A \\/ C)) -> (A \\/ (B /\\ C))" 53 | let _ = test "(~ A -> A) -> A " 54 | let _ = test "((P -> (Q /\\ R /\\ S)) /\\ ~S) -> ~P" 55 | let _ = test "(P /\\ Q) -> (Q /\\ P)" 56 | let _ = test "(A /\\ A) \\/ ~A" 57 | let _ = test "~~A <-> A" 58 | let _ = test "~(A /\\ B) <-> (~A \\/ ~B)" 59 | let _ = test "~(A \\/ B) <-> (~A /\\ ~ B)" 60 | let _ = test "(A \\/ (B /\\ C)) <-> ((A \\/ B) /\\ (A \\/ C))" 61 | let _ = test "(A /\\ (B \\/ C)) <-> ((A /\\ B) \\/ (A /\\ C))" 62 | 63 | let _ = test "((b <-> c) -> (a/\\b/\\c)) /\\ 64 | ((c<->a)->(a/\\b/\\c)) /\\ ((a<->b)->(a/\\b/\\c)) -> (a/\\b/\\c)" 65 | 66 | let _ = test "~ ~(~p1 \\/ ~p2 \\/ ~p3 \\/ (p1 & p2 & p3))" 67 | 68 | let de_bruijn_p_2 = test " 69 | (((((p1 -> p2) & (p2 -> p1)) -> (p1 & (p2 & (p3 & (p4 & p5))))) & ((((p2 -> 70 | p3) & (p3 -> p2)) -> (p1 & (p2 & (p3 & (p4 & p5))))) & ((((p3 -> p4) & (p4 -> 71 | p3)) -> (p1 & (p2 & (p3 & (p4 & p5))))) & ((((p4 -> p5) & (p5 -> p4)) -> 72 | (p1 & (p2 & (p3 & (p4 & p5))))) & (((p5 -> p1) & (p1 -> p5)) -> (p1 & (p2 & 73 | (p3 & (p4 & p5))))))))) -> (p1 & (p2 & (p3 & (p4 & p5)))))" 74 | 75 | let _ = test2 "A -> (A -> ~ A)" 76 | let _ = test2 "A /\\ ~A" 77 | let _ = test2 "(A \\/ B) /\\ ~A /\\ ~B" 78 | let _ = test2 "(A -> B) -> (~A -> ~B)" 79 | let _ = test2 "(A -> B) -> (B -> A)" 80 | let _ = test2 "B -> (B /\\ A)" 81 | let _ = test2 "(A -> A) <-> A" 82 | 83 | let () = 84 | let _, b = bdd_formula (Bench_prop.de_bruijn_n 5) in 85 | B.display (B.build b) 86 | -------------------------------------------------------------------------------- /test/check.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | open Bdd 16 | open Prop 17 | 18 | module B = (val make 42) 19 | let of_formula s = 20 | let nv, f = bdd_formula (Lexer.formula_of_string s) in 21 | assert (nv <= 42); 22 | B.build f 23 | 24 | let valid s = 25 | assert (B.tautology (of_formula s)) 26 | let invalid s = 27 | assert (not (B.tautology (of_formula s))) 28 | 29 | let () = valid " 30 | ((b <-> c) -> (a&b&c)) & 31 | ((c<->a)->(a&b&c)) & ((a<->b)->(a&b&c)) -> (a&b&c)" 32 | 33 | let () = valid "~ ~(~p1 \\/ ~p2 \\/ ~p3 \\/ (p1 & p2 & p3))" 34 | 35 | let () = valid "(a1<->a2)<->(a2<->a1)" 36 | 37 | let () = valid " A \\/ ~A" 38 | let () = valid " A -> ~~A" 39 | let () = valid " A -> A" 40 | let () = valid " ((A -> B) -> A) -> A" 41 | let () = valid " (A -> B)-> (~B -> ~ A)" 42 | let () = valid " ((A -> B) & A) -> B" 43 | let () = valid " ((A -> B) & ~ B) -> ~ A" 44 | let () = valid " ((A -> B) & (B -> C)) -> (A -> C)" 45 | let () = valid " (A & (B \\/ C)) -> ((A & B) \\/ (A & C))" 46 | let () = valid " ((A & B) \\/ (A & C)) -> (A & (B \\/ C))" 47 | let () = valid " (A \\/ (B & C)) -> ((A \\/ B) & (A \\/ C))" 48 | let () = valid " ((A \\/ B) & (A \\/ C)) -> (A \\/ (B & C))" 49 | let () = valid " (~ A -> A) -> A " 50 | let () = valid " ((P -> (Q & R & S)) & ~S) -> ~P" 51 | let () = valid " (P & Q) -> (Q & P)" 52 | let () = valid " (A & A) \\/ ~A" 53 | let () = valid " ~~A <-> A" 54 | let () = valid " ~(A & B) <-> (~A \\/ ~B)" 55 | let () = valid " ~(A \\/ B) <-> (~A & ~ B)" 56 | let () = valid " (A \\/ (B & C)) <-> ((A \\/ B) & (A \\/ C))" 57 | let () = valid " (A & (B \\/ C)) <-> ((A & B) \\/ (A & C))" 58 | 59 | 60 | let () = invalid " A -> (A -> ~ A)" 61 | let () = invalid " A & ~A" 62 | let () = invalid " (A \\/ B) & ~A & ~B" 63 | let () = invalid " (A -> B) -> (~A -> ~B)" 64 | let () = invalid " (A -> B) -> (B -> A)" 65 | let () = invalid " B -> (B & A)" 66 | let () = invalid " (A -> A) <-> A" 67 | 68 | open Format 69 | 70 | let print_count_sat s = 71 | let n = B.count_sat (of_formula s) in 72 | printf "count_sat(%s) = %Ld@." s n 73 | 74 | let check_count_sat s n = 75 | let nv, f = bdd_formula (Lexer.formula_of_string s) in 76 | let module B = (val make nv) in 77 | assert (B.count_sat (B.build f) = n) 78 | 79 | let () = check_count_sat "A" 1L 80 | let () = check_count_sat "A \\/ B" 3L 81 | let () = check_count_sat "A /\\ B" 1L 82 | let () = check_count_sat "A /\\ (B \\/ C)" 3L 83 | 84 | let () = check_count_sat "A \\/ ~A" 2L 85 | let () = check_count_sat "(A \\/ ~A) /\\ (B \\/ ~B)" 4L 86 | 87 | let () = print_endline "all tests successfully completed" 88 | 89 | let x1 = B.mk_var 1 90 | let () = assert (B.restrict x1 1 true == B.one) 91 | let () = assert (B.restrict x1 1 false == B.zero) 92 | let x2 = B.mk_var 2 93 | let e12 = B.mk_and (B.mk_imp x1 x2) (B.mk_imp x2 x1) (* x1 <-> x2 *) 94 | let () = assert (B.restrict e12 1 true == x2) 95 | let () = assert (B.restrict e12 2 true == x1) 96 | let () = assert (B.restrict e12 1 false == B.mk_not x2) 97 | 98 | let f1 = of_formula "(A & (B \\/ C))" 99 | let g1 = of_formula "A \\/ C" 100 | 101 | let f1' = B.constrain f1 g1 102 | let () = assert B.(mk_imp (mk_and f1 g1) f1' == one) 103 | let () = assert B.(mk_imp f1' (mk_or f1 (mk_not g1)) == one) 104 | let nf1' = B.(constrain f1 (mk_not g1)) 105 | let () = assert 106 | B.(mk_iff f1 (mk_or (mk_and g1 f1') (mk_and (mk_not g1) nf1')) == one) 107 | 108 | let f1' = B.restriction f1 g1 109 | let ()= assert B.(mk_imp (mk_and f1 g1) f1' == one) 110 | let ()= assert B.(mk_imp f1' (mk_or f1 (mk_not g1)) == one) 111 | 112 | -------------------------------------------------------------------------------- /lib/bdd.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | (** Propositional formulas *) 16 | 17 | type variable = int 18 | (** A variable is an integer, ranging from 1 to [max_var] (within 19 | a BDD module). *) 20 | 21 | module BddVarMap : Map.S with type key = variable 22 | (** Module providing general-purpose map data structures indexed by 23 | BDD variables. *) 24 | 25 | type formula = 26 | | Ffalse 27 | | Ftrue 28 | | Fvar of variable 29 | | Fand of formula * formula 30 | | For of formula * formula 31 | | Fimp of formula * formula 32 | | Fiff of formula * formula 33 | | Fnot of formula 34 | | Fite of formula * formula * formula (* if f1 then f2 else f3 *) 35 | 36 | module type BDD = sig 37 | (** Binary Decision Diagrams (BDDs) *) 38 | 39 | (** Number of variables *) 40 | 41 | val get_max_var : unit -> int 42 | (** Returns the number of variables [max_var]. 43 | Default value is 0, which means that bdds cannot be created 44 | until the module is initialized using [set_max_var]. *) 45 | 46 | (** The abstract type of BDD nodes *) 47 | 48 | type t 49 | 50 | (** View *) 51 | 52 | type view = Zero | One | Node of variable * t (*low*) * t (*high*) 53 | 54 | val view : t -> view 55 | (** Displays a bdd as a tree. *) 56 | 57 | (** Accessors *) 58 | 59 | val var : t -> variable 60 | (** The root variable of a bdd. 61 | Convention: [Zero] and [One] have variable [max_var+1] *) 62 | 63 | val low : t -> t 64 | val high : t -> t 65 | (** The low and high parts of a bdd, respectively. 66 | [low] and [high] raise [Invalid_argument] on [Zero] and [One]. *) 67 | 68 | (** Constructors *) 69 | 70 | val zero : t 71 | val one : t 72 | 73 | val make : variable -> low:t -> high:t -> t 74 | (** Builds a bdd node. 75 | Raises [Invalid_argument] is the variable is out of [1..max_var]. *) 76 | 77 | val mk_var : variable -> t 78 | (** Builds the bdd reduced to a single variable. *) 79 | 80 | val mk_not : t -> t 81 | val mk_and : t -> t -> t 82 | val mk_or : t -> t -> t 83 | val mk_imp : t -> t -> t 84 | val mk_iff : t -> t -> t 85 | (** Builds bdds for negation, conjunction, disjunction, implication, 86 | and logical equivalence. *) 87 | 88 | (** Quantifier elimination *) 89 | 90 | val mk_exist : (variable -> bool) -> t -> t 91 | val mk_forall : (variable -> bool) -> t -> t 92 | (** [mk_exists f b] (resp. [mk_forall f b]) quantifies bdd [b] over 93 | all variables [v] for which [f v] holds. For example: [mk_exists 94 | x. x /\ y] produces [y], [mk_exists x. x \/ y] produces [one], 95 | [mk_forall x. x /\ y] produces [zero] and [mk_forall x. x \/ y] 96 | produces [y]. See [test/quant_elim.ml]. *) 97 | 98 | val extract_known_values : t -> bool BddVarMap.t 99 | (** [extract_known_values b] returns a map indexed by variables, 100 | associated to Boolean values. In that map, a variable [v] is 101 | associated to [true] (resp. [false]) if bdd [b] entails [v] to 102 | have this value, that is [b -> v=true] (resp [b -> v=false]) is a 103 | tautology. *) 104 | 105 | (** Generic binary operator constructor *) 106 | 107 | val apply : (bool -> bool -> bool) -> t -> t -> t 108 | (** Applies the given Boolean function to two bdds. 109 | Caveat: Do not use this function to compute the usual Boolean 110 | operations (conjunction, disjunction, etc.). Use instead the 111 | operations above ([mk_and], etc.), which are more efficient. *) 112 | 113 | val constrain : t -> t -> t 114 | (** [constrain f g] is the generalized cofactor, sometimes written 115 | [f ↓ g]. It is defined for any function [g <> false] so that 116 | [f = (g /\ (f ↓ g)) \/ (~g /\ (f ↓ ~g))]. Setting [g] to a variable [x] 117 | gives the classical Shannon cofactors: 118 | [f = (x /\ (f ↓ x)) \/ (~x /\ (f ↓ ~x))]. 119 | For [f' = constrain f g], [f' xs = f xs] if [g xs], the graph of 120 | [f'] is often simper than that of [f], but not always. 121 | Note also that [(∃xs, (α ↓ β)(xs)) = (∃xs, (α /\ β)(xs))], but 122 | [constrain] is, in general, less costly to calculate than [mk_and]. 123 | See, e.g., Raymond 2008, 124 | "Synchronous program verification with Lustre/Lesar", §7.9. *) 125 | 126 | val restriction : t -> t -> t 127 | (** For [f' = restriction f g], [f' xs = f xs] if [g xs], and the graph of 128 | [f'] is a subset of that of [f]. 129 | I.e., [f'] is a smaller version of [f] for input vectors in the 130 | "care set" [g]. 131 | See, e.g., Raymond 2008, 132 | "Synchronous program verification with Lustre/Lesar", §7.9. *) 133 | 134 | val restrict : t -> variable -> bool -> t 135 | (** [restrict t v b] is the bdd for [t[b/v]], that is, [t] where 136 | variable [v] is assigned the truth value [b]. *) 137 | 138 | val build : formula -> t 139 | (** Builds a bdd from a propositional formula [f]. 140 | Raises [Invalid_argument] if [f] contains a variable out of 141 | [1..max_var]. *) 142 | 143 | val as_formula : t -> formula 144 | (** Builds a propositional formula from the given BDD. The returned 145 | formula is only build using if-then-else ([Fite]) and variables 146 | ([Fvar]). *) 147 | 148 | val as_compact_formula : t -> formula 149 | (** Builds a ``compact'' formula from the given BDD. The returned 150 | formula is only built using conjunctions, disjunctions, 151 | variables, negations of variables, and if-then-else where the if 152 | condition is a variable. *) 153 | 154 | (** Satisfiability *) 155 | 156 | val is_sat : t -> bool 157 | (** Checks if a bdd is satisfiable i.e. different from [zero] *) 158 | 159 | val tautology : t -> bool 160 | (** Checks if a bdd is a tautology i.e. equal to [one] *) 161 | 162 | val equivalent : t -> t -> bool 163 | (** Checks if a bdd is equivalent to another bdd *) 164 | 165 | val entails : t -> t -> bool 166 | (** [entails b1 b2] checks that [b1] entails [b2], in other words 167 | [b1] implies [b2] *) 168 | 169 | val count_sat_int : t -> int 170 | val count_sat : t -> Int64.t 171 | (** Counts the number of different ways to satisfy a bdd. *) 172 | 173 | val any_sat : t -> (variable * bool) list 174 | (** Returns one truth assignment which satisfies a bdd, if any. 175 | The result is chosen deterministically. 176 | Raises [Not_found] if the bdd is [zero] *) 177 | 178 | val random_sat : t -> (variable * bool) list 179 | (** Returns one truth assignment which satisfies a bdd, if any. 180 | The result is chosen randomly. 181 | Raises [Not_found] if the bdd is [zero] *) 182 | 183 | val all_sat : t -> (variable * bool) list list 184 | (** Returns all truth assignments which satisfy a bdd [b]. *) 185 | 186 | (** Pretty printer *) 187 | 188 | val print_var : Format.formatter -> variable -> unit 189 | 190 | val print : Format.formatter -> t -> unit 191 | (** Prints as compound if-then-else expressions *) 192 | 193 | val print_compact : Format.formatter -> t -> unit 194 | (** Prints as Boolean expressions, with fallback to if-then-else 195 | expressions when nothing is more compact *) 196 | 197 | val cnf_size: t -> int 198 | (** Returns the number of clauses when the bdd is printed in 199 | conjunctive normal form. This is the number of lines when 200 | the bdd is printed with function [print_dimacs] below, each 201 | line having up to [max_var] literals. *) 202 | 203 | val print_dimacs : Format.formatter -> t -> unit 204 | (** Prints a bdd in conjunctive normal form using the DIMACS format. 205 | 206 | Warning: The output may be exponential in the size of the bdd. 207 | The number of clauses (that is, the number of lines printed) 208 | is given by [cnf_size]. *) 209 | 210 | val print_dot : Format.formatter -> t -> unit 211 | (** Prints a DOT output of a given bdd. *) 212 | 213 | val to_dot : t -> string 214 | (** @deprecated Use [print_dot] instead. *) 215 | 216 | val print_to_dot : t -> file:string -> unit 217 | (** @deprecated Use [print_dot] instead. *) 218 | 219 | val display : t -> unit 220 | (** Renders a given bdd using DOT and runs the shell command 221 | "dot -Tps | gv -" *) 222 | 223 | (** Stats *) 224 | 225 | val nb_nodes: t -> int 226 | (** Returns the number of internal nodes of the bdd (i.e. nodes 227 | [Zero] and [One] are not counted). This is proportional to the 228 | space used internally by the bdd (7 words per node). *) 229 | 230 | val stats : unit -> (int * int * int * int * int * int) array 231 | (** Returns statistics on the internal nodes tables (one for each variable). 232 | The numbers are, in order: 233 | table length, number of entries, sum of bucket lengths, 234 | smallest bucket length, median bucket length, biggest bucket length. *) 235 | 236 | end 237 | 238 | module Make(X: sig 239 | val print_var: Format.formatter -> int -> unit 240 | val size: int 241 | val max_var: int 242 | end) : BDD 243 | 244 | val make : ?print_var:(Format.formatter -> variable -> unit) 245 | -> ?size:int 246 | -> int 247 | -> (module BDD) 248 | (** Creates a BDD module with a given maximum number of variables. 249 | Additionally, the size of the internal nodes table for each variable 250 | can be specified. Each table has a default size (7001) and is 251 | resized when necessary (i.e. when too many collisions occur). 252 | The [print_var] argument can be used to associate names with variables 253 | (by default it gives "x1", "x2", ...). *) 254 | -------------------------------------------------------------------------------- /lib/bdd.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Lesser General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (**************************************************************************) 14 | 15 | (* Binary Decision Diagrams *) 16 | 17 | type variable = int (* 1..max_var *) 18 | 19 | module BddVarMap = 20 | Map.Make(struct 21 | type t = variable 22 | let compare (x:variable) (y:variable) = compare x y 23 | end) 24 | 25 | type formula = 26 | | Ffalse 27 | | Ftrue 28 | | Fvar of variable 29 | | Fand of formula * formula 30 | | For of formula * formula 31 | | Fimp of formula * formula 32 | | Fiff of formula * formula 33 | | Fnot of formula 34 | | Fite of formula * formula * formula (* if f1 then f2 else f3 *) 35 | 36 | module type BDD = sig 37 | val get_max_var : unit -> int 38 | type t 39 | type view = Zero | One | Node of variable * t * t 40 | val view : t -> view 41 | val var : t -> variable 42 | val low : t -> t 43 | val high : t -> t 44 | val zero : t 45 | val one : t 46 | val make : variable -> low:t -> high:t -> t 47 | val mk_var : variable -> t 48 | val mk_not : t -> t 49 | val mk_and : t -> t -> t 50 | val mk_or : t -> t -> t 51 | val mk_imp : t -> t -> t 52 | val mk_iff : t -> t -> t 53 | val mk_exist : (variable -> bool) -> t -> t 54 | val mk_forall : (variable -> bool) -> t -> t 55 | val extract_known_values : t -> bool BddVarMap.t 56 | val apply : (bool -> bool -> bool) -> t -> t -> t 57 | val constrain : t -> t -> t 58 | val restriction : t -> t -> t 59 | val restrict : t -> variable -> bool -> t 60 | val build : formula -> t 61 | val as_formula : t -> formula 62 | val as_compact_formula : t -> formula 63 | val is_sat : t -> bool 64 | val tautology : t -> bool 65 | val equivalent : t -> t -> bool 66 | val entails : t -> t -> bool 67 | val count_sat_int : t -> int 68 | val count_sat : t -> Int64.t 69 | val any_sat : t -> (variable * bool) list 70 | val random_sat : t -> (variable * bool) list 71 | val all_sat : t -> (variable * bool) list list 72 | val print_var : Format.formatter -> variable -> unit 73 | val print : Format.formatter -> t -> unit 74 | val print_compact : Format.formatter -> t -> unit 75 | val cnf_size: t -> int 76 | val print_dimacs : Format.formatter -> t -> unit 77 | val print_dot : Format.formatter -> t -> unit 78 | val to_dot : t -> string 79 | val print_to_dot : t -> file:string -> unit 80 | val display : t -> unit 81 | val nb_nodes : t -> int 82 | val stats : unit -> (int * int * int * int * int * int) array 83 | end 84 | 85 | let debug = false 86 | 87 | (* Make a fresh module *) 88 | module Make(X: sig 89 | val print_var: Format.formatter -> int -> unit 90 | val size: int 91 | val max_var: int 92 | end) = struct 93 | open X 94 | 95 | let rec power_2_above x n = 96 | if x >= n then x 97 | else if x * 2 > Sys.max_array_length then x 98 | else power_2_above (x * 2) n 99 | 100 | let size = power_2_above 16 size 101 | 102 | let print_var = print_var 103 | 104 | let get_max_var () = max_var 105 | 106 | type bdd = { tag: int; node : view } 107 | and view = Zero | One | Node of variable * bdd (*low*) * bdd (*high*) 108 | 109 | (* Notes: 110 | - Variables are ordered as integers, i.e. variable indices increase 111 | as we descend in the BDD. 112 | - A node is created using function `mk` below. *) 113 | 114 | type t = bdd (* export *) 115 | 116 | let view b = b.node 117 | 118 | let rec print fmt b = 119 | match b.node with 120 | | Zero -> Format.fprintf fmt "false" 121 | | One -> Format.fprintf fmt "true" 122 | | Node(v,l,h) -> 123 | Format.fprintf fmt "@[if %a@ then %a@ else %a@]" print_var v print h print l 124 | 125 | let rec print_compact fmt b = 126 | match b.node with 127 | | Zero -> Format.fprintf fmt "false" 128 | | One -> Format.fprintf fmt "true" 129 | | Node(v,{node=Zero;_},{node=One;_}) -> 130 | (* if v then 1 else 0 --> v *) 131 | Format.fprintf fmt "%a" print_var v 132 | | Node(v,{node=One;_},{node=Zero;_}) -> 133 | (* if v then 0 else 1 --> !v *) 134 | Format.fprintf fmt "!%a" print_var v 135 | | Node(v,{node=Zero;_},h) -> 136 | (* if v then h else 0 --> v /\ h *) 137 | Format.fprintf fmt "@[%a /\\@ %a@]" print_var v print_compact h 138 | | Node(v,{node=One;_},h) -> 139 | (* if v then h else 1 --> !v \/ h *) 140 | Format.fprintf fmt "@[!%a \\/@ %a@]" print_var v print_compact h 141 | | Node(v,l,{node=Zero;_}) -> 142 | (* if v then 0 else l --> !v /\ l *) 143 | Format.fprintf fmt "@[!%a /\\@ %a@]" print_var v print_compact l 144 | | Node(v,l,{node=One;_}) -> 145 | (* if v then 1 else l --> v \/ l *) 146 | Format.fprintf fmt "@[%a \\/@ %a@]" print_var v print_compact l 147 | | Node(v,l,h) -> 148 | Format.fprintf fmt "@[if %a@ then %a@ else %a@]" print_var v print_compact h print_compact l 149 | 150 | 151 | (* unused 152 | let equal x y = match x, y with 153 | | Node (v1, l1, h1), Node (v2, l2, h2) -> 154 | v1 == v2 && l1 == l2 && h1 == h2 155 | | _ -> 156 | x == y 157 | *) 158 | 159 | (** perfect hashing is actually less efficient 160 | let pair a b = (a + b) * (a + b + 1) / 2 + a 161 | let triple a b c = pair c (pair a b) 162 | let hash_node v l h = abs (triple l.tag h.tag v) 163 | **) 164 | let hash_node l h = 19 * l.tag + h.tag 165 | 166 | let hash = function 167 | | Zero -> 0 168 | | One -> 1 169 | | Node (_, l, h) -> hash_node l h 170 | 171 | let gentag = let r = ref (-1) in fun () -> incr r; !r 172 | 173 | type table = { 174 | mutable table : bdd Weak.t array; 175 | mutable totsize : int; (* sum of the bucket sizes *) 176 | mutable limit : int; (* max ratio totsize/table length *) 177 | } 178 | 179 | let create sz = 180 | let emptybucket = Weak.create 0 in 181 | { table = Array.make sz emptybucket; 182 | totsize = 0; 183 | limit = 3; } 184 | 185 | let vt = Array.init max_var (fun _ -> create size) 186 | 187 | let fold f t init = 188 | let rec fold_bucket i b accu = 189 | if i >= Weak.length b then accu else 190 | match Weak.get b i with 191 | | Some v -> fold_bucket (i+1) b (f v accu) 192 | | None -> fold_bucket (i+1) b accu 193 | in 194 | Array.fold_right (fold_bucket 0) t.table init 195 | 196 | (* unused 197 | 198 | let iter f t = 199 | let rec iter_bucket i b = 200 | if i >= Weak.length b then () else 201 | match Weak.get b i with 202 | | Some v -> f v; iter_bucket (i+1) b 203 | | None -> iter_bucket (i+1) b 204 | in 205 | Array.iter (iter_bucket 0) t.table 206 | *) 207 | 208 | let count t = 209 | let rec count_bucket i b accu = 210 | if i >= Weak.length b then accu else 211 | count_bucket (i+1) b (accu + (if Weak.check b i then 1 else 0)) 212 | in 213 | Array.fold_right (count_bucket 0) t.table 0 214 | 215 | let rec resize t = 216 | if debug then Format.eprintf "resizing...@."; 217 | let oldlen = Array.length t.table in 218 | let newlen = oldlen * 2 in 219 | if newlen > oldlen then begin 220 | let newt = create newlen in 221 | newt.limit <- t.limit + 100; (* prevent resizing of newt *) 222 | fold (fun d () -> add newt d) t (); 223 | t.table <- newt.table; 224 | t.limit <- t.limit + 2; 225 | end 226 | 227 | and add t d = 228 | add_index t d ((hash d.node) land (Array.length t.table - 1)) 229 | 230 | and add_index t d index = 231 | let bucket = t.table.(index) in 232 | let sz = Weak.length bucket in 233 | let rec loop i = 234 | if i >= sz then begin 235 | let newsz = min (sz + 3) (Sys.max_array_length - 1) in 236 | if newsz <= sz then 237 | failwith "Hashcons.Make: hash bucket cannot grow more"; 238 | let newbucket = Weak.create newsz in 239 | Weak.blit bucket 0 newbucket 0 sz; 240 | Weak.set newbucket i (Some d); 241 | t.table.(index) <- newbucket; 242 | t.totsize <- t.totsize + (newsz - sz); 243 | if t.totsize > t.limit * Array.length t.table then resize t; 244 | end else begin 245 | if Weak.check bucket i 246 | then loop (i+1) 247 | else Weak.set bucket i (Some d) 248 | end 249 | in 250 | loop 0 251 | 252 | let hashcons_node v l h = 253 | let t = vt.(v - 1) in 254 | let index = (hash_node l h) mod (Array.length t.table) in 255 | let bucket = t.table.(index) in 256 | let sz = Weak.length bucket in 257 | let rec loop i = 258 | if i >= sz then begin 259 | let hnode = { tag = gentag (); node = Node (v, l, h) } in 260 | add_index t hnode index; 261 | hnode 262 | end else begin 263 | match Weak.get_copy bucket i with 264 | | Some {node=Node(v',l',h'); _} when v==v' && l==l' && h==h' -> 265 | begin match Weak.get bucket i with 266 | | Some v -> v 267 | | None -> loop (i+1) 268 | end 269 | | _ -> loop (i+1) 270 | end 271 | in 272 | loop 0 273 | 274 | let stat t = 275 | let len = Array.length t.table in 276 | let lens = Array.map Weak.length t.table in 277 | Array.sort compare lens; 278 | let totlen = Array.fold_left ( + ) 0 lens in 279 | (len, count t, totlen, lens.(0), lens.(len/2), lens.(len-1)) 280 | 281 | let stats () = Array.map stat vt 282 | 283 | (* zero and one allocated once and for all *) 284 | let zero = { tag = gentag (); node = Zero } 285 | let one = { tag = gentag (); node = One } 286 | 287 | let var b = match b.node with 288 | | Zero | One -> max_var + 1 289 | | Node (v, _, _) -> v 290 | 291 | let low b = match b.node with 292 | | Zero | One -> invalid_arg "Bdd.low" 293 | | Node (_, l, _) -> l 294 | 295 | let high b = match b.node with 296 | | Zero | One -> invalid_arg "Bdd.low" 297 | | Node (_, _, h) -> h 298 | 299 | (* Note: `mk` ensures that BDDs are reduced and maximally shared. 300 | But it *does not* ensure that BDDs are ordered. This is ensured by 301 | the various functions below. See for instance the code of `gapply` 302 | and the way it compares variables before proceeding recursively. *) 303 | let mk v ~low ~high = 304 | if low == high then low else hashcons_node v low high 305 | 306 | let make v ~low ~high = 307 | if v < 1 || v > max_var then invalid_arg "Bdd.make"; 308 | mk v ~low ~high 309 | 310 | let mk_var v = 311 | if v < 1 || v > max_var then invalid_arg "Bdd.mk_var"; 312 | mk v ~low:zero ~high:one 313 | 314 | module Bdd = struct 315 | type t = bdd 316 | let equal = (==) 317 | let hash b = b.tag 318 | let compare b1 b2 = Stdlib.compare b1.tag b2.tag 319 | end 320 | module H1 = Hashtbl.Make(Bdd) 321 | 322 | let cache_default_size = 7001 323 | 324 | let mk_not x = 325 | let cache = H1.create cache_default_size in 326 | let rec mk_not_rec x = 327 | try 328 | H1.find cache x 329 | with Not_found -> 330 | let res = match x.node with 331 | | Zero -> one 332 | | One -> zero 333 | | Node (v, l, h) -> mk v ~low:(mk_not_rec l) ~high:(mk_not_rec h) 334 | in 335 | H1.add cache x res; 336 | res 337 | in 338 | mk_not_rec x 339 | 340 | (* unused 341 | let bool_of = function Zero -> false | One -> true | _ -> invalid_arg "bool_of"*) 342 | let of_bool b = if b then one else zero 343 | 344 | module H2 = Hashtbl.Make( 345 | struct 346 | type t = bdd * bdd 347 | let equal (u1,v1) (u2,v2) = u1==u2 && v1==v2 348 | let hash (u,v) = 349 | (*abs (19 * u.tag + v.tag)*) 350 | let s = u.tag + v.tag in abs (s * (s+1) / 2 + u.tag) 351 | end) 352 | 353 | type operator = 354 | | Op_and | Op_or | Op_imp 355 | | Op_any of (bool -> bool -> bool) 356 | 357 | let apply_op op b1 b2 = match op with 358 | | Op_and -> b1 && b2 359 | | Op_or -> b1 || b2 360 | | Op_imp -> (not b1) || b2 361 | | Op_any f -> f b1 b2 362 | 363 | let gapply op = 364 | let op_z_z = of_bool (apply_op op false false) in 365 | let op_z_o = of_bool (apply_op op false true) in 366 | let op_o_z = of_bool (apply_op op true false) in 367 | let op_o_o = of_bool (apply_op op true true) in 368 | fun b1 b2 -> 369 | let cache = H2.create cache_default_size in 370 | let rec app ((u1,u2) as u12) = 371 | match op with 372 | | Op_and -> 373 | if u1 == u2 then 374 | u1 375 | else if u1 == zero || u2 == zero then 376 | zero 377 | else if u1 == one then 378 | u2 379 | else if u2 == one then 380 | u1 381 | else 382 | app_gen u12 383 | | Op_or -> 384 | if u1 == u2 then 385 | u1 386 | else if u1 == one || u2 == one then 387 | one 388 | else if u1 == zero then 389 | u2 390 | else if u2 == zero then 391 | u1 392 | else 393 | app_gen u12 394 | | Op_imp -> 395 | if u1 == zero then 396 | one 397 | else if u1 == one then 398 | u2 399 | else if u2 == one then 400 | one 401 | else 402 | app_gen u12 403 | | Op_any _ -> 404 | app_gen u12 405 | and app_gen ((u1,u2) as u12) = 406 | match u1.node, u2.node with 407 | | Zero, Zero -> op_z_z 408 | | Zero, One -> op_z_o 409 | | One, Zero -> op_o_z 410 | | One, One -> op_o_o 411 | | _ -> 412 | try 413 | H2.find cache u12 414 | with Not_found -> 415 | let res = 416 | let v1 = var u1 in 417 | let v2 = var u2 in 418 | if v1 == v2 then 419 | mk v1 ~low:(app (low u1, low u2)) ~high:(app (high u1, high u2)) 420 | else if v1 < v2 then 421 | mk v1 ~low:(app (low u1, u2)) ~high:(app (high u1, u2)) 422 | else (* v1 > v2 *) 423 | mk v2 ~low:(app (u1, low u2)) ~high:(app (u1, high u2)) 424 | in 425 | H2.add cache u12 res; 426 | res 427 | in 428 | app (b1, b2) 429 | 430 | let mk_and = gapply Op_and 431 | let mk_or = gapply Op_or 432 | let mk_imp = gapply Op_imp 433 | let mk_iff = gapply (Op_any (fun b1 b2 -> b1 == b2)) 434 | 435 | let mk_ite f1 f2 f3 = 436 | mk_and (mk_imp f1 f2) (mk_imp (mk_not f1) f3) 437 | 438 | (** {2 quantifier elimination} *) 439 | 440 | let rec quantifier_elim cache op filter b = 441 | try 442 | H1.find cache b 443 | with Not_found -> 444 | let res = match b.node with 445 | | Zero | One -> b 446 | | Node(v,l,h) -> 447 | let low = quantifier_elim cache op filter l in 448 | let high = quantifier_elim cache op filter h in 449 | if filter v then 450 | op low high 451 | else 452 | mk v ~low ~high 453 | in 454 | H1.add cache b res; 455 | res 456 | 457 | 458 | let mk_exist filter b = 459 | let cache = H1.create cache_default_size in 460 | quantifier_elim cache mk_or filter b 461 | 462 | let mk_forall filter b = 463 | let cache = H1.create cache_default_size in 464 | quantifier_elim cache mk_and filter b 465 | 466 | 467 | let rec extract_known_values cache b = 468 | try 469 | H1.find cache b 470 | with Not_found -> 471 | let res = match b.node with 472 | | Zero | One -> BddVarMap.empty 473 | | Node(v, {node=Zero;_}, h) -> 474 | (* if v then h else 0 --> v /\ h *) 475 | BddVarMap.add v true (extract_known_values cache h) 476 | | Node(v, l, {node=Zero;_}) -> 477 | (* if v then 0 else l --> !v /\ l *) 478 | BddVarMap.add v false (extract_known_values cache l) 479 | | Node(_, l, h) -> 480 | let m1 = extract_known_values cache l in 481 | let m2 = extract_known_values cache h in 482 | let merge_bool _ b1 b2 = 483 | match b1, b2 with 484 | | Some b1, Some b2 when b1=b2 -> Some b1 485 | | _ -> None 486 | in 487 | BddVarMap.merge merge_bool m1 m2 488 | in 489 | H1.add cache b res; 490 | res 491 | 492 | let extract_known_values b = 493 | let cache = H1.create cache_default_size in 494 | extract_known_values cache b 495 | 496 | let apply f = gapply (Op_any f) 497 | 498 | let constrain b1 b2 = 499 | let cache = H2.create cache_default_size in 500 | let rec app ((u1,u2) as u12) = 501 | match u1.node, u2.node with 502 | | _, Zero -> failwith "constrain 0 is undefined" 503 | | _, One -> u1 504 | | Zero, _ -> u1 505 | | One, _ -> u1 506 | | _ -> 507 | try 508 | H2.find cache u12 509 | with Not_found -> 510 | let res = 511 | let v1 = var u1 in 512 | let v2 = var u2 in 513 | if v1 == v2 then begin 514 | if low u2 == zero then app (high u1, high u2) 515 | else if high u2 == zero then app (low u1, low u2) 516 | else mk (var u1) ~low:(app (low u1, low u2)) ~high:(app (high u1, high u2)) 517 | end 518 | else if v1 < v2 then 519 | mk v1 ~low:(app (low u1, u2)) ~high:(app (high u1, u2)) 520 | else (* v1 > v2 *) 521 | mk v2 ~low:(app (u1, low u2)) ~high:(app (u1, high u2)) 522 | in 523 | H2.add cache u12 res; 524 | res 525 | in 526 | app (b1, b2) 527 | 528 | let restriction b1 b2 = 529 | let cache = H2.create cache_default_size in 530 | let rec app ((u1,u2) as u12) = 531 | match u1.node, u2.node with 532 | | _, Zero -> failwith "constrain 0 is undefined" 533 | | _, One -> u1 534 | | Zero, _ -> u1 535 | | One, _ -> u1 536 | | _ -> 537 | try 538 | H2.find cache u12 539 | with Not_found -> 540 | let res = 541 | let v1 = var u1 in 542 | let v2 = var u2 in 543 | if v1 == v2 then begin 544 | if low u2 == zero then app (high u1, high u2) 545 | else if high u2 == zero then app (low u1, low u2) 546 | else mk (var u1) ~low:(app (low u1, low u2)) ~high:(app (high u1, high u2)) 547 | end 548 | else if v1 < v2 then 549 | mk v1 ~low:(app (low u1, u2)) ~high:(app (high u1, u2)) 550 | else (* v1 > v2 *) 551 | app (u1, mk_or (low u2) (high u2)) 552 | in 553 | H2.add cache u12 res; 554 | res 555 | in 556 | app (b1, b2) 557 | 558 | let restrict u x b = 559 | let cache = H1.create cache_default_size in 560 | let rec app u = 561 | try 562 | H1.find cache u 563 | with Not_found -> 564 | let res = 565 | if var u > x then u 566 | else if var u < x then mk (var u) ~low:(app (low u)) ~high:(app (high u)) 567 | else (* var u = x *) if b then app (high u) 568 | else (* var u = x, b = 0 *) app (low u) 569 | in 570 | H1.add cache u res; 571 | res 572 | in 573 | app u 574 | 575 | (* formula -> bdd *) 576 | 577 | let rec build = function 578 | | Ffalse -> zero 579 | | Ftrue -> one 580 | | Fvar v -> mk_var v 581 | | Fand (f1, f2) -> mk_and (build f1) (build f2) 582 | | For (f1, f2) -> mk_or (build f1) (build f2) 583 | | Fimp (f1, f2) -> mk_imp (build f1) (build f2) 584 | | Fiff (f1, f2) -> mk_iff (build f1) (build f2) 585 | | Fnot f -> mk_not (build f) 586 | | Fite (f1, f2, f3) -> mk_ite (build f1) (build f2) (build f3) 587 | 588 | let rec as_formula b = 589 | match b.node with 590 | | Zero -> Ffalse 591 | | One -> Ftrue 592 | | Node(v,l,h) -> Fite (Fvar v, as_formula h, as_formula l) 593 | 594 | let rec as_compact_formula b = 595 | match b.node with 596 | | Zero -> Ffalse 597 | | One -> Ftrue 598 | | Node(v,{node=Zero;_},{node=One;_}) -> 599 | (* if v then 1 else 0 --> v *) 600 | Fvar v 601 | | Node(v,{node=One;_},{node=Zero;_}) -> 602 | (* if v then 0 else 1 --> !v *) 603 | Fnot (Fvar v) 604 | | Node(v,{node=Zero;_},h) -> 605 | (* if v then h else 0 --> v /\ h *) 606 | Fand (Fvar v, as_compact_formula h) 607 | | Node(v,{node=One;_},h) -> 608 | (* if v then h else 1 --> !v \/ h *) 609 | For (Fnot (Fvar v), as_compact_formula h) 610 | | Node(v,l,{node=Zero;_}) -> 611 | (* if v then 0 else l --> !v /\ l *) 612 | Fand (Fnot (Fvar v), as_compact_formula l) 613 | | Node(v,l,{node=One;_}) -> 614 | (* if v then 1 else l --> v \/ l *) 615 | For (Fvar v, as_compact_formula l) 616 | | Node(v,l,h) -> 617 | Fite (Fvar v, as_compact_formula h, as_compact_formula l) 618 | 619 | let mk_Fand f1 f2 = 620 | match f2 with 621 | | Ftrue -> f1 622 | | _ -> Fand(f1,f2) 623 | 624 | let as_compact_formula b = 625 | let m = extract_known_values b in 626 | let reduced_bdd = 627 | mk_exist (fun v -> 628 | try let _ = BddVarMap.find v m in true 629 | with Not_found -> false) b 630 | in 631 | let f = as_compact_formula reduced_bdd in 632 | BddVarMap.fold 633 | (fun v b f -> 634 | mk_Fand (if b then Fvar v else Fnot(Fvar v)) f ) 635 | m f 636 | 637 | 638 | (* satisfiability *) 639 | 640 | let is_sat b = b.node != Zero 641 | 642 | let tautology b = b.node == One 643 | 644 | let equivalent b1 b2 = b1 == b2 645 | 646 | let entails b1 b2 = tautology (mk_imp b1 b2) 647 | 648 | let rec int64_two_to = function 649 | | 0 -> 650 | Int64.one 651 | | n -> 652 | let r = int64_two_to (n/2) in 653 | let r2 = Int64.mul r r in 654 | if n mod 2 == 0 then r2 else Int64.mul (Int64.of_int 2) r2 655 | 656 | let count_sat_int b = 657 | let cache = H1.create cache_default_size in 658 | let rec count b = 659 | try 660 | H1.find cache b 661 | with Not_found -> 662 | let n = match b.node with 663 | | Zero -> 0 664 | | One -> 1 665 | | Node (v, l, h) -> 666 | let dvl = var l - v - 1 in 667 | let dvh = var h - v - 1 in 668 | (1 lsl dvl) * count l + (1 lsl dvh) * count h 669 | in 670 | H1.add cache b n; 671 | n 672 | in 673 | (1 lsl (var b - 1)) * count b 674 | 675 | let count_sat b = 676 | let cache = H1.create cache_default_size in 677 | let rec count b = 678 | try 679 | H1.find cache b 680 | with Not_found -> 681 | let n = match b.node with 682 | | Zero -> Int64.zero 683 | | One -> Int64.one 684 | | Node (v, l, h) -> 685 | let dvl = var l - v - 1 in 686 | let dvh = var h - v - 1 in 687 | Int64.add 688 | (Int64.mul (int64_two_to dvl) (count l)) 689 | (Int64.mul (int64_two_to dvh) (count h)) 690 | in 691 | H1.add cache b n; 692 | n 693 | in 694 | Int64.mul (int64_two_to (var b - 1)) (count b) 695 | 696 | let any_sat = 697 | let rec mk acc b = match b.node with 698 | | Zero -> raise Not_found 699 | | One -> acc 700 | | Node (v, {node=Zero; _}, h) -> mk ((v,true)::acc) h 701 | | Node (v, l, _) -> mk ((v,false)::acc) l 702 | in 703 | mk [] 704 | 705 | let random_sat = 706 | let rec mk acc b = match b.node with 707 | | Zero -> raise Not_found 708 | | One -> acc 709 | | Node (v, {node=Zero; _}, h) -> mk ((v,true) :: acc) h 710 | | Node (v, l, {node=Zero; _}) -> mk ((v,false) :: acc) l 711 | | Node (v, l, _) when Random.bool () -> mk ((v,false) :: acc) l 712 | | Node (v, _, h) -> mk ((v,true) :: acc) h 713 | in 714 | mk [] 715 | 716 | (* TODO: a CPS version of all_sat *) 717 | let all_sat = 718 | let cache = H1.create cache_default_size in 719 | let rec mk b = 720 | try 721 | H1.find cache b 722 | with Not_found -> 723 | let res = match b.node with 724 | | Zero -> [] 725 | | One -> [[]] 726 | | Node (v, l, h) -> 727 | (List.map (fun a -> (v,false)::a) (mk l)) 728 | @ (List.map (fun a -> (v,true)::a) (mk h)) 729 | in 730 | H1.add cache b res; 731 | res 732 | in 733 | mk 734 | 735 | (** iter-like traversal of a bdd *) 736 | 737 | let iter ~zero:(zero: unit -> unit) ~one:(one: unit -> unit) 738 | (f: variable -> low:t -> high:t -> unit) 739 | (b: t) : unit = 740 | let visited = H1.create cache_default_size in 741 | let rec visit b = 742 | if not (H1.mem visited b) then ( 743 | H1.add visited b (); 744 | match b.node with 745 | | Zero -> zero () 746 | | One -> one () 747 | | Node (v, low, high) -> f v ~low ~high; visit high; visit low 748 | ) in 749 | visit b 750 | 751 | let nb_nodes b = 752 | let n = ref 0 in 753 | iter ~zero:(fun () -> ()) ~one:(fun () -> ()) 754 | (fun _ ~low:_ ~high:_ -> incr n) b; 755 | !n 756 | 757 | (** fold-like traversal of a bdd *) 758 | 759 | let fold ~(zero: 'a) ~(one: 'a) 760 | (f: variable -> low:'a -> high:'a -> 'a) (b: t) : 'a = 761 | let cache = H1.create cache_default_size in 762 | let rec visit b = 763 | try 764 | H1.find cache b 765 | with Not_found -> 766 | match b.node with 767 | | Zero -> zero 768 | | One -> one 769 | | Node (v, l, h) -> 770 | let y = f v ~low:(visit l) ~high:(visit h) in 771 | H1.add cache b y; 772 | y 773 | in 774 | visit b 775 | 776 | let cnf_size (b: t) : int = 777 | fold ~zero:1 ~one:0 (fun _ ~low ~high -> low + high) b 778 | 779 | let paths_to_zero b = 780 | fold ~zero:[[]] ~one:[] 781 | (fun v ~low ~high -> 782 | List.map (fun p -> v :: p) low @ 783 | List.map (fun p -> -v :: p) high ) 784 | b 785 | 786 | let print_dimacs fmt b = 787 | let nc = cnf_size b in 788 | Format.fprintf fmt "p cnf %d %d@\n" max_var nc; 789 | match b.node with 790 | | Zero -> Format.fprintf fmt "0" 791 | | One -> () 792 | | _ -> 793 | let print_literal x = Format.fprintf fmt "%d " x in 794 | let print_clause c = List.iter print_literal c; Format.fprintf fmt "0" in 795 | let rec print_clauses = function 796 | | [] -> () 797 | | c :: cl -> 798 | print_clause c; 799 | if cl <> [] then (Format.fprintf fmt "@\n"; print_clauses cl) in 800 | print_clauses (paths_to_zero b) 801 | 802 | (* DOT pretty-printing *) 803 | 804 | module S = Set.Make(Bdd) 805 | 806 | open Format 807 | 808 | let print_dot fmt b = 809 | fprintf fmt "digraph bdd {@\n"; 810 | let ranks = Hashtbl.create 17 in (* var -> set of nodes *) 811 | let add_rank v b = 812 | try Hashtbl.replace ranks v (S.add b (Hashtbl.find ranks v)) 813 | with Not_found -> Hashtbl.add ranks v (S.singleton b) 814 | in 815 | let visited = H1.create cache_default_size in 816 | let rec visit b = 817 | if not (H1.mem visited b) then begin 818 | H1.add visited b (); 819 | match b.node with 820 | | Zero -> 821 | fprintf fmt "%d [shape=box label=\"0\"];" b.tag 822 | | One -> 823 | fprintf fmt "%d [shape=box label=\"1\"];" b.tag 824 | | Node (v, l, h) -> 825 | add_rank v b; 826 | fprintf fmt "%d [label=\"%a\"];" b.tag print_var v; 827 | fprintf fmt "%d -> %d;@\n" b.tag h.tag; 828 | fprintf fmt "%d -> %d [style=\"dashed\"];@\n" b.tag l.tag; 829 | visit h; visit l 830 | end 831 | in 832 | Hashtbl.iter 833 | (fun _ s -> 834 | fprintf fmt "{rank=same; "; 835 | S.iter (fun x -> fprintf fmt "%d " x.tag) s; 836 | fprintf fmt ";}@\n" 837 | ) 838 | ranks; 839 | visit b; 840 | fprintf fmt "}@." 841 | 842 | let to_dot b = 843 | Buffer.truncate Format.stdbuf 0; 844 | print_dot Format.str_formatter b; 845 | Buffer.contents Format.stdbuf 846 | 847 | let print_to_dot b ~file = 848 | let c = open_out file in 849 | let fmt = formatter_of_out_channel c in 850 | print_dot fmt b; 851 | close_out c 852 | 853 | let display b = 854 | let file = Filename.temp_file "bdd" ".dot" in 855 | print_to_dot b ~file; 856 | let cmd = sprintf "dot -Tps %s | gv -" file in 857 | begin try ignore (Sys.command cmd) with _ -> () end; 858 | try Sys.remove file with _ -> () 859 | 860 | end (* module Session *) 861 | 862 | let make ?(print_var=fun ff -> Format.fprintf ff "x%d") 863 | ?(size=7001) 864 | max_var 865 | = let module B = Make(struct let print_var = print_var 866 | let size = size let max_var = max_var end) in 867 | (module B: BDD) 868 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The library Creal is distributed under the terms of the GNU Lesser 2 | General Public License version 2.1 (included below). 3 | 4 | As a special exception to the GNU Lesser General Public License, you 5 | may link, statically or dynamically, a "work that uses the Library" 6 | with a publicly distributed version of the Library to produce an 7 | executable file containing portions of the Library, and distribute 8 | that executable file under terms of your choice, without any of the 9 | additional requirements listed in clause 6 of the GNU Lesser General 10 | Public License. By "a publicly distributed version of the Library", we 11 | mean either the unmodified Library as distributed, or a 12 | modified version of the Library that is distributed under the 13 | conditions defined in clause 2 of the GNU Lesser General Public 14 | License. This exception does not however invalidate any other reasons 15 | why the executable file might be covered by the GNU Lesser General 16 | Public License. 17 | 18 | ====================================================================== 19 | 20 | GNU LESSER GENERAL PUBLIC LICENSE 21 | Version 2.1, February 1999 22 | 23 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 24 | 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 25 | Everyone is permitted to copy and distribute verbatim copies 26 | of this license document, but changing it is not allowed. 27 | 28 | [This is the first released version of the Lesser GPL. It also counts 29 | as the successor of the GNU Library Public License, version 2, hence 30 | the version number 2.1.] 31 | 32 | Preamble 33 | 34 | The licenses for most software are designed to take away your 35 | freedom to share and change it. By contrast, the GNU General Public 36 | Licenses are intended to guarantee your freedom to share and change 37 | free software--to make sure the software is free for all its users. 38 | 39 | This license, the Lesser General Public License, applies to some 40 | specially designated software packages--typically libraries--of the 41 | Free Software Foundation and other authors who decide to use it. You 42 | can use it too, but we suggest you first think carefully about whether 43 | this license or the ordinary General Public License is the better 44 | strategy to use in any particular case, based on the explanations 45 | below. 46 | 47 | When we speak of free software, we are referring to freedom of use, 48 | not price. Our General Public Licenses are designed to make sure that 49 | you have the freedom to distribute copies of free software (and charge 50 | for this service if you wish); that you receive source code or can get 51 | it if you want it; that you can change the software and use pieces of 52 | it in new free programs; and that you are informed that you can do 53 | these things. 54 | 55 | To protect your rights, we need to make restrictions that forbid 56 | distributors to deny you these rights or to ask you to surrender these 57 | rights. These restrictions translate to certain responsibilities for 58 | you if you distribute copies of the library or if you modify it. 59 | 60 | For example, if you distribute copies of the library, whether gratis 61 | or for a fee, you must give the recipients all the rights that we gave 62 | you. You must make sure that they, too, receive or can get the source 63 | code. If you link other code with the library, you must provide 64 | complete object files to the recipients, so that they can relink them 65 | with the library after making changes to the library and recompiling 66 | it. And you must show them these terms so they know their rights. 67 | 68 | We protect your rights with a two-step method: (1) we copyright the 69 | library, and (2) we offer you this license, which gives you legal 70 | permission to copy, distribute and/or modify the library. 71 | 72 | To protect each distributor, we want to make it very clear that 73 | there is no warranty for the free library. Also, if the library is 74 | modified by someone else and passed on, the recipients should know 75 | that what they have is not the original version, so that the original 76 | author's reputation will not be affected by problems that might be 77 | introduced by others. 78 | 79 | Finally, software patents pose a constant threat to the existence of 80 | any free program. We wish to make sure that a company cannot 81 | effectively restrict the users of a free program by obtaining a 82 | restrictive license from a patent holder. Therefore, we insist that 83 | any patent license obtained for a version of the library must be 84 | consistent with the full freedom of use specified in this license. 85 | 86 | Most GNU software, including some libraries, is covered by the 87 | ordinary GNU General Public License. This license, the GNU Lesser 88 | General Public License, applies to certain designated libraries, and 89 | is quite different from the ordinary General Public License. We use 90 | this license for certain libraries in order to permit linking those 91 | libraries into non-free programs. 92 | 93 | When a program is linked with a library, whether statically or using 94 | a shared library, the combination of the two is legally speaking a 95 | combined work, a derivative of the original library. The ordinary 96 | General Public License therefore permits such linking only if the 97 | entire combination fits its criteria of freedom. The Lesser General 98 | Public License permits more lax criteria for linking other code with 99 | the library. 100 | 101 | We call this license the "Lesser" General Public License because it 102 | does Less to protect the user's freedom than the ordinary General 103 | Public License. It also provides other free software developers Less 104 | of an advantage over competing non-free programs. These disadvantages 105 | are the reason we use the ordinary General Public License for many 106 | libraries. However, the Lesser license provides advantages in certain 107 | special circumstances. 108 | 109 | For example, on rare occasions, there may be a special need to 110 | encourage the widest possible use of a certain library, so that it 111 | becomes a de-facto standard. To achieve this, non-free programs must 112 | be allowed to use the library. A more frequent case is that a free 113 | library does the same job as widely used non-free libraries. In this 114 | case, there is little to gain by limiting the free library to free 115 | software only, so we use the Lesser General Public License. 116 | 117 | In other cases, permission to use a particular library in non-free 118 | programs enables a greater number of people to use a large body of 119 | free software. For example, permission to use the GNU C Library in 120 | non-free programs enables many more people to use the whole GNU 121 | operating system, as well as its variant, the GNU/Linux operating 122 | system. 123 | 124 | Although the Lesser General Public License is Less protective of the 125 | users' freedom, it does ensure that the user of a program that is 126 | linked with the Library has the freedom and the wherewithal to run 127 | that program using a modified version of the Library. 128 | 129 | The precise terms and conditions for copying, distribution and 130 | modification follow. Pay close attention to the difference between a 131 | "work based on the library" and a "work that uses the library". The 132 | former contains code derived from the library, whereas the latter must 133 | be combined with the library in order to run. 134 | 135 | GNU LESSER GENERAL PUBLIC LICENSE 136 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 137 | 138 | 0. This License Agreement applies to any software library or other 139 | program which contains a notice placed by the copyright holder or 140 | other authorized party saying it may be distributed under the terms of 141 | this Lesser General Public License (also called "this License"). 142 | Each licensee is addressed as "you". 143 | 144 | A "library" means a collection of software functions and/or data 145 | prepared so as to be conveniently linked with application programs 146 | (which use some of those functions and data) to form executables. 147 | 148 | The "Library", below, refers to any such software library or work 149 | which has been distributed under these terms. A "work based on the 150 | Library" means either the Library or any derivative work under 151 | copyright law: that is to say, a work containing the Library or a 152 | portion of it, either verbatim or with modifications and/or translated 153 | straightforwardly into another language. (Hereinafter, translation is 154 | included without limitation in the term "modification".) 155 | 156 | "Source code" for a work means the preferred form of the work for 157 | making modifications to it. For a library, complete source code means 158 | all the source code for all modules it contains, plus any associated 159 | interface definition files, plus the scripts used to control 160 | compilation and installation of the library. 161 | 162 | Activities other than copying, distribution and modification are not 163 | covered by this License; they are outside its scope. The act of 164 | running a program using the Library is not restricted, and output from 165 | such a program is covered only if its contents constitute a work based 166 | on the Library (independent of the use of the Library in a tool for 167 | writing it). Whether that is true depends on what the Library does 168 | and what the program that uses the Library does. 169 | 170 | 1. You may copy and distribute verbatim copies of the Library's 171 | complete source code as you receive it, in any medium, provided that 172 | you conspicuously and appropriately publish on each copy an 173 | appropriate copyright notice and disclaimer of warranty; keep intact 174 | all the notices that refer to this License and to the absence of any 175 | warranty; and distribute a copy of this License along with the 176 | Library. 177 | 178 | You may charge a fee for the physical act of transferring a copy, 179 | and you may at your option offer warranty protection in exchange for a 180 | fee. 181 | 182 | 2. You may modify your copy or copies of the Library or any portion 183 | of it, thus forming a work based on the Library, and copy and 184 | distribute such modifications or work under the terms of Section 1 185 | above, provided that you also meet all of these conditions: 186 | 187 | a) The modified work must itself be a software library. 188 | 189 | b) You must cause the files modified to carry prominent notices 190 | stating that you changed the files and the date of any change. 191 | 192 | c) You must cause the whole of the work to be licensed at no 193 | charge to all third parties under the terms of this License. 194 | 195 | d) If a facility in the modified Library refers to a function or a 196 | table of data to be supplied by an application program that uses 197 | the facility, other than as an argument passed when the facility 198 | is invoked, then you must make a good faith effort to ensure that, 199 | in the event an application does not supply such function or 200 | table, the facility still operates, and performs whatever part of 201 | its purpose remains meaningful. 202 | 203 | (For example, a function in a library to compute square roots has 204 | a purpose that is entirely well-defined independent of the 205 | application. Therefore, Subsection 2d requires that any 206 | application-supplied function or table used by this function must 207 | be optional: if the application does not supply it, the square 208 | root function must still compute square roots.) 209 | 210 | These requirements apply to the modified work as a whole. If 211 | identifiable sections of that work are not derived from the Library, 212 | and can be reasonably considered independent and separate works in 213 | themselves, then this License, and its terms, do not apply to those 214 | sections when you distribute them as separate works. But when you 215 | distribute the same sections as part of a whole which is a work based 216 | on the Library, the distribution of the whole must be on the terms of 217 | this License, whose permissions for other licensees extend to the 218 | entire whole, and thus to each and every part regardless of who wrote 219 | it. 220 | 221 | Thus, it is not the intent of this section to claim rights or contest 222 | your rights to work written entirely by you; rather, the intent is to 223 | exercise the right to control the distribution of derivative or 224 | collective works based on the Library. 225 | 226 | In addition, mere aggregation of another work not based on the Library 227 | with the Library (or with a work based on the Library) on a volume of 228 | a storage or distribution medium does not bring the other work under 229 | the scope of this License. 230 | 231 | 3. You may opt to apply the terms of the ordinary GNU General Public 232 | License instead of this License to a given copy of the Library. To do 233 | this, you must alter all the notices that refer to this License, so 234 | that they refer to the ordinary GNU General Public License, version 2, 235 | instead of to this License. (If a newer version than version 2 of the 236 | ordinary GNU General Public License has appeared, then you can specify 237 | that version instead if you wish.) Do not make any other change in 238 | these notices. 239 | 240 | Once this change is made in a given copy, it is irreversible for 241 | that copy, so the ordinary GNU General Public License applies to all 242 | subsequent copies and derivative works made from that copy. 243 | 244 | This option is useful when you wish to copy part of the code of 245 | the Library into a program that is not a library. 246 | 247 | 4. You may copy and distribute the Library (or a portion or 248 | derivative of it, under Section 2) in object code or executable form 249 | under the terms of Sections 1 and 2 above provided that you accompany 250 | it with the complete corresponding machine-readable source code, which 251 | must be distributed under the terms of Sections 1 and 2 above on a 252 | medium customarily used for software interchange. 253 | 254 | If distribution of object code is made by offering access to copy 255 | from a designated place, then offering equivalent access to copy the 256 | source code from the same place satisfies the requirement to 257 | distribute the source code, even though third parties are not 258 | compelled to copy the source along with the object code. 259 | 260 | 5. A program that contains no derivative of any portion of the 261 | Library, but is designed to work with the Library by being compiled or 262 | linked with it, is called a "work that uses the Library". Such a 263 | work, in isolation, is not a derivative work of the Library, and 264 | therefore falls outside the scope of this License. 265 | 266 | However, linking a "work that uses the Library" with the Library 267 | creates an executable that is a derivative of the Library (because it 268 | contains portions of the Library), rather than a "work that uses the 269 | library". The executable is therefore covered by this License. 270 | Section 6 states terms for distribution of such executables. 271 | 272 | When a "work that uses the Library" uses material from a header file 273 | that is part of the Library, the object code for the work may be a 274 | derivative work of the Library even though the source code is not. 275 | Whether this is true is especially significant if the work can be 276 | linked without the Library, or if the work is itself a library. The 277 | threshold for this to be true is not precisely defined by law. 278 | 279 | If such an object file uses only numerical parameters, data 280 | structure layouts and accessors, and small macros and small inline 281 | functions (ten lines or less in length), then the use of the object 282 | file is unrestricted, regardless of whether it is legally a derivative 283 | work. (Executables containing this object code plus portions of the 284 | Library will still fall under Section 6.) 285 | 286 | Otherwise, if the work is a derivative of the Library, you may 287 | distribute the object code for the work under the terms of Section 6. 288 | Any executables containing that work also fall under Section 6, 289 | whether or not they are linked directly with the Library itself. 290 | 291 | 6. As an exception to the Sections above, you may also combine or 292 | link a "work that uses the Library" with the Library to produce a 293 | work containing portions of the Library, and distribute that work 294 | under terms of your choice, provided that the terms permit 295 | modification of the work for the customer's own use and reverse 296 | engineering for debugging such modifications. 297 | 298 | You must give prominent notice with each copy of the work that the 299 | Library is used in it and that the Library and its use are covered by 300 | this License. You must supply a copy of this License. If the work 301 | during execution displays copyright notices, you must include the 302 | copyright notice for the Library among them, as well as a reference 303 | directing the user to the copy of this License. Also, you must do one 304 | of these things: 305 | 306 | a) Accompany the work with the complete corresponding 307 | machine-readable source code for the Library including whatever 308 | changes were used in the work (which must be distributed under 309 | Sections 1 and 2 above); and, if the work is an executable linked 310 | with the Library, with the complete machine-readable "work that 311 | uses the Library", as object code and/or source code, so that the 312 | user can modify the Library and then relink to produce a modified 313 | executable containing the modified Library. (It is understood 314 | that the user who changes the contents of definitions files in the 315 | Library will not necessarily be able to recompile the application 316 | to use the modified definitions.) 317 | 318 | b) Use a suitable shared library mechanism for linking with the 319 | Library. A suitable mechanism is one that (1) uses at run time a 320 | copy of the library already present on the user's computer system, 321 | rather than copying library functions into the executable, and (2) 322 | will operate properly with a modified version of the library, if 323 | the user installs one, as long as the modified version is 324 | interface-compatible with the version that the work was made with. 325 | 326 | c) Accompany the work with a written offer, valid for at least 327 | three years, to give the same user the materials specified in 328 | Subsection 6a, above, for a charge no more than the cost of 329 | performing this distribution. 330 | 331 | d) If distribution of the work is made by offering access to copy 332 | from a designated place, offer equivalent access to copy the above 333 | specified materials from the same place. 334 | 335 | e) Verify that the user has already received a copy of these 336 | materials or that you have already sent this user a copy. 337 | 338 | For an executable, the required form of the "work that uses the 339 | Library" must include any data and utility programs needed for 340 | reproducing the executable from it. However, as a special exception, 341 | the materials to be distributed need not include anything that is 342 | normally distributed (in either source or binary form) with the major 343 | components (compiler, kernel, and so on) of the operating system on 344 | which the executable runs, unless that component itself accompanies 345 | the executable. 346 | 347 | It may happen that this requirement contradicts the license 348 | restrictions of other proprietary libraries that do not normally 349 | accompany the operating system. Such a contradiction means you cannot 350 | use both them and the Library together in an executable that you 351 | distribute. 352 | 353 | 7. You may place library facilities that are a work based on the 354 | Library side-by-side in a single library together with other library 355 | facilities not covered by this License, and distribute such a combined 356 | library, provided that the separate distribution of the work based on 357 | the Library and of the other library facilities is otherwise 358 | permitted, and provided that you do these two things: 359 | 360 | a) Accompany the combined library with a copy of the same work 361 | based on the Library, uncombined with any other library 362 | facilities. This must be distributed under the terms of the 363 | Sections above. 364 | 365 | b) Give prominent notice with the combined library of the fact 366 | that part of it is a work based on the Library, and explaining 367 | where to find the accompanying uncombined form of the same work. 368 | 369 | 8. You may not copy, modify, sublicense, link with, or distribute 370 | the Library except as expressly provided under this License. Any 371 | attempt otherwise to copy, modify, sublicense, link with, or 372 | distribute the Library is void, and will automatically terminate your 373 | rights under this License. However, parties who have received copies, 374 | or rights, from you under this License will not have their licenses 375 | terminated so long as such parties remain in full compliance. 376 | 377 | 9. You are not required to accept this License, since you have not 378 | signed it. However, nothing else grants you permission to modify or 379 | distribute the Library or its derivative works. These actions are 380 | prohibited by law if you do not accept this License. Therefore, by 381 | modifying or distributing the Library (or any work based on the 382 | Library), you indicate your acceptance of this License to do so, and 383 | all its terms and conditions for copying, distributing or modifying 384 | the Library or works based on it. 385 | 386 | 10. Each time you redistribute the Library (or any work based on the 387 | Library), the recipient automatically receives a license from the 388 | original licensor to copy, distribute, link with or modify the Library 389 | subject to these terms and conditions. You may not impose any further 390 | restrictions on the recipients' exercise of the rights granted herein. 391 | You are not responsible for enforcing compliance by third parties with 392 | this License. 393 | 394 | 11. If, as a consequence of a court judgment or allegation of patent 395 | infringement or for any other reason (not limited to patent issues), 396 | conditions are imposed on you (whether by court order, agreement or 397 | otherwise) that contradict the conditions of this License, they do not 398 | excuse you from the conditions of this License. If you cannot 399 | distribute so as to satisfy simultaneously your obligations under this 400 | License and any other pertinent obligations, then as a consequence you 401 | may not distribute the Library at all. For example, if a patent 402 | license would not permit royalty-free redistribution of the Library by 403 | all those who receive copies directly or indirectly through you, then 404 | the only way you could satisfy both it and this License would be to 405 | refrain entirely from distribution of the Library. 406 | 407 | If any portion of this section is held invalid or unenforceable under 408 | any particular circumstance, the balance of the section is intended to 409 | apply, and the section as a whole is intended to apply in other 410 | circumstances. 411 | 412 | It is not the purpose of this section to induce you to infringe any 413 | patents or other property right claims or to contest validity of any 414 | such claims; this section has the sole purpose of protecting the 415 | integrity of the free software distribution system which is 416 | implemented by public license practices. Many people have made 417 | generous contributions to the wide range of software distributed 418 | through that system in reliance on consistent application of that 419 | system; it is up to the author/donor to decide if he or she is willing 420 | to distribute software through any other system and a licensee cannot 421 | impose that choice. 422 | 423 | This section is intended to make thoroughly clear what is believed to 424 | be a consequence of the rest of this License. 425 | 426 | 12. If the distribution and/or use of the Library is restricted in 427 | certain countries either by patents or by copyrighted interfaces, the 428 | original copyright holder who places the Library under this License 429 | may add an explicit geographical distribution limitation excluding those 430 | countries, so that distribution is permitted only in or among 431 | countries not thus excluded. In such case, this License incorporates 432 | the limitation as if written in the body of this License. 433 | 434 | 13. The Free Software Foundation may publish revised and/or new 435 | versions of the Lesser General Public License from time to time. 436 | Such new versions will be similar in spirit to the present version, 437 | but may differ in detail to address new problems or concerns. 438 | 439 | Each version is given a distinguishing version number. If the Library 440 | specifies a version number of this License which applies to it and 441 | "any later version", you have the option of following the terms and 442 | conditions either of that version or of any later version published by 443 | the Free Software Foundation. If the Library does not specify a 444 | license version number, you may choose any version ever published by 445 | the Free Software Foundation. 446 | 447 | 14. If you wish to incorporate parts of the Library into other free 448 | programs whose distribution conditions are incompatible with these, 449 | write to the author to ask for permission. For software which is 450 | copyrighted by the Free Software Foundation, write to the Free 451 | Software Foundation; we sometimes make exceptions for this. Our 452 | decision will be guided by the two goals of preserving the free status 453 | of all derivatives of our free software and of promoting the sharing 454 | and reuse of software generally. 455 | 456 | NO WARRANTY 457 | 458 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 459 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 460 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 461 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 462 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 463 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 464 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 465 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 466 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 467 | 468 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 469 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 470 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 471 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 472 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 473 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 474 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 475 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 476 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 477 | DAMAGES. 478 | 479 | END OF TERMS AND CONDITIONS 480 | 481 | How to Apply These Terms to Your New Libraries 482 | 483 | If you develop a new library, and you want it to be of the greatest 484 | possible use to the public, we recommend making it free software that 485 | everyone can redistribute and change. You can do so by permitting 486 | redistribution under these terms (or, alternatively, under the terms 487 | of the ordinary General Public License). 488 | 489 | To apply these terms, attach the following notices to the library. 490 | It is safest to attach them to the start of each source file to most 491 | effectively convey the exclusion of warranty; and each file should 492 | have at least the "copyright" line and a pointer to where the full 493 | notice is found. 494 | 495 | 496 | 497 | Copyright (C) 498 | 499 | This library is free software; you can redistribute it and/or 500 | modify it under the terms of the GNU Lesser General Public 501 | License as published by the Free Software Foundation; either 502 | version 2.1 of the License, or (at your option) any later version. 503 | 504 | This library is distributed in the hope that it will be useful, 505 | but WITHOUT ANY WARRANTY; without even the implied warranty of 506 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 507 | Lesser General Public License for more details. 508 | 509 | You should have received a copy of the GNU Lesser General Public 510 | License along with this library; if not, write to the Free Software 511 | Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 512 | 513 | Also add information on how to contact you by electronic and paper mail. 514 | 515 | You should also get your employer (if you work as a programmer) or 516 | your school, if any, to sign a "copyright disclaimer" for the library, 517 | if necessary. Here is a sample; alter the names: 518 | 519 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 520 | library `Frob' (a library for tweaking knobs) written by James 521 | Random Hacker. 522 | 523 | , 1 April 1990 524 | Ty Coon, President of Vice 525 | 526 | That's all there is to it! 527 | --------------------------------------------------------------------------------