src/HOL/Tools/sat_solver.ML
changeset 20463 062c4e9bf3bb
parent 20441 a9034285b96b
child 21267 5294ecae6708
equal deleted inserted replaced
20462:0cb88ed29776 20463:062c4e9bf3bb
   762 				case Int.fromString s of
   762 				case Int.fromString s of
   763 				  SOME i => i
   763 				  SOME i => i
   764 				| NONE   => raise INVALID_PROOF ("File format error: number expected (" ^ quote s ^ " encountered).")
   764 				| NONE   => raise INVALID_PROOF ("File format error: number expected (" ^ quote s ^ " encountered).")
   765 			)
   765 			)
   766 			(* parse the "resolve_trace" file *)
   766 			(* parse the "resolve_trace" file *)
   767 			(* int ref *)
       
   768 			val clause_offset = ref ~1
   767 			val clause_offset = ref ~1
   769 			(* string list -> proof -> proof *)
   768 			val clause_table  = ref (Inttab.empty : int list Inttab.table)
   770 			fun process_tokens [] proof =
   769 			val empty_id      = ref ~1
   771 				proof
   770 			(* string list -> unit *)
   772 			  | process_tokens (tok::toks) (clause_table, empty_id) =
   771 			fun process_tokens [] =
       
   772 				()
       
   773 			  | process_tokens (tok::toks) =
   773 				if tok="CL:" then (
   774 				if tok="CL:" then (
   774 					case toks of
   775 					case toks of
   775 					  id::sep::ids =>
   776 					  id::sep::ids =>
   776 						let
   777 						let
   777 							val _   = if !clause_offset = ~1 then () else raise INVALID_PROOF ("File format error: \"CL:\" disallowed after \"VAR:\".")
   778 							val _   = if !clause_offset = ~1 then () else raise INVALID_PROOF ("File format error: \"CL:\" disallowed after \"VAR:\".")
   778 							val _   = if empty_id = ~1 then () else raise INVALID_PROOF ("File format error: \"CL:\" disallowed after \"CONF:\".")
   779 							val _   = if !empty_id = ~1 then () else raise INVALID_PROOF ("File format error: \"CL:\" disallowed after \"CONF:\".")
   779 							val cid = int_from_string id
   780 							val cid = int_from_string id
   780 							val _   = if sep = "<=" then () else raise INVALID_PROOF ("File format error: \"<=\" expected (" ^ quote sep ^ " encountered).")
   781 							val _   = if sep = "<=" then () else raise INVALID_PROOF ("File format error: \"<=\" expected (" ^ quote sep ^ " encountered).")
   781 							val rs  = map int_from_string ids
   782 							val rs  = map int_from_string ids
   782 						in
   783 						in
   783 							(* update clause table *)
   784 							(* update clause table *)
   784 							(Inttab.update_new (cid, rs) clause_table, empty_id)
   785 							clause_table := Inttab.update_new (cid, rs) (!clause_table)
   785 								handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ id ^ " defined more than once.")
   786 								handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ id ^ " defined more than once.")
   786 						end
   787 						end
   787 					| _ =>
   788 					| _ =>
   788 						raise INVALID_PROOF "File format error: \"CL:\" followed by an insufficient number of tokens."
   789 						raise INVALID_PROOF "File format error: \"CL:\" followed by an insufficient number of tokens."
   789 				) else if tok="VAR:" then (
   790 				) else if tok="VAR:" then (
   790 					case toks of
   791 					case toks of
   791 					  id::levsep::levid::valsep::valid::antesep::anteid::litsep::lits =>
   792 					  id::levsep::levid::valsep::valid::antesep::anteid::litsep::lits =>
   792 						let
   793 						let
   793 							val _   = if empty_id = ~1 then () else raise INVALID_PROOF ("File format error: \"VAR:\" disallowed after \"CONF:\".")
   794 							val _   = if !empty_id = ~1 then () else raise INVALID_PROOF ("File format error: \"VAR:\" disallowed after \"CONF:\".")
   794 							(* set 'clause_offset' to the largest used clause ID *)
   795 							(* set 'clause_offset' to the largest used clause ID *)
   795 							val _   = if !clause_offset = ~1 then clause_offset :=
   796 							val _   = if !clause_offset = ~1 then clause_offset :=
   796 								(case Inttab.max_key clause_table of
   797 								(case Inttab.max_key (!clause_table) of
   797 								  SOME id => id
   798 								  SOME id => id
   798 								| NONE    => cnf_number_of_clauses (PropLogic.defcnf fm) - 1  (* the first clause ID is 0, not 1 *))
   799 								| NONE    => cnf_number_of_clauses (PropLogic.defcnf fm) - 1  (* the first clause ID is 0, not 1 *))
   799 								else
   800 								else
   800 									()
   801 									()
   801 							val vid = int_from_string id
   802 							val vid = int_from_string id
   817 							(* we add '!clause_offset' to obtain the ID of the corresponding unit clause  *)
   818 							(* we add '!clause_offset' to obtain the ID of the corresponding unit clause  *)
   818 							val vids = filter (not_equal vid) (map (fn l => l div 2) ls)
   819 							val vids = filter (not_equal vid) (map (fn l => l div 2) ls)
   819 							val rs   = aid :: map (fn v => !clause_offset + v) vids
   820 							val rs   = aid :: map (fn v => !clause_offset + v) vids
   820 						in
   821 						in
   821 							(* update clause table *)
   822 							(* update clause table *)
   822 							(Inttab.update_new (cid, rs) clause_table, empty_id)
   823 							clause_table := Inttab.update_new (cid, rs) (!clause_table)
   823 								handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ string_of_int cid ^ " (derived from antecedent for variable " ^ id ^ ") already defined.")
   824 								handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ string_of_int cid ^ " (derived from antecedent for variable " ^ id ^ ") already defined.")
   824 						end
   825 						end
   825 					| _ =>
   826 					| _ =>
   826 						raise INVALID_PROOF "File format error: \"VAR:\" followed by an insufficient number of tokens."
   827 						raise INVALID_PROOF "File format error: \"VAR:\" followed by an insufficient number of tokens."
   827 				) else if tok="CONF:" then (
   828 				) else if tok="CONF:" then (
   828 					case toks of
   829 					case toks of
   829 					  id::sep::ids =>
   830 					  id::sep::ids =>
   830 						let
   831 						let
   831 							val _   = if empty_id = ~1 then () else raise INVALID_PROOF "File format error: more than one conflicting clause specified."
   832 							val _   = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: more than one conflicting clause specified."
   832 							val cid = int_from_string id
   833 							val cid = int_from_string id
   833 							val _   = if sep = "==" then () else raise INVALID_PROOF ("File format error: \"==\" expected (" ^ quote sep ^ " encountered).")
   834 							val _   = if sep = "==" then () else raise INVALID_PROOF ("File format error: \"==\" expected (" ^ quote sep ^ " encountered).")
   834 							val ls  = map int_from_string ids
   835 							val ls  = map int_from_string ids
   835 							(* the conflict clause must be resolved with the unit clauses *)
   836 							(* the conflict clause must be resolved with the unit clauses *)
   836 							(* for its literals to obtain the empty clause                *)
   837 							(* for its literals to obtain the empty clause                *)
   837 							val vids         = map (fn l => l div 2) ls
   838 							val vids         = map (fn l => l div 2) ls
   838 							val rs           = cid :: map (fn v => !clause_offset + v) vids
   839 							val rs           = cid :: map (fn v => !clause_offset + v) vids
   839 							val new_empty_id = getOpt (Inttab.max_key clause_table, !clause_offset) + 1
   840 							val new_empty_id = getOpt (Inttab.max_key (!clause_table), !clause_offset) + 1
   840 						in
   841 						in
   841 							(* update clause table and conflict id *)
   842 							(* update clause table and conflict id *)
   842 							(Inttab.update_new (new_empty_id, rs) clause_table, new_empty_id)
   843 							clause_table := Inttab.update_new (new_empty_id, rs) (!clause_table)
   843 								handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ string_of_int new_empty_id ^ " (empty clause derived from clause " ^ id ^ ") already defined.")
   844 								handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ string_of_int new_empty_id ^ " (empty clause derived from clause " ^ id ^ ") already defined.");
       
   845 							empty_id     := new_empty_id
   844 						end
   846 						end
   845 					| _ =>
   847 					| _ =>
   846 						raise INVALID_PROOF "File format error: \"CONF:\" followed by an insufficient number of tokens."
   848 						raise INVALID_PROOF "File format error: \"CONF:\" followed by an insufficient number of tokens."
   847 				) else
   849 				) else
   848 					raise INVALID_PROOF ("File format error: unknown token " ^ quote tok ^ " encountered.")
   850 					raise INVALID_PROOF ("File format error: unknown token " ^ quote tok ^ " encountered.")
   849 			(* string list -> proof -> proof *)
   851 			(* string list -> unit *)
   850 			fun process_lines [] proof =
   852 			fun process_lines [] =
   851 				proof
   853 				()
   852 			  | process_lines (l::ls) proof =
   854 			  | process_lines (l::ls) = (
   853 				process_lines ls (process_tokens (String.tokens (fn c => c = #" " orelse c = #"\t") l) proof)
   855 					process_tokens (String.tokens (fn c => c = #" " orelse c = #"\t") l);
       
   856 					process_lines ls
       
   857 				)
   854 			(* proof *)
   858 			(* proof *)
   855 			val (clause_table, empty_id) = process_lines proof_lines (Inttab.empty, ~1)
   859 			val _ = process_lines proof_lines
   856 			val _                        = if empty_id <> ~1 then () else raise INVALID_PROOF "File format error: no conflicting clause specified."
   860 			val _ = if !empty_id <> ~1 then () else raise INVALID_PROOF "File format error: no conflicting clause specified."
   857 		in
   861 		in
   858 			SatSolver.UNSATISFIABLE (SOME (clause_table, empty_id))
   862 			SatSolver.UNSATISFIABLE (SOME (!clause_table, !empty_id))
   859 		end handle INVALID_PROOF reason => (warning reason; SatSolver.UNSATISFIABLE NONE))
   863 		end handle INVALID_PROOF reason => (warning reason; SatSolver.UNSATISFIABLE NONE))
   860 	| result =>
   864 	| result =>
   861 		result
   865 		result
   862 in
   866 in
   863 	SatSolver.add_solver ("zchaff_with_proofs", zchaff_with_proofs)
   867 	SatSolver.add_solver ("zchaff_with_proofs", zchaff_with_proofs)