removed assert/deny (avoid clash with Alice keywords and confusion due to strict evaluation);
authorwenzelm
Tue Apr 03 19:24:11 2007 +0200 (2007-04-03)
changeset 225671565d476a9e2
parent 22566 535ae9dd4c45
child 22568 ed7aa5a350ef
removed assert/deny (avoid clash with Alice keywords and confusion due to strict evaluation);
src/HOL/Library/sct.ML
src/HOL/Tools/function_package/mutual.ML
src/HOL/Tools/refute.ML
src/HOL/Tools/sat_solver.ML
src/Pure/General/secure.ML
src/Pure/library.ML
src/ZF/Tools/inductive_package.ML
src/ZF/ind_syntax.ML
     1.1 --- a/src/HOL/Library/sct.ML	Tue Apr 03 19:24:10 2007 +0200
     1.2 +++ b/src/HOL/Library/sct.ML	Tue Apr 03 19:24:11 2007 +0200
     1.3 @@ -101,7 +101,7 @@
     1.4      end
     1.5    | dest_all_ex t = ([],t)
     1.6  
     1.7 -fun dist_vars [] vs = (assert (null vs) "dist_vars"; [])
     1.8 +fun dist_vars [] vs = (null vs orelse error "dist_vars"; [])
     1.9    | dist_vars (T::Ts) vs = 
    1.10      case find_index (fn v => fastype_of v = T) vs of
    1.11        ~1 => Free ("", T) :: dist_vars Ts vs
     2.1 --- a/src/HOL/Tools/function_package/mutual.ML	Tue Apr 03 19:24:10 2007 +0200
     2.2 +++ b/src/HOL/Tools/function_package/mutual.ML	Tue Apr 03 19:24:11 2007 +0200
     2.3 @@ -93,24 +93,24 @@
     2.4        val fname = fst (dest_Free head)
     2.5            handle TERM _ => error (input_error invalid_head_msg)
     2.6  
     2.7 -      val _ = assert (fname mem fnames) (input_error invalid_head_msg)
     2.8 +      val _ = fname mem fnames orelse error (input_error invalid_head_msg)
     2.9  
    2.10        fun add_bvs t is = add_loose_bnos (t, 0, is)
    2.11        val rvs = (add_bvs rhs [] \\ fold add_bvs args [])
    2.12                    |> map (fst o nth (rev qs))
    2.13                  
    2.14 -      val _ = assert (null rvs) (input_error ("Variable" ^ plural " " "s " rvs ^ commas_quote rvs
    2.15 +      val _ = null rvs orelse error (input_error ("Variable" ^ plural " " "s " rvs ^ commas_quote rvs
    2.16                                                ^ " occur" ^ plural "s" "" rvs ^ " on right hand side only:"))
    2.17  
    2.18 -      val _ = assert (forall (forall_aterms (fn Free (n, _) => not (n mem fnames) | _ => true)) gs)
    2.19 -                     (input_error "Recursive Calls not allowed in premises")
    2.20 +      val _ = forall (forall_aterms (fn Free (n, _) => not (n mem fnames) | _ => true)) gs orelse
    2.21 +                     error (input_error "Recursive Calls not allowed in premises")
    2.22  
    2.23        val k = length args
    2.24  
    2.25        val arities' = case Symtab.lookup arities fname of
    2.26                         NONE => Symtab.update (fname, k) arities
    2.27 -                     | SOME i => (assert (i = k)
    2.28 -                                  (input_error ("Function " ^ quote fname ^ " has different numbers of arguments in different equations"));
    2.29 +                     | SOME i => (i = k orelse
    2.30 +                                  error (input_error ("Function " ^ quote fname ^ " has different numbers of arguments in different equations"));
    2.31                                    arities)
    2.32      in
    2.33        ((fname, qs, gs, args, rhs), arities')
     3.1 --- a/src/HOL/Tools/refute.ML	Tue Apr 03 19:24:10 2007 +0200
     3.2 +++ b/src/HOL/Tools/refute.ML	Tue Apr 03 19:24:11 2007 +0200
     3.3 @@ -14,67 +14,67 @@
     3.4  signature REFUTE =
     3.5  sig
     3.6  
     3.7 -	exception REFUTE of string * string
     3.8 +  exception REFUTE of string * string
     3.9  
    3.10  (* ------------------------------------------------------------------------- *)
    3.11  (* Model/interpretation related code (translation HOL -> propositional logic *)
    3.12  (* ------------------------------------------------------------------------- *)
    3.13  
    3.14 -	type params
    3.15 -	type interpretation
    3.16 -	type model
    3.17 -	type arguments
    3.18 +  type params
    3.19 +  type interpretation
    3.20 +  type model
    3.21 +  type arguments
    3.22  
    3.23 -	exception MAXVARS_EXCEEDED
    3.24 +  exception MAXVARS_EXCEEDED
    3.25  
    3.26 -	val add_interpreter : string -> (theory -> model -> arguments -> Term.term ->
    3.27 -		(interpretation * model * arguments) option) -> theory -> theory
    3.28 -	val add_printer     : string -> (theory -> model -> Term.term ->
    3.29 -		interpretation -> (int -> bool) -> Term.term option) -> theory -> theory
    3.30 +  val add_interpreter : string -> (theory -> model -> arguments -> Term.term ->
    3.31 +    (interpretation * model * arguments) option) -> theory -> theory
    3.32 +  val add_printer     : string -> (theory -> model -> Term.term ->
    3.33 +    interpretation -> (int -> bool) -> Term.term option) -> theory -> theory
    3.34  
    3.35 -	val interpret : theory -> model -> arguments -> Term.term ->
    3.36 -		(interpretation * model * arguments)
    3.37 +  val interpret : theory -> model -> arguments -> Term.term ->
    3.38 +    (interpretation * model * arguments)
    3.39  
    3.40 -	val print       : theory -> model -> Term.term -> interpretation ->
    3.41 -		(int -> bool) -> Term.term
    3.42 -	val print_model : theory -> model -> (int -> bool) -> string
    3.43 +  val print       : theory -> model -> Term.term -> interpretation ->
    3.44 +    (int -> bool) -> Term.term
    3.45 +  val print_model : theory -> model -> (int -> bool) -> string
    3.46  
    3.47  (* ------------------------------------------------------------------------- *)
    3.48  (* Interface                                                                 *)
    3.49  (* ------------------------------------------------------------------------- *)
    3.50  
    3.51 -	val set_default_param  : (string * string) -> theory -> theory
    3.52 -	val get_default_param  : theory -> string -> string option
    3.53 -	val get_default_params : theory -> (string * string) list
    3.54 -	val actual_params      : theory -> (string * string) list -> params
    3.55 +  val set_default_param  : (string * string) -> theory -> theory
    3.56 +  val get_default_param  : theory -> string -> string option
    3.57 +  val get_default_params : theory -> (string * string) list
    3.58 +  val actual_params      : theory -> (string * string) list -> params
    3.59  
    3.60 -	val find_model : theory -> params -> Term.term -> bool -> unit
    3.61 +  val find_model : theory -> params -> Term.term -> bool -> unit
    3.62  
    3.63 -	(* tries to find a model for a formula: *)
    3.64 -	val satisfy_term   : theory -> (string * string) list -> Term.term -> unit
    3.65 -	(* tries to find a model that refutes a formula: *)
    3.66 -	val refute_term    : theory -> (string * string) list -> Term.term -> unit
    3.67 -	val refute_subgoal :
    3.68 -		theory -> (string * string) list -> Thm.thm -> int -> unit
    3.69 +  (* tries to find a model for a formula: *)
    3.70 +  val satisfy_term   : theory -> (string * string) list -> Term.term -> unit
    3.71 +  (* tries to find a model that refutes a formula: *)
    3.72 +  val refute_term    : theory -> (string * string) list -> Term.term -> unit
    3.73 +  val refute_subgoal :
    3.74 +    theory -> (string * string) list -> Thm.thm -> int -> unit
    3.75  
    3.76 -	val setup : theory -> theory
    3.77 +  val setup : theory -> theory
    3.78  
    3.79  end;  (* signature REFUTE *)
    3.80  
    3.81  structure Refute : REFUTE =
    3.82  struct
    3.83  
    3.84 -	open PropLogic;
    3.85 +  open PropLogic;
    3.86  
    3.87 -	(* We use 'REFUTE' only for internal error conditions that should    *)
    3.88 -	(* never occur in the first place (i.e. errors caused by bugs in our *)
    3.89 -	(* code).  Otherwise (e.g. to indicate invalid input data) we use    *)
    3.90 -	(* 'error'.                                                          *)
    3.91 -	exception REFUTE of string * string;  (* ("in function", "cause") *)
    3.92 +  (* We use 'REFUTE' only for internal error conditions that should    *)
    3.93 +  (* never occur in the first place (i.e. errors caused by bugs in our *)
    3.94 +  (* code).  Otherwise (e.g. to indicate invalid input data) we use    *)
    3.95 +  (* 'error'.                                                          *)
    3.96 +  exception REFUTE of string * string;  (* ("in function", "cause") *)
    3.97  
    3.98 -	(* should be raised by an interpreter when more variables would be *)
    3.99 -	(* required than allowed by 'maxvars'                              *)
   3.100 -	exception MAXVARS_EXCEEDED;
   3.101 +  (* should be raised by an interpreter when more variables would be *)
   3.102 +  (* required than allowed by 'maxvars'                              *)
   3.103 +  exception MAXVARS_EXCEEDED;
   3.104  
   3.105  (* ------------------------------------------------------------------------- *)
   3.106  (* TREES                                                                     *)
   3.107 @@ -85,43 +85,43 @@
   3.108  (*       of (lists of ...) elements                                          *)
   3.109  (* ------------------------------------------------------------------------- *)
   3.110  
   3.111 -	datatype 'a tree =
   3.112 -		  Leaf of 'a
   3.113 -		| Node of ('a tree) list;
   3.114 +  datatype 'a tree =
   3.115 +      Leaf of 'a
   3.116 +    | Node of ('a tree) list;
   3.117  
   3.118 -	(* ('a -> 'b) -> 'a tree -> 'b tree *)
   3.119 +  (* ('a -> 'b) -> 'a tree -> 'b tree *)
   3.120  
   3.121 -	fun tree_map f tr =
   3.122 -		case tr of
   3.123 -		  Leaf x  => Leaf (f x)
   3.124 -		| Node xs => Node (map (tree_map f) xs);
   3.125 +  fun tree_map f tr =
   3.126 +    case tr of
   3.127 +      Leaf x  => Leaf (f x)
   3.128 +    | Node xs => Node (map (tree_map f) xs);
   3.129  
   3.130 -	(* ('a * 'b -> 'a) -> 'a * ('b tree) -> 'a *)
   3.131 +  (* ('a * 'b -> 'a) -> 'a * ('b tree) -> 'a *)
   3.132  
   3.133 -	fun tree_foldl f =
   3.134 -	let
   3.135 -		fun itl (e, Leaf x)  = f(e,x)
   3.136 -		  | itl (e, Node xs) = Library.foldl (tree_foldl f) (e,xs)
   3.137 -	in
   3.138 -		itl
   3.139 -	end;
   3.140 +  fun tree_foldl f =
   3.141 +  let
   3.142 +    fun itl (e, Leaf x)  = f(e,x)
   3.143 +      | itl (e, Node xs) = Library.foldl (tree_foldl f) (e,xs)
   3.144 +  in
   3.145 +    itl
   3.146 +  end;
   3.147  
   3.148 -	(* 'a tree * 'b tree -> ('a * 'b) tree *)
   3.149 +  (* 'a tree * 'b tree -> ('a * 'b) tree *)
   3.150  
   3.151 -	fun tree_pair (t1, t2) =
   3.152 -		case t1 of
   3.153 -		  Leaf x =>
   3.154 -			(case t2 of
   3.155 -				  Leaf y => Leaf (x,y)
   3.156 -				| Node _ => raise REFUTE ("tree_pair",
   3.157 -						"trees are of different height (second tree is higher)"))
   3.158 -		| Node xs =>
   3.159 -			(case t2 of
   3.160 -				  (* '~~' will raise an exception if the number of branches in   *)
   3.161 -				  (* both trees is different at the current node                 *)
   3.162 -				  Node ys => Node (map tree_pair (xs ~~ ys))
   3.163 -				| Leaf _  => raise REFUTE ("tree_pair",
   3.164 -						"trees are of different height (first tree is higher)"));
   3.165 +  fun tree_pair (t1, t2) =
   3.166 +    case t1 of
   3.167 +      Leaf x =>
   3.168 +      (case t2 of
   3.169 +          Leaf y => Leaf (x,y)
   3.170 +        | Node _ => raise REFUTE ("tree_pair",
   3.171 +            "trees are of different height (second tree is higher)"))
   3.172 +    | Node xs =>
   3.173 +      (case t2 of
   3.174 +          (* '~~' will raise an exception if the number of branches in   *)
   3.175 +          (* both trees is different at the current node                 *)
   3.176 +          Node ys => Node (map tree_pair (xs ~~ ys))
   3.177 +        | Leaf _  => raise REFUTE ("tree_pair",
   3.178 +            "trees are of different height (first tree is higher)"));
   3.179  
   3.180  (* ------------------------------------------------------------------------- *)
   3.181  (* params: parameters that control the translation into a propositional      *)
   3.182 @@ -143,76 +143,76 @@
   3.183  (* "satsolver"   string  SAT solver to be used.                              *)
   3.184  (* ------------------------------------------------------------------------- *)
   3.185  
   3.186 -	type params =
   3.187 -		{
   3.188 -			sizes    : (string * int) list,
   3.189 -			minsize  : int,
   3.190 -			maxsize  : int,
   3.191 -			maxvars  : int,
   3.192 -			maxtime  : int,
   3.193 -			satsolver: string
   3.194 -		};
   3.195 +  type params =
   3.196 +    {
   3.197 +      sizes    : (string * int) list,
   3.198 +      minsize  : int,
   3.199 +      maxsize  : int,
   3.200 +      maxvars  : int,
   3.201 +      maxtime  : int,
   3.202 +      satsolver: string
   3.203 +    };
   3.204  
   3.205  (* ------------------------------------------------------------------------- *)
   3.206  (* interpretation: a term's interpretation is given by a variable of type    *)
   3.207  (*                 'interpretation'                                          *)
   3.208  (* ------------------------------------------------------------------------- *)
   3.209  
   3.210 -	type interpretation =
   3.211 -		prop_formula list tree;
   3.212 +  type interpretation =
   3.213 +    prop_formula list tree;
   3.214  
   3.215  (* ------------------------------------------------------------------------- *)
   3.216  (* model: a model specifies the size of types and the interpretation of      *)
   3.217  (*        terms                                                              *)
   3.218  (* ------------------------------------------------------------------------- *)
   3.219  
   3.220 -	type model =
   3.221 -		(Term.typ * int) list * (Term.term * interpretation) list;
   3.222 +  type model =
   3.223 +    (Term.typ * int) list * (Term.term * interpretation) list;
   3.224  
   3.225  (* ------------------------------------------------------------------------- *)
   3.226  (* arguments: additional arguments required during interpretation of terms   *)
   3.227  (* ------------------------------------------------------------------------- *)
   3.228  
   3.229 -	type arguments =
   3.230 -		{
   3.231 -			(* just passed unchanged from 'params': *)
   3.232 -			maxvars   : int,
   3.233 -			(* whether to use 'make_equality' or 'make_def_equality': *)
   3.234 -			def_eq    : bool,
   3.235 -			(* the following may change during the translation: *)
   3.236 -			next_idx  : int,
   3.237 -			bounds    : interpretation list,
   3.238 -			wellformed: prop_formula
   3.239 -		};
   3.240 +  type arguments =
   3.241 +    {
   3.242 +      (* just passed unchanged from 'params': *)
   3.243 +      maxvars   : int,
   3.244 +      (* whether to use 'make_equality' or 'make_def_equality': *)
   3.245 +      def_eq    : bool,
   3.246 +      (* the following may change during the translation: *)
   3.247 +      next_idx  : int,
   3.248 +      bounds    : interpretation list,
   3.249 +      wellformed: prop_formula
   3.250 +    };
   3.251  
   3.252  
   3.253 -	structure RefuteDataArgs =
   3.254 -	struct
   3.255 -		val name = "HOL/refute";
   3.256 -		type T =
   3.257 -			{interpreters: (string * (theory -> model -> arguments -> Term.term ->
   3.258 -				(interpretation * model * arguments) option)) list,
   3.259 -			 printers: (string * (theory -> model -> Term.term -> interpretation ->
   3.260 -				(int -> bool) -> Term.term option)) list,
   3.261 -			 parameters: string Symtab.table};
   3.262 -		val empty = {interpreters = [], printers = [], parameters = Symtab.empty};
   3.263 -		val copy = I;
   3.264 -		val extend = I;
   3.265 -		fun merge _
   3.266 -			({interpreters = in1, printers = pr1, parameters = pa1},
   3.267 -			 {interpreters = in2, printers = pr2, parameters = pa2}) =
   3.268 -			{interpreters = AList.merge (op =) (K true) (in1, in2),
   3.269 -			 printers = AList.merge (op =) (K true) (pr1, pr2),
   3.270 -			 parameters = Symtab.merge (op=) (pa1, pa2)};
   3.271 -		fun print sg {interpreters, printers, parameters} =
   3.272 -			Pretty.writeln (Pretty.chunks
   3.273 -				[Pretty.strs ("default parameters:" :: List.concat (map
   3.274 -					(fn (name, value) => [name, "=", value]) (Symtab.dest parameters))),
   3.275 -				 Pretty.strs ("interpreters:" :: map fst interpreters),
   3.276 -				 Pretty.strs ("printers:" :: map fst printers)]);
   3.277 -	end;
   3.278 +  structure RefuteDataArgs =
   3.279 +  struct
   3.280 +    val name = "HOL/refute";
   3.281 +    type T =
   3.282 +      {interpreters: (string * (theory -> model -> arguments -> Term.term ->
   3.283 +        (interpretation * model * arguments) option)) list,
   3.284 +       printers: (string * (theory -> model -> Term.term -> interpretation ->
   3.285 +        (int -> bool) -> Term.term option)) list,
   3.286 +       parameters: string Symtab.table};
   3.287 +    val empty = {interpreters = [], printers = [], parameters = Symtab.empty};
   3.288 +    val copy = I;
   3.289 +    val extend = I;
   3.290 +    fun merge _
   3.291 +      ({interpreters = in1, printers = pr1, parameters = pa1},
   3.292 +       {interpreters = in2, printers = pr2, parameters = pa2}) =
   3.293 +      {interpreters = AList.merge (op =) (K true) (in1, in2),
   3.294 +       printers = AList.merge (op =) (K true) (pr1, pr2),
   3.295 +       parameters = Symtab.merge (op=) (pa1, pa2)};
   3.296 +    fun print sg {interpreters, printers, parameters} =
   3.297 +      Pretty.writeln (Pretty.chunks
   3.298 +        [Pretty.strs ("default parameters:" :: List.concat (map
   3.299 +          (fn (name, value) => [name, "=", value]) (Symtab.dest parameters))),
   3.300 +         Pretty.strs ("interpreters:" :: map fst interpreters),
   3.301 +         Pretty.strs ("printers:" :: map fst printers)]);
   3.302 +  end;
   3.303  
   3.304 -	structure RefuteData = TheoryDataFun(RefuteDataArgs);
   3.305 +  structure RefuteData = TheoryDataFun(RefuteDataArgs);
   3.306  
   3.307  
   3.308  (* ------------------------------------------------------------------------- *)
   3.309 @@ -221,30 +221,30 @@
   3.310  (*            track of the interpretation of subterms                        *)
   3.311  (* ------------------------------------------------------------------------- *)
   3.312  
   3.313 -	(* theory -> model -> arguments -> Term.term ->
   3.314 -		(interpretation * model * arguments) *)
   3.315 +  (* theory -> model -> arguments -> Term.term ->
   3.316 +    (interpretation * model * arguments) *)
   3.317  
   3.318 -	fun interpret thy model args t =
   3.319 -		case get_first (fn (_, f) => f thy model args t)
   3.320 -			(#interpreters (RefuteData.get thy)) of
   3.321 -		  NONE   => raise REFUTE ("interpret",
   3.322 -				"no interpreter for term " ^ quote (Sign.string_of_term thy t))
   3.323 -		| SOME x => x;
   3.324 +  fun interpret thy model args t =
   3.325 +    case get_first (fn (_, f) => f thy model args t)
   3.326 +      (#interpreters (RefuteData.get thy)) of
   3.327 +      NONE   => raise REFUTE ("interpret",
   3.328 +        "no interpreter for term " ^ quote (Sign.string_of_term thy t))
   3.329 +    | SOME x => x;
   3.330  
   3.331  (* ------------------------------------------------------------------------- *)
   3.332  (* print: converts the constant denoted by the term 't' into a term using a  *)
   3.333  (*        suitable printer                                                   *)
   3.334  (* ------------------------------------------------------------------------- *)
   3.335  
   3.336 -	(* theory -> model -> Term.term -> interpretation -> (int -> bool) ->
   3.337 -		Term.term *)
   3.338 +  (* theory -> model -> Term.term -> interpretation -> (int -> bool) ->
   3.339 +    Term.term *)
   3.340  
   3.341 -	fun print thy model t intr assignment =
   3.342 -		case get_first (fn (_, f) => f thy model t intr assignment)
   3.343 -			(#printers (RefuteData.get thy)) of
   3.344 -		  NONE   => raise REFUTE ("print",
   3.345 -				"no printer for term " ^ quote (Sign.string_of_term thy t))
   3.346 -		| SOME x => x;
   3.347 +  fun print thy model t intr assignment =
   3.348 +    case get_first (fn (_, f) => f thy model t intr assignment)
   3.349 +      (#printers (RefuteData.get thy)) of
   3.350 +      NONE   => raise REFUTE ("print",
   3.351 +        "no printer for term " ^ quote (Sign.string_of_term thy t))
   3.352 +    | SOME x => x;
   3.353  
   3.354  (* ------------------------------------------------------------------------- *)
   3.355  (* print_model: turns the model into a string, using a fixed interpretation  *)
   3.356 @@ -252,105 +252,105 @@
   3.357  (*              printers                                                     *)
   3.358  (* ------------------------------------------------------------------------- *)
   3.359  
   3.360 -	(* theory -> model -> (int -> bool) -> string *)
   3.361 +  (* theory -> model -> (int -> bool) -> string *)
   3.362  
   3.363 -	fun print_model thy model assignment =
   3.364 -	let
   3.365 -		val (typs, terms) = model
   3.366 -		val typs_msg =
   3.367 -			if null typs then
   3.368 -				"empty universe (no type variables in term)\n"
   3.369 -			else
   3.370 -				"Size of types: " ^ commas (map (fn (T, i) =>
   3.371 -					Sign.string_of_typ thy T ^ ": " ^ string_of_int i) typs) ^ "\n"
   3.372 -		val show_consts_msg =
   3.373 -			if not (!show_consts) andalso Library.exists (is_Const o fst) terms then
   3.374 -				"set \"show_consts\" to show the interpretation of constants\n"
   3.375 -			else
   3.376 -				""
   3.377 -		val terms_msg =
   3.378 -			if null terms then
   3.379 -				"empty interpretation (no free variables in term)\n"
   3.380 -			else
   3.381 -				space_implode "\n" (List.mapPartial (fn (t, intr) =>
   3.382 -					(* print constants only if 'show_consts' is true *)
   3.383 -					if (!show_consts) orelse not (is_Const t) then
   3.384 -						SOME (Sign.string_of_term thy t ^ ": " ^
   3.385 -							Sign.string_of_term thy (print thy model t intr assignment))
   3.386 -					else
   3.387 -						NONE) terms) ^ "\n"
   3.388 -	in
   3.389 -		typs_msg ^ show_consts_msg ^ terms_msg
   3.390 -	end;
   3.391 +  fun print_model thy model assignment =
   3.392 +  let
   3.393 +    val (typs, terms) = model
   3.394 +    val typs_msg =
   3.395 +      if null typs then
   3.396 +        "empty universe (no type variables in term)\n"
   3.397 +      else
   3.398 +        "Size of types: " ^ commas (map (fn (T, i) =>
   3.399 +          Sign.string_of_typ thy T ^ ": " ^ string_of_int i) typs) ^ "\n"
   3.400 +    val show_consts_msg =
   3.401 +      if not (!show_consts) andalso Library.exists (is_Const o fst) terms then
   3.402 +        "set \"show_consts\" to show the interpretation of constants\n"
   3.403 +      else
   3.404 +        ""
   3.405 +    val terms_msg =
   3.406 +      if null terms then
   3.407 +        "empty interpretation (no free variables in term)\n"
   3.408 +      else
   3.409 +        space_implode "\n" (List.mapPartial (fn (t, intr) =>
   3.410 +          (* print constants only if 'show_consts' is true *)
   3.411 +          if (!show_consts) orelse not (is_Const t) then
   3.412 +            SOME (Sign.string_of_term thy t ^ ": " ^
   3.413 +              Sign.string_of_term thy (print thy model t intr assignment))
   3.414 +          else
   3.415 +            NONE) terms) ^ "\n"
   3.416 +  in
   3.417 +    typs_msg ^ show_consts_msg ^ terms_msg
   3.418 +  end;
   3.419  
   3.420  
   3.421  (* ------------------------------------------------------------------------- *)
   3.422  (* PARAMETER MANAGEMENT                                                      *)
   3.423  (* ------------------------------------------------------------------------- *)
   3.424  
   3.425 -	(* string -> (theory -> model -> arguments -> Term.term ->
   3.426 -		(interpretation * model * arguments) option) -> theory -> theory *)
   3.427 +  (* string -> (theory -> model -> arguments -> Term.term ->
   3.428 +    (interpretation * model * arguments) option) -> theory -> theory *)
   3.429  
   3.430 -	fun add_interpreter name f thy =
   3.431 -	let
   3.432 -		val {interpreters, printers, parameters} = RefuteData.get thy
   3.433 -	in
   3.434 -		case AList.lookup (op =) interpreters name of
   3.435 -		  NONE   => RefuteData.put {interpreters = (name, f) :: interpreters,
   3.436 -			printers = printers, parameters = parameters} thy
   3.437 -		| SOME _ => error ("Interpreter " ^ name ^ " already declared")
   3.438 -	end;
   3.439 +  fun add_interpreter name f thy =
   3.440 +  let
   3.441 +    val {interpreters, printers, parameters} = RefuteData.get thy
   3.442 +  in
   3.443 +    case AList.lookup (op =) interpreters name of
   3.444 +      NONE   => RefuteData.put {interpreters = (name, f) :: interpreters,
   3.445 +      printers = printers, parameters = parameters} thy
   3.446 +    | SOME _ => error ("Interpreter " ^ name ^ " already declared")
   3.447 +  end;
   3.448  
   3.449 -	(* string -> (theory -> model -> Term.term -> interpretation ->
   3.450 -		(int -> bool) -> Term.term option) -> theory -> theory *)
   3.451 +  (* string -> (theory -> model -> Term.term -> interpretation ->
   3.452 +    (int -> bool) -> Term.term option) -> theory -> theory *)
   3.453  
   3.454 -	fun add_printer name f thy =
   3.455 -	let
   3.456 -		val {interpreters, printers, parameters} = RefuteData.get thy
   3.457 -	in
   3.458 -		case AList.lookup (op =) printers name of
   3.459 -		  NONE   => RefuteData.put {interpreters = interpreters,
   3.460 -			printers = (name, f) :: printers, parameters = parameters} thy
   3.461 -		| SOME _ => error ("Printer " ^ name ^ " already declared")
   3.462 -	end;
   3.463 +  fun add_printer name f thy =
   3.464 +  let
   3.465 +    val {interpreters, printers, parameters} = RefuteData.get thy
   3.466 +  in
   3.467 +    case AList.lookup (op =) printers name of
   3.468 +      NONE   => RefuteData.put {interpreters = interpreters,
   3.469 +      printers = (name, f) :: printers, parameters = parameters} thy
   3.470 +    | SOME _ => error ("Printer " ^ name ^ " already declared")
   3.471 +  end;
   3.472  
   3.473  (* ------------------------------------------------------------------------- *)
   3.474  (* set_default_param: stores the '(name, value)' pair in RefuteData's        *)
   3.475  (*                    parameter table                                        *)
   3.476  (* ------------------------------------------------------------------------- *)
   3.477  
   3.478 -	(* (string * string) -> theory -> theory *)
   3.479 +  (* (string * string) -> theory -> theory *)
   3.480  
   3.481 -	fun set_default_param (name, value) thy =
   3.482 -	let
   3.483 -		val {interpreters, printers, parameters} = RefuteData.get thy
   3.484 -	in
   3.485 -		RefuteData.put (case Symtab.lookup parameters name of
   3.486 -		  NONE   =>
   3.487 -			{interpreters = interpreters, printers = printers,
   3.488 -				parameters = Symtab.extend (parameters, [(name, value)])}
   3.489 -		| SOME _ =>
   3.490 -			{interpreters = interpreters, printers = printers,
   3.491 -				parameters = Symtab.update (name, value) parameters}) thy
   3.492 -	end;
   3.493 +  fun set_default_param (name, value) thy =
   3.494 +  let
   3.495 +    val {interpreters, printers, parameters} = RefuteData.get thy
   3.496 +  in
   3.497 +    RefuteData.put (case Symtab.lookup parameters name of
   3.498 +      NONE   =>
   3.499 +      {interpreters = interpreters, printers = printers,
   3.500 +        parameters = Symtab.extend (parameters, [(name, value)])}
   3.501 +    | SOME _ =>
   3.502 +      {interpreters = interpreters, printers = printers,
   3.503 +        parameters = Symtab.update (name, value) parameters}) thy
   3.504 +  end;
   3.505  
   3.506  (* ------------------------------------------------------------------------- *)
   3.507  (* get_default_param: retrieves the value associated with 'name' from        *)
   3.508  (*                    RefuteData's parameter table                           *)
   3.509  (* ------------------------------------------------------------------------- *)
   3.510  
   3.511 -	(* theory -> string -> string option *)
   3.512 +  (* theory -> string -> string option *)
   3.513  
   3.514 -	val get_default_param = Symtab.lookup o #parameters o RefuteData.get;
   3.515 +  val get_default_param = Symtab.lookup o #parameters o RefuteData.get;
   3.516  
   3.517  (* ------------------------------------------------------------------------- *)
   3.518  (* get_default_params: returns a list of all '(name, value)' pairs that are  *)
   3.519  (*                     stored in RefuteData's parameter table                *)
   3.520  (* ------------------------------------------------------------------------- *)
   3.521  
   3.522 -	(* theory -> (string * string) list *)
   3.523 +  (* theory -> (string * string) list *)
   3.524  
   3.525 -	val get_default_params = Symtab.dest o #parameters o RefuteData.get;
   3.526 +  val get_default_params = Symtab.dest o #parameters o RefuteData.get;
   3.527  
   3.528  (* ------------------------------------------------------------------------- *)
   3.529  (* actual_params: takes a (possibly empty) list 'params' of parameters that  *)
   3.530 @@ -358,59 +358,59 @@
   3.531  (*      returns a record that can be passed to 'find_model'.                 *)
   3.532  (* ------------------------------------------------------------------------- *)
   3.533  
   3.534 -	(* theory -> (string * string) list -> params *)
   3.535 +  (* theory -> (string * string) list -> params *)
   3.536  
   3.537 -	fun actual_params thy override =
   3.538 -	let
   3.539 -		(* (string * string) list * string -> int *)
   3.540 -		fun read_int (parms, name) =
   3.541 -			case AList.lookup (op =) parms name of
   3.542 -			  SOME s => (case Int.fromString s of
   3.543 -				  SOME i => i
   3.544 -				| NONE   => error ("parameter " ^ quote name ^
   3.545 -					" (value is " ^ quote s ^ ") must be an integer value"))
   3.546 -			| NONE   => error ("parameter " ^ quote name ^
   3.547 -					" must be assigned a value")
   3.548 -		(* (string * string) list * string -> string *)
   3.549 -		fun read_string (parms, name) =
   3.550 -			case AList.lookup (op =) parms name of
   3.551 -			  SOME s => s
   3.552 -			| NONE   => error ("parameter " ^ quote name ^
   3.553 -				" must be assigned a value")
   3.554 -		(* 'override' first, defaults last: *)
   3.555 -		(* (string * string) list *)
   3.556 -		val allparams = override @ (get_default_params thy)
   3.557 -		(* int *)
   3.558 -		val minsize   = read_int (allparams, "minsize")
   3.559 -		val maxsize   = read_int (allparams, "maxsize")
   3.560 -		val maxvars   = read_int (allparams, "maxvars")
   3.561 -		val maxtime   = read_int (allparams, "maxtime")
   3.562 -		(* string *)
   3.563 -		val satsolver = read_string (allparams, "satsolver")
   3.564 -		(* all remaining parameters of the form "string=int" are collected in *)
   3.565 -		(* 'sizes'                                                            *)
   3.566 -		(* TODO: it is currently not possible to specify a size for a type    *)
   3.567 -		(*       whose name is one of the other parameters (e.g. 'maxvars')   *)
   3.568 -		(* (string * int) list *)
   3.569 -		val sizes     = List.mapPartial
   3.570 -			(fn (name, value) => Option.map (pair name) (Int.fromString value))
   3.571 -			(List.filter (fn (name, _) => name<>"minsize" andalso name<>"maxsize"
   3.572 -				andalso name<>"maxvars" andalso name<>"maxtime"
   3.573 -				andalso name<>"satsolver") allparams)
   3.574 -	in
   3.575 -		{sizes=sizes, minsize=minsize, maxsize=maxsize, maxvars=maxvars,
   3.576 -			maxtime=maxtime, satsolver=satsolver}
   3.577 -	end;
   3.578 +  fun actual_params thy override =
   3.579 +  let
   3.580 +    (* (string * string) list * string -> int *)
   3.581 +    fun read_int (parms, name) =
   3.582 +      case AList.lookup (op =) parms name of
   3.583 +        SOME s => (case Int.fromString s of
   3.584 +          SOME i => i
   3.585 +        | NONE   => error ("parameter " ^ quote name ^
   3.586 +          " (value is " ^ quote s ^ ") must be an integer value"))
   3.587 +      | NONE   => error ("parameter " ^ quote name ^
   3.588 +          " must be assigned a value")
   3.589 +    (* (string * string) list * string -> string *)
   3.590 +    fun read_string (parms, name) =
   3.591 +      case AList.lookup (op =) parms name of
   3.592 +        SOME s => s
   3.593 +      | NONE   => error ("parameter " ^ quote name ^
   3.594 +        " must be assigned a value")
   3.595 +    (* 'override' first, defaults last: *)
   3.596 +    (* (string * string) list *)
   3.597 +    val allparams = override @ (get_default_params thy)
   3.598 +    (* int *)
   3.599 +    val minsize   = read_int (allparams, "minsize")
   3.600 +    val maxsize   = read_int (allparams, "maxsize")
   3.601 +    val maxvars   = read_int (allparams, "maxvars")
   3.602 +    val maxtime   = read_int (allparams, "maxtime")
   3.603 +    (* string *)
   3.604 +    val satsolver = read_string (allparams, "satsolver")
   3.605 +    (* all remaining parameters of the form "string=int" are collected in *)
   3.606 +    (* 'sizes'                                                            *)
   3.607 +    (* TODO: it is currently not possible to specify a size for a type    *)
   3.608 +    (*       whose name is one of the other parameters (e.g. 'maxvars')   *)
   3.609 +    (* (string * int) list *)
   3.610 +    val sizes     = List.mapPartial
   3.611 +      (fn (name, value) => Option.map (pair name) (Int.fromString value))
   3.612 +      (List.filter (fn (name, _) => name<>"minsize" andalso name<>"maxsize"
   3.613 +        andalso name<>"maxvars" andalso name<>"maxtime"
   3.614 +        andalso name<>"satsolver") allparams)
   3.615 +  in
   3.616 +    {sizes=sizes, minsize=minsize, maxsize=maxsize, maxvars=maxvars,
   3.617 +      maxtime=maxtime, satsolver=satsolver}
   3.618 +  end;
   3.619  
   3.620  
   3.621  (* ------------------------------------------------------------------------- *)
   3.622  (* TRANSLATION HOL -> PROPOSITIONAL LOGIC, BOOLEAN ASSIGNMENT -> MODEL       *)
   3.623  (* ------------------------------------------------------------------------- *)
   3.624  
   3.625 -	(* (''a * 'b) list -> ''a -> 'b *)
   3.626 +  (* (''a * 'b) list -> ''a -> 'b *)
   3.627  
   3.628 -	fun lookup xs key =
   3.629 -		Option.valOf (AList.lookup (op =) xs key);
   3.630 +  fun lookup xs key =
   3.631 +    Option.valOf (AList.lookup (op =) xs key);
   3.632  
   3.633  (* ------------------------------------------------------------------------- *)
   3.634  (* typ_of_dtyp: converts a data type ('DatatypeAux.dtyp') into a type        *)
   3.635 @@ -418,55 +418,55 @@
   3.636  (*              arguments                                                    *)
   3.637  (* ------------------------------------------------------------------------- *)
   3.638  
   3.639 -	(* DatatypeAux.descr -> (DatatypeAux.dtyp * Term.typ) list ->
   3.640 -		DatatypeAux.dtyp -> Term.typ *)
   3.641 +  (* DatatypeAux.descr -> (DatatypeAux.dtyp * Term.typ) list ->
   3.642 +    DatatypeAux.dtyp -> Term.typ *)
   3.643  
   3.644 -	fun typ_of_dtyp descr typ_assoc (DatatypeAux.DtTFree a) =
   3.645 -		(* replace a 'DtTFree' variable by the associated type *)
   3.646 -		lookup typ_assoc (DatatypeAux.DtTFree a)
   3.647 -	  | typ_of_dtyp descr typ_assoc (DatatypeAux.DtType (s, ds)) =
   3.648 -		Type (s, map (typ_of_dtyp descr typ_assoc) ds)
   3.649 -	  | typ_of_dtyp descr typ_assoc (DatatypeAux.DtRec i) =
   3.650 -		let
   3.651 -			val (s, ds, _) = lookup descr i
   3.652 -		in
   3.653 -			Type (s, map (typ_of_dtyp descr typ_assoc) ds)
   3.654 -		end;
   3.655 +  fun typ_of_dtyp descr typ_assoc (DatatypeAux.DtTFree a) =
   3.656 +    (* replace a 'DtTFree' variable by the associated type *)
   3.657 +    lookup typ_assoc (DatatypeAux.DtTFree a)
   3.658 +    | typ_of_dtyp descr typ_assoc (DatatypeAux.DtType (s, ds)) =
   3.659 +    Type (s, map (typ_of_dtyp descr typ_assoc) ds)
   3.660 +    | typ_of_dtyp descr typ_assoc (DatatypeAux.DtRec i) =
   3.661 +    let
   3.662 +      val (s, ds, _) = lookup descr i
   3.663 +    in
   3.664 +      Type (s, map (typ_of_dtyp descr typ_assoc) ds)
   3.665 +    end;
   3.666  
   3.667  (* ------------------------------------------------------------------------- *)
   3.668  (* close_form: universal closure over schematic variables in 't'             *)
   3.669  (* ------------------------------------------------------------------------- *)
   3.670  
   3.671 -	(* Term.term -> Term.term *)
   3.672 +  (* Term.term -> Term.term *)
   3.673  
   3.674 -	fun close_form t =
   3.675 -	let
   3.676 -		(* (Term.indexname * Term.typ) list *)
   3.677 -		val vars = sort_wrt (fst o fst) (map dest_Var (term_vars t))
   3.678 -	in
   3.679 -		Library.foldl (fn (t', ((x, i), T)) =>
   3.680 -			(Term.all T) $ Abs (x, T, abstract_over (Var ((x, i), T), t')))
   3.681 -			(t, vars)
   3.682 -	end;
   3.683 +  fun close_form t =
   3.684 +  let
   3.685 +    (* (Term.indexname * Term.typ) list *)
   3.686 +    val vars = sort_wrt (fst o fst) (map dest_Var (term_vars t))
   3.687 +  in
   3.688 +    Library.foldl (fn (t', ((x, i), T)) =>
   3.689 +      (Term.all T) $ Abs (x, T, abstract_over (Var ((x, i), T), t')))
   3.690 +      (t, vars)
   3.691 +  end;
   3.692  
   3.693  (* ------------------------------------------------------------------------- *)
   3.694  (* monomorphic_term: applies a type substitution 'typeSubs' for all type     *)
   3.695  (*                   variables in a term 't'                                 *)
   3.696  (* ------------------------------------------------------------------------- *)
   3.697  
   3.698 -	(* Type.tyenv -> Term.term -> Term.term *)
   3.699 +  (* Type.tyenv -> Term.term -> Term.term *)
   3.700  
   3.701 -	fun monomorphic_term typeSubs t =
   3.702 -		map_types (map_type_tvar
   3.703 -			(fn v =>
   3.704 -				case Type.lookup (typeSubs, v) of
   3.705 -				  NONE =>
   3.706 -					(* schematic type variable not instantiated *)
   3.707 -					raise REFUTE ("monomorphic_term",
   3.708 -						"no substitution for type variable " ^ fst (fst v) ^
   3.709 -						" in term " ^ Display.raw_string_of_term t)
   3.710 -				| SOME typ =>
   3.711 -					typ)) t;
   3.712 +  fun monomorphic_term typeSubs t =
   3.713 +    map_types (map_type_tvar
   3.714 +      (fn v =>
   3.715 +        case Type.lookup (typeSubs, v) of
   3.716 +          NONE =>
   3.717 +          (* schematic type variable not instantiated *)
   3.718 +          raise REFUTE ("monomorphic_term",
   3.719 +            "no substitution for type variable " ^ fst (fst v) ^
   3.720 +            " in term " ^ Display.raw_string_of_term t)
   3.721 +        | SOME typ =>
   3.722 +          typ)) t;
   3.723  
   3.724  (* ------------------------------------------------------------------------- *)
   3.725  (* specialize_type: given a constant 's' of type 'T', which is a subterm of  *)
   3.726 @@ -475,186 +475,186 @@
   3.727  (*                  match the type 'T' (may raise Type.TYPE_MATCH)           *)
   3.728  (* ------------------------------------------------------------------------- *)
   3.729  
   3.730 -	(* theory -> (string * Term.typ) -> Term.term -> Term.term *)
   3.731 +  (* theory -> (string * Term.typ) -> Term.term -> Term.term *)
   3.732  
   3.733 -	fun specialize_type thy (s, T) t =
   3.734 -	let
   3.735 -		fun find_typeSubs (Const (s', T')) =
   3.736 -			if s=s' then
   3.737 -				SOME (Sign.typ_match thy (T', T) Vartab.empty)
   3.738 -					handle Type.TYPE_MATCH => NONE
   3.739 -			else
   3.740 -				NONE
   3.741 -		  | find_typeSubs (Free _)           = NONE
   3.742 -		  | find_typeSubs (Var _)            = NONE
   3.743 -		  | find_typeSubs (Bound _)          = NONE
   3.744 -		  | find_typeSubs (Abs (_, _, body)) = find_typeSubs body
   3.745 -		  | find_typeSubs (t1 $ t2)          =
   3.746 -			(case find_typeSubs t1 of SOME x => SOME x
   3.747 -			                        | NONE   => find_typeSubs t2)
   3.748 -	in
   3.749 -		case find_typeSubs t of
   3.750 -		  SOME typeSubs =>
   3.751 -			monomorphic_term typeSubs t
   3.752 -		| NONE =>
   3.753 -			(* no match found - perhaps due to sort constraints *)
   3.754 -			raise Type.TYPE_MATCH
   3.755 -	end;
   3.756 +  fun specialize_type thy (s, T) t =
   3.757 +  let
   3.758 +    fun find_typeSubs (Const (s', T')) =
   3.759 +      if s=s' then
   3.760 +        SOME (Sign.typ_match thy (T', T) Vartab.empty)
   3.761 +          handle Type.TYPE_MATCH => NONE
   3.762 +      else
   3.763 +        NONE
   3.764 +      | find_typeSubs (Free _)           = NONE
   3.765 +      | find_typeSubs (Var _)            = NONE
   3.766 +      | find_typeSubs (Bound _)          = NONE
   3.767 +      | find_typeSubs (Abs (_, _, body)) = find_typeSubs body
   3.768 +      | find_typeSubs (t1 $ t2)          =
   3.769 +      (case find_typeSubs t1 of SOME x => SOME x
   3.770 +                              | NONE   => find_typeSubs t2)
   3.771 +  in
   3.772 +    case find_typeSubs t of
   3.773 +      SOME typeSubs =>
   3.774 +      monomorphic_term typeSubs t
   3.775 +    | NONE =>
   3.776 +      (* no match found - perhaps due to sort constraints *)
   3.777 +      raise Type.TYPE_MATCH
   3.778 +  end;
   3.779  
   3.780  (* ------------------------------------------------------------------------- *)
   3.781  (* is_const_of_class: returns 'true' iff 'Const (s, T)' is a constant that   *)
   3.782  (*                    denotes membership to an axiomatic type class          *)
   3.783  (* ------------------------------------------------------------------------- *)
   3.784  
   3.785 -	(* theory -> string * Term.typ -> bool *)
   3.786 +  (* theory -> string * Term.typ -> bool *)
   3.787  
   3.788 -	fun is_const_of_class thy (s, T) =
   3.789 -	let
   3.790 -		val class_const_names = map Logic.const_of_class (Sign.all_classes thy)
   3.791 -	in
   3.792 -		(* I'm not quite sure if checking the name 's' is sufficient, *)
   3.793 -		(* or if we should also check the type 'T'.                   *)
   3.794 -		s mem_string class_const_names
   3.795 -	end;
   3.796 +  fun is_const_of_class thy (s, T) =
   3.797 +  let
   3.798 +    val class_const_names = map Logic.const_of_class (Sign.all_classes thy)
   3.799 +  in
   3.800 +    (* I'm not quite sure if checking the name 's' is sufficient, *)
   3.801 +    (* or if we should also check the type 'T'.                   *)
   3.802 +    s mem_string class_const_names
   3.803 +  end;
   3.804  
   3.805  (* ------------------------------------------------------------------------- *)
   3.806  (* is_IDT_constructor: returns 'true' iff 'Const (s, T)' is the constructor  *)
   3.807  (*                     of an inductive datatype in 'thy'                     *)
   3.808  (* ------------------------------------------------------------------------- *)
   3.809  
   3.810 -	(* theory -> string * Term.typ -> bool *)
   3.811 +  (* theory -> string * Term.typ -> bool *)
   3.812  
   3.813 -	fun is_IDT_constructor thy (s, T) =
   3.814 -		(case body_type T of
   3.815 -		  Type (s', _) =>
   3.816 -			(case DatatypePackage.get_datatype_constrs thy s' of
   3.817 -			  SOME constrs =>
   3.818 -				List.exists (fn (cname, cty) =>
   3.819 -					cname = s andalso Sign.typ_instance thy (T, cty)) constrs
   3.820 -			| NONE =>
   3.821 -				false)
   3.822 -		| _  =>
   3.823 -			false);
   3.824 +  fun is_IDT_constructor thy (s, T) =
   3.825 +    (case body_type T of
   3.826 +      Type (s', _) =>
   3.827 +      (case DatatypePackage.get_datatype_constrs thy s' of
   3.828 +        SOME constrs =>
   3.829 +        List.exists (fn (cname, cty) =>
   3.830 +          cname = s andalso Sign.typ_instance thy (T, cty)) constrs
   3.831 +      | NONE =>
   3.832 +        false)
   3.833 +    | _  =>
   3.834 +      false);
   3.835  
   3.836  (* ------------------------------------------------------------------------- *)
   3.837  (* is_IDT_recursor: returns 'true' iff 'Const (s, T)' is the recursion       *)
   3.838  (*                  operator of an inductive datatype in 'thy'               *)
   3.839  (* ------------------------------------------------------------------------- *)
   3.840  
   3.841 -	(* theory -> string * Term.typ -> bool *)
   3.842 +  (* theory -> string * Term.typ -> bool *)
   3.843  
   3.844 -	fun is_IDT_recursor thy (s, T) =
   3.845 -	let
   3.846 -		val rec_names = Symtab.fold (append o #rec_names o snd)
   3.847 -			(DatatypePackage.get_datatypes thy) []
   3.848 -	in
   3.849 -		(* I'm not quite sure if checking the name 's' is sufficient, *)
   3.850 -		(* or if we should also check the type 'T'.                   *)
   3.851 -		s mem_string rec_names
   3.852 -	end;
   3.853 +  fun is_IDT_recursor thy (s, T) =
   3.854 +  let
   3.855 +    val rec_names = Symtab.fold (append o #rec_names o snd)
   3.856 +      (DatatypePackage.get_datatypes thy) []
   3.857 +  in
   3.858 +    (* I'm not quite sure if checking the name 's' is sufficient, *)
   3.859 +    (* or if we should also check the type 'T'.                   *)
   3.860 +    s mem_string rec_names
   3.861 +  end;
   3.862  
   3.863  (* ------------------------------------------------------------------------- *)
   3.864  (* get_def: looks up the definition of a constant, as created by "constdefs" *)
   3.865  (* ------------------------------------------------------------------------- *)
   3.866  
   3.867 -	(* theory -> string * Term.typ -> (string * Term.term) option *)
   3.868 +  (* theory -> string * Term.typ -> (string * Term.term) option *)
   3.869  
   3.870 -	fun get_def thy (s, T) =
   3.871 -	let
   3.872 -		(* maps  f ?t1 ... ?tn == rhs  to  %t1...tn. rhs *)
   3.873 -		fun norm_rhs eqn =
   3.874 -		let
   3.875 -			fun lambda (v as Var ((x, _), T)) t = Abs (x, T, abstract_over (v, t))
   3.876 -			  | lambda v t                      = raise TERM ("lambda", [v, t])
   3.877 -			val (lhs, rhs) = Logic.dest_equals eqn
   3.878 -			val (_, args)  = Term.strip_comb lhs
   3.879 -		in
   3.880 -			fold lambda (rev args) rhs
   3.881 -		end
   3.882 -		(* (string * Term.term) list -> (string * Term.term) option *)
   3.883 -		fun get_def_ax [] = NONE
   3.884 -		  | get_def_ax ((axname, ax) :: axioms) =
   3.885 -			(let
   3.886 -				val (lhs, _) = Logic.dest_equals ax  (* equations only *)
   3.887 -				val c        = Term.head_of lhs
   3.888 -				val (s', T') = Term.dest_Const c
   3.889 -			in
   3.890 -				if s=s' then
   3.891 -					let
   3.892 -						val typeSubs = Sign.typ_match thy (T', T) Vartab.empty
   3.893 -						val ax'      = monomorphic_term typeSubs ax
   3.894 -						val rhs      = norm_rhs ax'
   3.895 -					in
   3.896 -						SOME (axname, rhs)
   3.897 -					end
   3.898 -				else
   3.899 -					get_def_ax axioms
   3.900 -			end handle ERROR _         => get_def_ax axioms
   3.901 -			         | TERM _          => get_def_ax axioms
   3.902 -			         | Type.TYPE_MATCH => get_def_ax axioms)
   3.903 -	in
   3.904 -		get_def_ax (Theory.all_axioms_of thy)
   3.905 -	end;
   3.906 +  fun get_def thy (s, T) =
   3.907 +  let
   3.908 +    (* maps  f ?t1 ... ?tn == rhs  to  %t1...tn. rhs *)
   3.909 +    fun norm_rhs eqn =
   3.910 +    let
   3.911 +      fun lambda (v as Var ((x, _), T)) t = Abs (x, T, abstract_over (v, t))
   3.912 +        | lambda v t                      = raise TERM ("lambda", [v, t])
   3.913 +      val (lhs, rhs) = Logic.dest_equals eqn
   3.914 +      val (_, args)  = Term.strip_comb lhs
   3.915 +    in
   3.916 +      fold lambda (rev args) rhs
   3.917 +    end
   3.918 +    (* (string * Term.term) list -> (string * Term.term) option *)
   3.919 +    fun get_def_ax [] = NONE
   3.920 +      | get_def_ax ((axname, ax) :: axioms) =
   3.921 +      (let
   3.922 +        val (lhs, _) = Logic.dest_equals ax  (* equations only *)
   3.923 +        val c        = Term.head_of lhs
   3.924 +        val (s', T') = Term.dest_Const c
   3.925 +      in
   3.926 +        if s=s' then
   3.927 +          let
   3.928 +            val typeSubs = Sign.typ_match thy (T', T) Vartab.empty
   3.929 +            val ax'      = monomorphic_term typeSubs ax
   3.930 +            val rhs      = norm_rhs ax'
   3.931 +          in
   3.932 +            SOME (axname, rhs)
   3.933 +          end
   3.934 +        else
   3.935 +          get_def_ax axioms
   3.936 +      end handle ERROR _         => get_def_ax axioms
   3.937 +               | TERM _          => get_def_ax axioms
   3.938 +               | Type.TYPE_MATCH => get_def_ax axioms)
   3.939 +  in
   3.940 +    get_def_ax (Theory.all_axioms_of thy)
   3.941 +  end;
   3.942  
   3.943  (* ------------------------------------------------------------------------- *)
   3.944  (* get_typedef: looks up the definition of a type, as created by "typedef"   *)
   3.945  (* ------------------------------------------------------------------------- *)
   3.946  
   3.947 -	(* theory -> (string * Term.typ) -> (string * Term.term) option *)
   3.948 +  (* theory -> (string * Term.typ) -> (string * Term.term) option *)
   3.949  
   3.950 -	fun get_typedef thy T =
   3.951 -	let
   3.952 -		(* (string * Term.term) list -> (string * Term.term) option *)
   3.953 -		fun get_typedef_ax [] = NONE
   3.954 -		  | get_typedef_ax ((axname, ax) :: axioms) =
   3.955 -			(let
   3.956 -				(* Term.term -> Term.typ option *)
   3.957 -				fun type_of_type_definition (Const (s', T')) =
   3.958 -					if s'="Typedef.type_definition" then
   3.959 -						SOME T'
   3.960 -					else
   3.961 -						NONE
   3.962 -				  | type_of_type_definition (Free _)           = NONE
   3.963 -				  | type_of_type_definition (Var _)            = NONE
   3.964 -				  | type_of_type_definition (Bound _)          = NONE
   3.965 -				  | type_of_type_definition (Abs (_, _, body)) =
   3.966 -					type_of_type_definition body
   3.967 -				  | type_of_type_definition (t1 $ t2)          =
   3.968 -					(case type_of_type_definition t1 of
   3.969 -					  SOME x => SOME x
   3.970 -					| NONE   => type_of_type_definition t2)
   3.971 -			in
   3.972 -				case type_of_type_definition ax of
   3.973 -				  SOME T' =>
   3.974 -					let
   3.975 -						val T''      = (domain_type o domain_type) T'
   3.976 -						val typeSubs = Sign.typ_match thy (T'', T) Vartab.empty
   3.977 -					in
   3.978 -						SOME (axname, monomorphic_term typeSubs ax)
   3.979 -					end
   3.980 -				| NONE =>
   3.981 -					get_typedef_ax axioms
   3.982 -			end handle ERROR _         => get_typedef_ax axioms
   3.983 -			         | MATCH           => get_typedef_ax axioms
   3.984 -			         | Type.TYPE_MATCH => get_typedef_ax axioms)
   3.985 -	in
   3.986 -		get_typedef_ax (Theory.all_axioms_of thy)
   3.987 -	end;
   3.988 +  fun get_typedef thy T =
   3.989 +  let
   3.990 +    (* (string * Term.term) list -> (string * Term.term) option *)
   3.991 +    fun get_typedef_ax [] = NONE
   3.992 +      | get_typedef_ax ((axname, ax) :: axioms) =
   3.993 +      (let
   3.994 +        (* Term.term -> Term.typ option *)
   3.995 +        fun type_of_type_definition (Const (s', T')) =
   3.996 +          if s'="Typedef.type_definition" then
   3.997 +            SOME T'
   3.998 +          else
   3.999 +            NONE
  3.1000 +          | type_of_type_definition (Free _)           = NONE
  3.1001 +          | type_of_type_definition (Var _)            = NONE
  3.1002 +          | type_of_type_definition (Bound _)          = NONE
  3.1003 +          | type_of_type_definition (Abs (_, _, body)) =
  3.1004 +          type_of_type_definition body
  3.1005 +          | type_of_type_definition (t1 $ t2)          =
  3.1006 +          (case type_of_type_definition t1 of
  3.1007 +            SOME x => SOME x
  3.1008 +          | NONE   => type_of_type_definition t2)
  3.1009 +      in
  3.1010 +        case type_of_type_definition ax of
  3.1011 +          SOME T' =>
  3.1012 +          let
  3.1013 +            val T''      = (domain_type o domain_type) T'
  3.1014 +            val typeSubs = Sign.typ_match thy (T'', T) Vartab.empty
  3.1015 +          in
  3.1016 +            SOME (axname, monomorphic_term typeSubs ax)
  3.1017 +          end
  3.1018 +        | NONE =>
  3.1019 +          get_typedef_ax axioms
  3.1020 +      end handle ERROR _         => get_typedef_ax axioms
  3.1021 +               | MATCH           => get_typedef_ax axioms
  3.1022 +               | Type.TYPE_MATCH => get_typedef_ax axioms)
  3.1023 +  in
  3.1024 +    get_typedef_ax (Theory.all_axioms_of thy)
  3.1025 +  end;
  3.1026  
  3.1027  (* ------------------------------------------------------------------------- *)
  3.1028  (* get_classdef: looks up the defining axiom for an axiomatic type class, as *)
  3.1029  (*               created by the "axclass" command                            *)
  3.1030  (* ------------------------------------------------------------------------- *)
  3.1031  
  3.1032 -	(* theory -> string -> (string * Term.term) option *)
  3.1033 +  (* theory -> string -> (string * Term.term) option *)
  3.1034  
  3.1035 -	fun get_classdef thy class =
  3.1036 -	let
  3.1037 -		val axname = class ^ "_class_def"
  3.1038 -	in
  3.1039 -		Option.map (pair axname)
  3.1040 -			(AList.lookup (op =) (Theory.all_axioms_of thy) axname)
  3.1041 -	end;
  3.1042 +  fun get_classdef thy class =
  3.1043 +  let
  3.1044 +    val axname = class ^ "_class_def"
  3.1045 +  in
  3.1046 +    Option.map (pair axname)
  3.1047 +      (AList.lookup (op =) (Theory.all_axioms_of thy) axname)
  3.1048 +  end;
  3.1049  
  3.1050  (* ------------------------------------------------------------------------- *)
  3.1051  (* unfold_defs: unfolds all defined constants in a term 't', beta-eta        *)
  3.1052 @@ -664,293 +664,293 @@
  3.1053  (*              that definition does not need to be unfolded                 *)
  3.1054  (* ------------------------------------------------------------------------- *)
  3.1055  
  3.1056 -	(* theory -> Term.term -> Term.term *)
  3.1057 +  (* theory -> Term.term -> Term.term *)
  3.1058  
  3.1059 -	(* Note: we could intertwine unfolding of constants and beta-(eta-)       *)
  3.1060 -	(*       normalization; this would save some unfolding for terms where    *)
  3.1061 -	(*       constants are eliminated by beta-reduction (e.g. 'K c1 c2').  On *)
  3.1062 -	(*       the other hand, this would cause additional work for terms where *)
  3.1063 -	(*       constants are duplicated by beta-reduction (e.g. 'S c1 c2 c3').  *)
  3.1064 +  (* Note: we could intertwine unfolding of constants and beta-(eta-)       *)
  3.1065 +  (*       normalization; this would save some unfolding for terms where    *)
  3.1066 +  (*       constants are eliminated by beta-reduction (e.g. 'K c1 c2').  On *)
  3.1067 +  (*       the other hand, this would cause additional work for terms where *)
  3.1068 +  (*       constants are duplicated by beta-reduction (e.g. 'S c1 c2 c3').  *)
  3.1069  
  3.1070 -	fun unfold_defs thy t =
  3.1071 -	let
  3.1072 -		(* Term.term -> Term.term *)
  3.1073 -		fun unfold_loop t =
  3.1074 -			case t of
  3.1075 -			(* Pure *)
  3.1076 -			  Const ("all", _)                => t
  3.1077 -			| Const ("==", _)                 => t
  3.1078 -			| Const ("==>", _)                => t
  3.1079 -			| Const ("TYPE", _)               => t  (* axiomatic type classes *)
  3.1080 -			(* HOL *)
  3.1081 -			| Const ("Trueprop", _)           => t
  3.1082 -			| Const ("Not", _)                => t
  3.1083 -			| (* redundant, since 'True' is also an IDT constructor *)
  3.1084 -			  Const ("True", _)               => t
  3.1085 -			| (* redundant, since 'False' is also an IDT constructor *)
  3.1086 -			  Const ("False", _)              => t
  3.1087 -			| Const ("arbitrary", _)          => t
  3.1088 -			| Const ("The", _)                => t
  3.1089 -			| Const ("Hilbert_Choice.Eps", _) => t
  3.1090 -			| Const ("All", _)                => t
  3.1091 -			| Const ("Ex", _)                 => t
  3.1092 -			| Const ("op =", _)               => t
  3.1093 -			| Const ("op &", _)               => t
  3.1094 -			| Const ("op |", _)               => t
  3.1095 -			| Const ("op -->", _)             => t
  3.1096 -			(* sets *)
  3.1097 -			| Const ("Collect", _)            => t
  3.1098 -			| Const ("op :", _)               => t
  3.1099 -			(* other optimizations *)
  3.1100 -			| Const ("Finite_Set.card", _)    => t
  3.1101 -			| Const ("Finite_Set.Finites", _) => t
  3.1102 -			| Const ("Finite_Set.finite", _)  => t
  3.1103 -			| Const ("Orderings.less", Type ("fun", [Type ("nat", []),
  3.1104 -				Type ("fun", [Type ("nat", []), Type ("bool", [])])])) => t
  3.1105 -			| Const ("HOL.plus", Type ("fun", [Type ("nat", []),
  3.1106 -				Type ("fun", [Type ("nat", []), Type ("nat", [])])])) => t
  3.1107 -			| Const ("HOL.minus", Type ("fun", [Type ("nat", []),
  3.1108 -				Type ("fun", [Type ("nat", []), Type ("nat", [])])])) => t
  3.1109 -			| Const ("HOL.times", Type ("fun", [Type ("nat", []),
  3.1110 -				Type ("fun", [Type ("nat", []), Type ("nat", [])])])) => t
  3.1111 -			| Const ("List.op @", _)          => t
  3.1112 -			| Const ("Lfp.lfp", _)            => t
  3.1113 -			| Const ("Gfp.gfp", _)            => t
  3.1114 -			| Const ("fst", _)                => t
  3.1115 -			| Const ("snd", _)                => t
  3.1116 -			(* simply-typed lambda calculus *)
  3.1117 -			| Const (s, T) =>
  3.1118 -				(if is_IDT_constructor thy (s, T)
  3.1119 -					orelse is_IDT_recursor thy (s, T) then
  3.1120 -					t  (* do not unfold IDT constructors/recursors *)
  3.1121 -				(* unfold the constant if there is a defining equation *)
  3.1122 -				else case get_def thy (s, T) of
  3.1123 -				  SOME (axname, rhs) =>
  3.1124 -					(* Note: if the term to be unfolded (i.e. 'Const (s, T)')  *)
  3.1125 -					(* occurs on the right-hand side of the equation, i.e. in  *)
  3.1126 -					(* 'rhs', we must not use this equation to unfold, because *)
  3.1127 -					(* that would loop.  Here would be the right place to      *)
  3.1128 -					(* check this.  However, getting this really right seems   *)
  3.1129 -					(* difficult because the user may state arbitrary axioms,  *)
  3.1130 -					(* which could interact with overloading to create loops.  *)
  3.1131 -					((*immediate_output (" unfolding: " ^ axname);*)unfold_loop rhs)
  3.1132 -				| NONE => t)
  3.1133 -			| Free _           => t
  3.1134 -			| Var _            => t
  3.1135 -			| Bound _          => t
  3.1136 -			| Abs (s, T, body) => Abs (s, T, unfold_loop body)
  3.1137 -			| t1 $ t2          => (unfold_loop t1) $ (unfold_loop t2)
  3.1138 -		val result = Envir.beta_eta_contract (unfold_loop t)
  3.1139 -	in
  3.1140 -		result
  3.1141 -	end;
  3.1142 +  fun unfold_defs thy t =
  3.1143 +  let
  3.1144 +    (* Term.term -> Term.term *)
  3.1145 +    fun unfold_loop t =
  3.1146 +      case t of
  3.1147 +      (* Pure *)
  3.1148 +        Const ("all", _)                => t
  3.1149 +      | Const ("==", _)                 => t
  3.1150 +      | Const ("==>", _)                => t
  3.1151 +      | Const ("TYPE", _)               => t  (* axiomatic type classes *)
  3.1152 +      (* HOL *)
  3.1153 +      | Const ("Trueprop", _)           => t
  3.1154 +      | Const ("Not", _)                => t
  3.1155 +      | (* redundant, since 'True' is also an IDT constructor *)
  3.1156 +        Const ("True", _)               => t
  3.1157 +      | (* redundant, since 'False' is also an IDT constructor *)
  3.1158 +        Const ("False", _)              => t
  3.1159 +      | Const ("arbitrary", _)          => t
  3.1160 +      | Const ("The", _)                => t
  3.1161 +      | Const ("Hilbert_Choice.Eps", _) => t
  3.1162 +      | Const ("All", _)                => t
  3.1163 +      | Const ("Ex", _)                 => t
  3.1164 +      | Const ("op =", _)               => t
  3.1165 +      | Const ("op &", _)               => t
  3.1166 +      | Const ("op |", _)               => t
  3.1167 +      | Const ("op -->", _)             => t
  3.1168 +      (* sets *)
  3.1169 +      | Const ("Collect", _)            => t
  3.1170 +      | Const ("op :", _)               => t
  3.1171 +      (* other optimizations *)
  3.1172 +      | Const ("Finite_Set.card", _)    => t
  3.1173 +      | Const ("Finite_Set.Finites", _) => t
  3.1174 +      | Const ("Finite_Set.finite", _)  => t
  3.1175 +      | Const ("Orderings.less", Type ("fun", [Type ("nat", []),
  3.1176 +        Type ("fun", [Type ("nat", []), Type ("bool", [])])])) => t
  3.1177 +      | Const ("HOL.plus", Type ("fun", [Type ("nat", []),
  3.1178 +        Type ("fun", [Type ("nat", []), Type ("nat", [])])])) => t
  3.1179 +      | Const ("HOL.minus", Type ("fun", [Type ("nat", []),
  3.1180 +        Type ("fun", [Type ("nat", []), Type ("nat", [])])])) => t
  3.1181 +      | Const ("HOL.times", Type ("fun", [Type ("nat", []),
  3.1182 +        Type ("fun", [Type ("nat", []), Type ("nat", [])])])) => t
  3.1183 +      | Const ("List.op @", _)          => t
  3.1184 +      | Const ("Lfp.lfp", _)            => t
  3.1185 +      | Const ("Gfp.gfp", _)            => t
  3.1186 +      | Const ("fst", _)                => t
  3.1187 +      | Const ("snd", _)                => t
  3.1188 +      (* simply-typed lambda calculus *)
  3.1189 +      | Const (s, T) =>
  3.1190 +        (if is_IDT_constructor thy (s, T)
  3.1191 +          orelse is_IDT_recursor thy (s, T) then
  3.1192 +          t  (* do not unfold IDT constructors/recursors *)
  3.1193 +        (* unfold the constant if there is a defining equation *)
  3.1194 +        else case get_def thy (s, T) of
  3.1195 +          SOME (axname, rhs) =>
  3.1196 +          (* Note: if the term to be unfolded (i.e. 'Const (s, T)')  *)
  3.1197 +          (* occurs on the right-hand side of the equation, i.e. in  *)
  3.1198 +          (* 'rhs', we must not use this equation to unfold, because *)
  3.1199 +          (* that would loop.  Here would be the right place to      *)
  3.1200 +          (* check this.  However, getting this really right seems   *)
  3.1201 +          (* difficult because the user may state arbitrary axioms,  *)
  3.1202 +          (* which could interact with overloading to create loops.  *)
  3.1203 +          ((*immediate_output (" unfolding: " ^ axname);*)unfold_loop rhs)
  3.1204 +        | NONE => t)
  3.1205 +      | Free _           => t
  3.1206 +      | Var _            => t
  3.1207 +      | Bound _          => t
  3.1208 +      | Abs (s, T, body) => Abs (s, T, unfold_loop body)
  3.1209 +      | t1 $ t2          => (unfold_loop t1) $ (unfold_loop t2)
  3.1210 +    val result = Envir.beta_eta_contract (unfold_loop t)
  3.1211 +  in
  3.1212 +    result
  3.1213 +  end;
  3.1214  
  3.1215  (* ------------------------------------------------------------------------- *)
  3.1216  (* collect_axioms: collects (monomorphic, universally quantified, unfolded   *)
  3.1217  (*                 versions of) all HOL axioms that are relevant w.r.t 't'   *)
  3.1218  (* ------------------------------------------------------------------------- *)
  3.1219  
  3.1220 -	(* Note: to make the collection of axioms more easily extensible, this    *)
  3.1221 -	(*       function could be based on user-supplied "axiom collectors",     *)
  3.1222 -	(*       similar to 'interpret'/interpreters or 'print'/printers          *)
  3.1223 +  (* Note: to make the collection of axioms more easily extensible, this    *)
  3.1224 +  (*       function could be based on user-supplied "axiom collectors",     *)
  3.1225 +  (*       similar to 'interpret'/interpreters or 'print'/printers          *)
  3.1226  
  3.1227 -	(* Note: currently we use "inverse" functions to the definitional         *)
  3.1228 -	(*       mechanisms provided by Isabelle/HOL, e.g. for "axclass",         *)
  3.1229 -	(*       "typedef", "constdefs".  A more general approach could consider  *)
  3.1230 -	(*       *every* axiom of the theory and collect it if it has a constant/ *)
  3.1231 -	(*       type/typeclass in common with the term 't'.                      *)
  3.1232 +  (* Note: currently we use "inverse" functions to the definitional         *)
  3.1233 +  (*       mechanisms provided by Isabelle/HOL, e.g. for "axclass",         *)
  3.1234 +  (*       "typedef", "constdefs".  A more general approach could consider  *)
  3.1235 +  (*       *every* axiom of the theory and collect it if it has a constant/ *)
  3.1236 +  (*       type/typeclass in common with the term 't'.                      *)
  3.1237  
  3.1238 -	(* theory -> Term.term -> Term.term list *)
  3.1239 +  (* theory -> Term.term -> Term.term list *)
  3.1240  
  3.1241 -	(* Which axioms are "relevant" for a particular term/type goes hand in    *)
  3.1242 -	(* hand with the interpretation of that term/type by its interpreter (see *)
  3.1243 -	(* way below): if the interpretation respects an axiom anyway, the axiom  *)
  3.1244 -	(* does not need to be added as a constraint here.                        *)
  3.1245 +  (* Which axioms are "relevant" for a particular term/type goes hand in    *)
  3.1246 +  (* hand with the interpretation of that term/type by its interpreter (see *)
  3.1247 +  (* way below): if the interpretation respects an axiom anyway, the axiom  *)
  3.1248 +  (* does not need to be added as a constraint here.                        *)
  3.1249  
  3.1250 -	(* To avoid collecting the same axiom multiple times, we use an           *)
  3.1251 -	(* accumulator 'axs' which contains all axioms collected so far.          *)
  3.1252 +  (* To avoid collecting the same axiom multiple times, we use an           *)
  3.1253 +  (* accumulator 'axs' which contains all axioms collected so far.          *)
  3.1254  
  3.1255 -	fun collect_axioms thy t =
  3.1256 -	let
  3.1257 -		val _ = immediate_output "Adding axioms..."
  3.1258 -		(* (string * Term.term) list *)
  3.1259 -		val axioms = Theory.all_axioms_of thy
  3.1260 -		(* string * Term.term -> Term.term list -> Term.term list *)
  3.1261 -		fun collect_this_axiom (axname, ax) axs =
  3.1262 -		let
  3.1263 -			val ax' = unfold_defs thy ax
  3.1264 -		in
  3.1265 -			if member (op aconv) axs ax' then
  3.1266 -				axs
  3.1267 -			else (
  3.1268 -				immediate_output (" " ^ axname);
  3.1269 -				collect_term_axioms (ax' :: axs, ax')
  3.1270 -			)
  3.1271 -		end
  3.1272 -		(* Term.term list * Term.typ -> Term.term list *)
  3.1273 -		and collect_sort_axioms (axs, T) =
  3.1274 -		let
  3.1275 -			(* string list *)
  3.1276 -			val sort = (case T of
  3.1277 -				  TFree (_, sort) => sort
  3.1278 -				| TVar (_, sort)  => sort
  3.1279 -				| _               => raise REFUTE ("collect_axioms", "type " ^
  3.1280 -					Sign.string_of_typ thy T ^ " is not a variable"))
  3.1281 -			(* obtain axioms for all superclasses *)
  3.1282 -			val superclasses = sort @ (maps (Sign.super_classes thy) sort)
  3.1283 -			(* merely an optimization, because 'collect_this_axiom' disallows *)
  3.1284 -			(* duplicate axioms anyway:                                       *)
  3.1285 -			val superclasses = distinct (op =) superclasses
  3.1286 -			val class_axioms = maps (fn class => map (fn ax =>
  3.1287 -				("<" ^ class ^ ">", Thm.prop_of ax))
  3.1288 -				(#axioms (AxClass.get_definition thy class) handle ERROR _ => []))
  3.1289 -				superclasses
  3.1290 -			(* replace the (at most one) schematic type variable in each axiom *)
  3.1291 -			(* by the actual type 'T'                                          *)
  3.1292 -			val monomorphic_class_axioms = map (fn (axname, ax) =>
  3.1293 -				(case Term.term_tvars ax of
  3.1294 -				  [] =>
  3.1295 -					(axname, ax)
  3.1296 -				| [(idx, S)] =>
  3.1297 -					(axname, monomorphic_term (Vartab.make [(idx, (S, T))]) ax)
  3.1298 -				| _ =>
  3.1299 -					raise REFUTE ("collect_axioms", "class axiom " ^ axname ^ " (" ^
  3.1300 -						Sign.string_of_term thy ax ^
  3.1301 -						") contains more than one type variable")))
  3.1302 -				class_axioms
  3.1303 -		in
  3.1304 -			fold collect_this_axiom monomorphic_class_axioms axs
  3.1305 -		end
  3.1306 -		(* Term.term list * Term.typ -> Term.term list *)
  3.1307 -		and collect_type_axioms (axs, T) =
  3.1308 -			case T of
  3.1309 -			(* simple types *)
  3.1310 -			  Type ("prop", [])      => axs
  3.1311 -			| Type ("fun", [T1, T2]) => collect_type_axioms
  3.1312 -				(collect_type_axioms (axs, T1), T2)
  3.1313 -			| Type ("set", [T1])     => collect_type_axioms (axs, T1)
  3.1314 -			(* axiomatic type classes *)
  3.1315 -			| Type ("itself", [T1])  => collect_type_axioms (axs, T1)
  3.1316 -			| Type (s, Ts)           =>
  3.1317 -				(case DatatypePackage.get_datatype thy s of
  3.1318 -				  SOME info =>  (* inductive datatype *)
  3.1319 -						(* only collect relevant type axioms for the argument types *)
  3.1320 -						Library.foldl collect_type_axioms (axs, Ts)
  3.1321 -				| NONE =>
  3.1322 -					(case get_typedef thy T of
  3.1323 -					  SOME (axname, ax) =>
  3.1324 -						collect_this_axiom (axname, ax) axs
  3.1325 -					| NONE =>
  3.1326 -						(* unspecified type, perhaps introduced with "typedecl" *)
  3.1327 -						(* at least collect relevant type axioms for the argument types *)
  3.1328 -						Library.foldl collect_type_axioms (axs, Ts)))
  3.1329 -			(* axiomatic type classes *)
  3.1330 -			| TFree _                => collect_sort_axioms (axs, T)
  3.1331 -			(* axiomatic type classes *)
  3.1332 -			| TVar _                 => collect_sort_axioms (axs, T)
  3.1333 -		(* Term.term list * Term.term -> Term.term list *)
  3.1334 -		and collect_term_axioms (axs, t) =
  3.1335 -			case t of
  3.1336 -			(* Pure *)
  3.1337 -			  Const ("all", _)                => axs
  3.1338 -			| Const ("==", _)                 => axs
  3.1339 -			| Const ("==>", _)                => axs
  3.1340 -			(* axiomatic type classes *)
  3.1341 -			| Const ("TYPE", T)               => collect_type_axioms (axs, T)
  3.1342 -			(* HOL *)
  3.1343 -			| Const ("Trueprop", _)           => axs
  3.1344 -			| Const ("Not", _)                => axs
  3.1345 -			(* redundant, since 'True' is also an IDT constructor *)
  3.1346 -			| Const ("True", _)               => axs
  3.1347 -			(* redundant, since 'False' is also an IDT constructor *)
  3.1348 -			| Const ("False", _)              => axs
  3.1349 -			| Const ("arbitrary", T)          => collect_type_axioms (axs, T)
  3.1350 -			| Const ("The", T)                =>
  3.1351 -				let
  3.1352 -					val ax = specialize_type thy ("The", T)
  3.1353 -						(lookup axioms "HOL.the_eq_trivial")
  3.1354 -				in
  3.1355 -					collect_this_axiom ("HOL.the_eq_trivial", ax) axs
  3.1356 -				end
  3.1357 -			| Const ("Hilbert_Choice.Eps", T) =>
  3.1358 -				let
  3.1359 -					val ax = specialize_type thy ("Hilbert_Choice.Eps", T)
  3.1360 -						(lookup axioms "Hilbert_Choice.someI")
  3.1361 -				in
  3.1362 -					collect_this_axiom ("Hilbert_Choice.someI", ax) axs
  3.1363 -				end
  3.1364 -			| Const ("All", T)                => collect_type_axioms (axs, T)
  3.1365 -			| Const ("Ex", T)                 => collect_type_axioms (axs, T)
  3.1366 -			| Const ("op =", T)               => collect_type_axioms (axs, T)
  3.1367 -			| Const ("op &", _)               => axs
  3.1368 -			| Const ("op |", _)               => axs
  3.1369 -			| Const ("op -->", _)             => axs
  3.1370 -			(* sets *)
  3.1371 -			| Const ("Collect", T)            => collect_type_axioms (axs, T)
  3.1372 -			| Const ("op :", T)               => collect_type_axioms (axs, T)
  3.1373 -			(* other optimizations *)
  3.1374 -			| Const ("Finite_Set.card", T)    => collect_type_axioms (axs, T)
  3.1375 -			| Const ("Finite_Set.Finites", T) => collect_type_axioms (axs, T)
  3.1376 -			| Const ("Finite_Set.finite", T)  => collect_type_axioms (axs, T)
  3.1377 -			| Const ("Orderings.less", T as Type ("fun", [Type ("nat", []),
  3.1378 -				Type ("fun", [Type ("nat", []), Type ("bool", [])])])) =>
  3.1379 -					collect_type_axioms (axs, T)
  3.1380 -			| Const ("HOL.plus", T as Type ("fun", [Type ("nat", []),
  3.1381 -				Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.1382 -					collect_type_axioms (axs, T)
  3.1383 -			| Const ("HOL.minus", T as Type ("fun", [Type ("nat", []),
  3.1384 -				Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.1385 -					collect_type_axioms (axs, T)
  3.1386 -			| Const ("HOL.times", T as Type ("fun", [Type ("nat", []),
  3.1387 -				Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.1388 -					collect_type_axioms (axs, T)
  3.1389 -			| Const ("List.op @", T)          => collect_type_axioms (axs, T)
  3.1390 -			| Const ("Lfp.lfp", T)            => collect_type_axioms (axs, T)
  3.1391 -			| Const ("Gfp.gfp", T)            => collect_type_axioms (axs, T)
  3.1392 -			| Const ("fst", T)                => collect_type_axioms (axs, T)
  3.1393 -			| Const ("snd", T)                => collect_type_axioms (axs, T)
  3.1394 -			(* simply-typed lambda calculus *)
  3.1395 -			| Const (s, T)                    =>
  3.1396 -					if is_const_of_class thy (s, T) then
  3.1397 -						(* axiomatic type classes: add "OFCLASS(?'a::c, c_class)" *)
  3.1398 -						(* and the class definition                               *)
  3.1399 -						let
  3.1400 -							val class   = Logic.class_of_const s
  3.1401 -							val inclass = Logic.mk_inclass (TVar (("'a", 0), [class]), class)
  3.1402 -							val ax_in   = SOME (specialize_type thy (s, T) inclass)
  3.1403 -								(* type match may fail due to sort constraints *)
  3.1404 -								handle Type.TYPE_MATCH => NONE
  3.1405 -							val ax_1 = Option.map (fn ax => (Sign.string_of_term thy ax, ax))
  3.1406 -								ax_in
  3.1407 -							val ax_2 = Option.map (apsnd (specialize_type thy (s, T)))
  3.1408 -								(get_classdef thy class)
  3.1409 -						in
  3.1410 -							collect_type_axioms (fold collect_this_axiom
  3.1411 -								(map_filter I [ax_1, ax_2]) axs, T)
  3.1412 -						end
  3.1413 -					else if is_IDT_constructor thy (s, T)
  3.1414 -						orelse is_IDT_recursor thy (s, T) then
  3.1415 -						(* only collect relevant type axioms *)
  3.1416 -						collect_type_axioms (axs, T)
  3.1417 -					else
  3.1418 -						(* other constants should have been unfolded, with some *)
  3.1419 -						(* exceptions: e.g. Abs_xxx/Rep_xxx functions for       *)
  3.1420 -						(* typedefs, or type-class related constants            *)
  3.1421 -						(* only collect relevant type axioms *)
  3.1422 -						collect_type_axioms (axs, T)
  3.1423 -			| Free (_, T)      => collect_type_axioms (axs, T)
  3.1424 -			| Var (_, T)       => collect_type_axioms (axs, T)
  3.1425 -			| Bound i          => axs
  3.1426 -			| Abs (_, T, body) => collect_term_axioms
  3.1427 -				(collect_type_axioms (axs, T), body)
  3.1428 -			| t1 $ t2          => collect_term_axioms
  3.1429 -				(collect_term_axioms (axs, t1), t2)
  3.1430 -		(* Term.term list *)
  3.1431 -		val result = map close_form (collect_term_axioms ([], t))
  3.1432 -		val _ = writeln " ...done."
  3.1433 -	in
  3.1434 -		result
  3.1435 -	end;
  3.1436 +  fun collect_axioms thy t =
  3.1437 +  let
  3.1438 +    val _ = immediate_output "Adding axioms..."
  3.1439 +    (* (string * Term.term) list *)
  3.1440 +    val axioms = Theory.all_axioms_of thy
  3.1441 +    (* string * Term.term -> Term.term list -> Term.term list *)
  3.1442 +    fun collect_this_axiom (axname, ax) axs =
  3.1443 +    let
  3.1444 +      val ax' = unfold_defs thy ax
  3.1445 +    in
  3.1446 +      if member (op aconv) axs ax' then
  3.1447 +        axs
  3.1448 +      else (
  3.1449 +        immediate_output (" " ^ axname);
  3.1450 +        collect_term_axioms (ax' :: axs, ax')
  3.1451 +      )
  3.1452 +    end
  3.1453 +    (* Term.term list * Term.typ -> Term.term list *)
  3.1454 +    and collect_sort_axioms (axs, T) =
  3.1455 +    let
  3.1456 +      (* string list *)
  3.1457 +      val sort = (case T of
  3.1458 +          TFree (_, sort) => sort
  3.1459 +        | TVar (_, sort)  => sort
  3.1460 +        | _               => raise REFUTE ("collect_axioms", "type " ^
  3.1461 +          Sign.string_of_typ thy T ^ " is not a variable"))
  3.1462 +      (* obtain axioms for all superclasses *)
  3.1463 +      val superclasses = sort @ (maps (Sign.super_classes thy) sort)
  3.1464 +      (* merely an optimization, because 'collect_this_axiom' disallows *)
  3.1465 +      (* duplicate axioms anyway:                                       *)
  3.1466 +      val superclasses = distinct (op =) superclasses
  3.1467 +      val class_axioms = maps (fn class => map (fn ax =>
  3.1468 +        ("<" ^ class ^ ">", Thm.prop_of ax))
  3.1469 +        (#axioms (AxClass.get_definition thy class) handle ERROR _ => []))
  3.1470 +        superclasses
  3.1471 +      (* replace the (at most one) schematic type variable in each axiom *)
  3.1472 +      (* by the actual type 'T'                                          *)
  3.1473 +      val monomorphic_class_axioms = map (fn (axname, ax) =>
  3.1474 +        (case Term.term_tvars ax of
  3.1475 +          [] =>
  3.1476 +          (axname, ax)
  3.1477 +        | [(idx, S)] =>
  3.1478 +          (axname, monomorphic_term (Vartab.make [(idx, (S, T))]) ax)
  3.1479 +        | _ =>
  3.1480 +          raise REFUTE ("collect_axioms", "class axiom " ^ axname ^ " (" ^
  3.1481 +            Sign.string_of_term thy ax ^
  3.1482 +            ") contains more than one type variable")))
  3.1483 +        class_axioms
  3.1484 +    in
  3.1485 +      fold collect_this_axiom monomorphic_class_axioms axs
  3.1486 +    end
  3.1487 +    (* Term.term list * Term.typ -> Term.term list *)
  3.1488 +    and collect_type_axioms (axs, T) =
  3.1489 +      case T of
  3.1490 +      (* simple types *)
  3.1491 +        Type ("prop", [])      => axs
  3.1492 +      | Type ("fun", [T1, T2]) => collect_type_axioms
  3.1493 +        (collect_type_axioms (axs, T1), T2)
  3.1494 +      | Type ("set", [T1])     => collect_type_axioms (axs, T1)
  3.1495 +      (* axiomatic type classes *)
  3.1496 +      | Type ("itself", [T1])  => collect_type_axioms (axs, T1)
  3.1497 +      | Type (s, Ts)           =>
  3.1498 +        (case DatatypePackage.get_datatype thy s of
  3.1499 +          SOME info =>  (* inductive datatype *)
  3.1500 +            (* only collect relevant type axioms for the argument types *)
  3.1501 +            Library.foldl collect_type_axioms (axs, Ts)
  3.1502 +        | NONE =>
  3.1503 +          (case get_typedef thy T of
  3.1504 +            SOME (axname, ax) =>
  3.1505 +            collect_this_axiom (axname, ax) axs
  3.1506 +          | NONE =>
  3.1507 +            (* unspecified type, perhaps introduced with "typedecl" *)
  3.1508 +            (* at least collect relevant type axioms for the argument types *)
  3.1509 +            Library.foldl collect_type_axioms (axs, Ts)))
  3.1510 +      (* axiomatic type classes *)
  3.1511 +      | TFree _                => collect_sort_axioms (axs, T)
  3.1512 +      (* axiomatic type classes *)
  3.1513 +      | TVar _                 => collect_sort_axioms (axs, T)
  3.1514 +    (* Term.term list * Term.term -> Term.term list *)
  3.1515 +    and collect_term_axioms (axs, t) =
  3.1516 +      case t of
  3.1517 +      (* Pure *)
  3.1518 +        Const ("all", _)                => axs
  3.1519 +      | Const ("==", _)                 => axs
  3.1520 +      | Const ("==>", _)                => axs
  3.1521 +      (* axiomatic type classes *)
  3.1522 +      | Const ("TYPE", T)               => collect_type_axioms (axs, T)
  3.1523 +      (* HOL *)
  3.1524 +      | Const ("Trueprop", _)           => axs
  3.1525 +      | Const ("Not", _)                => axs
  3.1526 +      (* redundant, since 'True' is also an IDT constructor *)
  3.1527 +      | Const ("True", _)               => axs
  3.1528 +      (* redundant, since 'False' is also an IDT constructor *)
  3.1529 +      | Const ("False", _)              => axs
  3.1530 +      | Const ("arbitrary", T)          => collect_type_axioms (axs, T)
  3.1531 +      | Const ("The", T)                =>
  3.1532 +        let
  3.1533 +          val ax = specialize_type thy ("The", T)
  3.1534 +            (lookup axioms "HOL.the_eq_trivial")
  3.1535 +        in
  3.1536 +          collect_this_axiom ("HOL.the_eq_trivial", ax) axs
  3.1537 +        end
  3.1538 +      | Const ("Hilbert_Choice.Eps", T) =>
  3.1539 +        let
  3.1540 +          val ax = specialize_type thy ("Hilbert_Choice.Eps", T)
  3.1541 +            (lookup axioms "Hilbert_Choice.someI")
  3.1542 +        in
  3.1543 +          collect_this_axiom ("Hilbert_Choice.someI", ax) axs
  3.1544 +        end
  3.1545 +      | Const ("All", T)                => collect_type_axioms (axs, T)
  3.1546 +      | Const ("Ex", T)                 => collect_type_axioms (axs, T)
  3.1547 +      | Const ("op =", T)               => collect_type_axioms (axs, T)
  3.1548 +      | Const ("op &", _)               => axs
  3.1549 +      | Const ("op |", _)               => axs
  3.1550 +      | Const ("op -->", _)             => axs
  3.1551 +      (* sets *)
  3.1552 +      | Const ("Collect", T)            => collect_type_axioms (axs, T)
  3.1553 +      | Const ("op :", T)               => collect_type_axioms (axs, T)
  3.1554 +      (* other optimizations *)
  3.1555 +      | Const ("Finite_Set.card", T)    => collect_type_axioms (axs, T)
  3.1556 +      | Const ("Finite_Set.Finites", T) => collect_type_axioms (axs, T)
  3.1557 +      | Const ("Finite_Set.finite", T)  => collect_type_axioms (axs, T)
  3.1558 +      | Const ("Orderings.less", T as Type ("fun", [Type ("nat", []),
  3.1559 +        Type ("fun", [Type ("nat", []), Type ("bool", [])])])) =>
  3.1560 +          collect_type_axioms (axs, T)
  3.1561 +      | Const ("HOL.plus", T as Type ("fun", [Type ("nat", []),
  3.1562 +        Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.1563 +          collect_type_axioms (axs, T)
  3.1564 +      | Const ("HOL.minus", T as Type ("fun", [Type ("nat", []),
  3.1565 +        Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.1566 +          collect_type_axioms (axs, T)
  3.1567 +      | Const ("HOL.times", T as Type ("fun", [Type ("nat", []),
  3.1568 +        Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.1569 +          collect_type_axioms (axs, T)
  3.1570 +      | Const ("List.op @", T)          => collect_type_axioms (axs, T)
  3.1571 +      | Const ("Lfp.lfp", T)            => collect_type_axioms (axs, T)
  3.1572 +      | Const ("Gfp.gfp", T)            => collect_type_axioms (axs, T)
  3.1573 +      | Const ("fst", T)                => collect_type_axioms (axs, T)
  3.1574 +      | Const ("snd", T)                => collect_type_axioms (axs, T)
  3.1575 +      (* simply-typed lambda calculus *)
  3.1576 +      | Const (s, T)                    =>
  3.1577 +          if is_const_of_class thy (s, T) then
  3.1578 +            (* axiomatic type classes: add "OFCLASS(?'a::c, c_class)" *)
  3.1579 +            (* and the class definition                               *)
  3.1580 +            let
  3.1581 +              val class   = Logic.class_of_const s
  3.1582 +              val inclass = Logic.mk_inclass (TVar (("'a", 0), [class]), class)
  3.1583 +              val ax_in   = SOME (specialize_type thy (s, T) inclass)
  3.1584 +                (* type match may fail due to sort constraints *)
  3.1585 +                handle Type.TYPE_MATCH => NONE
  3.1586 +              val ax_1 = Option.map (fn ax => (Sign.string_of_term thy ax, ax))
  3.1587 +                ax_in
  3.1588 +              val ax_2 = Option.map (apsnd (specialize_type thy (s, T)))
  3.1589 +                (get_classdef thy class)
  3.1590 +            in
  3.1591 +              collect_type_axioms (fold collect_this_axiom
  3.1592 +                (map_filter I [ax_1, ax_2]) axs, T)
  3.1593 +            end
  3.1594 +          else if is_IDT_constructor thy (s, T)
  3.1595 +            orelse is_IDT_recursor thy (s, T) then
  3.1596 +            (* only collect relevant type axioms *)
  3.1597 +            collect_type_axioms (axs, T)
  3.1598 +          else
  3.1599 +            (* other constants should have been unfolded, with some *)
  3.1600 +            (* exceptions: e.g. Abs_xxx/Rep_xxx functions for       *)
  3.1601 +            (* typedefs, or type-class related constants            *)
  3.1602 +            (* only collect relevant type axioms *)
  3.1603 +            collect_type_axioms (axs, T)
  3.1604 +      | Free (_, T)      => collect_type_axioms (axs, T)
  3.1605 +      | Var (_, T)       => collect_type_axioms (axs, T)
  3.1606 +      | Bound i          => axs
  3.1607 +      | Abs (_, T, body) => collect_term_axioms
  3.1608 +        (collect_type_axioms (axs, T), body)
  3.1609 +      | t1 $ t2          => collect_term_axioms
  3.1610 +        (collect_term_axioms (axs, t1), t2)
  3.1611 +    (* Term.term list *)
  3.1612 +    val result = map close_form (collect_term_axioms ([], t))
  3.1613 +    val _ = writeln " ...done."
  3.1614 +  in
  3.1615 +    result
  3.1616 +  end;
  3.1617  
  3.1618  (* ------------------------------------------------------------------------- *)
  3.1619  (* ground_types: collects all ground types in a term (including argument     *)
  3.1620 @@ -960,61 +960,61 @@
  3.1621  (*               are considered.                                             *)
  3.1622  (* ------------------------------------------------------------------------- *)
  3.1623  
  3.1624 -	(* theory -> Term.term -> Term.typ list *)
  3.1625 +  (* theory -> Term.term -> Term.typ list *)
  3.1626  
  3.1627 -	fun ground_types thy t =
  3.1628 -	let
  3.1629 -		(* Term.typ * Term.typ list -> Term.typ list *)
  3.1630 -		fun collect_types (T, acc) =
  3.1631 -			if T mem acc then
  3.1632 -				acc  (* prevent infinite recursion (for IDTs) *)
  3.1633 -			else
  3.1634 -				(case T of
  3.1635 -				  Type ("fun", [T1, T2]) => collect_types (T1, collect_types (T2, acc))
  3.1636 -				| Type ("prop", [])      => acc
  3.1637 -				| Type ("set", [T1])     => collect_types (T1, acc)
  3.1638 -				| Type (s, Ts)           =>
  3.1639 -					(case DatatypePackage.get_datatype thy s of
  3.1640 -					  SOME info =>  (* inductive datatype *)
  3.1641 -						let
  3.1642 -							val index               = #index info
  3.1643 -							val descr               = #descr info
  3.1644 -							val (_, dtyps, constrs) = lookup descr index
  3.1645 -							val typ_assoc           = dtyps ~~ Ts
  3.1646 -							(* sanity check: every element in 'dtyps' must be a 'DtTFree' *)
  3.1647 -							val _ = (if Library.exists (fn d =>
  3.1648 -									case d of DatatypeAux.DtTFree _ => false | _ => true) dtyps
  3.1649 -								then
  3.1650 -									raise REFUTE ("ground_types", "datatype argument (for type "
  3.1651 -										^ Sign.string_of_typ thy (Type (s, Ts))
  3.1652 -										^ ") is not a variable")
  3.1653 -								else
  3.1654 -									())
  3.1655 -							(* if the current type is a recursive IDT (i.e. a depth is *)
  3.1656 -							(* required), add it to 'acc'                              *)
  3.1657 -							val acc' = (if Library.exists (fn (_, ds) => Library.exists
  3.1658 -								DatatypeAux.is_rec_type ds) constrs then
  3.1659 -									insert (op =) T acc
  3.1660 -								else
  3.1661 -									acc)
  3.1662 -							(* collect argument types *)
  3.1663 -							val acc_args = foldr collect_types acc' Ts
  3.1664 -							(* collect constructor types *)
  3.1665 -							val acc_constrs = foldr collect_types acc_args (List.concat
  3.1666 -								(map (fn (_, ds) => map (typ_of_dtyp descr typ_assoc) ds)
  3.1667 -									constrs))
  3.1668 -						in
  3.1669 -							acc_constrs
  3.1670 -						end
  3.1671 -					| NONE =>
  3.1672 -						(* not an inductive datatype, e.g. defined via "typedef" or *)
  3.1673 -						(* "typedecl"                                               *)
  3.1674 -						insert (op =) T (foldr collect_types acc Ts))
  3.1675 -				| TFree _                => insert (op =) T acc
  3.1676 -				| TVar _                 => insert (op =) T acc)
  3.1677 -	in
  3.1678 -		it_term_types collect_types (t, [])
  3.1679 -	end;
  3.1680 +  fun ground_types thy t =
  3.1681 +  let
  3.1682 +    (* Term.typ * Term.typ list -> Term.typ list *)
  3.1683 +    fun collect_types (T, acc) =
  3.1684 +      if T mem acc then
  3.1685 +        acc  (* prevent infinite recursion (for IDTs) *)
  3.1686 +      else
  3.1687 +        (case T of
  3.1688 +          Type ("fun", [T1, T2]) => collect_types (T1, collect_types (T2, acc))
  3.1689 +        | Type ("prop", [])      => acc
  3.1690 +        | Type ("set", [T1])     => collect_types (T1, acc)
  3.1691 +        | Type (s, Ts)           =>
  3.1692 +          (case DatatypePackage.get_datatype thy s of
  3.1693 +            SOME info =>  (* inductive datatype *)
  3.1694 +            let
  3.1695 +              val index               = #index info
  3.1696 +              val descr               = #descr info
  3.1697 +              val (_, dtyps, constrs) = lookup descr index
  3.1698 +              val typ_assoc           = dtyps ~~ Ts
  3.1699 +              (* sanity check: every element in 'dtyps' must be a 'DtTFree' *)
  3.1700 +              val _ = (if Library.exists (fn d =>
  3.1701 +                  case d of DatatypeAux.DtTFree _ => false | _ => true) dtyps
  3.1702 +                then
  3.1703 +                  raise REFUTE ("ground_types", "datatype argument (for type "
  3.1704 +                    ^ Sign.string_of_typ thy (Type (s, Ts))
  3.1705 +                    ^ ") is not a variable")
  3.1706 +                else
  3.1707 +                  ())
  3.1708 +              (* if the current type is a recursive IDT (i.e. a depth is *)
  3.1709 +              (* required), add it to 'acc'                              *)
  3.1710 +              val acc' = (if Library.exists (fn (_, ds) => Library.exists
  3.1711 +                DatatypeAux.is_rec_type ds) constrs then
  3.1712 +                  insert (op =) T acc
  3.1713 +                else
  3.1714 +                  acc)
  3.1715 +              (* collect argument types *)
  3.1716 +              val acc_args = foldr collect_types acc' Ts
  3.1717 +              (* collect constructor types *)
  3.1718 +              val acc_constrs = foldr collect_types acc_args (List.concat
  3.1719 +                (map (fn (_, ds) => map (typ_of_dtyp descr typ_assoc) ds)
  3.1720 +                  constrs))
  3.1721 +            in
  3.1722 +              acc_constrs
  3.1723 +            end
  3.1724 +          | NONE =>
  3.1725 +            (* not an inductive datatype, e.g. defined via "typedef" or *)
  3.1726 +            (* "typedecl"                                               *)
  3.1727 +            insert (op =) T (foldr collect_types acc Ts))
  3.1728 +        | TFree _                => insert (op =) T acc
  3.1729 +        | TVar _                 => insert (op =) T acc)
  3.1730 +  in
  3.1731 +    it_term_types collect_types (t, [])
  3.1732 +  end;
  3.1733  
  3.1734  (* ------------------------------------------------------------------------- *)
  3.1735  (* string_of_typ: (rather naive) conversion from types to strings, used to   *)
  3.1736 @@ -1023,11 +1023,11 @@
  3.1737  (*                list") are identified.                                     *)
  3.1738  (* ------------------------------------------------------------------------- *)
  3.1739  
  3.1740 -	(* Term.typ -> string *)
  3.1741 +  (* Term.typ -> string *)
  3.1742  
  3.1743 -	fun string_of_typ (Type (s, _))     = s
  3.1744 -	  | string_of_typ (TFree (s, _))    = s
  3.1745 -	  | string_of_typ (TVar ((s,_), _)) = s;
  3.1746 +  fun string_of_typ (Type (s, _))     = s
  3.1747 +    | string_of_typ (TFree (s, _))    = s
  3.1748 +    | string_of_typ (TVar ((s,_), _)) = s;
  3.1749  
  3.1750  (* ------------------------------------------------------------------------- *)
  3.1751  (* first_universe: returns the "first" (i.e. smallest) universe by assigning *)
  3.1752 @@ -1035,17 +1035,17 @@
  3.1753  (*                 'sizes'                                                   *)
  3.1754  (* ------------------------------------------------------------------------- *)
  3.1755  
  3.1756 -	(* Term.typ list -> (string * int) list -> int -> (Term.typ * int) list *)
  3.1757 +  (* Term.typ list -> (string * int) list -> int -> (Term.typ * int) list *)
  3.1758  
  3.1759 -	fun first_universe xs sizes minsize =
  3.1760 -	let
  3.1761 -		fun size_of_typ T =
  3.1762 -			case AList.lookup (op =) sizes (string_of_typ T) of
  3.1763 -			  SOME n => n
  3.1764 -			| NONE   => minsize
  3.1765 -	in
  3.1766 -		map (fn T => (T, size_of_typ T)) xs
  3.1767 -	end;
  3.1768 +  fun first_universe xs sizes minsize =
  3.1769 +  let
  3.1770 +    fun size_of_typ T =
  3.1771 +      case AList.lookup (op =) sizes (string_of_typ T) of
  3.1772 +        SOME n => n
  3.1773 +      | NONE   => minsize
  3.1774 +  in
  3.1775 +    map (fn T => (T, size_of_typ T)) xs
  3.1776 +  end;
  3.1777  
  3.1778  (* ------------------------------------------------------------------------- *)
  3.1779  (* next_universe: enumerates all universes (i.e. assignments of sizes to     *)
  3.1780 @@ -1054,70 +1054,70 @@
  3.1781  (*                type may have a fixed size given in 'sizes'                *)
  3.1782  (* ------------------------------------------------------------------------- *)
  3.1783  
  3.1784 -	(* (Term.typ * int) list -> (string * int) list -> int -> int ->
  3.1785 -		(Term.typ * int) list option *)
  3.1786 +  (* (Term.typ * int) list -> (string * int) list -> int -> int ->
  3.1787 +    (Term.typ * int) list option *)
  3.1788  
  3.1789 -	fun next_universe xs sizes minsize maxsize =
  3.1790 -	let
  3.1791 -		(* creates the "first" list of length 'len', where the sum of all list *)
  3.1792 -		(* elements is 'sum', and the length of the list is 'len'              *)
  3.1793 -		(* int -> int -> int -> int list option *)
  3.1794 -		fun make_first _ 0 sum =
  3.1795 -			if sum=0 then
  3.1796 -				SOME []
  3.1797 -			else
  3.1798 -				NONE
  3.1799 -		  | make_first max len sum =
  3.1800 -			if sum<=max orelse max<0 then
  3.1801 -				Option.map (fn xs' => sum :: xs') (make_first max (len-1) 0)
  3.1802 -			else
  3.1803 -				Option.map (fn xs' => max :: xs') (make_first max (len-1) (sum-max))
  3.1804 -		(* enumerates all int lists with a fixed length, where 0<=x<='max' for *)
  3.1805 -		(* all list elements x (unless 'max'<0)                                *)
  3.1806 -		(* int -> int -> int -> int list -> int list option *)
  3.1807 -		fun next max len sum [] =
  3.1808 -			NONE
  3.1809 -		  | next max len sum [x] =
  3.1810 -			(* we've reached the last list element, so there's no shift possible *)
  3.1811 -			make_first max (len+1) (sum+x+1)  (* increment 'sum' by 1 *)
  3.1812 -		  | next max len sum (x1::x2::xs) =
  3.1813 -			if x1>0 andalso (x2<max orelse max<0) then
  3.1814 -				(* we can shift *)
  3.1815 -				SOME (valOf (make_first max (len+1) (sum+x1-1)) @ (x2+1) :: xs)
  3.1816 -			else
  3.1817 -				(* continue search *)
  3.1818 -				next max (len+1) (sum+x1) (x2::xs)
  3.1819 -		(* only consider those types for which the size is not fixed *)
  3.1820 -		val mutables = List.filter
  3.1821 -			(not o (AList.defined (op =) sizes) o string_of_typ o fst) xs
  3.1822 -		(* subtract 'minsize' from every size (will be added again at the end) *)
  3.1823 -		val diffs = map (fn (_, n) => n-minsize) mutables
  3.1824 -	in
  3.1825 -		case next (maxsize-minsize) 0 0 diffs of
  3.1826 -		  SOME diffs' =>
  3.1827 -			(* merge with those types for which the size is fixed *)
  3.1828 -			SOME (snd (foldl_map (fn (ds, (T, _)) =>
  3.1829 -				case AList.lookup (op =) sizes (string_of_typ T) of
  3.1830 -				(* return the fixed size *)
  3.1831 -				  SOME n => (ds, (T, n))
  3.1832 -				(* consume the head of 'ds', add 'minsize' *)
  3.1833 -				| NONE   => (tl ds, (T, minsize + hd ds)))
  3.1834 -				(diffs', xs)))
  3.1835 -		| NONE =>
  3.1836 -			NONE
  3.1837 -	end;
  3.1838 +  fun next_universe xs sizes minsize maxsize =
  3.1839 +  let
  3.1840 +    (* creates the "first" list of length 'len', where the sum of all list *)
  3.1841 +    (* elements is 'sum', and the length of the list is 'len'              *)
  3.1842 +    (* int -> int -> int -> int list option *)
  3.1843 +    fun make_first _ 0 sum =
  3.1844 +      if sum=0 then
  3.1845 +        SOME []
  3.1846 +      else
  3.1847 +        NONE
  3.1848 +      | make_first max len sum =
  3.1849 +      if sum<=max orelse max<0 then
  3.1850 +        Option.map (fn xs' => sum :: xs') (make_first max (len-1) 0)
  3.1851 +      else
  3.1852 +        Option.map (fn xs' => max :: xs') (make_first max (len-1) (sum-max))
  3.1853 +    (* enumerates all int lists with a fixed length, where 0<=x<='max' for *)
  3.1854 +    (* all list elements x (unless 'max'<0)                                *)
  3.1855 +    (* int -> int -> int -> int list -> int list option *)
  3.1856 +    fun next max len sum [] =
  3.1857 +      NONE
  3.1858 +      | next max len sum [x] =
  3.1859 +      (* we've reached the last list element, so there's no shift possible *)
  3.1860 +      make_first max (len+1) (sum+x+1)  (* increment 'sum' by 1 *)
  3.1861 +      | next max len sum (x1::x2::xs) =
  3.1862 +      if x1>0 andalso (x2<max orelse max<0) then
  3.1863 +        (* we can shift *)
  3.1864 +        SOME (valOf (make_first max (len+1) (sum+x1-1)) @ (x2+1) :: xs)
  3.1865 +      else
  3.1866 +        (* continue search *)
  3.1867 +        next max (len+1) (sum+x1) (x2::xs)
  3.1868 +    (* only consider those types for which the size is not fixed *)
  3.1869 +    val mutables = List.filter
  3.1870 +      (not o (AList.defined (op =) sizes) o string_of_typ o fst) xs
  3.1871 +    (* subtract 'minsize' from every size (will be added again at the end) *)
  3.1872 +    val diffs = map (fn (_, n) => n-minsize) mutables
  3.1873 +  in
  3.1874 +    case next (maxsize-minsize) 0 0 diffs of
  3.1875 +      SOME diffs' =>
  3.1876 +      (* merge with those types for which the size is fixed *)
  3.1877 +      SOME (snd (foldl_map (fn (ds, (T, _)) =>
  3.1878 +        case AList.lookup (op =) sizes (string_of_typ T) of
  3.1879 +        (* return the fixed size *)
  3.1880 +          SOME n => (ds, (T, n))
  3.1881 +        (* consume the head of 'ds', add 'minsize' *)
  3.1882 +        | NONE   => (tl ds, (T, minsize + hd ds)))
  3.1883 +        (diffs', xs)))
  3.1884 +    | NONE =>
  3.1885 +      NONE
  3.1886 +  end;
  3.1887  
  3.1888  (* ------------------------------------------------------------------------- *)
  3.1889  (* toTrue: converts the interpretation of a Boolean value to a propositional *)
  3.1890  (*         formula that is true iff the interpretation denotes "true"        *)
  3.1891  (* ------------------------------------------------------------------------- *)
  3.1892  
  3.1893 -	(* interpretation -> prop_formula *)
  3.1894 +  (* interpretation -> prop_formula *)
  3.1895  
  3.1896 -	fun toTrue (Leaf [fm, _]) =
  3.1897 -		fm
  3.1898 -	  | toTrue _              =
  3.1899 -		raise REFUTE ("toTrue", "interpretation does not denote a Boolean value");
  3.1900 +  fun toTrue (Leaf [fm, _]) =
  3.1901 +    fm
  3.1902 +    | toTrue _              =
  3.1903 +    raise REFUTE ("toTrue", "interpretation does not denote a Boolean value");
  3.1904  
  3.1905  (* ------------------------------------------------------------------------- *)
  3.1906  (* toFalse: converts the interpretation of a Boolean value to a              *)
  3.1907 @@ -1125,12 +1125,12 @@
  3.1908  (*          denotes "false"                                                  *)
  3.1909  (* ------------------------------------------------------------------------- *)
  3.1910  
  3.1911 -	(* interpretation -> prop_formula *)
  3.1912 +  (* interpretation -> prop_formula *)
  3.1913  
  3.1914 -	fun toFalse (Leaf [_, fm]) =
  3.1915 -		fm
  3.1916 -	  | toFalse _              =
  3.1917 -		raise REFUTE ("toFalse", "interpretation does not denote a Boolean value");
  3.1918 +  fun toFalse (Leaf [_, fm]) =
  3.1919 +    fm
  3.1920 +    | toFalse _              =
  3.1921 +    raise REFUTE ("toFalse", "interpretation does not denote a Boolean value");
  3.1922  
  3.1923  (* ------------------------------------------------------------------------- *)
  3.1924  (* find_model: repeatedly calls 'interpret' with appropriate parameters,     *)
  3.1925 @@ -1142,121 +1142,121 @@
  3.1926  (* negate    : if true, find a model that makes 't' false (rather than true) *)
  3.1927  (* ------------------------------------------------------------------------- *)
  3.1928  
  3.1929 -	(* theory -> params -> Term.term -> bool -> unit *)
  3.1930 +  (* theory -> params -> Term.term -> bool -> unit *)
  3.1931  
  3.1932 -	fun find_model thy {sizes, minsize, maxsize, maxvars, maxtime, satsolver} t
  3.1933 -		negate =
  3.1934 -	let
  3.1935 -		(* unit -> unit *)
  3.1936 -		fun wrapper () =
  3.1937 -		let
  3.1938 -			val u      = unfold_defs thy t
  3.1939 -			val _      = writeln ("Unfolded term: " ^ Sign.string_of_term thy u)
  3.1940 -			val axioms = collect_axioms thy u
  3.1941 -			(* Term.typ list *)
  3.1942 -			val types = Library.foldl (fn (acc, t') =>
  3.1943 -				acc union (ground_types thy t')) ([], u :: axioms)
  3.1944 -			val _     = writeln ("Ground types: "
  3.1945 -				^ (if null types then "none."
  3.1946 -				   else commas (map (Sign.string_of_typ thy) types)))
  3.1947 -			(* we can only consider fragments of recursive IDTs, so we issue a  *)
  3.1948 -			(* warning if the formula contains a recursive IDT                  *)
  3.1949 -			(* TODO: no warning needed for /positive/ occurrences of IDTs       *)
  3.1950 -			val _ = if Library.exists (fn
  3.1951 -				  Type (s, _) =>
  3.1952 -					(case DatatypePackage.get_datatype thy s of
  3.1953 -					  SOME info =>  (* inductive datatype *)
  3.1954 -						let
  3.1955 -							val index           = #index info
  3.1956 -							val descr           = #descr info
  3.1957 -							val (_, _, constrs) = lookup descr index
  3.1958 -						in
  3.1959 -							(* recursive datatype? *)
  3.1960 -							Library.exists (fn (_, ds) =>
  3.1961 -								Library.exists DatatypeAux.is_rec_type ds) constrs
  3.1962 -						end
  3.1963 -					| NONE => false)
  3.1964 -				| _ => false) types then
  3.1965 -					warning ("Term contains a recursive datatype; "
  3.1966 -						^ "countermodel(s) may be spurious!")
  3.1967 -				else
  3.1968 -					()
  3.1969 -			(* (Term.typ * int) list -> unit *)
  3.1970 -			fun find_model_loop universe =
  3.1971 -			let
  3.1972 -				val init_model = (universe, [])
  3.1973 -				val init_args  = {maxvars = maxvars, def_eq = false, next_idx = 1,
  3.1974 -					bounds = [], wellformed = True}
  3.1975 -				val _          = immediate_output ("Translating term (sizes: "
  3.1976 -					^ commas (map (fn (_, n) => string_of_int n) universe) ^ ") ...")
  3.1977 -				(* translate 'u' and all axioms *)
  3.1978 -				val ((model, args), intrs) = foldl_map (fn ((m, a), t') =>
  3.1979 -					let
  3.1980 -						val (i, m', a') = interpret thy m a t'
  3.1981 -					in
  3.1982 -						(* set 'def_eq' to 'true' *)
  3.1983 -						((m', {maxvars = #maxvars a', def_eq = true,
  3.1984 -							next_idx = #next_idx a', bounds = #bounds a',
  3.1985 -							wellformed = #wellformed a'}), i)
  3.1986 -					end) ((init_model, init_args), u :: axioms)
  3.1987 -				(* make 'u' either true or false, and make all axioms true, and *)
  3.1988 -				(* add the well-formedness side condition                       *)
  3.1989 -				val fm_u  = (if negate then toFalse else toTrue) (hd intrs)
  3.1990 -				val fm_ax = PropLogic.all (map toTrue (tl intrs))
  3.1991 -				val fm    = PropLogic.all [#wellformed args, fm_ax, fm_u]
  3.1992 -			in
  3.1993 -				immediate_output " invoking SAT solver...";
  3.1994 -				(case SatSolver.invoke_solver satsolver fm of
  3.1995 -				  SatSolver.SATISFIABLE assignment =>
  3.1996 -					(writeln " model found!";
  3.1997 -					writeln ("*** Model found: ***\n" ^ print_model thy model
  3.1998 -						(fn i => case assignment i of SOME b => b | NONE => true)))
  3.1999 -				| SatSolver.UNSATISFIABLE _ =>
  3.2000 -					(immediate_output " no model exists.\n";
  3.2001 -					case next_universe universe sizes minsize maxsize of
  3.2002 -					  SOME universe' => find_model_loop universe'
  3.2003 -					| NONE           => writeln
  3.2004 -						"Search terminated, no larger universe within the given limits.")
  3.2005 -				| SatSolver.UNKNOWN =>
  3.2006 -					(immediate_output " no model found.\n";
  3.2007 -					case next_universe universe sizes minsize maxsize of
  3.2008 -					  SOME universe' => find_model_loop universe'
  3.2009 -					| NONE           => writeln
  3.2010 -						"Search terminated, no larger universe within the given limits.")
  3.2011 -				) handle SatSolver.NOT_CONFIGURED =>
  3.2012 -					error ("SAT solver " ^ quote satsolver ^ " is not configured.")
  3.2013 -			end handle MAXVARS_EXCEEDED =>
  3.2014 -				writeln ("\nSearch terminated, number of Boolean variables ("
  3.2015 -					^ string_of_int maxvars ^ " allowed) exceeded.")
  3.2016 -			in
  3.2017 -				find_model_loop (first_universe types sizes minsize)
  3.2018 -			end
  3.2019 -		in
  3.2020 -			(* some parameter sanity checks *)
  3.2021 -			assert (minsize>=1)
  3.2022 -				("\"minsize\" is " ^ string_of_int minsize ^ ", must be at least 1");
  3.2023 -			assert (maxsize>=1)
  3.2024 -				("\"maxsize\" is " ^ string_of_int maxsize ^ ", must be at least 1");
  3.2025 -			assert (maxsize>=minsize)
  3.2026 -				("\"maxsize\" (=" ^ string_of_int maxsize ^
  3.2027 -				") is less than \"minsize\" (=" ^ string_of_int minsize ^ ").");
  3.2028 -			assert (maxvars>=0)
  3.2029 -				("\"maxvars\" is " ^ string_of_int maxvars ^ ", must be at least 0");
  3.2030 -			assert (maxtime>=0)
  3.2031 -				("\"maxtime\" is " ^ string_of_int maxtime ^ ", must be at least 0");
  3.2032 -			(* enter loop with or without time limit *)
  3.2033 -			writeln ("Trying to find a model that "
  3.2034 -				^ (if negate then "refutes" else "satisfies") ^ ": "
  3.2035 -				^ Sign.string_of_term thy t);
  3.2036 -			if maxtime>0 then (
  3.2037 -				interrupt_timeout (Time.fromSeconds (Int.toLarge maxtime))
  3.2038 -					wrapper ()
  3.2039 -				handle Interrupt =>
  3.2040 -					writeln ("\nSearch terminated, time limit (" ^ string_of_int maxtime
  3.2041 -						^ (if maxtime=1 then " second" else " seconds") ^ ") exceeded.")
  3.2042 -			) else
  3.2043 -				wrapper ()
  3.2044 -		end;
  3.2045 +  fun find_model thy {sizes, minsize, maxsize, maxvars, maxtime, satsolver} t
  3.2046 +    negate =
  3.2047 +  let
  3.2048 +    (* unit -> unit *)
  3.2049 +    fun wrapper () =
  3.2050 +    let
  3.2051 +      val u      = unfold_defs thy t
  3.2052 +      val _      = writeln ("Unfolded term: " ^ Sign.string_of_term thy u)
  3.2053 +      val axioms = collect_axioms thy u
  3.2054 +      (* Term.typ list *)
  3.2055 +      val types = Library.foldl (fn (acc, t') =>
  3.2056 +        acc union (ground_types thy t')) ([], u :: axioms)
  3.2057 +      val _     = writeln ("Ground types: "
  3.2058 +        ^ (if null types then "none."
  3.2059 +           else commas (map (Sign.string_of_typ thy) types)))
  3.2060 +      (* we can only consider fragments of recursive IDTs, so we issue a  *)
  3.2061 +      (* warning if the formula contains a recursive IDT                  *)
  3.2062 +      (* TODO: no warning needed for /positive/ occurrences of IDTs       *)
  3.2063 +      val _ = if Library.exists (fn
  3.2064 +          Type (s, _) =>
  3.2065 +          (case DatatypePackage.get_datatype thy s of
  3.2066 +            SOME info =>  (* inductive datatype *)
  3.2067 +            let
  3.2068 +              val index           = #index info
  3.2069 +              val descr           = #descr info
  3.2070 +              val (_, _, constrs) = lookup descr index
  3.2071 +            in
  3.2072 +              (* recursive datatype? *)
  3.2073 +              Library.exists (fn (_, ds) =>
  3.2074 +                Library.exists DatatypeAux.is_rec_type ds) constrs
  3.2075 +            end
  3.2076 +          | NONE => false)
  3.2077 +        | _ => false) types then
  3.2078 +          warning ("Term contains a recursive datatype; "
  3.2079 +            ^ "countermodel(s) may be spurious!")
  3.2080 +        else
  3.2081 +          ()
  3.2082 +      (* (Term.typ * int) list -> unit *)
  3.2083 +      fun find_model_loop universe =
  3.2084 +      let
  3.2085 +        val init_model = (universe, [])
  3.2086 +        val init_args  = {maxvars = maxvars, def_eq = false, next_idx = 1,
  3.2087 +          bounds = [], wellformed = True}
  3.2088 +        val _          = immediate_output ("Translating term (sizes: "
  3.2089 +          ^ commas (map (fn (_, n) => string_of_int n) universe) ^ ") ...")
  3.2090 +        (* translate 'u' and all axioms *)
  3.2091 +        val ((model, args), intrs) = foldl_map (fn ((m, a), t') =>
  3.2092 +          let
  3.2093 +            val (i, m', a') = interpret thy m a t'
  3.2094 +          in
  3.2095 +            (* set 'def_eq' to 'true' *)
  3.2096 +            ((m', {maxvars = #maxvars a', def_eq = true,
  3.2097 +              next_idx = #next_idx a', bounds = #bounds a',
  3.2098 +              wellformed = #wellformed a'}), i)
  3.2099 +          end) ((init_model, init_args), u :: axioms)
  3.2100 +        (* make 'u' either true or false, and make all axioms true, and *)
  3.2101 +        (* add the well-formedness side condition                       *)
  3.2102 +        val fm_u  = (if negate then toFalse else toTrue) (hd intrs)
  3.2103 +        val fm_ax = PropLogic.all (map toTrue (tl intrs))
  3.2104 +        val fm    = PropLogic.all [#wellformed args, fm_ax, fm_u]
  3.2105 +      in
  3.2106 +        immediate_output " invoking SAT solver...";
  3.2107 +        (case SatSolver.invoke_solver satsolver fm of
  3.2108 +          SatSolver.SATISFIABLE assignment =>
  3.2109 +          (writeln " model found!";
  3.2110 +          writeln ("*** Model found: ***\n" ^ print_model thy model
  3.2111 +            (fn i => case assignment i of SOME b => b | NONE => true)))
  3.2112 +        | SatSolver.UNSATISFIABLE _ =>
  3.2113 +          (immediate_output " no model exists.\n";
  3.2114 +          case next_universe universe sizes minsize maxsize of
  3.2115 +            SOME universe' => find_model_loop universe'
  3.2116 +          | NONE           => writeln
  3.2117 +            "Search terminated, no larger universe within the given limits.")
  3.2118 +        | SatSolver.UNKNOWN =>
  3.2119 +          (immediate_output " no model found.\n";
  3.2120 +          case next_universe universe sizes minsize maxsize of
  3.2121 +            SOME universe' => find_model_loop universe'
  3.2122 +          | NONE           => writeln
  3.2123 +            "Search terminated, no larger universe within the given limits.")
  3.2124 +        ) handle SatSolver.NOT_CONFIGURED =>
  3.2125 +          error ("SAT solver " ^ quote satsolver ^ " is not configured.")
  3.2126 +      end handle MAXVARS_EXCEEDED =>
  3.2127 +        writeln ("\nSearch terminated, number of Boolean variables ("
  3.2128 +          ^ string_of_int maxvars ^ " allowed) exceeded.")
  3.2129 +      in
  3.2130 +        find_model_loop (first_universe types sizes minsize)
  3.2131 +      end
  3.2132 +    in
  3.2133 +      (* some parameter sanity checks *)
  3.2134 +      minsize>=1 orelse
  3.2135 +        error ("\"minsize\" is " ^ string_of_int minsize ^ ", must be at least 1");
  3.2136 +      maxsize>=1 orelse
  3.2137 +        error ("\"maxsize\" is " ^ string_of_int maxsize ^ ", must be at least 1");
  3.2138 +      maxsize>=minsize orelse
  3.2139 +        error ("\"maxsize\" (=" ^ string_of_int maxsize ^
  3.2140 +        ") is less than \"minsize\" (=" ^ string_of_int minsize ^ ").");
  3.2141 +      maxvars>=0 orelse
  3.2142 +        error ("\"maxvars\" is " ^ string_of_int maxvars ^ ", must be at least 0");
  3.2143 +      maxtime>=0 orelse
  3.2144 +        error ("\"maxtime\" is " ^ string_of_int maxtime ^ ", must be at least 0");
  3.2145 +      (* enter loop with or without time limit *)
  3.2146 +      writeln ("Trying to find a model that "
  3.2147 +        ^ (if negate then "refutes" else "satisfies") ^ ": "
  3.2148 +        ^ Sign.string_of_term thy t);
  3.2149 +      if maxtime>0 then (
  3.2150 +        interrupt_timeout (Time.fromSeconds (Int.toLarge maxtime))
  3.2151 +          wrapper ()
  3.2152 +        handle Interrupt =>
  3.2153 +          writeln ("\nSearch terminated, time limit (" ^ string_of_int maxtime
  3.2154 +            ^ (if maxtime=1 then " second" else " seconds") ^ ") exceeded.")
  3.2155 +      ) else
  3.2156 +        wrapper ()
  3.2157 +    end;
  3.2158  
  3.2159  
  3.2160  (* ------------------------------------------------------------------------- *)
  3.2161 @@ -1269,10 +1269,10 @@
  3.2162  (*               parameters                                                  *)
  3.2163  (* ------------------------------------------------------------------------- *)
  3.2164  
  3.2165 -	(* theory -> (string * string) list -> Term.term -> unit *)
  3.2166 +  (* theory -> (string * string) list -> Term.term -> unit *)
  3.2167  
  3.2168 -	fun satisfy_term thy params t =
  3.2169 -		find_model thy (actual_params thy params) t false;
  3.2170 +  fun satisfy_term thy params t =
  3.2171 +    find_model thy (actual_params thy params) t false;
  3.2172  
  3.2173  (* ------------------------------------------------------------------------- *)
  3.2174  (* refute_term: calls 'find_model' to find a model that refutes 't'          *)
  3.2175 @@ -1280,57 +1280,57 @@
  3.2176  (*              parameters                                                   *)
  3.2177  (* ------------------------------------------------------------------------- *)
  3.2178  
  3.2179 -	(* theory -> (string * string) list -> Term.term -> unit *)
  3.2180 +  (* theory -> (string * string) list -> Term.term -> unit *)
  3.2181  
  3.2182 -	fun refute_term thy params t =
  3.2183 -	let
  3.2184 -		(* disallow schematic type variables, since we cannot properly negate  *)
  3.2185 -		(* terms containing them (their logical meaning is that there EXISTS a *)
  3.2186 -		(* type s.t. ...; to refute such a formula, we would have to show that *)
  3.2187 -		(* for ALL types, not ...)                                             *)
  3.2188 -		val _ = assert (null (term_tvars t))
  3.2189 -			"Term to be refuted contains schematic type variables"
  3.2190 +  fun refute_term thy params t =
  3.2191 +  let
  3.2192 +    (* disallow schematic type variables, since we cannot properly negate  *)
  3.2193 +    (* terms containing them (their logical meaning is that there EXISTS a *)
  3.2194 +    (* type s.t. ...; to refute such a formula, we would have to show that *)
  3.2195 +    (* for ALL types, not ...)                                             *)
  3.2196 +    val _ = null (term_tvars t) orelse
  3.2197 +      error "Term to be refuted contains schematic type variables"
  3.2198  
  3.2199 -		(* existential closure over schematic variables *)
  3.2200 -		(* (Term.indexname * Term.typ) list *)
  3.2201 -		val vars = sort_wrt (fst o fst) (map dest_Var (term_vars t))
  3.2202 -		(* Term.term *)
  3.2203 -		val ex_closure = Library.foldl (fn (t', ((x, i), T)) =>
  3.2204 -			(HOLogic.exists_const T) $
  3.2205 -				Abs (x, T, abstract_over (Var ((x, i), T), t')))
  3.2206 -			(t, vars)
  3.2207 -		(* Note: If 't' is of type 'propT' (rather than 'boolT'), applying   *)
  3.2208 -		(* 'HOLogic.exists_const' is not type-correct.  However, this is not *)
  3.2209 -		(* really a problem as long as 'find_model' still interprets the     *)
  3.2210 -		(* resulting term correctly, without checking its type.              *)
  3.2211 +    (* existential closure over schematic variables *)
  3.2212 +    (* (Term.indexname * Term.typ) list *)
  3.2213 +    val vars = sort_wrt (fst o fst) (map dest_Var (term_vars t))
  3.2214 +    (* Term.term *)
  3.2215 +    val ex_closure = Library.foldl (fn (t', ((x, i), T)) =>
  3.2216 +      (HOLogic.exists_const T) $
  3.2217 +        Abs (x, T, abstract_over (Var ((x, i), T), t')))
  3.2218 +      (t, vars)
  3.2219 +    (* Note: If 't' is of type 'propT' (rather than 'boolT'), applying   *)
  3.2220 +    (* 'HOLogic.exists_const' is not type-correct.  However, this is not *)
  3.2221 +    (* really a problem as long as 'find_model' still interprets the     *)
  3.2222 +    (* resulting term correctly, without checking its type.              *)
  3.2223  
  3.2224 -		(* replace outermost universally quantified variables by Free's:     *)
  3.2225 -		(* refuting a term with Free's is generally faster than refuting a   *)
  3.2226 -		(* term with (nested) quantifiers, because quantifiers are expanded, *)
  3.2227 -		(* while the SAT solver searches for an interpretation for Free's.   *)
  3.2228 -		(* Also we get more information back that way, namely an             *)
  3.2229 -		(* interpretation which includes values for the (formerly)           *)
  3.2230 -		(* quantified variables.                                             *)
  3.2231 -		(* maps  !!x1...xn. !xk...xm. t   to   t  *)
  3.2232 -		fun strip_all_body (Const ("all", _) $ Abs (_, _, t)) = strip_all_body t
  3.2233 -		  | strip_all_body (Const ("Trueprop", _) $ t)        = strip_all_body t
  3.2234 -		  | strip_all_body (Const ("All", _) $ Abs (_, _, t)) = strip_all_body t
  3.2235 -		  | strip_all_body t                                  = t
  3.2236 -		(* maps  !!x1...xn. !xk...xm. t   to   [x1, ..., xn, xk, ..., xm]  *)
  3.2237 -		fun strip_all_vars (Const ("all", _) $ Abs (a, T, t)) =
  3.2238 -			(a, T) :: strip_all_vars t
  3.2239 -		  | strip_all_vars (Const ("Trueprop", _) $ t)        =
  3.2240 -			strip_all_vars t
  3.2241 -		  | strip_all_vars (Const ("All", _) $ Abs (a, T, t)) =
  3.2242 -			(a, T) :: strip_all_vars t
  3.2243 -		  | strip_all_vars t                                  =
  3.2244 -			[] : (string * typ) list
  3.2245 -		val strip_t = strip_all_body ex_closure
  3.2246 -		val frees   = Term.rename_wrt_term strip_t (strip_all_vars ex_closure)
  3.2247 -		val subst_t = Term.subst_bounds (map Free frees, strip_t)
  3.2248 -	in
  3.2249 -		find_model thy (actual_params thy params) subst_t true
  3.2250 -	end;
  3.2251 +    (* replace outermost universally quantified variables by Free's:     *)
  3.2252 +    (* refuting a term with Free's is generally faster than refuting a   *)
  3.2253 +    (* term with (nested) quantifiers, because quantifiers are expanded, *)
  3.2254 +    (* while the SAT solver searches for an interpretation for Free's.   *)
  3.2255 +    (* Also we get more information back that way, namely an             *)
  3.2256 +    (* interpretation which includes values for the (formerly)           *)
  3.2257 +    (* quantified variables.                                             *)
  3.2258 +    (* maps  !!x1...xn. !xk...xm. t   to   t  *)
  3.2259 +    fun strip_all_body (Const ("all", _) $ Abs (_, _, t)) = strip_all_body t
  3.2260 +      | strip_all_body (Const ("Trueprop", _) $ t)        = strip_all_body t
  3.2261 +      | strip_all_body (Const ("All", _) $ Abs (_, _, t)) = strip_all_body t
  3.2262 +      | strip_all_body t                                  = t
  3.2263 +    (* maps  !!x1...xn. !xk...xm. t   to   [x1, ..., xn, xk, ..., xm]  *)
  3.2264 +    fun strip_all_vars (Const ("all", _) $ Abs (a, T, t)) =
  3.2265 +      (a, T) :: strip_all_vars t
  3.2266 +      | strip_all_vars (Const ("Trueprop", _) $ t)        =
  3.2267 +      strip_all_vars t
  3.2268 +      | strip_all_vars (Const ("All", _) $ Abs (a, T, t)) =
  3.2269 +      (a, T) :: strip_all_vars t
  3.2270 +      | strip_all_vars t                                  =
  3.2271 +      [] : (string * typ) list
  3.2272 +    val strip_t = strip_all_body ex_closure
  3.2273 +    val frees   = Term.rename_wrt_term strip_t (strip_all_vars ex_closure)
  3.2274 +    val subst_t = Term.subst_bounds (map Free frees, strip_t)
  3.2275 +  in
  3.2276 +    find_model thy (actual_params thy params) subst_t true
  3.2277 +  end;
  3.2278  
  3.2279  (* ------------------------------------------------------------------------- *)
  3.2280  (* refute_subgoal: calls 'refute_term' on a specific subgoal                 *)
  3.2281 @@ -1339,10 +1339,10 @@
  3.2282  (* subgoal       : 0-based index specifying the subgoal number               *)
  3.2283  (* ------------------------------------------------------------------------- *)
  3.2284  
  3.2285 -	(* theory -> (string * string) list -> Thm.thm -> int -> unit *)
  3.2286 +  (* theory -> (string * string) list -> Thm.thm -> int -> unit *)
  3.2287  
  3.2288 -	fun refute_subgoal thy params thm subgoal =
  3.2289 -		refute_term thy params (List.nth (Thm.prems_of thm, subgoal));
  3.2290 +  fun refute_subgoal thy params thm subgoal =
  3.2291 +    refute_term thy params (List.nth (Thm.prems_of thm, subgoal));
  3.2292  
  3.2293  
  3.2294  (* ------------------------------------------------------------------------- *)
  3.2295 @@ -1355,71 +1355,71 @@
  3.2296  (*                 'True'/'False' only (no Boolean variables)                *)
  3.2297  (* ------------------------------------------------------------------------- *)
  3.2298  
  3.2299 -	(* interpretation -> interpretation list *)
  3.2300 +  (* interpretation -> interpretation list *)
  3.2301  
  3.2302 -	fun make_constants intr =
  3.2303 -	let
  3.2304 -		(* returns a list with all unit vectors of length n *)
  3.2305 -		(* int -> interpretation list *)
  3.2306 -		fun unit_vectors n =
  3.2307 -		let
  3.2308 -			(* returns the k-th unit vector of length n *)
  3.2309 -			(* int * int -> interpretation *)
  3.2310 -			fun unit_vector (k,n) =
  3.2311 -				Leaf ((replicate (k-1) False) @ (True :: (replicate (n-k) False)))
  3.2312 -			(* int -> interpretation list -> interpretation list *)
  3.2313 -			fun unit_vectors_acc k vs =
  3.2314 -				if k>n then [] else (unit_vector (k,n))::(unit_vectors_acc (k+1) vs)
  3.2315 -		in
  3.2316 -			unit_vectors_acc 1 []
  3.2317 -		end
  3.2318 -		(* returns a list of lists, each one consisting of n (possibly *)
  3.2319 -		(* identical) elements from 'xs'                               *)
  3.2320 -		(* int -> 'a list -> 'a list list *)
  3.2321 -		fun pick_all 1 xs =
  3.2322 -			map single xs
  3.2323 -		  | pick_all n xs =
  3.2324 -			let val rec_pick = pick_all (n-1) xs in
  3.2325 -				Library.foldl (fn (acc, x) => map (cons x) rec_pick @ acc) ([], xs)
  3.2326 -			end
  3.2327 -	in
  3.2328 -		case intr of
  3.2329 -		  Leaf xs => unit_vectors (length xs)
  3.2330 -		| Node xs => map (fn xs' => Node xs') (pick_all (length xs)
  3.2331 -			(make_constants (hd xs)))
  3.2332 -	end;
  3.2333 +  fun make_constants intr =
  3.2334 +  let
  3.2335 +    (* returns a list with all unit vectors of length n *)
  3.2336 +    (* int -> interpretation list *)
  3.2337 +    fun unit_vectors n =
  3.2338 +    let
  3.2339 +      (* returns the k-th unit vector of length n *)
  3.2340 +      (* int * int -> interpretation *)
  3.2341 +      fun unit_vector (k,n) =
  3.2342 +        Leaf ((replicate (k-1) False) @ (True :: (replicate (n-k) False)))
  3.2343 +      (* int -> interpretation list -> interpretation list *)
  3.2344 +      fun unit_vectors_acc k vs =
  3.2345 +        if k>n then [] else (unit_vector (k,n))::(unit_vectors_acc (k+1) vs)
  3.2346 +    in
  3.2347 +      unit_vectors_acc 1 []
  3.2348 +    end
  3.2349 +    (* returns a list of lists, each one consisting of n (possibly *)
  3.2350 +    (* identical) elements from 'xs'                               *)
  3.2351 +    (* int -> 'a list -> 'a list list *)
  3.2352 +    fun pick_all 1 xs =
  3.2353 +      map single xs
  3.2354 +      | pick_all n xs =
  3.2355 +      let val rec_pick = pick_all (n-1) xs in
  3.2356 +        Library.foldl (fn (acc, x) => map (cons x) rec_pick @ acc) ([], xs)
  3.2357 +      end
  3.2358 +  in
  3.2359 +    case intr of
  3.2360 +      Leaf xs => unit_vectors (length xs)
  3.2361 +    | Node xs => map (fn xs' => Node xs') (pick_all (length xs)
  3.2362 +      (make_constants (hd xs)))
  3.2363 +  end;
  3.2364  
  3.2365  (* ------------------------------------------------------------------------- *)
  3.2366  (* size_of_type: returns the number of constants in a type (i.e. 'length     *)
  3.2367  (*               (make_constants intr)', but implemented more efficiently)   *)
  3.2368  (* ------------------------------------------------------------------------- *)
  3.2369  
  3.2370 -	(* interpretation -> int *)
  3.2371 +  (* interpretation -> int *)
  3.2372  
  3.2373 -	fun size_of_type intr =
  3.2374 -	let
  3.2375 -		(* power (a, b) computes a^b, for a>=0, b>=0 *)
  3.2376 -		(* int * int -> int *)
  3.2377 -		fun power (a, 0) = 1
  3.2378 -		  | power (a, 1) = a
  3.2379 -		  | power (a, b) = let val ab = power(a, b div 2) in
  3.2380 -				ab * ab * power(a, b mod 2)
  3.2381 -			end
  3.2382 -	in
  3.2383 -		case intr of
  3.2384 -		  Leaf xs => length xs
  3.2385 -		| Node xs => power (size_of_type (hd xs), length xs)
  3.2386 -	end;
  3.2387 +  fun size_of_type intr =
  3.2388 +  let
  3.2389 +    (* power (a, b) computes a^b, for a>=0, b>=0 *)
  3.2390 +    (* int * int -> int *)
  3.2391 +    fun power (a, 0) = 1
  3.2392 +      | power (a, 1) = a
  3.2393 +      | power (a, b) = let val ab = power(a, b div 2) in
  3.2394 +        ab * ab * power(a, b mod 2)
  3.2395 +      end
  3.2396 +  in
  3.2397 +    case intr of
  3.2398 +      Leaf xs => length xs
  3.2399 +    | Node xs => power (size_of_type (hd xs), length xs)
  3.2400 +  end;
  3.2401  
  3.2402  (* ------------------------------------------------------------------------- *)
  3.2403  (* TT/FF: interpretations that denote "true" or "false", respectively        *)
  3.2404  (* ------------------------------------------------------------------------- *)
  3.2405  
  3.2406 -	(* interpretation *)
  3.2407 +  (* interpretation *)
  3.2408  
  3.2409 -	val TT = Leaf [True, False];
  3.2410 +  val TT = Leaf [True, False];
  3.2411  
  3.2412 -	val FF = Leaf [False, True];
  3.2413 +  val FF = Leaf [False, True];
  3.2414  
  3.2415  (* ------------------------------------------------------------------------- *)
  3.2416  (* make_equality: returns an interpretation that denotes (extensional)       *)
  3.2417 @@ -1432,51 +1432,51 @@
  3.2418  (*   'not_equal' to another interpretation                                   *)
  3.2419  (* ------------------------------------------------------------------------- *)
  3.2420  
  3.2421 -	(* We could in principle represent '=' on a type T by a particular        *)
  3.2422 -	(* interpretation.  However, the size of that interpretation is quadratic *)
  3.2423 -	(* in the size of T.  Therefore comparing the interpretations 'i1' and    *)
  3.2424 -	(* 'i2' directly is more efficient than constructing the interpretation   *)
  3.2425 -	(* for equality on T first, and "applying" this interpretation to 'i1'    *)
  3.2426 -	(* and 'i2' in the usual way (cf. 'interpretation_apply') then.           *)
  3.2427 +  (* We could in principle represent '=' on a type T by a particular        *)
  3.2428 +  (* interpretation.  However, the size of that interpretation is quadratic *)
  3.2429 +  (* in the size of T.  Therefore comparing the interpretations 'i1' and    *)
  3.2430 +  (* 'i2' directly is more efficient than constructing the interpretation   *)
  3.2431 +  (* for equality on T first, and "applying" this interpretation to 'i1'    *)
  3.2432 +  (* and 'i2' in the usual way (cf. 'interpretation_apply') then.           *)
  3.2433  
  3.2434 -	(* interpretation * interpretation -> interpretation *)
  3.2435 +  (* interpretation * interpretation -> interpretation *)
  3.2436  
  3.2437 -	fun make_equality (i1, i2) =
  3.2438 -	let
  3.2439 -		(* interpretation * interpretation -> prop_formula *)
  3.2440 -		fun equal (i1, i2) =
  3.2441 -			(case i1 of
  3.2442 -			  Leaf xs =>
  3.2443 -				(case i2 of
  3.2444 -				  Leaf ys => PropLogic.dot_product (xs, ys)  (* defined and equal *)
  3.2445 -				| Node _  => raise REFUTE ("make_equality",
  3.2446 -					"second interpretation is higher"))
  3.2447 -			| Node xs =>
  3.2448 -				(case i2 of
  3.2449 -				  Leaf _  => raise REFUTE ("make_equality",
  3.2450 -					"first interpretation is higher")
  3.2451 -				| Node ys => PropLogic.all (map equal (xs ~~ ys))))
  3.2452 -		(* interpretation * interpretation -> prop_formula *)
  3.2453 -		fun not_equal (i1, i2) =
  3.2454 -			(case i1 of
  3.2455 -			  Leaf xs =>
  3.2456 -				(case i2 of
  3.2457 -				  (* defined and not equal *)
  3.2458 -				  Leaf ys => PropLogic.all ((PropLogic.exists xs)
  3.2459 -					:: (PropLogic.exists ys)
  3.2460 -					:: (map (fn (x,y) => SOr (SNot x, SNot y)) (xs ~~ ys)))
  3.2461 -				| Node _  => raise REFUTE ("make_equality",
  3.2462 -					"second interpretation is higher"))
  3.2463 -			| Node xs =>
  3.2464 -				(case i2 of
  3.2465 -				  Leaf _  => raise REFUTE ("make_equality",
  3.2466 -					"first interpretation is higher")
  3.2467 -				| Node ys => PropLogic.exists (map not_equal (xs ~~ ys))))
  3.2468 -	in
  3.2469 -		(* a value may be undefined; therefore 'not_equal' is not just the *)
  3.2470 -		(* negation of 'equal'                                             *)
  3.2471 -		Leaf [equal (i1, i2), not_equal (i1, i2)]
  3.2472 -	end;
  3.2473 +  fun make_equality (i1, i2) =
  3.2474 +  let
  3.2475 +    (* interpretation * interpretation -> prop_formula *)
  3.2476 +    fun equal (i1, i2) =
  3.2477 +      (case i1 of
  3.2478 +        Leaf xs =>
  3.2479 +        (case i2 of
  3.2480 +          Leaf ys => PropLogic.dot_product (xs, ys)  (* defined and equal *)
  3.2481 +        | Node _  => raise REFUTE ("make_equality",
  3.2482 +          "second interpretation is higher"))
  3.2483 +      | Node xs =>
  3.2484 +        (case i2 of
  3.2485 +          Leaf _  => raise REFUTE ("make_equality",
  3.2486 +          "first interpretation is higher")
  3.2487 +        | Node ys => PropLogic.all (map equal (xs ~~ ys))))
  3.2488 +    (* interpretation * interpretation -> prop_formula *)
  3.2489 +    fun not_equal (i1, i2) =
  3.2490 +      (case i1 of
  3.2491 +        Leaf xs =>
  3.2492 +        (case i2 of
  3.2493 +          (* defined and not equal *)
  3.2494 +          Leaf ys => PropLogic.all ((PropLogic.exists xs)
  3.2495 +          :: (PropLogic.exists ys)
  3.2496 +          :: (map (fn (x,y) => SOr (SNot x, SNot y)) (xs ~~ ys)))
  3.2497 +        | Node _  => raise REFUTE ("make_equality",
  3.2498 +          "second interpretation is higher"))
  3.2499 +      | Node xs =>
  3.2500 +        (case i2 of
  3.2501 +          Leaf _  => raise REFUTE ("make_equality",
  3.2502 +          "first interpretation is higher")
  3.2503 +        | Node ys => PropLogic.exists (map not_equal (xs ~~ ys))))
  3.2504 +  in
  3.2505 +    (* a value may be undefined; therefore 'not_equal' is not just the *)
  3.2506 +    (* negation of 'equal'                                             *)
  3.2507 +    Leaf [equal (i1, i2), not_equal (i1, i2)]
  3.2508 +  end;
  3.2509  
  3.2510  (* ------------------------------------------------------------------------- *)
  3.2511  (* make_def_equality: returns an interpretation that denotes (extensional)   *)
  3.2512 @@ -1487,30 +1487,30 @@
  3.2513  (* to an undefined interpretation.                                           *)
  3.2514  (* ------------------------------------------------------------------------- *)
  3.2515  
  3.2516 -	(* interpretation * interpretation -> interpretation *)
  3.2517 +  (* interpretation * interpretation -> interpretation *)
  3.2518  
  3.2519 -	fun make_def_equality (i1, i2) =
  3.2520 -	let
  3.2521 -		(* interpretation * interpretation -> prop_formula *)
  3.2522 -		fun equal (i1, i2) =
  3.2523 -			(case i1 of
  3.2524 -			  Leaf xs =>
  3.2525 -				(case i2 of
  3.2526 -				  (* defined and equal, or both undefined *)
  3.2527 -				  Leaf ys => SOr (PropLogic.dot_product (xs, ys),
  3.2528 -					SAnd (PropLogic.all (map SNot xs), PropLogic.all (map SNot ys)))
  3.2529 -				| Node _  => raise REFUTE ("make_def_equality",
  3.2530 -					"second interpretation is higher"))
  3.2531 -			| Node xs =>
  3.2532 -				(case i2 of
  3.2533 -				  Leaf _  => raise REFUTE ("make_def_equality",
  3.2534 -					"first interpretation is higher")
  3.2535 -				| Node ys => PropLogic.all (map equal (xs ~~ ys))))
  3.2536 -		(* interpretation *)
  3.2537 -		val eq = equal (i1, i2)
  3.2538 -	in
  3.2539 -		Leaf [eq, SNot eq]
  3.2540 -	end;
  3.2541 +  fun make_def_equality (i1, i2) =
  3.2542 +  let
  3.2543 +    (* interpretation * interpretation -> prop_formula *)
  3.2544 +    fun equal (i1, i2) =
  3.2545 +      (case i1 of
  3.2546 +        Leaf xs =>
  3.2547 +        (case i2 of
  3.2548 +          (* defined and equal, or both undefined *)
  3.2549 +          Leaf ys => SOr (PropLogic.dot_product (xs, ys),
  3.2550 +          SAnd (PropLogic.all (map SNot xs), PropLogic.all (map SNot ys)))
  3.2551 +        | Node _  => raise REFUTE ("make_def_equality",
  3.2552 +          "second interpretation is higher"))
  3.2553 +      | Node xs =>
  3.2554 +        (case i2 of
  3.2555 +          Leaf _  => raise REFUTE ("make_def_equality",
  3.2556 +          "first interpretation is higher")
  3.2557 +        | Node ys => PropLogic.all (map equal (xs ~~ ys))))
  3.2558 +    (* interpretation *)
  3.2559 +    val eq = equal (i1, i2)
  3.2560 +  in
  3.2561 +    Leaf [eq, SNot eq]
  3.2562 +  end;
  3.2563  
  3.2564  (* ------------------------------------------------------------------------- *)
  3.2565  (* interpretation_apply: returns an interpretation that denotes the result   *)
  3.2566 @@ -1518,86 +1518,86 @@
  3.2567  (*                       argument denoted by 'i2'                            *)
  3.2568  (* ------------------------------------------------------------------------- *)
  3.2569  
  3.2570 -	(* interpretation * interpretation -> interpretation *)
  3.2571 +  (* interpretation * interpretation -> interpretation *)
  3.2572  
  3.2573 -	fun interpretation_apply (i1, i2) =
  3.2574 -	let
  3.2575 -		(* interpretation * interpretation -> interpretation *)
  3.2576 -		fun interpretation_disjunction (tr1,tr2) =
  3.2577 -			tree_map (fn (xs,ys) => map (fn (x,y) => SOr(x,y)) (xs ~~ ys))
  3.2578 -				(tree_pair (tr1,tr2))
  3.2579 -		(* prop_formula * interpretation -> interpretation *)
  3.2580 -		fun prop_formula_times_interpretation (fm,tr) =
  3.2581 -			tree_map (map (fn x => SAnd (fm,x))) tr
  3.2582 -		(* prop_formula list * interpretation list -> interpretation *)
  3.2583 -		fun prop_formula_list_dot_product_interpretation_list ([fm],[tr]) =
  3.2584 -			prop_formula_times_interpretation (fm,tr)
  3.2585 -		  | prop_formula_list_dot_product_interpretation_list (fm::fms,tr::trees) =
  3.2586 -			interpretation_disjunction (prop_formula_times_interpretation (fm,tr),
  3.2587 -				prop_formula_list_dot_product_interpretation_list (fms,trees))
  3.2588 -		  | prop_formula_list_dot_product_interpretation_list (_,_) =
  3.2589 -			raise REFUTE ("interpretation_apply", "empty list (in dot product)")
  3.2590 -		(* concatenates 'x' with every list in 'xss', returning a new list of *)
  3.2591 -		(* lists                                                              *)
  3.2592 -		(* 'a -> 'a list list -> 'a list list *)
  3.2593 -		fun cons_list x xss =
  3.2594 -			map (cons x) xss
  3.2595 -		(* returns a list of lists, each one consisting of one element from each *)
  3.2596 -		(* element of 'xss'                                                      *)
  3.2597 -		(* 'a list list -> 'a list list *)
  3.2598 -		fun pick_all [xs] =
  3.2599 -			map single xs
  3.2600 -		  | pick_all (xs::xss) =
  3.2601 -			let val rec_pick = pick_all xss in
  3.2602 -				Library.foldl (fn (acc, x) => (cons_list x rec_pick) @ acc) ([], xs)
  3.2603 -			end
  3.2604 -		  | pick_all _ =
  3.2605 -			raise REFUTE ("interpretation_apply", "empty list (in pick_all)")
  3.2606 -		(* interpretation -> prop_formula list *)
  3.2607 -		fun interpretation_to_prop_formula_list (Leaf xs) =
  3.2608 -			xs
  3.2609 -		  | interpretation_to_prop_formula_list (Node trees) =
  3.2610 -			map PropLogic.all (pick_all
  3.2611 -				(map interpretation_to_prop_formula_list trees))
  3.2612 -	in
  3.2613 -		case i1 of
  3.2614 -		  Leaf _ =>
  3.2615 -			raise REFUTE ("interpretation_apply", "first interpretation is a leaf")
  3.2616 -		| Node xs =>
  3.2617 -			prop_formula_list_dot_product_interpretation_list
  3.2618 -				(interpretation_to_prop_formula_list i2, xs)
  3.2619 -	end;
  3.2620 +  fun interpretation_apply (i1, i2) =
  3.2621 +  let
  3.2622 +    (* interpretation * interpretation -> interpretation *)
  3.2623 +    fun interpretation_disjunction (tr1,tr2) =
  3.2624 +      tree_map (fn (xs,ys) => map (fn (x,y) => SOr(x,y)) (xs ~~ ys))
  3.2625 +        (tree_pair (tr1,tr2))
  3.2626 +    (* prop_formula * interpretation -> interpretation *)
  3.2627 +    fun prop_formula_times_interpretation (fm,tr) =
  3.2628 +      tree_map (map (fn x => SAnd (fm,x))) tr
  3.2629 +    (* prop_formula list * interpretation list -> interpretation *)
  3.2630 +    fun prop_formula_list_dot_product_interpretation_list ([fm],[tr]) =
  3.2631 +      prop_formula_times_interpretation (fm,tr)
  3.2632 +      | prop_formula_list_dot_product_interpretation_list (fm::fms,tr::trees) =
  3.2633 +      interpretation_disjunction (prop_formula_times_interpretation (fm,tr),
  3.2634 +        prop_formula_list_dot_product_interpretation_list (fms,trees))
  3.2635 +      | prop_formula_list_dot_product_interpretation_list (_,_) =
  3.2636 +      raise REFUTE ("interpretation_apply", "empty list (in dot product)")
  3.2637 +    (* concatenates 'x' with every list in 'xss', returning a new list of *)
  3.2638 +    (* lists                                                              *)
  3.2639 +    (* 'a -> 'a list list -> 'a list list *)
  3.2640 +    fun cons_list x xss =
  3.2641 +      map (cons x) xss
  3.2642 +    (* returns a list of lists, each one consisting of one element from each *)
  3.2643 +    (* element of 'xss'                                                      *)
  3.2644 +    (* 'a list list -> 'a list list *)
  3.2645 +    fun pick_all [xs] =
  3.2646 +      map single xs
  3.2647 +      | pick_all (xs::xss) =
  3.2648 +      let val rec_pick = pick_all xss in
  3.2649 +        Library.foldl (fn (acc, x) => (cons_list x rec_pick) @ acc) ([], xs)
  3.2650 +      end
  3.2651 +      | pick_all _ =
  3.2652 +      raise REFUTE ("interpretation_apply", "empty list (in pick_all)")
  3.2653 +    (* interpretation -> prop_formula list *)
  3.2654 +    fun interpretation_to_prop_formula_list (Leaf xs) =
  3.2655 +      xs
  3.2656 +      | interpretation_to_prop_formula_list (Node trees) =
  3.2657 +      map PropLogic.all (pick_all
  3.2658 +        (map interpretation_to_prop_formula_list trees))
  3.2659 +  in
  3.2660 +    case i1 of
  3.2661 +      Leaf _ =>
  3.2662 +      raise REFUTE ("interpretation_apply", "first interpretation is a leaf")
  3.2663 +    | Node xs =>
  3.2664 +      prop_formula_list_dot_product_interpretation_list
  3.2665 +        (interpretation_to_prop_formula_list i2, xs)
  3.2666 +  end;
  3.2667  
  3.2668  (* ------------------------------------------------------------------------- *)
  3.2669  (* eta_expand: eta-expands a term 't' by adding 'i' lambda abstractions      *)
  3.2670  (* ------------------------------------------------------------------------- *)
  3.2671  
  3.2672 -	(* Term.term -> int -> Term.term *)
  3.2673 +  (* Term.term -> int -> Term.term *)
  3.2674  
  3.2675 -	fun eta_expand t i =
  3.2676 -	let
  3.2677 -		val Ts = Term.binder_types (Term.fastype_of t)
  3.2678 -		val t' = Term.incr_boundvars i t
  3.2679 -	in
  3.2680 -		foldr (fn (T, term) => Abs ("<eta_expand>", T, term))
  3.2681 -			(Term.list_comb (t', map Bound (i-1 downto 0))) (List.take (Ts, i))
  3.2682 -	end;
  3.2683 +  fun eta_expand t i =
  3.2684 +  let
  3.2685 +    val Ts = Term.binder_types (Term.fastype_of t)
  3.2686 +    val t' = Term.incr_boundvars i t
  3.2687 +  in
  3.2688 +    foldr (fn (T, term) => Abs ("<eta_expand>", T, term))
  3.2689 +      (Term.list_comb (t', map Bound (i-1 downto 0))) (List.take (Ts, i))
  3.2690 +  end;
  3.2691  
  3.2692  (* ------------------------------------------------------------------------- *)
  3.2693  (* sum: returns the sum of a list 'xs' of integers                           *)
  3.2694  (* ------------------------------------------------------------------------- *)
  3.2695  
  3.2696 -	(* int list -> int *)
  3.2697 +  (* int list -> int *)
  3.2698  
  3.2699 -	fun sum xs = foldl op+ 0 xs;
  3.2700 +  fun sum xs = foldl op+ 0 xs;
  3.2701  
  3.2702  (* ------------------------------------------------------------------------- *)
  3.2703  (* product: returns the product of a list 'xs' of integers                   *)
  3.2704  (* ------------------------------------------------------------------------- *)
  3.2705  
  3.2706 -	(* int list -> int *)
  3.2707 +  (* int list -> int *)
  3.2708  
  3.2709 -	fun product xs = foldl op* 1 xs;
  3.2710 +  fun product xs = foldl op* 1 xs;
  3.2711  
  3.2712  (* ------------------------------------------------------------------------- *)
  3.2713  (* size_of_dtyp: the size of (an initial fragment of) an inductive data type *)
  3.2714 @@ -1605,1594 +1605,1594 @@
  3.2715  (*               their arguments) of the size of the argument types          *)
  3.2716  (* ------------------------------------------------------------------------- *)
  3.2717  
  3.2718 -	(* theory -> (Term.typ * int) list -> DatatypeAux.descr ->
  3.2719 -		(DatatypeAux.dtyp * Term.typ) list ->
  3.2720 -		(string * DatatypeAux.dtyp list) list -> int *)
  3.2721 +  (* theory -> (Term.typ * int) list -> DatatypeAux.descr ->
  3.2722 +    (DatatypeAux.dtyp * Term.typ) list ->
  3.2723 +    (string * DatatypeAux.dtyp list) list -> int *)
  3.2724  
  3.2725 -	fun size_of_dtyp thy typ_sizes descr typ_assoc constructors =
  3.2726 -		sum (map (fn (_, dtyps) =>
  3.2727 -			product (map (fn dtyp =>
  3.2728 -				let
  3.2729 -					val T         = typ_of_dtyp descr typ_assoc dtyp
  3.2730 -					val (i, _, _) = interpret thy (typ_sizes, [])
  3.2731 -						{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.2732 -						(Free ("dummy", T))
  3.2733 -				in
  3.2734 -					size_of_type i
  3.2735 -				end) dtyps)) constructors);
  3.2736 +  fun size_of_dtyp thy typ_sizes descr typ_assoc constructors =
  3.2737 +    sum (map (fn (_, dtyps) =>
  3.2738 +      product (map (fn dtyp =>
  3.2739 +        let
  3.2740 +          val T         = typ_of_dtyp descr typ_assoc dtyp
  3.2741 +          val (i, _, _) = interpret thy (typ_sizes, [])
  3.2742 +            {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.2743 +            (Free ("dummy", T))
  3.2744 +        in
  3.2745 +          size_of_type i
  3.2746 +        end) dtyps)) constructors);
  3.2747  
  3.2748  
  3.2749  (* ------------------------------------------------------------------------- *)
  3.2750  (* INTERPRETERS: Actual Interpreters                                         *)
  3.2751  (* ------------------------------------------------------------------------- *)
  3.2752  
  3.2753 -	(* theory -> model -> arguments -> Term.term ->
  3.2754 -		(interpretation * model * arguments) option *)
  3.2755 +  (* theory -> model -> arguments -> Term.term ->
  3.2756 +    (interpretation * model * arguments) option *)
  3.2757  
  3.2758 -	(* simply typed lambda calculus: Isabelle's basic term syntax, with type *)
  3.2759 -	(* variables, function types, and propT                                  *)
  3.2760 +  (* simply typed lambda calculus: Isabelle's basic term syntax, with type *)
  3.2761 +  (* variables, function types, and propT                                  *)
  3.2762  
  3.2763 -	fun stlc_interpreter thy model args t =
  3.2764 -	let
  3.2765 -		val (typs, terms)                                   = model
  3.2766 -		val {maxvars, def_eq, next_idx, bounds, wellformed} = args
  3.2767 -		(* Term.typ -> (interpretation * model * arguments) option *)
  3.2768 -		fun interpret_groundterm T =
  3.2769 -		let
  3.2770 -			(* unit -> (interpretation * model * arguments) option *)
  3.2771 -			fun interpret_groundtype () =
  3.2772 -			let
  3.2773 -				(* the model must specify a size for ground types *)
  3.2774 -				val size = (if T = Term.propT then 2 else lookup typs T)
  3.2775 -				val next = next_idx+size
  3.2776 -				(* check if 'maxvars' is large enough *)
  3.2777 -				val _    = (if next-1>maxvars andalso maxvars>0 then
  3.2778 -					raise MAXVARS_EXCEEDED else ())
  3.2779 -				(* prop_formula list *)
  3.2780 -				val fms  = map BoolVar (next_idx upto (next_idx+size-1))
  3.2781 -				(* interpretation *)
  3.2782 -				val intr = Leaf fms
  3.2783 -				(* prop_formula list -> prop_formula *)
  3.2784 -				fun one_of_two_false []      = True
  3.2785 -				  | one_of_two_false (x::xs) = SAnd (PropLogic.all (map (fn x' =>
  3.2786 -					SOr (SNot x, SNot x')) xs), one_of_two_false xs)
  3.2787 -				(* prop_formula *)
  3.2788 -				val wf   = one_of_two_false fms
  3.2789 -			in
  3.2790 -				(* extend the model, increase 'next_idx', add well-formedness *)
  3.2791 -				(* condition                                                  *)
  3.2792 -				SOME (intr, (typs, (t, intr)::terms), {maxvars = maxvars,
  3.2793 -					def_eq = def_eq, next_idx = next, bounds = bounds,
  3.2794 -					wellformed = SAnd (wellformed, wf)})
  3.2795 -			end
  3.2796 -		in
  3.2797 -			case T of
  3.2798 -			  Type ("fun", [T1, T2]) =>
  3.2799 -				let
  3.2800 -					(* we create 'size_of_type (interpret (... T1))' different copies *)
  3.2801 -					(* of the interpretation for 'T2', which are then combined into a *)
  3.2802 -					(* single new interpretation                                      *)
  3.2803 -					val (i1, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.2804 -						next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T1))
  3.2805 -					(* make fresh copies, with different variable indices *)
  3.2806 -					(* 'idx': next variable index                         *)
  3.2807 -					(* 'n'  : number of copies                            *)
  3.2808 -					(* int -> int -> (int * interpretation list * prop_formula *)
  3.2809 -					fun make_copies idx 0 =
  3.2810 -						(idx, [], True)
  3.2811 -					  | make_copies idx n =
  3.2812 -						let
  3.2813 -							val (copy, _, new_args) = interpret thy (typs, [])
  3.2814 -								{maxvars = maxvars, def_eq = false, next_idx = idx,
  3.2815 -								bounds = [], wellformed = True} (Free ("dummy", T2))
  3.2816 -							val (idx', copies, wf') = make_copies (#next_idx new_args) (n-1)
  3.2817 -						in
  3.2818 -							(idx', copy :: copies, SAnd (#wellformed new_args, wf'))
  3.2819 -						end
  3.2820 -					val (next, copies, wf) = make_copies next_idx (size_of_type i1)
  3.2821 -					(* combine copies into a single interpretation *)
  3.2822 -					val intr = Node copies
  3.2823 -				in
  3.2824 -					(* extend the model, increase 'next_idx', add well-formedness *)
  3.2825 -					(* condition                                                  *)
  3.2826 -					SOME (intr, (typs, (t, intr)::terms), {maxvars = maxvars,
  3.2827 -						def_eq = def_eq, next_idx = next, bounds = bounds,
  3.2828 -						wellformed = SAnd (wellformed, wf)})
  3.2829 -				end
  3.2830 -			| Type _  => interpret_groundtype ()
  3.2831 -			| TFree _ => interpret_groundtype ()
  3.2832 -			| TVar  _ => interpret_groundtype ()
  3.2833 -		end
  3.2834 -	in
  3.2835 -		case AList.lookup (op =) terms t of
  3.2836 -		  SOME intr =>
  3.2837 -			(* return an existing interpretation *)
  3.2838 -			SOME (intr, model, args)
  3.2839 -		| NONE =>
  3.2840 -			(case t of
  3.2841 -			  Const (_, T)     =>
  3.2842 -				interpret_groundterm T
  3.2843 -			| Free (_, T)      =>
  3.2844 -				interpret_groundterm T
  3.2845 -			| Var (_, T)       =>
  3.2846 -				interpret_groundterm T
  3.2847 -			| Bound i          =>
  3.2848 -				SOME (List.nth (#bounds args, i), model, args)
  3.2849 -			| Abs (x, T, body) =>
  3.2850 -				let
  3.2851 -					(* create all constants of type 'T' *)
  3.2852 -					val (i, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.2853 -						next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T))
  3.2854 -					val constants = make_constants i
  3.2855 -					(* interpret the 'body' separately for each constant *)
  3.2856 -					val ((model', args'), bodies) = foldl_map
  3.2857 -						(fn ((m, a), c) =>
  3.2858 -							let
  3.2859 -								(* add 'c' to 'bounds' *)
  3.2860 -								val (i', m', a') = interpret thy m {maxvars = #maxvars a,
  3.2861 -									def_eq = #def_eq a, next_idx = #next_idx a,
  3.2862 -									bounds = (c :: #bounds a), wellformed = #wellformed a} body
  3.2863 -							in
  3.2864 -								(* keep the new model m' and 'next_idx' and 'wellformed', *)
  3.2865 -								(* but use old 'bounds'                                   *)
  3.2866 -								((m', {maxvars = maxvars, def_eq = def_eq,
  3.2867 -									next_idx = #next_idx a', bounds = bounds,
  3.2868 -									wellformed = #wellformed a'}), i')
  3.2869 -							end)
  3.2870 -						((model, args), constants)
  3.2871 -				in
  3.2872 -					SOME (Node bodies, model', args')
  3.2873 -				end
  3.2874 -			| t1 $ t2          =>
  3.2875 -				let
  3.2876 -					(* interpret 't1' and 't2' separately *)
  3.2877 -					val (intr1, model1, args1) = interpret thy model args t1
  3.2878 -					val (intr2, model2, args2) = interpret thy model1 args1 t2
  3.2879 -				in
  3.2880 -					SOME (interpretation_apply (intr1, intr2), model2, args2)
  3.2881 -				end)
  3.2882 -	end;
  3.2883 +  fun stlc_interpreter thy model args t =
  3.2884 +  let
  3.2885 +    val (typs, terms)                                   = model
  3.2886 +    val {maxvars, def_eq, next_idx, bounds, wellformed} = args
  3.2887 +    (* Term.typ -> (interpretation * model * arguments) option *)
  3.2888 +    fun interpret_groundterm T =
  3.2889 +    let
  3.2890 +      (* unit -> (interpretation * model * arguments) option *)
  3.2891 +      fun interpret_groundtype () =
  3.2892 +      let
  3.2893 +        (* the model must specify a size for ground types *)
  3.2894 +        val size = (if T = Term.propT then 2 else lookup typs T)
  3.2895 +        val next = next_idx+size
  3.2896 +        (* check if 'maxvars' is large enough *)
  3.2897 +        val _    = (if next-1>maxvars andalso maxvars>0 then
  3.2898 +          raise MAXVARS_EXCEEDED else ())
  3.2899 +        (* prop_formula list *)
  3.2900 +        val fms  = map BoolVar (next_idx upto (next_idx+size-1))
  3.2901 +        (* interpretation *)
  3.2902 +        val intr = Leaf fms
  3.2903 +        (* prop_formula list -> prop_formula *)
  3.2904 +        fun one_of_two_false []      = True
  3.2905 +          | one_of_two_false (x::xs) = SAnd (PropLogic.all (map (fn x' =>
  3.2906 +          SOr (SNot x, SNot x')) xs), one_of_two_false xs)
  3.2907 +        (* prop_formula *)
  3.2908 +        val wf   = one_of_two_false fms
  3.2909 +      in
  3.2910 +        (* extend the model, increase 'next_idx', add well-formedness *)
  3.2911 +        (* condition                                                  *)
  3.2912 +        SOME (intr, (typs, (t, intr)::terms), {maxvars = maxvars,
  3.2913 +          def_eq = def_eq, next_idx = next, bounds = bounds,
  3.2914 +          wellformed = SAnd (wellformed, wf)})
  3.2915 +      end
  3.2916 +    in
  3.2917 +      case T of
  3.2918 +        Type ("fun", [T1, T2]) =>
  3.2919 +        let
  3.2920 +          (* we create 'size_of_type (interpret (... T1))' different copies *)
  3.2921 +          (* of the interpretation for 'T2', which are then combined into a *)
  3.2922 +          (* single new interpretation                                      *)
  3.2923 +          val (i1, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.2924 +            next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T1))
  3.2925 +          (* make fresh copies, with different variable indices *)
  3.2926 +          (* 'idx': next variable index                         *)
  3.2927 +          (* 'n'  : number of copies                            *)
  3.2928 +          (* int -> int -> (int * interpretation list * prop_formula *)
  3.2929 +          fun make_copies idx 0 =
  3.2930 +            (idx, [], True)
  3.2931 +            | make_copies idx n =
  3.2932 +            let
  3.2933 +              val (copy, _, new_args) = interpret thy (typs, [])
  3.2934 +                {maxvars = maxvars, def_eq = false, next_idx = idx,
  3.2935 +                bounds = [], wellformed = True} (Free ("dummy", T2))
  3.2936 +              val (idx', copies, wf') = make_copies (#next_idx new_args) (n-1)
  3.2937 +            in
  3.2938 +              (idx', copy :: copies, SAnd (#wellformed new_args, wf'))
  3.2939 +            end
  3.2940 +          val (next, copies, wf) = make_copies next_idx (size_of_type i1)
  3.2941 +          (* combine copies into a single interpretation *)
  3.2942 +          val intr = Node copies
  3.2943 +        in
  3.2944 +          (* extend the model, increase 'next_idx', add well-formedness *)
  3.2945 +          (* condition                                                  *)
  3.2946 +          SOME (intr, (typs, (t, intr)::terms), {maxvars = maxvars,
  3.2947 +            def_eq = def_eq, next_idx = next, bounds = bounds,
  3.2948 +            wellformed = SAnd (wellformed, wf)})
  3.2949 +        end
  3.2950 +      | Type _  => interpret_groundtype ()
  3.2951 +      | TFree _ => interpret_groundtype ()
  3.2952 +      | TVar  _ => interpret_groundtype ()
  3.2953 +    end
  3.2954 +  in
  3.2955 +    case AList.lookup (op =) terms t of
  3.2956 +      SOME intr =>
  3.2957 +      (* return an existing interpretation *)
  3.2958 +      SOME (intr, model, args)
  3.2959 +    | NONE =>
  3.2960 +      (case t of
  3.2961 +        Const (_, T)     =>
  3.2962 +        interpret_groundterm T
  3.2963 +      | Free (_, T)      =>
  3.2964 +        interpret_groundterm T
  3.2965 +      | Var (_, T)       =>
  3.2966 +        interpret_groundterm T
  3.2967 +      | Bound i          =>
  3.2968 +        SOME (List.nth (#bounds args, i), model, args)
  3.2969 +      | Abs (x, T, body) =>
  3.2970 +        let
  3.2971 +          (* create all constants of type 'T' *)
  3.2972 +          val (i, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.2973 +            next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T))
  3.2974 +          val constants = make_constants i
  3.2975 +          (* interpret the 'body' separately for each constant *)
  3.2976 +          val ((model', args'), bodies) = foldl_map
  3.2977 +            (fn ((m, a), c) =>
  3.2978 +              let
  3.2979 +                (* add 'c' to 'bounds' *)
  3.2980 +                val (i', m', a') = interpret thy m {maxvars = #maxvars a,
  3.2981 +                  def_eq = #def_eq a, next_idx = #next_idx a,
  3.2982 +                  bounds = (c :: #bounds a), wellformed = #wellformed a} body
  3.2983 +              in
  3.2984 +                (* keep the new model m' and 'next_idx' and 'wellformed', *)
  3.2985 +                (* but use old 'bounds'                                   *)
  3.2986 +                ((m', {maxvars = maxvars, def_eq = def_eq,
  3.2987 +                  next_idx = #next_idx a', bounds = bounds,
  3.2988 +                  wellformed = #wellformed a'}), i')
  3.2989 +              end)
  3.2990 +            ((model, args), constants)
  3.2991 +        in
  3.2992 +          SOME (Node bodies, model', args')
  3.2993 +        end
  3.2994 +      | t1 $ t2          =>
  3.2995 +        let
  3.2996 +          (* interpret 't1' and 't2' separately *)
  3.2997 +          val (intr1, model1, args1) = interpret thy model args t1
  3.2998 +          val (intr2, model2, args2) = interpret thy model1 args1 t2
  3.2999 +        in
  3.3000 +          SOME (interpretation_apply (intr1, intr2), model2, args2)
  3.3001 +        end)
  3.3002 +  end;
  3.3003  
  3.3004 -	(* theory -> model -> arguments -> Term.term ->
  3.3005 -		(interpretation * model * arguments) option *)
  3.3006 +  (* theory -> model -> arguments -> Term.term ->
  3.3007 +    (interpretation * model * arguments) option *)
  3.3008  
  3.3009 -	fun Pure_interpreter thy model args t =
  3.3010 -		case t of
  3.3011 -		  Const ("all", _) $ t1 =>
  3.3012 -			let
  3.3013 -				val (i, m, a) = interpret thy model args t1
  3.3014 -			in
  3.3015 -				case i of
  3.3016 -				  Node xs =>
  3.3017 -					(* 3-valued logic *)
  3.3018 -					let
  3.3019 -						val fmTrue  = PropLogic.all (map toTrue xs)
  3.3020 -						val fmFalse = PropLogic.exists (map toFalse xs)
  3.3021 -					in
  3.3022 -						SOME (Leaf [fmTrue, fmFalse], m, a)
  3.3023 -					end
  3.3024 -				| _ =>
  3.3025 -					raise REFUTE ("Pure_interpreter",
  3.3026 -						"\"all\" is followed by a non-function")
  3.3027 -			end
  3.3028 -		| Const ("all", _) =>
  3.3029 -			SOME (interpret thy model args (eta_expand t 1))
  3.3030 -		| Const ("==", _) $ t1 $ t2 =>
  3.3031 -			let
  3.3032 -				val (i1, m1, a1) = interpret thy model args t1
  3.3033 -				val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3034 -			in
  3.3035 -				(* we use either 'make_def_equality' or 'make_equality' *)
  3.3036 -				SOME ((if #def_eq args then make_def_equality else make_equality)
  3.3037 -					(i1, i2), m2, a2)
  3.3038 -			end
  3.3039 -		| Const ("==", _) $ t1 =>
  3.3040 -			SOME (interpret thy model args (eta_expand t 1))
  3.3041 -		| Const ("==", _) =>
  3.3042 -			SOME (interpret thy model args (eta_expand t 2))
  3.3043 -		| Const ("==>", _) $ t1 $ t2 =>
  3.3044 -			(* 3-valued logic *)
  3.3045 -			let
  3.3046 -				val (i1, m1, a1) = interpret thy model args t1
  3.3047 -				val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3048 -				val fmTrue       = PropLogic.SOr (toFalse i1, toTrue i2)
  3.3049 -				val fmFalse      = PropLogic.SAnd (toTrue i1, toFalse i2)
  3.3050 -			in
  3.3051 -				SOME (Leaf [fmTrue, fmFalse], m2, a2)
  3.3052 -			end
  3.3053 -		| Const ("==>", _) $ t1 =>
  3.3054 -			SOME (interpret thy model args (eta_expand t 1))
  3.3055 -		| Const ("==>", _) =>
  3.3056 -			SOME (interpret thy model args (eta_expand t 2))
  3.3057 -		| _ => NONE;
  3.3058 +  fun Pure_interpreter thy model args t =
  3.3059 +    case t of
  3.3060 +      Const ("all", _) $ t1 =>
  3.3061 +      let
  3.3062 +        val (i, m, a) = interpret thy model args t1
  3.3063 +      in
  3.3064 +        case i of
  3.3065 +          Node xs =>
  3.3066 +          (* 3-valued logic *)
  3.3067 +          let
  3.3068 +            val fmTrue  = PropLogic.all (map toTrue xs)
  3.3069 +            val fmFalse = PropLogic.exists (map toFalse xs)
  3.3070 +          in
  3.3071 +            SOME (Leaf [fmTrue, fmFalse], m, a)
  3.3072 +          end
  3.3073 +        | _ =>
  3.3074 +          raise REFUTE ("Pure_interpreter",
  3.3075 +            "\"all\" is followed by a non-function")
  3.3076 +      end
  3.3077 +    | Const ("all", _) =>
  3.3078 +      SOME (interpret thy model args (eta_expand t 1))
  3.3079 +    | Const ("==", _) $ t1 $ t2 =>
  3.3080 +      let
  3.3081 +        val (i1, m1, a1) = interpret thy model args t1
  3.3082 +        val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3083 +      in
  3.3084 +        (* we use either 'make_def_equality' or 'make_equality' *)
  3.3085 +        SOME ((if #def_eq args then make_def_equality else make_equality)
  3.3086 +          (i1, i2), m2, a2)
  3.3087 +      end
  3.3088 +    | Const ("==", _) $ t1 =>
  3.3089 +      SOME (interpret thy model args (eta_expand t 1))
  3.3090 +    | Const ("==", _) =>
  3.3091 +      SOME (interpret thy model args (eta_expand t 2))
  3.3092 +    | Const ("==>", _) $ t1 $ t2 =>
  3.3093 +      (* 3-valued logic *)
  3.3094 +      let
  3.3095 +        val (i1, m1, a1) = interpret thy model args t1
  3.3096 +        val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3097 +        val fmTrue       = PropLogic.SOr (toFalse i1, toTrue i2)
  3.3098 +        val fmFalse      = PropLogic.SAnd (toTrue i1, toFalse i2)
  3.3099 +      in
  3.3100 +        SOME (Leaf [fmTrue, fmFalse], m2, a2)
  3.3101 +      end
  3.3102 +    | Const ("==>", _) $ t1 =>
  3.3103 +      SOME (interpret thy model args (eta_expand t 1))
  3.3104 +    | Const ("==>", _) =>
  3.3105 +      SOME (interpret thy model args (eta_expand t 2))
  3.3106 +    | _ => NONE;
  3.3107  
  3.3108 -	(* theory -> model -> arguments -> Term.term ->
  3.3109 -		(interpretation * model * arguments) option *)
  3.3110 +  (* theory -> model -> arguments -> Term.term ->
  3.3111 +    (interpretation * model * arguments) option *)
  3.3112  
  3.3113 -	fun HOLogic_interpreter thy model args t =
  3.3114 -	(* Providing interpretations directly is more efficient than unfolding the *)
  3.3115 -	(* logical constants.  In HOL however, logical constants can themselves be *)
  3.3116 -	(* arguments.  They are then translated using eta-expansion.               *)
  3.3117 -		case t of
  3.3118 -		  Const ("Trueprop", _) =>
  3.3119 -			SOME (Node [TT, FF], model, args)
  3.3120 -		| Const ("Not", _) =>
  3.3121 -			SOME (Node [FF, TT], model, args)
  3.3122 -		(* redundant, since 'True' is also an IDT constructor *)
  3.3123 -		| Const ("True", _) =>
  3.3124 -			SOME (TT, model, args)
  3.3125 -		(* redundant, since 'False' is also an IDT constructor *)
  3.3126 -		| Const ("False", _) =>
  3.3127 -			SOME (FF, model, args)
  3.3128 -		| Const ("All", _) $ t1 =>  (* similar to "all" (Pure) *)
  3.3129 -			let
  3.3130 -				val (i, m, a) = interpret thy model args t1
  3.3131 -			in
  3.3132 -				case i of
  3.3133 -				  Node xs =>
  3.3134 -					(* 3-valued logic *)
  3.3135 -					let
  3.3136 -						val fmTrue  = PropLogic.all (map toTrue xs)
  3.3137 -						val fmFalse = PropLogic.exists (map toFalse xs)
  3.3138 -					in
  3.3139 -						SOME (Leaf [fmTrue, fmFalse], m, a)
  3.3140 -					end
  3.3141 -				| _ =>
  3.3142 -					raise REFUTE ("HOLogic_interpreter",
  3.3143 -						"\"All\" is followed by a non-function")
  3.3144 -			end
  3.3145 -		| Const ("All", _) =>
  3.3146 -			SOME (interpret thy model args (eta_expand t 1))
  3.3147 -		| Const ("Ex", _) $ t1 =>
  3.3148 -			let
  3.3149 -				val (i, m, a) = interpret thy model args t1
  3.3150 -			in
  3.3151 -				case i of
  3.3152 -				  Node xs =>
  3.3153 -					(* 3-valued logic *)
  3.3154 -					let
  3.3155 -						val fmTrue  = PropLogic.exists (map toTrue xs)
  3.3156 -						val fmFalse = PropLogic.all (map toFalse xs)
  3.3157 -					in
  3.3158 -						SOME (Leaf [fmTrue, fmFalse], m, a)
  3.3159 -					end
  3.3160 -				| _ =>
  3.3161 -					raise REFUTE ("HOLogic_interpreter",
  3.3162 -						"\"Ex\" is followed by a non-function")
  3.3163 -			end
  3.3164 -		| Const ("Ex", _) =>
  3.3165 -			SOME (interpret thy model args (eta_expand t 1))
  3.3166 -		| Const ("op =", _) $ t1 $ t2 =>  (* similar to "==" (Pure) *)
  3.3167 -			let
  3.3168 -				val (i1, m1, a1) = interpret thy model args t1
  3.3169 -				val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3170 -			in
  3.3171 -				SOME (make_equality (i1, i2), m2, a2)
  3.3172 -			end
  3.3173 -		| Const ("op =", _) $ t1 =>
  3.3174 -			SOME (interpret thy model args (eta_expand t 1))
  3.3175 -		| Const ("op =", _) =>
  3.3176 -			SOME (interpret thy model args (eta_expand t 2))
  3.3177 -		| Const ("op &", _) $ t1 $ t2 =>
  3.3178 -			(* 3-valued logic *)
  3.3179 -			let
  3.3180 -				val (i1, m1, a1) = interpret thy model args t1
  3.3181 -				val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3182 -				val fmTrue       = PropLogic.SAnd (toTrue i1, toTrue i2)
  3.3183 -				val fmFalse      = PropLogic.SOr (toFalse i1, toFalse i2)
  3.3184 -			in
  3.3185 -				SOME (Leaf [fmTrue, fmFalse], m2, a2)
  3.3186 -			end
  3.3187 -		| Const ("op &", _) $ t1 =>
  3.3188 -			SOME (interpret thy model args (eta_expand t 1))
  3.3189 -		| Const ("op &", _) =>
  3.3190 -			SOME (interpret thy model args (eta_expand t 2))
  3.3191 -			(* this would make "undef" propagate, even for formulae like *)
  3.3192 -			(* "False & undef":                                          *)
  3.3193 -			(* SOME (Node [Node [TT, FF], Node [FF, FF]], model, args) *)
  3.3194 -		| Const ("op |", _) $ t1 $ t2 =>
  3.3195 -			(* 3-valued logic *)
  3.3196 -			let
  3.3197 -				val (i1, m1, a1) = interpret thy model args t1
  3.3198 -				val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3199 -				val fmTrue       = PropLogic.SOr (toTrue i1, toTrue i2)
  3.3200 -				val fmFalse      = PropLogic.SAnd (toFalse i1, toFalse i2)
  3.3201 -			in
  3.3202 -				SOME (Leaf [fmTrue, fmFalse], m2, a2)
  3.3203 -			end
  3.3204 -		| Const ("op |", _) $ t1 =>
  3.3205 -			SOME (interpret thy model args (eta_expand t 1))
  3.3206 -		| Const ("op |", _) =>
  3.3207 -			SOME (interpret thy model args (eta_expand t 2))
  3.3208 -			(* this would make "undef" propagate, even for formulae like *)
  3.3209 -			(* "True | undef":                                           *)
  3.3210 -			(* SOME (Node [Node [TT, TT], Node [TT, FF]], model, args) *)
  3.3211 -		| Const ("op -->", _) $ t1 $ t2 =>  (* similar to "==>" (Pure) *)
  3.3212 -			(* 3-valued logic *)
  3.3213 -			let
  3.3214 -				val (i1, m1, a1) = interpret thy model args t1
  3.3215 -				val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3216 -				val fmTrue       = PropLogic.SOr (toFalse i1, toTrue i2)
  3.3217 -				val fmFalse      = PropLogic.SAnd (toTrue i1, toFalse i2)
  3.3218 -			in
  3.3219 -				SOME (Leaf [fmTrue, fmFalse], m2, a2)
  3.3220 -			end
  3.3221 -		| Const ("op -->", _) $ t1 =>
  3.3222 -			SOME (interpret thy model args (eta_expand t 1))
  3.3223 -		| Const ("op -->", _) =>
  3.3224 -			SOME (interpret thy model args (eta_expand t 2))
  3.3225 -			(* this would make "undef" propagate, even for formulae like *)
  3.3226 -			(* "False --> undef":                                        *)
  3.3227 -			(* SOME (Node [Node [TT, FF], Node [TT, TT]], model, args) *)
  3.3228 -		| _ => NONE;
  3.3229 +  fun HOLogic_interpreter thy model args t =
  3.3230 +  (* Providing interpretations directly is more efficient than unfolding the *)
  3.3231 +  (* logical constants.  In HOL however, logical constants can themselves be *)
  3.3232 +  (* arguments.  They are then translated using eta-expansion.               *)
  3.3233 +    case t of
  3.3234 +      Const ("Trueprop", _) =>
  3.3235 +      SOME (Node [TT, FF], model, args)
  3.3236 +    | Const ("Not", _) =>
  3.3237 +      SOME (Node [FF, TT], model, args)
  3.3238 +    (* redundant, since 'True' is also an IDT constructor *)
  3.3239 +    | Const ("True", _) =>
  3.3240 +      SOME (TT, model, args)
  3.3241 +    (* redundant, since 'False' is also an IDT constructor *)
  3.3242 +    | Const ("False", _) =>
  3.3243 +      SOME (FF, model, args)
  3.3244 +    | Const ("All", _) $ t1 =>  (* similar to "all" (Pure) *)
  3.3245 +      let
  3.3246 +        val (i, m, a) = interpret thy model args t1
  3.3247 +      in
  3.3248 +        case i of
  3.3249 +          Node xs =>
  3.3250 +          (* 3-valued logic *)
  3.3251 +          let
  3.3252 +            val fmTrue  = PropLogic.all (map toTrue xs)
  3.3253 +            val fmFalse = PropLogic.exists (map toFalse xs)
  3.3254 +          in
  3.3255 +            SOME (Leaf [fmTrue, fmFalse], m, a)
  3.3256 +          end
  3.3257 +        | _ =>
  3.3258 +          raise REFUTE ("HOLogic_interpreter",
  3.3259 +            "\"All\" is followed by a non-function")
  3.3260 +      end
  3.3261 +    | Const ("All", _) =>
  3.3262 +      SOME (interpret thy model args (eta_expand t 1))
  3.3263 +    | Const ("Ex", _) $ t1 =>
  3.3264 +      let
  3.3265 +        val (i, m, a) = interpret thy model args t1
  3.3266 +      in
  3.3267 +        case i of
  3.3268 +          Node xs =>
  3.3269 +          (* 3-valued logic *)
  3.3270 +          let
  3.3271 +            val fmTrue  = PropLogic.exists (map toTrue xs)
  3.3272 +            val fmFalse = PropLogic.all (map toFalse xs)
  3.3273 +          in
  3.3274 +            SOME (Leaf [fmTrue, fmFalse], m, a)
  3.3275 +          end
  3.3276 +        | _ =>
  3.3277 +          raise REFUTE ("HOLogic_interpreter",
  3.3278 +            "\"Ex\" is followed by a non-function")
  3.3279 +      end
  3.3280 +    | Const ("Ex", _) =>
  3.3281 +      SOME (interpret thy model args (eta_expand t 1))
  3.3282 +    | Const ("op =", _) $ t1 $ t2 =>  (* similar to "==" (Pure) *)
  3.3283 +      let
  3.3284 +        val (i1, m1, a1) = interpret thy model args t1
  3.3285 +        val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3286 +      in
  3.3287 +        SOME (make_equality (i1, i2), m2, a2)
  3.3288 +      end
  3.3289 +    | Const ("op =", _) $ t1 =>
  3.3290 +      SOME (interpret thy model args (eta_expand t 1))
  3.3291 +    | Const ("op =", _) =>
  3.3292 +      SOME (interpret thy model args (eta_expand t 2))
  3.3293 +    | Const ("op &", _) $ t1 $ t2 =>
  3.3294 +      (* 3-valued logic *)
  3.3295 +      let
  3.3296 +        val (i1, m1, a1) = interpret thy model args t1
  3.3297 +        val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3298 +        val fmTrue       = PropLogic.SAnd (toTrue i1, toTrue i2)
  3.3299 +        val fmFalse      = PropLogic.SOr (toFalse i1, toFalse i2)
  3.3300 +      in
  3.3301 +        SOME (Leaf [fmTrue, fmFalse], m2, a2)
  3.3302 +      end
  3.3303 +    | Const ("op &", _) $ t1 =>
  3.3304 +      SOME (interpret thy model args (eta_expand t 1))
  3.3305 +    | Const ("op &", _) =>
  3.3306 +      SOME (interpret thy model args (eta_expand t 2))
  3.3307 +      (* this would make "undef" propagate, even for formulae like *)
  3.3308 +      (* "False & undef":                                          *)
  3.3309 +      (* SOME (Node [Node [TT, FF], Node [FF, FF]], model, args) *)
  3.3310 +    | Const ("op |", _) $ t1 $ t2 =>
  3.3311 +      (* 3-valued logic *)
  3.3312 +      let
  3.3313 +        val (i1, m1, a1) = interpret thy model args t1
  3.3314 +        val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3315 +        val fmTrue       = PropLogic.SOr (toTrue i1, toTrue i2)
  3.3316 +        val fmFalse      = PropLogic.SAnd (toFalse i1, toFalse i2)
  3.3317 +      in
  3.3318 +        SOME (Leaf [fmTrue, fmFalse], m2, a2)
  3.3319 +      end
  3.3320 +    | Const ("op |", _) $ t1 =>
  3.3321 +      SOME (interpret thy model args (eta_expand t 1))
  3.3322 +    | Const ("op |", _) =>
  3.3323 +      SOME (interpret thy model args (eta_expand t 2))
  3.3324 +      (* this would make "undef" propagate, even for formulae like *)
  3.3325 +      (* "True | undef":                                           *)
  3.3326 +      (* SOME (Node [Node [TT, TT], Node [TT, FF]], model, args) *)
  3.3327 +    | Const ("op -->", _) $ t1 $ t2 =>  (* similar to "==>" (Pure) *)
  3.3328 +      (* 3-valued logic *)
  3.3329 +      let
  3.3330 +        val (i1, m1, a1) = interpret thy model args t1
  3.3331 +        val (i2, m2, a2) = interpret thy m1 a1 t2
  3.3332 +        val fmTrue       = PropLogic.SOr (toFalse i1, toTrue i2)
  3.3333 +        val fmFalse      = PropLogic.SAnd (toTrue i1, toFalse i2)
  3.3334 +      in
  3.3335 +        SOME (Leaf [fmTrue, fmFalse], m2, a2)
  3.3336 +      end
  3.3337 +    | Const ("op -->", _) $ t1 =>
  3.3338 +      SOME (interpret thy model args (eta_expand t 1))
  3.3339 +    | Const ("op -->", _) =>
  3.3340 +      SOME (interpret thy model args (eta_expand t 2))
  3.3341 +      (* this would make "undef" propagate, even for formulae like *)
  3.3342 +      (* "False --> undef":                                        *)
  3.3343 +      (* SOME (Node [Node [TT, FF], Node [TT, TT]], model, args) *)
  3.3344 +    | _ => NONE;
  3.3345  
  3.3346 -	(* theory -> model -> arguments -> Term.term ->
  3.3347 -		(interpretation * model * arguments) option *)
  3.3348 +  (* theory -> model -> arguments -> Term.term ->
  3.3349 +    (interpretation * model * arguments) option *)
  3.3350  
  3.3351 -	fun set_interpreter thy model args t =
  3.3352 -	(* "T set" is isomorphic to "T --> bool" *)
  3.3353 -	let
  3.3354 -		val (typs, terms) = model
  3.3355 -	in
  3.3356 -		case AList.lookup (op =) terms t of
  3.3357 -		  SOME intr =>
  3.3358 -			(* return an existing interpretation *)
  3.3359 -			SOME (intr, model, args)
  3.3360 -		| NONE =>
  3.3361 -			(case t of
  3.3362 -			  Free (x, Type ("set", [T])) =>
  3.3363 -				let
  3.3364 -					val (intr, _, args') =
  3.3365 -						interpret thy (typs, []) args (Free (x, T --> HOLogic.boolT))
  3.3366 -				in
  3.3367 -					SOME (intr, (typs, (t, intr)::terms), args')
  3.3368 -				end
  3.3369 -			| Var ((x, i), Type ("set", [T])) =>
  3.3370 -				let
  3.3371 -					val (intr, _, args') =
  3.3372 -						interpret thy (typs, []) args (Var ((x,i), T --> HOLogic.boolT))
  3.3373 -				in
  3.3374 -					SOME (intr, (typs, (t, intr)::terms), args')
  3.3375 -				end
  3.3376 -			| Const (s, Type ("set", [T])) =>
  3.3377 -				let
  3.3378 -					val (intr, _, args') =
  3.3379 -						interpret thy (typs, []) args (Const (s, T --> HOLogic.boolT))
  3.3380 -				in
  3.3381 -					SOME (intr, (typs, (t, intr)::terms), args')
  3.3382 -				end
  3.3383 -			(* 'Collect' == identity *)
  3.3384 -			| Const ("Collect", _) $ t1 =>
  3.3385 -				SOME (interpret thy model args t1)
  3.3386 -			| Const ("Collect", _) =>
  3.3387 -				SOME (interpret thy model args (eta_expand t 1))
  3.3388 -			(* 'op :' == application *)
  3.3389 -			| Const ("op :", _) $ t1 $ t2 =>
  3.3390 -				SOME (interpret thy model args (t2 $ t1))
  3.3391 -			| Const ("op :", _) $ t1 =>
  3.3392 -				SOME (interpret thy model args (eta_expand t 1))
  3.3393 -			| Const ("op :", _) =>
  3.3394 -				SOME (interpret thy model args (eta_expand t 2))
  3.3395 -			| _ => NONE)
  3.3396 -	end;
  3.3397 +  fun set_interpreter thy model args t =
  3.3398 +  (* "T set" is isomorphic to "T --> bool" *)
  3.3399 +  let
  3.3400 +    val (typs, terms) = model
  3.3401 +  in
  3.3402 +    case AList.lookup (op =) terms t of
  3.3403 +      SOME intr =>
  3.3404 +      (* return an existing interpretation *)
  3.3405 +      SOME (intr, model, args)
  3.3406 +    | NONE =>
  3.3407 +      (case t of
  3.3408 +        Free (x, Type ("set", [T])) =>
  3.3409 +        let
  3.3410 +          val (intr, _, args') =
  3.3411 +            interpret thy (typs, []) args (Free (x, T --> HOLogic.boolT))
  3.3412 +        in
  3.3413 +          SOME (intr, (typs, (t, intr)::terms), args')
  3.3414 +        end
  3.3415 +      | Var ((x, i), Type ("set", [T])) =>
  3.3416 +        let
  3.3417 +          val (intr, _, args') =
  3.3418 +            interpret thy (typs, []) args (Var ((x,i), T --> HOLogic.boolT))
  3.3419 +        in
  3.3420 +          SOME (intr, (typs, (t, intr)::terms), args')
  3.3421 +        end
  3.3422 +      | Const (s, Type ("set", [T])) =>
  3.3423 +        let
  3.3424 +          val (intr, _, args') =
  3.3425 +            interpret thy (typs, []) args (Const (s, T --> HOLogic.boolT))
  3.3426 +        in
  3.3427 +          SOME (intr, (typs, (t, intr)::terms), args')
  3.3428 +        end
  3.3429 +      (* 'Collect' == identity *)
  3.3430 +      | Const ("Collect", _) $ t1 =>
  3.3431 +        SOME (interpret thy model args t1)
  3.3432 +      | Const ("Collect", _) =>
  3.3433 +        SOME (interpret thy model args (eta_expand t 1))
  3.3434 +      (* 'op :' == application *)
  3.3435 +      | Const ("op :", _) $ t1 $ t2 =>
  3.3436 +        SOME (interpret thy model args (t2 $ t1))
  3.3437 +      | Const ("op :", _) $ t1 =>
  3.3438 +        SOME (interpret thy model args (eta_expand t 1))
  3.3439 +      | Const ("op :", _) =>
  3.3440 +        SOME (interpret thy model args (eta_expand t 2))
  3.3441 +      | _ => NONE)
  3.3442 +  end;
  3.3443  
  3.3444 -	(* theory -> model -> arguments -> Term.term ->
  3.3445 -		(interpretation * model * arguments) option *)
  3.3446 +  (* theory -> model -> arguments -> Term.term ->
  3.3447 +    (interpretation * model * arguments) option *)
  3.3448  
  3.3449 -	(* interprets variables and constants whose type is an IDT; *)
  3.3450 -	(* constructors of IDTs however are properly interpreted by *)
  3.3451 -	(* 'IDT_constructor_interpreter'                            *)
  3.3452 +  (* interprets variables and constants whose type is an IDT; *)
  3.3453 +  (* constructors of IDTs however are properly interpreted by *)
  3.3454 +  (* 'IDT_constructor_interpreter'                            *)
  3.3455  
  3.3456 -	fun IDT_interpreter thy model args t =
  3.3457 -	let
  3.3458 -		val (typs, terms) = model
  3.3459 -		(* Term.typ -> (interpretation * model * arguments) option *)
  3.3460 -		fun interpret_term (Type (s, Ts)) =
  3.3461 -			(case DatatypePackage.get_datatype thy s of
  3.3462 -			  SOME info =>  (* inductive datatype *)
  3.3463 -				let
  3.3464 -					(* int option -- only recursive IDTs have an associated depth *)
  3.3465 -					val depth = AList.lookup (op =) typs (Type (s, Ts))
  3.3466 -				in
  3.3467 -					(* termination condition to avoid infinite recursion *)
  3.3468 -					if depth = (SOME 0) then
  3.3469 -						(* return a leaf of size 0 *)
  3.3470 -						SOME (Leaf [], model, args)
  3.3471 -					else
  3.3472 -						let
  3.3473 -							val index               = #index info
  3.3474 -							val descr               = #descr info
  3.3475 -							val (_, dtyps, constrs) = lookup descr index
  3.3476 -							val typ_assoc           = dtyps ~~ Ts
  3.3477 -							(* sanity check: every element in 'dtyps' must be a 'DtTFree' *)
  3.3478 -							val _ = (if Library.exists (fn d =>
  3.3479 -									case d of DatatypeAux.DtTFree _ => false | _ => true) dtyps
  3.3480 -								then
  3.3481 -									raise REFUTE ("IDT_interpreter",
  3.3482 -										"datatype argument (for type "
  3.3483 -										^ Sign.string_of_typ thy (Type (s, Ts))
  3.3484 -										^ ") is not a variable")
  3.3485 -								else
  3.3486 -									())
  3.3487 -							(* if the model specifies a depth for the current type, *)
  3.3488 -							(* decrement it to avoid infinite recursion             *)
  3.3489 -							val typs'    = case depth of NONE => typs | SOME n =>
  3.3490 -								AList.update (op =) (Type (s, Ts), n-1) typs
  3.3491 -							(* recursively compute the size of the datatype *)
  3.3492 -							val size     = size_of_dtyp thy typs' descr typ_assoc constrs
  3.3493 -							val next_idx = #next_idx args
  3.3494 -							val next     = next_idx+size
  3.3495 -							(* check if 'maxvars' is large enough *)
  3.3496 -							val _        = (if next-1 > #maxvars args andalso
  3.3497 -								#maxvars args > 0 then raise MAXVARS_EXCEEDED else ())
  3.3498 -							(* prop_formula list *)
  3.3499 -							val fms      = map BoolVar (next_idx upto (next_idx+size-1))
  3.3500 -							(* interpretation *)
  3.3501 -							val intr     = Leaf fms
  3.3502 -							(* prop_formula list -> prop_formula *)
  3.3503 -							fun one_of_two_false []      = True
  3.3504 -							  | one_of_two_false (x::xs) = SAnd (PropLogic.all (map (fn x' =>
  3.3505 -								SOr (SNot x, SNot x')) xs), one_of_two_false xs)
  3.3506 -							(* prop_formula *)
  3.3507 -							val wf       = one_of_two_false fms
  3.3508 -						in
  3.3509 -							(* extend the model, increase 'next_idx', add well-formedness *)
  3.3510 -							(* condition                                                  *)
  3.3511 -							SOME (intr, (typs, (t, intr)::terms), {maxvars = #maxvars args,
  3.3512 -								def_eq = #def_eq args, next_idx = next, bounds = #bounds args,
  3.3513 -								wellformed = SAnd (#wellformed args, wf)})
  3.3514 -						end
  3.3515 -				end
  3.3516 -			| NONE =>  (* not an inductive datatype *)
  3.3517 -				NONE)
  3.3518 -		  | interpret_term _ =  (* a (free or schematic) type variable *)
  3.3519 -			NONE
  3.3520 -	in
  3.3521 -		case AList.lookup (op =) terms t of
  3.3522 -		  SOME intr =>
  3.3523 -			(* return an existing interpretation *)
  3.3524 -			SOME (intr, model, args)
  3.3525 -		| NONE =>
  3.3526 -			(case t of
  3.3527 -			  Free (_, T)  => interpret_term T
  3.3528 -			| Var (_, T)   => interpret_term T
  3.3529 -			| Const (_, T) => interpret_term T
  3.3530 -			| _            => NONE)
  3.3531 -	end;
  3.3532 +  fun IDT_interpreter thy model args t =
  3.3533 +  let
  3.3534 +    val (typs, terms) = model
  3.3535 +    (* Term.typ -> (interpretation * model * arguments) option *)
  3.3536 +    fun interpret_term (Type (s, Ts)) =
  3.3537 +      (case DatatypePackage.get_datatype thy s of
  3.3538 +        SOME info =>  (* inductive datatype *)
  3.3539 +        let
  3.3540 +          (* int option -- only recursive IDTs have an associated depth *)
  3.3541 +          val depth = AList.lookup (op =) typs (Type (s, Ts))
  3.3542 +        in
  3.3543 +          (* termination condition to avoid infinite recursion *)
  3.3544 +          if depth = (SOME 0) then
  3.3545 +            (* return a leaf of size 0 *)
  3.3546 +            SOME (Leaf [], model, args)
  3.3547 +          else
  3.3548 +            let
  3.3549 +              val index               = #index info
  3.3550 +              val descr               = #descr info
  3.3551 +              val (_, dtyps, constrs) = lookup descr index
  3.3552 +              val typ_assoc           = dtyps ~~ Ts
  3.3553 +              (* sanity check: every element in 'dtyps' must be a 'DtTFree' *)
  3.3554 +              val _ = (if Library.exists (fn d =>
  3.3555 +                  case d of DatatypeAux.DtTFree _ => false | _ => true) dtyps
  3.3556 +                then
  3.3557 +                  raise REFUTE ("IDT_interpreter",
  3.3558 +                    "datatype argument (for type "
  3.3559 +                    ^ Sign.string_of_typ thy (Type (s, Ts))
  3.3560 +                    ^ ") is not a variable")
  3.3561 +                else
  3.3562 +                  ())
  3.3563 +              (* if the model specifies a depth for the current type, *)
  3.3564 +              (* decrement it to avoid infinite recursion             *)
  3.3565 +              val typs'    = case depth of NONE => typs | SOME n =>
  3.3566 +                AList.update (op =) (Type (s, Ts), n-1) typs
  3.3567 +              (* recursively compute the size of the datatype *)
  3.3568 +              val size     = size_of_dtyp thy typs' descr typ_assoc constrs
  3.3569 +              val next_idx = #next_idx args
  3.3570 +              val next     = next_idx+size
  3.3571 +              (* check if 'maxvars' is large enough *)
  3.3572 +              val _        = (if next-1 > #maxvars args andalso
  3.3573 +                #maxvars args > 0 then raise MAXVARS_EXCEEDED else ())
  3.3574 +              (* prop_formula list *)
  3.3575 +              val fms      = map BoolVar (next_idx upto (next_idx+size-1))
  3.3576 +              (* interpretation *)
  3.3577 +              val intr     = Leaf fms
  3.3578 +              (* prop_formula list -> prop_formula *)
  3.3579 +              fun one_of_two_false []      = True
  3.3580 +                | one_of_two_false (x::xs) = SAnd (PropLogic.all (map (fn x' =>
  3.3581 +                SOr (SNot x, SNot x')) xs), one_of_two_false xs)
  3.3582 +              (* prop_formula *)
  3.3583 +              val wf       = one_of_two_false fms
  3.3584 +            in
  3.3585 +              (* extend the model, increase 'next_idx', add well-formedness *)
  3.3586 +              (* condition                                                  *)
  3.3587 +              SOME (intr, (typs, (t, intr)::terms), {maxvars = #maxvars args,
  3.3588 +                def_eq = #def_eq args, next_idx = next, bounds = #bounds args,
  3.3589 +                wellformed = SAnd (#wellformed args, wf)})
  3.3590 +            end
  3.3591 +        end
  3.3592 +      | NONE =>  (* not an inductive datatype *)
  3.3593 +        NONE)
  3.3594 +      | interpret_term _ =  (* a (free or schematic) type variable *)
  3.3595 +      NONE
  3.3596 +  in
  3.3597 +    case AList.lookup (op =) terms t of
  3.3598 +      SOME intr =>
  3.3599 +      (* return an existing interpretation *)
  3.3600 +      SOME (intr, model, args)
  3.3601 +    | NONE =>
  3.3602 +      (case t of
  3.3603 +        Free (_, T)  => interpret_term T
  3.3604 +      | Var (_, T)   => interpret_term T
  3.3605 +      | Const (_, T) => interpret_term T
  3.3606 +      | _            => NONE)
  3.3607 +  end;
  3.3608  
  3.3609 -	(* theory -> model -> arguments -> Term.term ->
  3.3610 -		(interpretation * model * arguments) option *)
  3.3611 +  (* theory -> model -> arguments -> Term.term ->
  3.3612 +    (interpretation * model * arguments) option *)
  3.3613  
  3.3614 -	fun IDT_constructor_interpreter thy model args t =
  3.3615 -	let
  3.3616 -		val (typs, terms) = model
  3.3617 -	in
  3.3618 -		case AList.lookup (op =) terms t of
  3.3619 -		  SOME intr =>
  3.3620 -			(* return an existing interpretation *)
  3.3621 -			SOME (intr, model, args)
  3.3622 -		| NONE =>
  3.3623 -			(case t of
  3.3624 -			  Const (s, T) =>
  3.3625 -				(case body_type T of
  3.3626 -				  Type (s', Ts') =>
  3.3627 -					(case DatatypePackage.get_datatype thy s' of
  3.3628 -					  SOME info =>  (* body type is an inductive datatype *)
  3.3629 -						let
  3.3630 -							val index               = #index info
  3.3631 -							val descr               = #descr info
  3.3632 -							val (_, dtyps, constrs) = lookup descr index
  3.3633 -							val typ_assoc           = dtyps ~~ Ts'
  3.3634 -							(* sanity check: every element in 'dtyps' must be a 'DtTFree' *)
  3.3635 -							val _ = (if Library.exists (fn d =>
  3.3636 -									case d of DatatypeAux.DtTFree _ => false | _ => true) dtyps
  3.3637 -								then
  3.3638 -									raise REFUTE ("IDT_constructor_interpreter",
  3.3639 -										"datatype argument (for type "
  3.3640 -										^ Sign.string_of_typ thy (Type (s', Ts'))
  3.3641 -										^ ") is not a variable")
  3.3642 -								else
  3.3643 -									())
  3.3644 -							(* split the constructors into those occuring before/after *)
  3.3645 -							(* 'Const (s, T)'                                          *)
  3.3646 -							val (constrs1, constrs2) = take_prefix (fn (cname, ctypes) =>
  3.3647 -								not (cname = s andalso Sign.typ_instance thy (T,
  3.3648 -									map (typ_of_dtyp descr typ_assoc) ctypes
  3.3649 -										---> Type (s', Ts')))) constrs
  3.3650 -						in
  3.3651 -							case constrs2 of
  3.3652 -							  [] =>
  3.3653 -								(* 'Const (s, T)' is not a constructor of this datatype *)
  3.3654 -								NONE
  3.3655 -							| (_, ctypes)::cs =>
  3.3656 -								let
  3.3657 -									(* compute the total size of the datatype (with the *)
  3.3658 -									(* current depth)                                   *)
  3.3659 -									val (i, _, _) = interpret thy (typs, []) {maxvars=0,
  3.3660 -										def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3661 -										(Free ("dummy", Type (s', Ts')))
  3.3662 -									val total     = size_of_type i
  3.3663 -									(* int option -- only /recursive/ IDTs have an associated *)
  3.3664 -									(*               depth                                    *)
  3.3665 -									val depth = AList.lookup (op =) typs (Type (s', Ts'))
  3.3666 -									val typs' = (case depth of NONE => typs | SOME n =>
  3.3667 -										AList.update (op =) (Type (s', Ts'), n-1) typs)
  3.3668 -									(* returns an interpretation where everything is mapped to *)
  3.3669 -									(* "undefined"                                             *)
  3.3670 -									(* DatatypeAux.dtyp list -> interpretation *)
  3.3671 -									fun make_undef [] =
  3.3672 -										Leaf (replicate total False)
  3.3673 -									  | make_undef (d::ds) =
  3.3674 -										let
  3.3675 -											(* compute the current size of the type 'd' *)
  3.3676 -											val T           = typ_of_dtyp descr typ_assoc d
  3.3677 -											val (i, _, _)   = interpret thy (typs, []) {maxvars=0,
  3.3678 -												def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3679 -												(Free ("dummy", T))
  3.3680 -											val size        = size_of_type i
  3.3681 -										in
  3.3682 -											Node (replicate size (make_undef ds))
  3.3683 -										end
  3.3684 -									(* returns the interpretation for a constructor at depth 1 *)
  3.3685 -									(* int * DatatypeAux.dtyp list -> int * interpretation *)
  3.3686 -									fun make_constr (offset, []) =
  3.3687 -										if offset<total then
  3.3688 -											(offset+1, Leaf ((replicate offset False) @ True ::
  3.3689 -												(replicate (total-offset-1) False)))
  3.3690 -										else
  3.3691 -											raise REFUTE ("IDT_constructor_interpreter",
  3.3692 -												"offset >= total")
  3.3693 -									  | make_constr (offset, d::ds) =
  3.3694 -										let
  3.3695 -											(* compute the current and the old size of the type 'd' *)
  3.3696 -											val T           = typ_of_dtyp descr typ_assoc d
  3.3697 -											val (i, _, _)   = interpret thy (typs, []) {maxvars=0,
  3.3698 -												def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3699 -												(Free ("dummy", T))
  3.3700 -											val size        = size_of_type i
  3.3701 -											val (i', _, _)  = interpret thy (typs', []) {maxvars=0,
  3.3702 -												def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3703 -												(Free ("dummy", T))
  3.3704 -											val size'       = size_of_type i'
  3.3705 -											(* sanity check *)
  3.3706 -											val _           = if size < size' then
  3.3707 -													raise REFUTE ("IDT_constructor_interpreter",
  3.3708 -														"current size is less than old size")
  3.3709 -												else ()
  3.3710 -											(* int * interpretation list *)
  3.3711 -											val (new_offset, intrs) = foldl_map make_constr
  3.3712 -												(offset, replicate size' ds)
  3.3713 -											(* interpretation list *)
  3.3714 -											val undefs = replicate (size - size') (make_undef ds)
  3.3715 -										in
  3.3716 -											(* elements that exist at the previous depth are      *)
  3.3717 -											(* mapped to a defined value, while new elements are  *)
  3.3718 -											(* mapped to "undefined" by the recursive constructor *)
  3.3719 -											(new_offset, Node (intrs @ undefs))
  3.3720 -										end
  3.3721 -									(* extends the interpretation for a constructor (both      *)
  3.3722 -									(* recursive and non-recursive) obtained at depth n (n>=1) *)
  3.3723 -									(* to depth n+1                                            *)
  3.3724 -									(* int * DatatypeAux.dtyp list * interpretation
  3.3725 -										-> int * interpretation *)
  3.3726 -									fun extend_constr (offset, [], Leaf xs) =
  3.3727 -										let
  3.3728 -											(* returns the k-th unit vector of length n *)
  3.3729 -											(* int * int -> interpretation *)
  3.3730 -											fun unit_vector (k, n) =
  3.3731 -												Leaf ((replicate (k-1) False) @ True ::
  3.3732 -													(replicate (n-k) False))
  3.3733 -											(* int *)
  3.3734 -											val k = find_index_eq True xs
  3.3735 -										in
  3.3736 -											if k=(~1) then
  3.3737 -												(* if the element was mapped to "undefined" before, *)
  3.3738 -												(* map it to the value given by 'offset' now (and   *)
  3.3739 -												(* extend the length of the leaf)                   *)
  3.3740 -												(offset+1, unit_vector (offset+1, total))
  3.3741 -											else
  3.3742 -												(* if the element was already mapped to a defined  *)
  3.3743 -												(* value, map it to the same value again, just     *)
  3.3744 -												(* extend the length of the leaf, do not increment *)
  3.3745 -												(* the 'offset'                                    *)
  3.3746 -												(offset, unit_vector (k+1, total))
  3.3747 -										end
  3.3748 -									  | extend_constr (_, [], Node _) =
  3.3749 -										raise REFUTE ("IDT_constructor_interpreter",
  3.3750 -											"interpretation for constructor (with no arguments left)"
  3.3751 -											^ " is a node")
  3.3752 -									  | extend_constr (offset, d::ds, Node xs) =
  3.3753 -										let
  3.3754 -											(* compute the size of the type 'd' *)
  3.3755 -											val T          = typ_of_dtyp descr typ_assoc d
  3.3756 -											val (i, _, _)  = interpret thy (typs, []) {maxvars=0,
  3.3757 -												def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3758 -												(Free ("dummy", T))
  3.3759 -											val size       = size_of_type i
  3.3760 -											(* sanity check *)
  3.3761 -											val _          = if size < length xs then
  3.3762 -													raise REFUTE ("IDT_constructor_interpreter",
  3.3763 -														"new size of type is less than old size")
  3.3764 -												else ()
  3.3765 -											(* extend the existing interpretations *)
  3.3766 -											(* int * interpretation list *)
  3.3767 -											val (new_offset, intrs) = foldl_map (fn (off, i) =>
  3.3768 -												extend_constr (off, ds, i)) (offset, xs)
  3.3769 -											(* new elements of the type 'd' are mapped to *)
  3.3770 -											(* "undefined"                                *)
  3.3771 -											val undefs = replicate (size - length xs) (make_undef ds)
  3.3772 -										in
  3.3773 -											(new_offset, Node (intrs @ undefs))
  3.3774 -										end
  3.3775 -									  | extend_constr (_, d::ds, Leaf _) =
  3.3776 -										raise REFUTE ("IDT_constructor_interpreter",
  3.3777 -											"interpretation for constructor (with arguments left)"
  3.3778 -											^ " is a leaf")
  3.3779 -									(* returns 'true' iff the constructor has a recursive *)
  3.3780 -									(* argument                                           *)
  3.3781 -									(* DatatypeAux.dtyp list -> bool *)
  3.3782 -									fun is_rec_constr ds =
  3.3783 -										Library.exists DatatypeAux.is_rec_type ds
  3.3784 -									(* constructors before 'Const (s, T)' generate elements of *)
  3.3785 -									(* the datatype                                            *)
  3.3786 -									val offset = size_of_dtyp thy typs' descr typ_assoc constrs1
  3.3787 -								in
  3.3788 -									case depth of
  3.3789 -									  NONE =>  (* equivalent to a depth of 1 *)
  3.3790 -										SOME (snd (make_constr (offset, ctypes)), model, args)
  3.3791 -									| SOME 0 =>
  3.3792 -										raise REFUTE ("IDT_constructor_interpreter", "depth is 0")
  3.3793 -									| SOME 1 =>
  3.3794 -										SOME (snd (make_constr (offset, ctypes)), model, args)
  3.3795 -									| SOME n =>  (* n > 1 *)
  3.3796 -										let
  3.3797 -											(* interpret the constructor at depth-1 *)
  3.3798 -											val (iC, _, _) = interpret thy (typs', []) {maxvars=0,
  3.3799 -												def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3800 -												(Const (s, T))
  3.3801 -											(* elements generated by the constructor at depth-1 *)
  3.3802 -											(* must be added to 'offset'                        *)
  3.3803 -											(* interpretation -> int *)
  3.3804 -											fun number_of_defined_elements (Leaf xs) =
  3.3805 -												if find_index_eq True xs = (~1) then 0 else 1
  3.3806 -											  | number_of_defined_elements (Node xs) =
  3.3807 -												sum (map number_of_defined_elements xs)
  3.3808 -											(* int *)
  3.3809 -											val offset' = offset + number_of_defined_elements iC
  3.3810 -										in
  3.3811 -											SOME (snd (extend_constr (offset', ctypes, iC)), model,
  3.3812 -												args)
  3.3813 -										end
  3.3814 -								end
  3.3815 -						end
  3.3816 -					| NONE =>  (* body type is not an inductive datatype *)
  3.3817 -						NONE)
  3.3818 -				| _ =>  (* body type is a (free or schematic) type variable *)
  3.3819 -					NONE)
  3.3820 -			| _ =>  (* term is not a constant *)
  3.3821 -				NONE)
  3.3822 -	end;
  3.3823 +  fun IDT_constructor_interpreter thy model args t =
  3.3824 +  let
  3.3825 +    val (typs, terms) = model
  3.3826 +  in
  3.3827 +    case AList.lookup (op =) terms t of
  3.3828 +      SOME intr =>
  3.3829 +      (* return an existing interpretation *)
  3.3830 +      SOME (intr, model, args)
  3.3831 +    | NONE =>
  3.3832 +      (case t of
  3.3833 +        Const (s, T) =>
  3.3834 +        (case body_type T of
  3.3835 +          Type (s', Ts') =>
  3.3836 +          (case DatatypePackage.get_datatype thy s' of
  3.3837 +            SOME info =>  (* body type is an inductive datatype *)
  3.3838 +            let
  3.3839 +              val index               = #index info
  3.3840 +              val descr               = #descr info
  3.3841 +              val (_, dtyps, constrs) = lookup descr index
  3.3842 +              val typ_assoc           = dtyps ~~ Ts'
  3.3843 +              (* sanity check: every element in 'dtyps' must be a 'DtTFree' *)
  3.3844 +              val _ = (if Library.exists (fn d =>
  3.3845 +                  case d of DatatypeAux.DtTFree _ => false | _ => true) dtyps
  3.3846 +                then
  3.3847 +                  raise REFUTE ("IDT_constructor_interpreter",
  3.3848 +                    "datatype argument (for type "
  3.3849 +                    ^ Sign.string_of_typ thy (Type (s', Ts'))
  3.3850 +                    ^ ") is not a variable")
  3.3851 +                else
  3.3852 +                  ())
  3.3853 +              (* split the constructors into those occuring before/after *)
  3.3854 +              (* 'Const (s, T)'                                          *)
  3.3855 +              val (constrs1, constrs2) = take_prefix (fn (cname, ctypes) =>
  3.3856 +                not (cname = s andalso Sign.typ_instance thy (T,
  3.3857 +                  map (typ_of_dtyp descr typ_assoc) ctypes
  3.3858 +                    ---> Type (s', Ts')))) constrs
  3.3859 +            in
  3.3860 +              case constrs2 of
  3.3861 +                [] =>
  3.3862 +                (* 'Const (s, T)' is not a constructor of this datatype *)
  3.3863 +                NONE
  3.3864 +              | (_, ctypes)::cs =>
  3.3865 +                let
  3.3866 +                  (* compute the total size of the datatype (with the *)
  3.3867 +                  (* current depth)                                   *)
  3.3868 +                  val (i, _, _) = interpret thy (typs, []) {maxvars=0,
  3.3869 +                    def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3870 +                    (Free ("dummy", Type (s', Ts')))
  3.3871 +                  val total     = size_of_type i
  3.3872 +                  (* int option -- only /recursive/ IDTs have an associated *)
  3.3873 +                  (*               depth                                    *)
  3.3874 +                  val depth = AList.lookup (op =) typs (Type (s', Ts'))
  3.3875 +                  val typs' = (case depth of NONE => typs | SOME n =>
  3.3876 +                    AList.update (op =) (Type (s', Ts'), n-1) typs)
  3.3877 +                  (* returns an interpretation where everything is mapped to *)
  3.3878 +                  (* "undefined"                                             *)
  3.3879 +                  (* DatatypeAux.dtyp list -> interpretation *)
  3.3880 +                  fun make_undef [] =
  3.3881 +                    Leaf (replicate total False)
  3.3882 +                    | make_undef (d::ds) =
  3.3883 +                    let
  3.3884 +                      (* compute the current size of the type 'd' *)
  3.3885 +                      val T           = typ_of_dtyp descr typ_assoc d
  3.3886 +                      val (i, _, _)   = interpret thy (typs, []) {maxvars=0,
  3.3887 +                        def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3888 +                        (Free ("dummy", T))
  3.3889 +                      val size        = size_of_type i
  3.3890 +                    in
  3.3891 +                      Node (replicate size (make_undef ds))
  3.3892 +                    end
  3.3893 +                  (* returns the interpretation for a constructor at depth 1 *)
  3.3894 +                  (* int * DatatypeAux.dtyp list -> int * interpretation *)
  3.3895 +                  fun make_constr (offset, []) =
  3.3896 +                    if offset<total then
  3.3897 +                      (offset+1, Leaf ((replicate offset False) @ True ::
  3.3898 +                        (replicate (total-offset-1) False)))
  3.3899 +                    else
  3.3900 +                      raise REFUTE ("IDT_constructor_interpreter",
  3.3901 +                        "offset >= total")
  3.3902 +                    | make_constr (offset, d::ds) =
  3.3903 +                    let
  3.3904 +                      (* compute the current and the old size of the type 'd' *)
  3.3905 +                      val T           = typ_of_dtyp descr typ_assoc d
  3.3906 +                      val (i, _, _)   = interpret thy (typs, []) {maxvars=0,
  3.3907 +                        def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3908 +                        (Free ("dummy", T))
  3.3909 +                      val size        = size_of_type i
  3.3910 +                      val (i', _, _)  = interpret thy (typs', []) {maxvars=0,
  3.3911 +                        def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3912 +                        (Free ("dummy", T))
  3.3913 +                      val size'       = size_of_type i'
  3.3914 +                      (* sanity check *)
  3.3915 +                      val _           = if size < size' then
  3.3916 +                          raise REFUTE ("IDT_constructor_interpreter",
  3.3917 +                            "current size is less than old size")
  3.3918 +                        else ()
  3.3919 +                      (* int * interpretation list *)
  3.3920 +                      val (new_offset, intrs) = foldl_map make_constr
  3.3921 +                        (offset, replicate size' ds)
  3.3922 +                      (* interpretation list *)
  3.3923 +                      val undefs = replicate (size - size') (make_undef ds)
  3.3924 +                    in
  3.3925 +                      (* elements that exist at the previous depth are      *)
  3.3926 +                      (* mapped to a defined value, while new elements are  *)
  3.3927 +                      (* mapped to "undefined" by the recursive constructor *)
  3.3928 +                      (new_offset, Node (intrs @ undefs))
  3.3929 +                    end
  3.3930 +                  (* extends the interpretation for a constructor (both      *)
  3.3931 +                  (* recursive and non-recursive) obtained at depth n (n>=1) *)
  3.3932 +                  (* to depth n+1                                            *)
  3.3933 +                  (* int * DatatypeAux.dtyp list * interpretation
  3.3934 +                    -> int * interpretation *)
  3.3935 +                  fun extend_constr (offset, [], Leaf xs) =
  3.3936 +                    let
  3.3937 +                      (* returns the k-th unit vector of length n *)
  3.3938 +                      (* int * int -> interpretation *)
  3.3939 +                      fun unit_vector (k, n) =
  3.3940 +                        Leaf ((replicate (k-1) False) @ True ::
  3.3941 +                          (replicate (n-k) False))
  3.3942 +                      (* int *)
  3.3943 +                      val k = find_index_eq True xs
  3.3944 +                    in
  3.3945 +                      if k=(~1) then
  3.3946 +                        (* if the element was mapped to "undefined" before, *)
  3.3947 +                        (* map it to the value given by 'offset' now (and   *)
  3.3948 +                        (* extend the length of the leaf)                   *)
  3.3949 +                        (offset+1, unit_vector (offset+1, total))
  3.3950 +                      else
  3.3951 +                        (* if the element was already mapped to a defined  *)
  3.3952 +                        (* value, map it to the same value again, just     *)
  3.3953 +                        (* extend the length of the leaf, do not increment *)
  3.3954 +                        (* the 'offset'                                    *)
  3.3955 +                        (offset, unit_vector (k+1, total))
  3.3956 +                    end
  3.3957 +                    | extend_constr (_, [], Node _) =
  3.3958 +                    raise REFUTE ("IDT_constructor_interpreter",
  3.3959 +                      "interpretation for constructor (with no arguments left)"
  3.3960 +                      ^ " is a node")
  3.3961 +                    | extend_constr (offset, d::ds, Node xs) =
  3.3962 +                    let
  3.3963 +                      (* compute the size of the type 'd' *)
  3.3964 +                      val T          = typ_of_dtyp descr typ_assoc d
  3.3965 +                      val (i, _, _)  = interpret thy (typs, []) {maxvars=0,
  3.3966 +                        def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.3967 +                        (Free ("dummy", T))
  3.3968 +                      val size       = size_of_type i
  3.3969 +                      (* sanity check *)
  3.3970 +                      val _          = if size < length xs then
  3.3971 +                          raise REFUTE ("IDT_constructor_interpreter",
  3.3972 +                            "new size of type is less than old size")
  3.3973 +                        else ()
  3.3974 +                      (* extend the existing interpretations *)
  3.3975 +                      (* int * interpretation list *)
  3.3976 +                      val (new_offset, intrs) = foldl_map (fn (off, i) =>
  3.3977 +                        extend_constr (off, ds, i)) (offset, xs)
  3.3978 +                      (* new elements of the type 'd' are mapped to *)
  3.3979 +                      (* "undefined"                                *)
  3.3980 +                      val undefs = replicate (size - length xs) (make_undef ds)
  3.3981 +                    in
  3.3982 +                      (new_offset, Node (intrs @ undefs))
  3.3983 +                    end
  3.3984 +                    | extend_constr (_, d::ds, Leaf _) =
  3.3985 +                    raise REFUTE ("IDT_constructor_interpreter",
  3.3986 +                      "interpretation for constructor (with arguments left)"
  3.3987 +                      ^ " is a leaf")
  3.3988 +                  (* returns 'true' iff the constructor has a recursive *)
  3.3989 +                  (* argument                                           *)
  3.3990 +                  (* DatatypeAux.dtyp list -> bool *)
  3.3991 +                  fun is_rec_constr ds =
  3.3992 +                    Library.exists DatatypeAux.is_rec_type ds
  3.3993 +                  (* constructors before 'Const (s, T)' generate elements of *)
  3.3994 +                  (* the datatype                                            *)
  3.3995 +                  val offset = size_of_dtyp thy typs' descr typ_assoc constrs1
  3.3996 +                in
  3.3997 +                  case depth of
  3.3998 +                    NONE =>  (* equivalent to a depth of 1 *)
  3.3999 +                    SOME (snd (make_constr (offset, ctypes)), model, args)
  3.4000 +                  | SOME 0 =>
  3.4001 +                    raise REFUTE ("IDT_constructor_interpreter", "depth is 0")
  3.4002 +                  | SOME 1 =>
  3.4003 +                    SOME (snd (make_constr (offset, ctypes)), model, args)
  3.4004 +                  | SOME n =>  (* n > 1 *)
  3.4005 +                    let
  3.4006 +                      (* interpret the constructor at depth-1 *)
  3.4007 +                      val (iC, _, _) = interpret thy (typs', []) {maxvars=0,
  3.4008 +                        def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4009 +                        (Const (s, T))
  3.4010 +                      (* elements generated by the constructor at depth-1 *)
  3.4011 +                      (* must be added to 'offset'                        *)
  3.4012 +                      (* interpretation -> int *)
  3.4013 +                      fun number_of_defined_elements (Leaf xs) =
  3.4014 +                        if find_index_eq True xs = (~1) then 0 else 1
  3.4015 +                        | number_of_defined_elements (Node xs) =
  3.4016 +                        sum (map number_of_defined_elements xs)
  3.4017 +                      (* int *)
  3.4018 +                      val offset' = offset + number_of_defined_elements iC
  3.4019 +                    in
  3.4020 +                      SOME (snd (extend_constr (offset', ctypes, iC)), model,
  3.4021 +                        args)
  3.4022 +                    end
  3.4023 +                end
  3.4024 +            end
  3.4025 +          | NONE =>  (* body type is not an inductive datatype *)
  3.4026 +            NONE)
  3.4027 +        | _ =>  (* body type is a (free or schematic) type variable *)
  3.4028 +          NONE)
  3.4029 +      | _ =>  (* term is not a constant *)
  3.4030 +        NONE)
  3.4031 +  end;
  3.4032  
  3.4033 -	(* theory -> model -> arguments -> Term.term ->
  3.4034 -		(interpretation * model * arguments) option *)
  3.4035 +  (* theory -> model -> arguments -> Term.term ->
  3.4036 +    (interpretation * model * arguments) option *)
  3.4037  
  3.4038 -	(* Difficult code ahead.  Make sure you understand the                *)
  3.4039 -	(* 'IDT_constructor_interpreter' and the order in which it enumerates *)
  3.4040 -	(* elements of an IDT before you try to understand this function.     *)
  3.4041 +  (* Difficult code ahead.  Make sure you understand the                *)
  3.4042 +  (* 'IDT_constructor_interpreter' and the order in which it enumerates *)
  3.4043 +  (* elements of an IDT before you try to understand this function.     *)
  3.4044  
  3.4045 -	fun IDT_recursion_interpreter thy model args t =
  3.4046 -		(* careful: here we descend arbitrarily deep into 't', possibly before *)
  3.4047 -		(* any other interpreter for atomic terms has had a chance to look at  *)
  3.4048 -		(* 't'                                                                 *)
  3.4049 -		case strip_comb t of
  3.4050 -		  (Const (s, T), params) =>
  3.4051 -			(* iterate over all datatypes in 'thy' *)
  3.4052 -			Symtab.fold (fn (_, info) => fn result =>
  3.4053 -				case result of
  3.4054 -				  SOME _ =>
  3.4055 -					result  (* just keep 'result' *)
  3.4056 -				| NONE =>
  3.4057 -					if member (op =) (#rec_names info) s then
  3.4058 -						(* we do have a recursion operator of the datatype given by *)
  3.4059 -						(* 'info', or of a mutually recursive datatype              *)
  3.4060 -						let
  3.4061 -							val index              = #index info
  3.4062 -							val descr              = #descr info
  3.4063 -							val (dtname, dtyps, _) = lookup descr index
  3.4064 -							(* number of all constructors, including those of different  *)
  3.4065 -							(* (mutually recursive) datatypes within the same descriptor *)
  3.4066 -							(* 'descr'                                                   *)
  3.4067 -							val mconstrs_count = sum (map (fn (_, (_, _, cs)) => length cs)
  3.4068 -								descr)
  3.4069 -							val params_count   = length params
  3.4070 -							(* the type of a recursion operator: *)
  3.4071 -							(* [T1, ..., Tn, IDT] ---> Tresult   *)
  3.4072 -							val IDT = List.nth (binder_types T, mconstrs_count)
  3.4073 -						in
  3.4074 -							if (fst o dest_Type) IDT <> dtname then
  3.4075 -								(* recursion operator of a mutually recursive datatype *)
  3.4076 -								NONE
  3.4077 -							else if mconstrs_count < params_count then
  3.4078 -								(* too many actual parameters; for now we'll use the *)
  3.4079 -								(* 'stlc_interpreter' to strip off one application   *)
  3.4080 -								NONE
  3.4081 -							else if mconstrs_count > params_count then
  3.4082 -								(* too few actual parameters; we use eta expansion          *)
  3.4083 -								(* Note that the resulting expansion of lambda abstractions *)
  3.4084 -								(* by the 'stlc_interpreter' may be rather slow (depending  *)
  3.4085 -								(* on the argument types and the size of the IDT, of        *)
  3.4086 -								(* course).                                                 *)
  3.4087 -								SOME (interpret thy model args (eta_expand t
  3.4088 -									(mconstrs_count - params_count)))
  3.4089 -							else  (* mconstrs_count = params_count *)
  3.4090 -								let
  3.4091 -									(* interpret each parameter separately *)
  3.4092 -									val ((model', args'), p_intrs) = foldl_map (fn ((m, a), p) =>
  3.4093 -										let
  3.4094 -											val (i, m', a') = interpret thy m a p
  3.4095 -										in
  3.4096 -											((m', a'), i)
  3.4097 -										end) ((model, args), params)
  3.4098 -									val (typs, _) = model'
  3.4099 -									val typ_assoc = dtyps ~~ (snd o dest_Type) IDT
  3.4100 -									(* interpret each constructor in the descriptor (including *)
  3.4101 -									(* those of mutually recursive datatypes)                  *)
  3.4102 -									(* (int * interpretation list) list *)
  3.4103 -									val mc_intrs = map (fn (idx, (_, _, cs)) =>
  3.4104 -										let
  3.4105 -											val c_return_typ = typ_of_dtyp descr typ_assoc
  3.4106 -												(DatatypeAux.DtRec idx)
  3.4107 -										in
  3.4108 -											(idx, map (fn (cname, cargs) =>
  3.4109 -												(#1 o interpret thy (typs, []) {maxvars=0,
  3.4110 -													def_eq=false, next_idx=1, bounds=[],
  3.4111 -													wellformed=True}) (Const (cname, map (typ_of_dtyp
  3.4112 -													descr typ_assoc) cargs ---> c_return_typ))) cs)
  3.4113 -										end) descr
  3.4114 -									(* the recursion operator is a function that maps every   *)
  3.4115 -									(* element of the inductive datatype (and of mutually     *)
  3.4116 -									(* recursive types) to an element of some result type; an *)
  3.4117 -									(* array entry of NONE means that the actual result has   *)
  3.4118 -									(* not been computed yet                                  *)
  3.4119 -									(* (int * interpretation option Array.array) list *)
  3.4120 -									val INTRS = map (fn (idx, _) =>
  3.4121 -										let
  3.4122 -											val T         = typ_of_dtyp descr typ_assoc
  3.4123 -												(DatatypeAux.DtRec idx)
  3.4124 -											val (i, _, _) = interpret thy (typs, []) {maxvars=0,
  3.4125 -												def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4126 -												(Free ("dummy", T))
  3.4127 -											val size      = size_of_type i
  3.4128 -										in
  3.4129 -											(idx, Array.array (size, NONE))
  3.4130 -										end) descr
  3.4131 -									(* takes an interpretation, and if some leaf of this     *)
  3.4132 -									(* interpretation is the 'elem'-th element of the type,  *)
  3.4133 -									(* the indices of the arguments leading to this leaf are *)
  3.4134 -									(* returned                                              *)
  3.4135 -									(* interpretation -> int -> int list option *)
  3.4136 -									fun get_args (Leaf xs) elem =
  3.4137 -										if find_index_eq True xs = elem then
  3.4138 -											SOME []
  3.4139 -										else
  3.4140 -											NONE
  3.4141 -									  | get_args (Node xs) elem =
  3.4142 -										let
  3.4143 -											(* interpretation * int -> int list option *)
  3.4144 -											fun search ([], _) =
  3.4145 -												NONE
  3.4146 -											  | search (x::xs, n) =
  3.4147 -												(case get_args x elem of
  3.4148 -												  SOME result => SOME (n::result)
  3.4149 -												| NONE        => search (xs, n+1))
  3.4150 -										in
  3.4151 -											search (xs, 0)
  3.4152 -										end
  3.4153 -									(* returns the index of the constructor and indices for *)
  3.4154 -									(* its arguments that generate the 'elem'-th element of *)
  3.4155 -									(* the datatype given by 'idx'                          *)
  3.4156 -									(* int -> int -> int * int list *)
  3.4157 -									fun get_cargs idx elem =
  3.4158 -										let
  3.4159 -											(* int * interpretation list -> int * int list *)
  3.4160 -											fun get_cargs_rec (_, []) =
  3.4161 -												raise REFUTE ("IDT_recursion_interpreter",
  3.4162 -													"no matching constructor found for element "
  3.4163 -													^ string_of_int elem ^ " in datatype "
  3.4164 -													^ Sign.string_of_typ thy IDT ^ " (datatype index "
  3.4165 -													^ string_of_int idx ^ ")")
  3.4166 -											  | get_cargs_rec (n, x::xs) =
  3.4167 -												(case get_args x elem of
  3.4168 -												  SOME args => (n, args)
  3.4169 -												| NONE      => get_cargs_rec (n+1, xs))
  3.4170 -										in
  3.4171 -											get_cargs_rec (0, lookup mc_intrs idx)
  3.4172 -										end
  3.4173 -									(* returns the number of constructors in datatypes that *)
  3.4174 -									(* occur in the descriptor 'descr' before the datatype  *)
  3.4175 -									(* given by 'idx'                                       *)
  3.4176 -									fun get_coffset idx =
  3.4177 -										let
  3.4178 -											fun get_coffset_acc _ [] =
  3.4179 -												raise REFUTE ("IDT_recursion_interpreter", "index "
  3.4180 -													^ string_of_int idx ^ " not found in descriptor")
  3.4181 -											  | get_coffset_acc sum ((i, (_, _, cs))::descr') =
  3.4182 -												if i=idx then
  3.4183 -													sum
  3.4184 -												else
  3.4185 -													get_coffset_acc (sum + length cs) descr'
  3.4186 -										in
  3.4187 -											get_coffset_acc 0 descr
  3.4188 -										end
  3.4189 -									(* computes one entry in INTRS, and recursively all      *)
  3.4190 -									(* entries needed for it, where 'idx' gives the datatype *)
  3.4191 -									(* and 'elem' the element of it                          *)
  3.4192 -									(* int -> int -> interpretation *)
  3.4193 -									fun compute_array_entry idx elem =
  3.4194 -										case Array.sub (lookup INTRS idx, elem) of
  3.4195 -										  SOME result =>
  3.4196 -											(* simply return the previously computed result *)
  3.4197 -											result
  3.4198 -										| NONE =>
  3.4199 -											let
  3.4200 -												(* int * int list *)
  3.4201 -												val (c, args) = get_cargs idx elem
  3.4202 -												(* interpretation * int list -> interpretation *)
  3.4203 -												fun select_subtree (tr, []) =
  3.4204 -													tr  (* return the whole tree *)
  3.4205 -												  | select_subtree (Leaf _, _) =
  3.4206 -													raise REFUTE ("IDT_recursion_interpreter",
  3.4207 -														"interpretation for parameter is a leaf; "
  3.4208 -														^ "cannot select a subtree")
  3.4209 -												  | select_subtree (Node tr, x::xs) =
  3.4210 -													select_subtree (List.nth (tr, x), xs)
  3.4211 -												(* select the correct subtree of the parameter *)
  3.4212 -												(* corresponding to constructor 'c'            *)
  3.4213 -												val p_intr = select_subtree (List.nth
  3.4214 -													(p_intrs, get_coffset idx + c), args)
  3.4215 -												(* find the indices of the constructor's recursive *)
  3.4216 -												(* arguments                                       *)
  3.4217 -												val (_, _, constrs) = lookup descr idx
  3.4218 -												val constr_args     = (snd o List.nth) (constrs, c)
  3.4219 -												val rec_args        = List.filter
  3.4220 -													(DatatypeAux.is_rec_type o fst) (constr_args ~~ args)
  3.4221 -												val rec_args'       = map (fn (dtyp, elem) =>
  3.4222 -													(DatatypeAux.dest_DtRec dtyp, elem)) rec_args
  3.4223 -												(* apply 'p_intr' to recursively computed results *)
  3.4224 -												val result = foldl (fn ((idx, elem), intr) =>
  3.4225 -													interpretation_apply (intr,
  3.4226 -													compute_array_entry idx elem)) p_intr rec_args'
  3.4227 -												(* update 'INTRS' *)
  3.4228 -												val _ = Array.update (lookup INTRS idx, elem,
  3.4229 -													SOME result)
  3.4230 -											in
  3.4231 -												result
  3.4232 -											end
  3.4233 -									(* compute all entries in INTRS for the current datatype *)
  3.4234 -									(* (given by 'index')                                    *)
  3.4235 -									(* TODO: we can use Array.modifyi instead once PolyML's *)
  3.4236 -									(*       Array signature conforms to the ML standard    *)
  3.4237 -									(* (int * 'a -> 'a) -> 'a array -> unit *)
  3.4238 -									fun modifyi f arr =
  3.4239 -										let
  3.4240 -											val size = Array.length arr
  3.4241 -											fun modifyi_loop i =
  3.4242 -												if i < size then (
  3.4243 -													Array.update (arr, i, f (i, Array.sub (arr, i)));
  3.4244 -													modifyi_loop (i+1)
  3.4245 -												) else
  3.4246 -													()
  3.4247 -										in
  3.4248 -											modifyi_loop 0
  3.4249 -										end
  3.4250 -									val _ = modifyi (fn (i, _) =>
  3.4251 -										SOME (compute_array_entry index i)) (lookup INTRS index)
  3.4252 -									(* 'a Array.array -> 'a list *)
  3.4253 -									fun toList arr =
  3.4254 -										Array.foldr op:: [] arr
  3.4255 -								in
  3.4256 -									(* return the part of 'INTRS' that corresponds to the *)
  3.4257 -									(* current datatype                                   *)
  3.4258 -									SOME ((Node o map Option.valOf o toList o lookup INTRS)
  3.4259 -										index, model', args')
  3.4260 -								end
  3.4261 -						end
  3.4262 -					else
  3.4263 -						NONE  (* not a recursion operator of this datatype *)
  3.4264 -				) (DatatypePackage.get_datatypes thy) NONE
  3.4265 -		| _ =>  (* head of term is not a constant *)
  3.4266 -			NONE;
  3.4267 +  fun IDT_recursion_interpreter thy model args t =
  3.4268 +    (* careful: here we descend arbitrarily deep into 't', possibly before *)
  3.4269 +    (* any other interpreter for atomic terms has had a chance to look at  *)
  3.4270 +    (* 't'                                                                 *)
  3.4271 +    case strip_comb t of
  3.4272 +      (Const (s, T), params) =>
  3.4273 +      (* iterate over all datatypes in 'thy' *)
  3.4274 +      Symtab.fold (fn (_, info) => fn result =>
  3.4275 +        case result of
  3.4276 +          SOME _ =>
  3.4277 +          result  (* just keep 'result' *)
  3.4278 +        | NONE =>
  3.4279 +          if member (op =) (#rec_names info) s then
  3.4280 +            (* we do have a recursion operator of the datatype given by *)
  3.4281 +            (* 'info', or of a mutually recursive datatype              *)
  3.4282 +            let
  3.4283 +              val index              = #index info
  3.4284 +              val descr              = #descr info
  3.4285 +              val (dtname, dtyps, _) = lookup descr index
  3.4286 +              (* number of all constructors, including those of different  *)
  3.4287 +              (* (mutually recursive) datatypes within the same descriptor *)
  3.4288 +              (* 'descr'                                                   *)
  3.4289 +              val mconstrs_count = sum (map (fn (_, (_, _, cs)) => length cs)
  3.4290 +                descr)
  3.4291 +              val params_count   = length params
  3.4292 +              (* the type of a recursion operator: *)
  3.4293 +              (* [T1, ..., Tn, IDT] ---> Tresult   *)
  3.4294 +              val IDT = List.nth (binder_types T, mconstrs_count)
  3.4295 +            in
  3.4296 +              if (fst o dest_Type) IDT <> dtname then
  3.4297 +                (* recursion operator of a mutually recursive datatype *)
  3.4298 +                NONE
  3.4299 +              else if mconstrs_count < params_count then
  3.4300 +                (* too many actual parameters; for now we'll use the *)
  3.4301 +                (* 'stlc_interpreter' to strip off one application   *)
  3.4302 +                NONE
  3.4303 +              else if mconstrs_count > params_count then
  3.4304 +                (* too few actual parameters; we use eta expansion          *)
  3.4305 +                (* Note that the resulting expansion of lambda abstractions *)
  3.4306 +                (* by the 'stlc_interpreter' may be rather slow (depending  *)
  3.4307 +                (* on the argument types and the size of the IDT, of        *)
  3.4308 +                (* course).                                                 *)
  3.4309 +                SOME (interpret thy model args (eta_expand t
  3.4310 +                  (mconstrs_count - params_count)))
  3.4311 +              else  (* mconstrs_count = params_count *)
  3.4312 +                let
  3.4313 +                  (* interpret each parameter separately *)
  3.4314 +                  val ((model', args'), p_intrs) = foldl_map (fn ((m, a), p) =>
  3.4315 +                    let
  3.4316 +                      val (i, m', a') = interpret thy m a p
  3.4317 +                    in
  3.4318 +                      ((m', a'), i)
  3.4319 +                    end) ((model, args), params)
  3.4320 +                  val (typs, _) = model'
  3.4321 +                  val typ_assoc = dtyps ~~ (snd o dest_Type) IDT
  3.4322 +                  (* interpret each constructor in the descriptor (including *)
  3.4323 +                  (* those of mutually recursive datatypes)                  *)
  3.4324 +                  (* (int * interpretation list) list *)
  3.4325 +                  val mc_intrs = map (fn (idx, (_, _, cs)) =>
  3.4326 +                    let
  3.4327 +                      val c_return_typ = typ_of_dtyp descr typ_assoc
  3.4328 +                        (DatatypeAux.DtRec idx)
  3.4329 +                    in
  3.4330 +                      (idx, map (fn (cname, cargs) =>
  3.4331 +                        (#1 o interpret thy (typs, []) {maxvars=0,
  3.4332 +                          def_eq=false, next_idx=1, bounds=[],
  3.4333 +                          wellformed=True}) (Const (cname, map (typ_of_dtyp
  3.4334 +                          descr typ_assoc) cargs ---> c_return_typ))) cs)
  3.4335 +                    end) descr
  3.4336 +                  (* the recursion operator is a function that maps every   *)
  3.4337 +                  (* element of the inductive datatype (and of mutually     *)
  3.4338 +                  (* recursive types) to an element of some result type; an *)
  3.4339 +                  (* array entry of NONE means that the actual result has   *)
  3.4340 +                  (* not been computed yet                                  *)
  3.4341 +                  (* (int * interpretation option Array.array) list *)
  3.4342 +                  val INTRS = map (fn (idx, _) =>
  3.4343 +                    let
  3.4344 +                      val T         = typ_of_dtyp descr typ_assoc
  3.4345 +                        (DatatypeAux.DtRec idx)
  3.4346 +                      val (i, _, _) = interpret thy (typs, []) {maxvars=0,
  3.4347 +                        def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4348 +                        (Free ("dummy", T))
  3.4349 +                      val size      = size_of_type i
  3.4350 +                    in
  3.4351 +                      (idx, Array.array (size, NONE))
  3.4352 +                    end) descr
  3.4353 +                  (* takes an interpretation, and if some leaf of this     *)
  3.4354 +                  (* interpretation is the 'elem'-th element of the type,  *)
  3.4355 +                  (* the indices of the arguments leading to this leaf are *)
  3.4356 +                  (* returned                                              *)
  3.4357 +                  (* interpretation -> int -> int list option *)
  3.4358 +                  fun get_args (Leaf xs) elem =
  3.4359 +                    if find_index_eq True xs = elem then
  3.4360 +                      SOME []
  3.4361 +                    else
  3.4362 +                      NONE
  3.4363 +                    | get_args (Node xs) elem =
  3.4364 +                    let
  3.4365 +                      (* interpretation * int -> int list option *)
  3.4366 +                      fun search ([], _) =
  3.4367 +                        NONE
  3.4368 +                        | search (x::xs, n) =
  3.4369 +                        (case get_args x elem of
  3.4370 +                          SOME result => SOME (n::result)
  3.4371 +                        | NONE        => search (xs, n+1))
  3.4372 +                    in
  3.4373 +                      search (xs, 0)
  3.4374 +                    end
  3.4375 +                  (* returns the index of the constructor and indices for *)
  3.4376 +                  (* its arguments that generate the 'elem'-th element of *)
  3.4377 +                  (* the datatype given by 'idx'                          *)
  3.4378 +                  (* int -> int -> int * int list *)
  3.4379 +                  fun get_cargs idx elem =
  3.4380 +                    let
  3.4381 +                      (* int * interpretation list -> int * int list *)
  3.4382 +                      fun get_cargs_rec (_, []) =
  3.4383 +                        raise REFUTE ("IDT_recursion_interpreter",
  3.4384 +                          "no matching constructor found for element "
  3.4385 +                          ^ string_of_int elem ^ " in datatype "
  3.4386 +                          ^ Sign.string_of_typ thy IDT ^ " (datatype index "
  3.4387 +                          ^ string_of_int idx ^ ")")
  3.4388 +                        | get_cargs_rec (n, x::xs) =
  3.4389 +                        (case get_args x elem of
  3.4390 +                          SOME args => (n, args)
  3.4391 +                        | NONE      => get_cargs_rec (n+1, xs))
  3.4392 +                    in
  3.4393 +                      get_cargs_rec (0, lookup mc_intrs idx)
  3.4394 +                    end
  3.4395 +                  (* returns the number of constructors in datatypes that *)
  3.4396 +                  (* occur in the descriptor 'descr' before the datatype  *)
  3.4397 +                  (* given by 'idx'                                       *)
  3.4398 +                  fun get_coffset idx =
  3.4399 +                    let
  3.4400 +                      fun get_coffset_acc _ [] =
  3.4401 +                        raise REFUTE ("IDT_recursion_interpreter", "index "
  3.4402 +                          ^ string_of_int idx ^ " not found in descriptor")
  3.4403 +                        | get_coffset_acc sum ((i, (_, _, cs))::descr') =
  3.4404 +                        if i=idx then
  3.4405 +                          sum
  3.4406 +                        else
  3.4407 +                          get_coffset_acc (sum + length cs) descr'
  3.4408 +                    in
  3.4409 +                      get_coffset_acc 0 descr
  3.4410 +                    end
  3.4411 +                  (* computes one entry in INTRS, and recursively all      *)
  3.4412 +                  (* entries needed for it, where 'idx' gives the datatype *)
  3.4413 +                  (* and 'elem' the element of it                          *)
  3.4414 +                  (* int -> int -> interpretation *)
  3.4415 +                  fun compute_array_entry idx elem =
  3.4416 +                    case Array.sub (lookup INTRS idx, elem) of
  3.4417 +                      SOME result =>
  3.4418 +                      (* simply return the previously computed result *)
  3.4419 +                      result
  3.4420 +                    | NONE =>
  3.4421 +                      let
  3.4422 +                        (* int * int list *)
  3.4423 +                        val (c, args) = get_cargs idx elem
  3.4424 +                        (* interpretation * int list -> interpretation *)
  3.4425 +                        fun select_subtree (tr, []) =
  3.4426 +                          tr  (* return the whole tree *)
  3.4427 +                          | select_subtree (Leaf _, _) =
  3.4428 +                          raise REFUTE ("IDT_recursion_interpreter",
  3.4429 +                            "interpretation for parameter is a leaf; "
  3.4430 +                            ^ "cannot select a subtree")
  3.4431 +                          | select_subtree (Node tr, x::xs) =
  3.4432 +                          select_subtree (List.nth (tr, x), xs)
  3.4433 +                        (* select the correct subtree of the parameter *)
  3.4434 +                        (* corresponding to constructor 'c'            *)
  3.4435 +                        val p_intr = select_subtree (List.nth
  3.4436 +                          (p_intrs, get_coffset idx + c), args)
  3.4437 +                        (* find the indices of the constructor's recursive *)
  3.4438 +                        (* arguments                                       *)
  3.4439 +                        val (_, _, constrs) = lookup descr idx
  3.4440 +                        val constr_args     = (snd o List.nth) (constrs, c)
  3.4441 +                        val rec_args        = List.filter
  3.4442 +                          (DatatypeAux.is_rec_type o fst) (constr_args ~~ args)
  3.4443 +                        val rec_args'       = map (fn (dtyp, elem) =>
  3.4444 +                          (DatatypeAux.dest_DtRec dtyp, elem)) rec_args
  3.4445 +                        (* apply 'p_intr' to recursively computed results *)
  3.4446 +                        val result = foldl (fn ((idx, elem), intr) =>
  3.4447 +                          interpretation_apply (intr,
  3.4448 +                          compute_array_entry idx elem)) p_intr rec_args'
  3.4449 +                        (* update 'INTRS' *)
  3.4450 +                        val _ = Array.update (lookup INTRS idx, elem,
  3.4451 +                          SOME result)
  3.4452 +                      in
  3.4453 +                        result
  3.4454 +                      end
  3.4455 +                  (* compute all entries in INTRS for the current datatype *)
  3.4456 +                  (* (given by 'index')                                    *)
  3.4457 +                  (* TODO: we can use Array.modifyi instead once PolyML's *)
  3.4458 +                  (*       Array signature conforms to the ML standard    *)
  3.4459 +                  (* (int * 'a -> 'a) -> 'a array -> unit *)
  3.4460 +                  fun modifyi f arr =
  3.4461 +                    let
  3.4462 +                      val size = Array.length arr
  3.4463 +                      fun modifyi_loop i =
  3.4464 +                        if i < size then (
  3.4465 +                          Array.update (arr, i, f (i, Array.sub (arr, i)));
  3.4466 +                          modifyi_loop (i+1)
  3.4467 +                        ) else
  3.4468 +                          ()
  3.4469 +                    in
  3.4470 +                      modifyi_loop 0
  3.4471 +                    end
  3.4472 +                  val _ = modifyi (fn (i, _) =>
  3.4473 +                    SOME (compute_array_entry index i)) (lookup INTRS index)
  3.4474 +                  (* 'a Array.array -> 'a list *)
  3.4475 +                  fun toList arr =
  3.4476 +                    Array.foldr op:: [] arr
  3.4477 +                in
  3.4478 +                  (* return the part of 'INTRS' that corresponds to the *)
  3.4479 +                  (* current datatype                                   *)
  3.4480 +                  SOME ((Node o map Option.valOf o toList o lookup INTRS)
  3.4481 +                    index, model', args')
  3.4482 +                end
  3.4483 +            end
  3.4484 +          else
  3.4485 +            NONE  (* not a recursion operator of this datatype *)
  3.4486 +        ) (DatatypePackage.get_datatypes thy) NONE
  3.4487 +    | _ =>  (* head of term is not a constant *)
  3.4488 +      NONE;
  3.4489  
  3.4490 -	(* theory -> model -> arguments -> Term.term ->
  3.4491 -		(interpretation * model * arguments) option *)
  3.4492 +  (* theory -> model -> arguments -> Term.term ->
  3.4493 +    (interpretation * model * arguments) option *)
  3.4494  
  3.4495 -	(* only an optimization: 'card' could in principle be interpreted with *)
  3.4496 -	(* interpreters available already (using its definition), but the code *)
  3.4497 -	(* below is more efficient                                             *)
  3.4498 +  (* only an optimization: 'card' could in principle be interpreted with *)
  3.4499 +  (* interpreters available already (using its definition), but the code *)
  3.4500 +  (* below is more efficient                                             *)
  3.4501  
  3.4502 -	fun Finite_Set_card_interpreter thy model args t =
  3.4503 -		case t of
  3.4504 -		  Const ("Finite_Set.card",
  3.4505 -				Type ("fun", [Type ("set", [T]), Type ("nat", [])])) =>
  3.4506 -			let
  3.4507 -				val (i_nat, _, _) = interpret thy model
  3.4508 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4509 -					(Free ("dummy", Type ("nat", [])))
  3.4510 -				val size_nat      = size_of_type i_nat
  3.4511 -				val (i_set, _, _) = interpret thy model
  3.4512 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4513 -					(Free ("dummy", Type ("set", [T])))
  3.4514 -				val constants     = make_constants i_set
  3.4515 -				(* interpretation -> int *)
  3.4516 -				fun number_of_elements (Node xs) =
  3.4517 -					Library.foldl (fn (n, x) =>
  3.4518 -						if x=TT then
  3.4519 -							n+1
  3.4520 -						else if x=FF then
  3.4521 -							n
  3.4522 -						else
  3.4523 -							raise REFUTE ("Finite_Set_card_interpreter",
  3.4524 -								"interpretation for set type does not yield a Boolean"))
  3.4525 -						(0, xs)
  3.4526 -				  | number_of_elements (Leaf _) =
  3.4527 -					raise REFUTE ("Finite_Set_card_interpreter",
  3.4528 -						"interpretation for set type is a leaf")
  3.4529 -				(* takes an interpretation for a set and returns an interpretation *)
  3.4530 -				(* for a 'nat'                                                     *)
  3.4531 -				(* interpretation -> interpretation *)
  3.4532 -				fun card i =
  3.4533 -					let
  3.4534 -						val n = number_of_elements i
  3.4535 -					in
  3.4536 -						if n<size_nat then
  3.4537 -							Leaf ((replicate n False) @ True ::
  3.4538 -								(replicate (size_nat-n-1) False))
  3.4539 -						else
  3.4540 -							Leaf (replicate size_nat False)
  3.4541 -					end
  3.4542 -			in
  3.4543 -				SOME (Node (map card constants), model, args)
  3.4544 -			end
  3.4545 -		| _ =>
  3.4546 -			NONE;
  3.4547 +  fun Finite_Set_card_interpreter thy model args t =
  3.4548 +    case t of
  3.4549 +      Const ("Finite_Set.card",
  3.4550 +        Type ("fun", [Type ("set", [T]), Type ("nat", [])])) =>
  3.4551 +      let
  3.4552 +        val (i_nat, _, _) = interpret thy model
  3.4553 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4554 +          (Free ("dummy", Type ("nat", [])))
  3.4555 +        val size_nat      = size_of_type i_nat
  3.4556 +        val (i_set, _, _) = interpret thy model
  3.4557 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4558 +          (Free ("dummy", Type ("set", [T])))
  3.4559 +        val constants     = make_constants i_set
  3.4560 +        (* interpretation -> int *)
  3.4561 +        fun number_of_elements (Node xs) =
  3.4562 +          Library.foldl (fn (n, x) =>
  3.4563 +            if x=TT then
  3.4564 +              n+1
  3.4565 +            else if x=FF then
  3.4566 +              n
  3.4567 +            else
  3.4568 +              raise REFUTE ("Finite_Set_card_interpreter",
  3.4569 +                "interpretation for set type does not yield a Boolean"))
  3.4570 +            (0, xs)
  3.4571 +          | number_of_elements (Leaf _) =
  3.4572 +          raise REFUTE ("Finite_Set_card_interpreter",
  3.4573 +            "interpretation for set type is a leaf")
  3.4574 +        (* takes an interpretation for a set and returns an interpretation *)
  3.4575 +        (* for a 'nat'                                                     *)
  3.4576 +        (* interpretation -> interpretation *)
  3.4577 +        fun card i =
  3.4578 +          let
  3.4579 +            val n = number_of_elements i
  3.4580 +          in
  3.4581 +            if n<size_nat then
  3.4582 +              Leaf ((replicate n False) @ True ::
  3.4583 +                (replicate (size_nat-n-1) False))
  3.4584 +            else
  3.4585 +              Leaf (replicate size_nat False)
  3.4586 +          end
  3.4587 +      in
  3.4588 +        SOME (Node (map card constants), model, args)
  3.4589 +      end
  3.4590 +    | _ =>
  3.4591 +      NONE;
  3.4592  
  3.4593 -	(* theory -> model -> arguments -> Term.term ->
  3.4594 -		(interpretation * model * arguments) option *)
  3.4595 +  (* theory -> model -> arguments -> Term.term ->
  3.4596 +    (interpretation * model * arguments) option *)
  3.4597  
  3.4598 -	(* only an optimization: 'Finites' could in principle be interpreted with *)
  3.4599 -	(* interpreters available already (using its definition), but the code    *)
  3.4600 -	(* below is more efficient                                                *)
  3.4601 +  (* only an optimization: 'Finites' could in principle be interpreted with *)
  3.4602 +  (* interpreters available already (using its definition), but the code    *)
  3.4603 +  (* below is more efficient                                                *)
  3.4604  
  3.4605 -	fun Finite_Set_Finites_interpreter thy model args t =
  3.4606 -		case t of
  3.4607 -		  Const ("Finite_Set.Finites", Type ("set", [Type ("set", [T])])) =>
  3.4608 -			let
  3.4609 -				val (i_set, _, _) = interpret thy model
  3.4610 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4611 -					(Free ("dummy", Type ("set", [T])))
  3.4612 -				val size_set      = size_of_type i_set
  3.4613 -			in
  3.4614 -				(* we only consider finite models anyway, hence EVERY set is in *)
  3.4615 -				(* "Finites"                                                    *)
  3.4616 -				SOME (Node (replicate size_set TT), model, args)
  3.4617 -			end
  3.4618 -		| _ =>
  3.4619 -			NONE;
  3.4620 +  fun Finite_Set_Finites_interpreter thy model args t =
  3.4621 +    case t of
  3.4622 +      Const ("Finite_Set.Finites", Type ("set", [Type ("set", [T])])) =>
  3.4623 +      let
  3.4624 +        val (i_set, _, _) = interpret thy model
  3.4625 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4626 +          (Free ("dummy", Type ("set", [T])))
  3.4627 +        val size_set      = size_of_type i_set
  3.4628 +      in
  3.4629 +        (* we only consider finite models anyway, hence EVERY set is in *)
  3.4630 +        (* "Finites"                                                    *)
  3.4631 +        SOME (Node (replicate size_set TT), model, args)
  3.4632 +      end
  3.4633 +    | _ =>
  3.4634 +      NONE;
  3.4635  
  3.4636 -	(* theory -> model -> arguments -> Term.term ->
  3.4637 -		(interpretation * model * arguments) option *)
  3.4638 +  (* theory -> model -> arguments -> Term.term ->
  3.4639 +    (interpretation * model * arguments) option *)
  3.4640  
  3.4641 -	(* only an optimization: 'finite' could in principle be interpreted with  *)
  3.4642 -	(* interpreters available already (using its definition), but the code    *)
  3.4643 -	(* below is more efficient                                                *)
  3.4644 +  (* only an optimization: 'finite' could in principle be interpreted with  *)
  3.4645 +  (* interpreters available already (using its definition), but the code    *)
  3.4646 +  (* below is more efficient                                                *)
  3.4647  
  3.4648 -	fun Finite_Set_finite_interpreter thy model args t =
  3.4649 -		case t of
  3.4650 -		  Const ("Finite_Set.finite",
  3.4651 -				Type ("fun", [Type ("set", [T]), Type ("bool", [])])) $ _ =>
  3.4652 -				(* we only consider finite models anyway, hence EVERY set is *)
  3.4653 -				(* "finite"                                                  *)
  3.4654 -				SOME (TT, model, args)
  3.4655 -		| Const ("Finite_Set.finite",
  3.4656 -				Type ("fun", [Type ("set", [T]), Type ("bool", [])])) =>
  3.4657 -			let
  3.4658 -				val (i_set, _, _) = interpret thy model
  3.4659 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4660 -					(Free ("dummy", Type ("set", [T])))
  3.4661 -				val size_set      = size_of_type i_set
  3.4662 -			in
  3.4663 -				(* we only consider finite models anyway, hence EVERY set is *)
  3.4664 -				(* "finite"                                                  *)
  3.4665 -				SOME (Node (replicate size_set TT), model, args)
  3.4666 -			end
  3.4667 -		| _ =>
  3.4668 -			NONE;
  3.4669 +  fun Finite_Set_finite_interpreter thy model args t =
  3.4670 +    case t of
  3.4671 +      Const ("Finite_Set.finite",
  3.4672 +        Type ("fun", [Type ("set", [T]), Type ("bool", [])])) $ _ =>
  3.4673 +        (* we only consider finite models anyway, hence EVERY set is *)
  3.4674 +        (* "finite"                                                  *)
  3.4675 +        SOME (TT, model, args)
  3.4676 +    | Const ("Finite_Set.finite",
  3.4677 +        Type ("fun", [Type ("set", [T]), Type ("bool", [])])) =>
  3.4678 +      let
  3.4679 +        val (i_set, _, _) = interpret thy model
  3.4680 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4681 +          (Free ("dummy", Type ("set", [T])))
  3.4682 +        val size_set      = size_of_type i_set
  3.4683 +      in
  3.4684 +        (* we only consider finite models anyway, hence EVERY set is *)
  3.4685 +        (* "finite"                                                  *)
  3.4686 +        SOME (Node (replicate size_set TT), model, args)
  3.4687 +      end
  3.4688 +    | _ =>
  3.4689 +      NONE;
  3.4690  
  3.4691 -	(* theory -> model -> arguments -> Term.term ->
  3.4692 -		(interpretation * model * arguments) option *)
  3.4693 +  (* theory -> model -> arguments -> Term.term ->
  3.4694 +    (interpretation * model * arguments) option *)
  3.4695  
  3.4696 -	(* only an optimization: 'Orderings.less' could in principle be            *)
  3.4697 -	(* interpreted with interpreters available already (using its definition), *)
  3.4698 -	(* but the code below is more efficient                                    *)
  3.4699 +  (* only an optimization: 'Orderings.less' could in principle be            *)
  3.4700 +  (* interpreted with interpreters available already (using its definition), *)
  3.4701 +  (* but the code below is more efficient                                    *)
  3.4702  
  3.4703 -	fun Nat_less_interpreter thy model args t =
  3.4704 -		case t of
  3.4705 -		  Const ("Orderings.less", Type ("fun", [Type ("nat", []),
  3.4706 -				Type ("fun", [Type ("nat", []), Type ("bool", [])])])) =>
  3.4707 -			let
  3.4708 -				val (i_nat, _, _) = interpret thy model
  3.4709 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4710 -					(Free ("dummy", Type ("nat", [])))
  3.4711 -				val size_nat      = size_of_type i_nat
  3.4712 -				(* int -> interpretation *)
  3.4713 -				(* the 'n'-th nat is not less than the first 'n' nats, while it *)
  3.4714 -				(* is less than the remaining 'size_nat - n' nats               *)
  3.4715 -				fun less n = Node ((replicate n FF) @ (replicate (size_nat - n) TT))
  3.4716 -			in
  3.4717 -				SOME (Node (map less (1 upto size_nat)), model, args)
  3.4718 -			end
  3.4719 -		| _ =>
  3.4720 -			NONE;
  3.4721 +  fun Nat_less_interpreter thy model args t =
  3.4722 +    case t of
  3.4723 +      Const ("Orderings.less", Type ("fun", [Type ("nat", []),
  3.4724 +        Type ("fun", [Type ("nat", []), Type ("bool", [])])])) =>
  3.4725 +      let
  3.4726 +        val (i_nat, _, _) = interpret thy model
  3.4727 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4728 +          (Free ("dummy", Type ("nat", [])))
  3.4729 +        val size_nat      = size_of_type i_nat
  3.4730 +        (* int -> interpretation *)
  3.4731 +        (* the 'n'-th nat is not less than the first 'n' nats, while it *)
  3.4732 +        (* is less than the remaining 'size_nat - n' nats               *)
  3.4733 +        fun less n = Node ((replicate n FF) @ (replicate (size_nat - n) TT))
  3.4734 +      in
  3.4735 +        SOME (Node (map less (1 upto size_nat)), model, args)
  3.4736 +      end
  3.4737 +    | _ =>
  3.4738 +      NONE;
  3.4739  
  3.4740 -	(* theory -> model -> arguments -> Term.term ->
  3.4741 -		(interpretation * model * arguments) option *)
  3.4742 +  (* theory -> model -> arguments -> Term.term ->
  3.4743 +    (interpretation * model * arguments) option *)
  3.4744  
  3.4745 -	(* only an optimization: 'HOL.plus' could in principle be interpreted with *)
  3.4746 -	(* interpreters available already (using its definition), but the code     *)
  3.4747 -	(* below is more efficient                                                 *)
  3.4748 +  (* only an optimization: 'HOL.plus' could in principle be interpreted with *)
  3.4749 +  (* interpreters available already (using its definition), but the code     *)
  3.4750 +  (* below is more efficient                                                 *)
  3.4751  
  3.4752 -	fun Nat_plus_interpreter thy model args t =
  3.4753 -		case t of
  3.4754 -		  Const ("HOL.plus", Type ("fun", [Type ("nat", []),
  3.4755 -				Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.4756 -			let
  3.4757 -				val (i_nat, _, _) = interpret thy model
  3.4758 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4759 -					(Free ("dummy", Type ("nat", [])))
  3.4760 -				val size_nat      = size_of_type i_nat
  3.4761 -				(* int -> int -> interpretation *)
  3.4762 -				fun plus m n =
  3.4763 -					let
  3.4764 -						val element = (m+n)+1
  3.4765 -					in
  3.4766 -						if element > size_nat then
  3.4767 -							Leaf (replicate size_nat False)
  3.4768 -						else
  3.4769 -							Leaf ((replicate (element-1) False) @ True ::
  3.4770 -								(replicate (size_nat - element) False))
  3.4771 -					end
  3.4772 -			in
  3.4773 -				SOME (Node (map (fn m => Node (map (plus m) (0 upto size_nat-1)))
  3.4774 -					(0 upto size_nat-1)), model, args)
  3.4775 -			end
  3.4776 -		| _ =>
  3.4777 -			NONE;
  3.4778 +  fun Nat_plus_interpreter thy model args t =
  3.4779 +    case t of
  3.4780 +      Const ("HOL.plus", Type ("fun", [Type ("nat", []),
  3.4781 +        Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.4782 +      let
  3.4783 +        val (i_nat, _, _) = interpret thy model
  3.4784 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4785 +          (Free ("dummy", Type ("nat", [])))
  3.4786 +        val size_nat      = size_of_type i_nat
  3.4787 +        (* int -> int -> interpretation *)
  3.4788 +        fun plus m n =
  3.4789 +          let
  3.4790 +            val element = (m+n)+1
  3.4791 +          in
  3.4792 +            if element > size_nat then
  3.4793 +              Leaf (replicate size_nat False)
  3.4794 +            else
  3.4795 +              Leaf ((replicate (element-1) False) @ True ::
  3.4796 +                (replicate (size_nat - element) False))
  3.4797 +          end
  3.4798 +      in
  3.4799 +        SOME (Node (map (fn m => Node (map (plus m) (0 upto size_nat-1)))
  3.4800 +          (0 upto size_nat-1)), model, args)
  3.4801 +      end
  3.4802 +    | _ =>
  3.4803 +      NONE;
  3.4804  
  3.4805 -	(* theory -> model -> arguments -> Term.term ->
  3.4806 -		(interpretation * model * arguments) option *)
  3.4807 +  (* theory -> model -> arguments -> Term.term ->
  3.4808 +    (interpretation * model * arguments) option *)
  3.4809  
  3.4810 -	(* only an optimization: 'HOL.minus' could in principle be interpreted *)
  3.4811 -	(* with interpreters available already (using its definition), but the *)
  3.4812 -	(* code below is more efficient                                        *)
  3.4813 +  (* only an optimization: 'HOL.minus' could in principle be interpreted *)
  3.4814 +  (* with interpreters available already (using its definition), but the *)
  3.4815 +  (* code below is more efficient                                        *)
  3.4816  
  3.4817 -	fun Nat_minus_interpreter thy model args t =
  3.4818 -		case t of
  3.4819 -		  Const ("HOL.minus", Type ("fun", [Type ("nat", []),
  3.4820 -				Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.4821 -			let
  3.4822 -				val (i_nat, _, _) = interpret thy model
  3.4823 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4824 -					(Free ("dummy", Type ("nat", [])))
  3.4825 -				val size_nat      = size_of_type i_nat
  3.4826 -				(* int -> int -> interpretation *)
  3.4827 -				fun minus m n =
  3.4828 -					let
  3.4829 -						val element = Int.max (m-n, 0) + 1
  3.4830 -					in
  3.4831 -						Leaf ((replicate (element-1) False) @ True ::
  3.4832 -							(replicate (size_nat - element) False))
  3.4833 -					end
  3.4834 -			in
  3.4835 -				SOME (Node (map (fn m => Node (map (minus m) (0 upto size_nat-1)))
  3.4836 -					(0 upto size_nat-1)), model, args)
  3.4837 -			end
  3.4838 -		| _ =>
  3.4839 -			NONE;
  3.4840 +  fun Nat_minus_interpreter thy model args t =
  3.4841 +    case t of
  3.4842 +      Const ("HOL.minus", Type ("fun", [Type ("nat", []),
  3.4843 +        Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.4844 +      let
  3.4845 +        val (i_nat, _, _) = interpret thy model
  3.4846 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4847 +          (Free ("dummy", Type ("nat", [])))
  3.4848 +        val size_nat      = size_of_type i_nat
  3.4849 +        (* int -> int -> interpretation *)
  3.4850 +        fun minus m n =
  3.4851 +          let
  3.4852 +            val element = Int.max (m-n, 0) + 1
  3.4853 +          in
  3.4854 +            Leaf ((replicate (element-1) False) @ True ::
  3.4855 +              (replicate (size_nat - element) False))
  3.4856 +          end
  3.4857 +      in
  3.4858 +        SOME (Node (map (fn m => Node (map (minus m) (0 upto size_nat-1)))
  3.4859 +          (0 upto size_nat-1)), model, args)
  3.4860 +      end
  3.4861 +    | _ =>
  3.4862 +      NONE;
  3.4863  
  3.4864 -	(* theory -> model -> arguments -> Term.term ->
  3.4865 -		(interpretation * model * arguments) option *)
  3.4866 +  (* theory -> model -> arguments -> Term.term ->
  3.4867 +    (interpretation * model * arguments) option *)
  3.4868  
  3.4869 -	(* only an optimization: 'HOL.times' could in principle be interpreted with *)
  3.4870 -	(* interpreters available already (using its definition), but the code      *)
  3.4871 -	(* below is more efficient                                                  *)
  3.4872 +  (* only an optimization: 'HOL.times' could in principle be interpreted with *)
  3.4873 +  (* interpreters available already (using its definition), but the code      *)
  3.4874 +  (* below is more efficient                                                  *)
  3.4875  
  3.4876 -	fun Nat_times_interpreter thy model args t =
  3.4877 -		case t of
  3.4878 -		  Const ("HOL.times", Type ("fun", [Type ("nat", []),
  3.4879 -				Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.4880 -			let
  3.4881 -				val (i_nat, _, _) = interpret thy model
  3.4882 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4883 -					(Free ("dummy", Type ("nat", [])))
  3.4884 -				val size_nat      = size_of_type i_nat
  3.4885 -				(* nat -> nat -> interpretation *)
  3.4886 -				fun mult m n =
  3.4887 -					let
  3.4888 -						val element = (m*n)+1
  3.4889 -					in
  3.4890 -						if element > size_nat then
  3.4891 -							Leaf (replicate size_nat False)
  3.4892 -						else
  3.4893 -							Leaf ((replicate (element-1) False) @ True ::
  3.4894 -								(replicate (size_nat - element) False))
  3.4895 -					end
  3.4896 -			in
  3.4897 -				SOME (Node (map (fn m => Node (map (mult m) (0 upto size_nat-1)))
  3.4898 -					(0 upto size_nat-1)), model, args)
  3.4899 -			end
  3.4900 -		| _ =>
  3.4901 -			NONE;
  3.4902 +  fun Nat_times_interpreter thy model args t =
  3.4903 +    case t of
  3.4904 +      Const ("HOL.times", Type ("fun", [Type ("nat", []),
  3.4905 +        Type ("fun", [Type ("nat", []), Type ("nat", [])])])) =>
  3.4906 +      let
  3.4907 +        val (i_nat, _, _) = interpret thy model
  3.4908 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4909 +          (Free ("dummy", Type ("nat", [])))
  3.4910 +        val size_nat      = size_of_type i_nat
  3.4911 +        (* nat -> nat -> interpretation *)
  3.4912 +        fun mult m n =
  3.4913 +          let
  3.4914 +            val element = (m*n)+1
  3.4915 +          in
  3.4916 +            if element > size_nat then
  3.4917 +              Leaf (replicate size_nat False)
  3.4918 +            else
  3.4919 +              Leaf ((replicate (element-1) False) @ True ::
  3.4920 +                (replicate (size_nat - element) False))
  3.4921 +          end
  3.4922 +      in
  3.4923 +        SOME (Node (map (fn m => Node (map (mult m) (0 upto size_nat-1)))
  3.4924 +          (0 upto size_nat-1)), model, args)
  3.4925 +      end
  3.4926 +    | _ =>
  3.4927 +      NONE;
  3.4928  
  3.4929 -	(* theory -> model -> arguments -> Term.term ->
  3.4930 -		(interpretation * model * arguments) option *)
  3.4931 +  (* theory -> model -> arguments -> Term.term ->
  3.4932 +    (interpretation * model * arguments) option *)
  3.4933  
  3.4934 -	(* only an optimization: 'op @' could in principle be interpreted with *)
  3.4935 -	(* interpreters available already (using its definition), but the code *)
  3.4936 -	(* below is more efficient                                             *)
  3.4937 +  (* only an optimization: 'op @' could in principle be interpreted with *)
  3.4938 +  (* interpreters available already (using its definition), but the code *)
  3.4939 +  (* below is more efficient                                             *)
  3.4940  
  3.4941 -	fun List_append_interpreter thy model args t =
  3.4942 -		case t of
  3.4943 -		  Const ("List.op @", Type ("fun", [Type ("List.list", [T]), Type ("fun",
  3.4944 -				[Type ("List.list", [_]), Type ("List.list", [_])])])) =>
  3.4945 -			let
  3.4946 -				val (i_elem, _, _) = interpret thy model
  3.4947 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4948 -					(Free ("dummy", T))
  3.4949 -				val size_elem      = size_of_type i_elem
  3.4950 -				val (i_list, _, _) = interpret thy model
  3.4951 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4952 -					(Free ("dummy", Type ("List.list", [T])))
  3.4953 -				val size_list      = size_of_type i_list
  3.4954 -				(* power (a, b) computes a^b, for a>=0, b>=0 *)
  3.4955 -				(* int * int -> int *)
  3.4956 -				fun power (a, 0) = 1
  3.4957 -				  | power (a, 1) = a
  3.4958 -				  | power (a, b) =
  3.4959 -					let val ab = power(a, b div 2) in ab * ab * power(a, b mod 2) end
  3.4960 -				(* log (a, b) computes floor(log_a(b)), i.e. the largest integer x *)
  3.4961 -				(* s.t. a^x <= b, for a>=2, b>=1                                   *)
  3.4962 -				(* int * int -> int *)
  3.4963 -				fun log (a, b) =
  3.4964 -					let
  3.4965 -						fun logloop (ax, x) =
  3.4966 -							if ax > b then x-1 else logloop (a * ax, x+1)
  3.4967 -					in
  3.4968 -						logloop (1, 0)
  3.4969 -					end
  3.4970 -				(* nat -> nat -> interpretation *)
  3.4971 -				fun append m n =
  3.4972 -					let
  3.4973 -						(* The following formula depends on the order in which lists are *)
  3.4974 -						(* enumerated by the 'IDT_constructor_interpreter'.  It took me  *)
  3.4975 -						(* a little while to come up with this formula.                  *)
  3.4976 -						val element = n + m * (if size_elem = 1 then 1
  3.4977 -							else power (size_elem, log (size_elem, n+1))) + 1
  3.4978 -					in
  3.4979 -						if element > size_list then
  3.4980 -							Leaf (replicate size_list False)
  3.4981 -						else
  3.4982 -							Leaf ((replicate (element-1) False) @ True ::
  3.4983 -								(replicate (size_list - element) False))
  3.4984 -					end
  3.4985 -			in
  3.4986 -				SOME (Node (map (fn m => Node (map (append m) (0 upto size_list-1)))
  3.4987 -					(0 upto size_list-1)), model, args)
  3.4988 -			end
  3.4989 -		| _ =>
  3.4990 -			NONE;
  3.4991 +  fun List_append_interpreter thy model args t =
  3.4992 +    case t of
  3.4993 +      Const ("List.op @", Type ("fun", [Type ("List.list", [T]), Type ("fun",
  3.4994 +        [Type ("List.list", [_]), Type ("List.list", [_])])])) =>
  3.4995 +      let
  3.4996 +        val (i_elem, _, _) = interpret thy model
  3.4997 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.4998 +          (Free ("dummy", T))
  3.4999 +        val size_elem      = size_of_type i_elem
  3.5000 +        val (i_list, _, _) = interpret thy model
  3.5001 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5002 +          (Free ("dummy", Type ("List.list", [T])))
  3.5003 +        val size_list      = size_of_type i_list
  3.5004 +        (* power (a, b) computes a^b, for a>=0, b>=0 *)
  3.5005 +        (* int * int -> int *)
  3.5006 +        fun power (a, 0) = 1
  3.5007 +          | power (a, 1) = a
  3.5008 +          | power (a, b) =
  3.5009 +          let val ab = power(a, b div 2) in ab * ab * power(a, b mod 2) end
  3.5010 +        (* log (a, b) computes floor(log_a(b)), i.e. the largest integer x *)
  3.5011 +        (* s.t. a^x <= b, for a>=2, b>=1                                   *)
  3.5012 +        (* int * int -> int *)
  3.5013 +        fun log (a, b) =
  3.5014 +          let
  3.5015 +            fun logloop (ax, x) =
  3.5016 +              if ax > b then x-1 else logloop (a * ax, x+1)
  3.5017 +          in
  3.5018 +            logloop (1, 0)
  3.5019 +          end
  3.5020 +        (* nat -> nat -> interpretation *)
  3.5021 +        fun append m n =
  3.5022 +          let
  3.5023 +            (* The following formula depends on the order in which lists are *)
  3.5024 +            (* enumerated by the 'IDT_constructor_interpreter'.  It took me  *)
  3.5025 +            (* a little while to come up with this formula.                  *)
  3.5026 +            val element = n + m * (if size_elem = 1 then 1
  3.5027 +              else power (size_elem, log (size_elem, n+1))) + 1
  3.5028 +          in
  3.5029 +            if element > size_list then
  3.5030 +              Leaf (replicate size_list False)
  3.5031 +            else
  3.5032 +              Leaf ((replicate (element-1) False) @ True ::
  3.5033 +                (replicate (size_list - element) False))
  3.5034 +          end
  3.5035 +      in
  3.5036 +        SOME (Node (map (fn m => Node (map (append m) (0 upto size_list-1)))
  3.5037 +          (0 upto size_list-1)), model, args)
  3.5038 +      end
  3.5039 +    | _ =>
  3.5040 +      NONE;
  3.5041  
  3.5042 -	(* theory -> model -> arguments -> Term.term ->
  3.5043 -		(interpretation * model * arguments) option *)
  3.5044 +  (* theory -> model -> arguments -> Term.term ->
  3.5045 +    (interpretation * model * arguments) option *)
  3.5046  
  3.5047 -	(* only an optimization: 'lfp' could in principle be interpreted with  *)
  3.5048 -	(* interpreters available already (using its definition), but the code *)
  3.5049 -	(* below is more efficient                                             *)
  3.5050 +  (* only an optimization: 'lfp' could in principle be interpreted with  *)
  3.5051 +  (* interpreters available already (using its definition), but the code *)
  3.5052 +  (* below is more efficient                                             *)
  3.5053  
  3.5054 -	fun Lfp_lfp_interpreter thy model args t =
  3.5055 -		case t of
  3.5056 -		  Const ("Lfp.lfp", Type ("fun", [Type ("fun",
  3.5057 -				[Type ("set", [T]), Type ("set", [_])]), Type ("set", [_])])) =>
  3.5058 -			let
  3.5059 -				val (i_elem, _, _) = interpret thy model
  3.5060 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5061 -					(Free ("dummy", T))
  3.5062 -				val size_elem      = size_of_type i_elem
  3.5063 -				(* the universe (i.e. the set that contains every element) *)
  3.5064 -				val i_univ         = Node (replicate size_elem TT)
  3.5065 -				(* all sets with elements from type 'T' *)
  3.5066 -				val (i_set, _, _)  = interpret thy model
  3.5067 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5068 -					(Free ("dummy", Type ("set", [T])))
  3.5069 -				val i_sets         = make_constants i_set
  3.5070 -				(* all functions that map sets to sets *)
  3.5071 -				val (i_fun, _, _)  = interpret thy model {maxvars=0, def_eq=false,
  3.5072 -					next_idx=1, bounds=[], wellformed=True} (Free ("dummy",
  3.5073 -					Type ("fun", [Type ("set", [T]), Type ("set", [T])])))
  3.5074 -				val i_funs         = make_constants i_fun
  3.5075 -				(* "lfp(f) == Inter({u. f(u) <= u})" *)
  3.5076 -				(* interpretation * interpretation -> bool *)
  3.5077 -				fun is_subset (Node subs, Node sups) =
  3.5078 -					List.all (fn (sub, sup) => (sub = FF) orelse (sup = TT))
  3.5079 -						(subs ~~ sups)
  3.5080 -				  | is_subset (_, _) =
  3.5081 -					raise REFUTE ("Lfp_lfp_interpreter",
  3.5082 -						"is_subset: interpretation for set is not a node")
  3.5083 -				(* interpretation * interpretation -> interpretation *)
  3.5084 -				fun intersection (Node xs, Node ys) =
  3.5085 -					Node (map (fn (x, y) => if x=TT andalso y=TT then TT else FF)
  3.5086 -						(xs ~~ ys))
  3.5087 -				  | intersection (_, _) =
  3.5088 -					raise REFUTE ("Lfp_lfp_interpreter",
  3.5089 -						"intersection: interpretation for set is not a node")
  3.5090 -				(* interpretation -> interpretaion *)
  3.5091 -				fun lfp (Node resultsets) =
  3.5092 -					foldl (fn ((set, resultset), acc) =>
  3.5093 -						if is_subset (resultset, set) then
  3.5094 -							intersection (acc, set)
  3.5095 -						else
  3.5096 -							acc) i_univ (i_sets ~~ resultsets)
  3.5097 -				  | lfp _ =
  3.5098 -						raise REFUTE ("Lfp_lfp_interpreter",
  3.5099 -							"lfp: interpretation for function is not a node")
  3.5100 -			in
  3.5101 -				SOME (Node (map lfp i_funs), model, args)
  3.5102 -			end
  3.5103 -		| _ =>
  3.5104 -			NONE;
  3.5105 +  fun Lfp_lfp_interpreter thy model args t =
  3.5106 +    case t of
  3.5107 +      Const ("Lfp.lfp", Type ("fun", [Type ("fun",
  3.5108 +        [Type ("set", [T]), Type ("set", [_])]), Type ("set", [_])])) =>
  3.5109 +      let
  3.5110 +        val (i_elem, _, _) = interpret thy model
  3.5111 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5112 +          (Free ("dummy", T))
  3.5113 +        val size_elem      = size_of_type i_elem
  3.5114 +        (* the universe (i.e. the set that contains every element) *)
  3.5115 +        val i_univ         = Node (replicate size_elem TT)
  3.5116 +        (* all sets with elements from type 'T' *)
  3.5117 +        val (i_set, _, _)  = interpret thy model
  3.5118 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5119 +          (Free ("dummy", Type ("set", [T])))
  3.5120 +        val i_sets         = make_constants i_set
  3.5121 +        (* all functions that map sets to sets *)
  3.5122 +        val (i_fun, _, _)  = interpret thy model {maxvars=0, def_eq=false,
  3.5123 +          next_idx=1, bounds=[], wellformed=True} (Free ("dummy",
  3.5124 +          Type ("fun", [Type ("set", [T]), Type ("set", [T])])))
  3.5125 +        val i_funs         = make_constants i_fun
  3.5126 +        (* "lfp(f) == Inter({u. f(u) <= u})" *)
  3.5127 +        (* interpretation * interpretation -> bool *)
  3.5128 +        fun is_subset (Node subs, Node sups) =
  3.5129 +          List.all (fn (sub, sup) => (sub = FF) orelse (sup = TT))
  3.5130 +            (subs ~~ sups)
  3.5131 +          | is_subset (_, _) =
  3.5132 +          raise REFUTE ("Lfp_lfp_interpreter",
  3.5133 +            "is_subset: interpretation for set is not a node")
  3.5134 +        (* interpretation * interpretation -> interpretation *)
  3.5135 +        fun intersection (Node xs, Node ys) =
  3.5136 +          Node (map (fn (x, y) => if x=TT andalso y=TT then TT else FF)
  3.5137 +            (xs ~~ ys))
  3.5138 +          | intersection (_, _) =
  3.5139 +          raise REFUTE ("Lfp_lfp_interpreter",
  3.5140 +            "intersection: interpretation for set is not a node")
  3.5141 +        (* interpretation -> interpretaion *)
  3.5142 +        fun lfp (Node resultsets) =
  3.5143 +          foldl (fn ((set, resultset), acc) =>
  3.5144 +            if is_subset (resultset, set) then
  3.5145 +              intersection (acc, set)
  3.5146 +            else
  3.5147 +              acc) i_univ (i_sets ~~ resultsets)
  3.5148 +          | lfp _ =
  3.5149 +            raise REFUTE ("Lfp_lfp_interpreter",
  3.5150 +              "lfp: interpretation for function is not a node")
  3.5151 +      in
  3.5152 +        SOME (Node (map lfp i_funs), model, args)
  3.5153 +      end
  3.5154 +    | _ =>
  3.5155 +      NONE;
  3.5156  
  3.5157 -	(* theory -> model -> arguments -> Term.term ->
  3.5158 -		(interpretation * model * arguments) option *)
  3.5159 +  (* theory -> model -> arguments -> Term.term ->
  3.5160 +    (interpretation * model * arguments) option *)
  3.5161  
  3.5162 -	(* only an optimization: 'gfp' could in principle be interpreted with  *)
  3.5163 -	(* interpreters available already (using its definition), but the code *)
  3.5164 -	(* below is more efficient                                             *)
  3.5165 +  (* only an optimization: 'gfp' could in principle be interpreted with  *)
  3.5166 +  (* interpreters available already (using its definition), but the code *)
  3.5167 +  (* below is more efficient                                             *)
  3.5168  
  3.5169 -	fun Gfp_gfp_interpreter thy model args t =
  3.5170 -		case t of
  3.5171 -		  Const ("Gfp.gfp", Type ("fun", [Type ("fun",
  3.5172 -				[Type ("set", [T]), Type ("set", [_])]), Type ("set", [_])])) =>
  3.5173 -			let nonfix union (* because "union" is used below *)
  3.5174 -				val (i_elem, _, _) = interpret thy model
  3.5175 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5176 -					(Free ("dummy", T))
  3.5177 -				val size_elem      = size_of_type i_elem
  3.5178 -				(* the universe (i.e. the set that contains every element) *)
  3.5179 -				val i_univ         = Node (replicate size_elem TT)
  3.5180 -				(* all sets with elements from type 'T' *)
  3.5181 -				val (i_set, _, _)  = interpret thy model
  3.5182 -					{maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5183 -					(Free ("dummy", Type ("set", [T])))
  3.5184 -				val i_sets         = make_constants i_set
  3.5185 -				(* all functions that map sets to sets *)
  3.5186 -				val (i_fun, _, _)  = interpret thy model {maxvars=0, def_eq=false,
  3.5187 -					next_idx=1, bounds=[], wellformed=True} (Free ("dummy",
  3.5188 -					Type ("fun", [Type ("set", [T]), Type ("set", [T])])))
  3.5189 -				val i_funs         = make_constants i_fun
  3.5190 -				(* "gfp(f) == Union({u. u <= f(u)})" *)
  3.5191 -				(* interpretation * interpretation -> bool *)
  3.5192 -				fun is_subset (Node subs, Node sups) =
  3.5193 -					List.all (fn (sub, sup) => (sub = FF) orelse (sup = TT))
  3.5194 -						(subs ~~ sups)
  3.5195 -				  | is_subset (_, _) =
  3.5196 -					raise REFUTE ("Gfp_gfp_interpreter",
  3.5197 -						"is_subset: interpretation for set is not a node")
  3.5198 -				(* interpretation * interpretation -> interpretation *)
  3.5199 -				fun union (Node xs, Node ys) =
  3.5200 -					  Node (map (fn (x,y) => if x=TT orelse y=TT then TT else FF)
  3.5201 -					       (xs ~~ ys))
  3.5202 -				  | union (_, _) =
  3.5203 -					raise REFUTE ("Gfp_gfp_interpreter",
  3.5204 -						"union: interpretation for set is not a node")
  3.5205 -				(* interpretation -> interpretaion *)
  3.5206 -				fun gfp (Node resultsets) =
  3.5207 -					foldl (fn ((set, resultset), acc) =>
  3.5208 -						if is_subset (set, resultset) then
  3.5209 -							union (acc, set)
  3.5210 -						else
  3.5211 -							acc) i_univ (i_sets ~~ resultsets)
  3.5212 -				  | gfp _ =
  3.5213 -						raise REFUTE ("Gfp_gfp_interpreter",
  3.5214 -							"gfp: interpretation for function is not a node")
  3.5215 -			in
  3.5216 -				SOME (Node (map gfp i_funs), model, args)
  3.5217 -			end
  3.5218 -		| _ =>
  3.5219 -			NONE;
  3.5220 +  fun Gfp_gfp_interpreter thy model args t =
  3.5221 +    case t of
  3.5222 +      Const ("Gfp.gfp", Type ("fun", [Type ("fun",
  3.5223 +        [Type ("set", [T]), Type ("set", [_])]), Type ("set", [_])])) =>
  3.5224 +      let nonfix union (* because "union" is used below *)
  3.5225 +        val (i_elem, _, _) = interpret thy model
  3.5226 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5227 +          (Free ("dummy", T))
  3.5228 +        val size_elem      = size_of_type i_elem
  3.5229 +        (* the universe (i.e. the set that contains every element) *)
  3.5230 +        val i_univ         = Node (replicate size_elem TT)
  3.5231 +        (* all sets with elements from type 'T' *)
  3.5232 +        val (i_set, _, _)  = interpret thy model
  3.5233 +          {maxvars=0, def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5234 +          (Free ("dummy", Type ("set", [T])))
  3.5235 +        val i_sets         = make_constants i_set
  3.5236 +        (* all functions that map sets to sets *)
  3.5237 +        val (i_fun, _, _)  = interpret thy model {maxvars=0, def_eq=false,
  3.5238 +          next_idx=1, bounds=[], wellformed=True} (Free ("dummy",
  3.5239 +          Type ("fun", [Type ("set", [T]), Type ("set", [T])])))
  3.5240 +        val i_funs         = make_constants i_fun
  3.5241 +        (* "gfp(f) == Union({u. u <= f(u)})" *)
  3.5242 +        (* interpretation * interpretation -> bool *)
  3.5243 +        fun is_subset (Node subs, Node sups) =
  3.5244 +          List.all (fn (sub, sup) => (sub = FF) orelse (sup = TT))
  3.5245 +            (subs ~~ sups)
  3.5246 +          | is_subset (_, _) =
  3.5247 +          raise REFUTE ("Gfp_gfp_interpreter",
  3.5248 +            "is_subset: interpretation for set is not a node")
  3.5249 +        (* interpretation * interpretation -> interpretation *)
  3.5250 +        fun union (Node xs, Node ys) =
  3.5251 +            Node (map (fn (x,y) => if x=TT orelse y=TT then TT else FF)
  3.5252 +                 (xs ~~ ys))
  3.5253 +          | union (_, _) =
  3.5254 +          raise REFUTE ("Gfp_gfp_interpreter",
  3.5255 +            "union: interpretation for set is not a node")
  3.5256 +        (* interpretation -> interpretaion *)
  3.5257 +        fun gfp (Node resultsets) =
  3.5258 +          foldl (fn ((set, resultset), acc) =>
  3.5259 +            if is_subset (set, resultset) then
  3.5260 +              union (acc, set)
  3.5261 +            else
  3.5262 +              acc) i_univ (i_sets ~~ resultsets)
  3.5263 +          | gfp _ =
  3.5264 +            raise REFUTE ("Gfp_gfp_interpreter",
  3.5265 +              "gfp: interpretation for function is not a node")
  3.5266 +      in
  3.5267 +        SOME (Node (map gfp i_funs), model, args)
  3.5268 +      end
  3.5269 +    | _ =>
  3.5270 +      NONE;
  3.5271  
  3.5272 -	(* theory -> model -> arguments -> Term.term ->
  3.5273 -		(interpretation * model * arguments) option *)
  3.5274 +  (* theory -> model -> arguments -> Term.term ->
  3.5275 +    (interpretation * model * arguments) option *)
  3.5276  
  3.5277 -	(* only an optimization: 'fst' could in principle be interpreted with  *)
  3.5278 -	(* interpreters available already (using its definition), but the code *)
  3.5279 -	(* below is more efficient                                             *)
  3.5280 +  (* only an optimization: 'fst' could in principle be interpreted with  *)
  3.5281 +  (* interpreters available already (using its definition), but the code *)
  3.5282 +  (* below is more efficient                                             *)
  3.5283  
  3.5284 -	fun Product_Type_fst_interpreter thy model args t =
  3.5285 -		case t of
  3.5286 -		  Const ("fst", Type ("fun", [Type ("*", [T, U]), _])) =>
  3.5287 -			let
  3.5288 -				val (iT, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5289 -					next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T))
  3.5290 -				val is_T       = make_constants iT
  3.5291 -				val (iU, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5292 -					next_idx=1, bounds=[], wellformed=True} (Free ("dummy", U))
  3.5293 -				val size_U     = size_of_type iU
  3.5294 -			in
  3.5295 -				SOME (Node (List.concat (map (replicate size_U) is_T)), model, args)
  3.5296 -			end
  3.5297 -		| _ =>
  3.5298 -			NONE;
  3.5299 +  fun Product_Type_fst_interpreter thy model args t =
  3.5300 +    case t of
  3.5301 +      Const ("fst", Type ("fun", [Type ("*", [T, U]), _])) =>
  3.5302 +      let
  3.5303 +        val (iT, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5304 +          next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T))
  3.5305 +        val is_T       = make_constants iT
  3.5306 +        val (iU, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5307 +          next_idx=1, bounds=[], wellformed=True} (Free ("dummy", U))
  3.5308 +        val size_U     = size_of_type iU
  3.5309 +      in
  3.5310 +        SOME (Node (List.concat (map (replicate size_U) is_T)), model, args)
  3.5311 +      end
  3.5312 +    | _ =>
  3.5313 +      NONE;
  3.5314  
  3.5315 -	(* theory -> model -> arguments -> Term.term ->
  3.5316 -		(interpretation * model * arguments) option *)
  3.5317 +  (* theory -> model -> arguments -> Term.term ->
  3.5318 +    (interpretation * model * arguments) option *)
  3.5319  
  3.5320 -	(* only an optimization: 'snd' could in principle be interpreted with  *)
  3.5321 -	(* interpreters available already (using its definition), but the code *)
  3.5322 -	(* below is more efficient                                             *)
  3.5323 +  (* only an optimization: 'snd' could in principle be interpreted with  *)
  3.5324 +  (* interpreters available already (using its definition), but the code *)
  3.5325 +  (* below is more efficient                                             *)
  3.5326  
  3.5327 -	fun Product_Type_snd_interpreter thy model args t =
  3.5328 -		case t of
  3.5329 -		  Const ("snd", Type ("fun", [Type ("*", [T, U]), _])) =>
  3.5330 -			let
  3.5331 -				val (iT, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5332 -					next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T))
  3.5333 -				val size_T     = size_of_type iT
  3.5334 -				val (iU, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5335 -					next_idx=1, bounds=[], wellformed=True} (Free ("dummy", U))
  3.5336 -				val is_U       = make_constants iU
  3.5337 -			in
  3.5338 -				SOME (Node (List.concat (replicate size_T is_U)), model, args)
  3.5339 -			end
  3.5340 -		| _ =>
  3.5341 -			NONE;
  3.5342 +  fun Product_Type_snd_interpreter thy model args t =
  3.5343 +    case t of
  3.5344 +      Const ("snd", Type ("fun", [Type ("*", [T, U]), _])) =>
  3.5345 +      let
  3.5346 +        val (iT, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5347 +          next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T))
  3.5348 +        val size_T     = size_of_type iT
  3.5349 +        val (iU, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5350 +          next_idx=1, bounds=[], wellformed=True} (Free ("dummy", U))
  3.5351 +        val is_U       = make_constants iU
  3.5352 +      in
  3.5353 +        SOME (Node (List.concat (replicate size_T is_U)), model, args)
  3.5354 +      end
  3.5355 +    | _ =>
  3.5356 +      NONE;
  3.5357  
  3.5358  
  3.5359  (* ------------------------------------------------------------------------- *)
  3.5360  (* PRINTERS                                                                  *)
  3.5361  (* ------------------------------------------------------------------------- *)
  3.5362  
  3.5363 -	(* theory -> model -> Term.term -> interpretation -> (int -> bool) ->
  3.5364 -		Term.term option *)
  3.5365 +  (* theory -> model -> Term.term -> interpretation -> (int -> bool) ->
  3.5366 +    Term.term option *)
  3.5367  
  3.5368 -	fun stlc_printer thy model t intr assignment =
  3.5369 -	let
  3.5370 -		(* Term.term -> Term.typ option *)
  3.5371 -		fun typeof (Free (_, T))  = SOME T
  3.5372 -		  | typeof (Var (_, T))   = SOME T
  3.5373 -		  | typeof (Const (_, T)) = SOME T
  3.5374 -		  | typeof _              = NONE
  3.5375 -		(* string -> string *)
  3.5376 -		fun strip_leading_quote s =
  3.5377 -			(implode o (fn [] => [] | x::xs => if x="'" then xs else x::xs)
  3.5378 -				o explode) s
  3.5379 -		(* Term.typ -> string *)
  3.5380 -		fun string_of_typ (Type (s, _))     = s
  3.5381 -		  | string_of_typ (TFree (x, _))    = strip_leading_quote x
  3.5382 -		  | string_of_typ (TVar ((x,i), _)) =
  3.5383 -			strip_leading_quote x ^ string_of_int i
  3.5384 -		(* interpretation -> int *)
  3.5385 -		fun index_from_interpretation (Leaf xs) =
  3.5386 -			find_index (PropLogic.eval assignment) xs
  3.5387 -		  | index_from_interpretation _ =
  3.5388 -			raise REFUTE ("stlc_printer",
  3.5389 -				"interpretation for ground type is not a leaf")
  3.5390 -	in
  3.5391 -		case typeof t of
  3.5392 -		  SOME T =>
  3.5393 -			(case T of
  3.5394 -			  Type ("fun", [T1, T2]) =>
  3.5395 -				let
  3.5396 -					(* create all constants of type 'T1' *)
  3.5397 -					val (i, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5398 -						next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T1))
  3.5399 -					val constants = make_constants i
  3.5400 -					(* interpretation list *)
  3.5401 -					val results = (case intr of
  3.5402 -						  Node xs => xs
  3.5403 -						| _       => raise REFUTE ("stlc_printer",
  3.5404 -							"interpretation for function type is a leaf"))
  3.5405 -					(* Term.term list *)
  3.5406 -					val pairs = map (fn (arg, result) =>
  3.5407 -						HOLogic.mk_prod
  3.5408 -							(print thy model (Free ("dummy", T1)) arg assignment,
  3.5409 -							 print thy model (Free ("dummy", T2)) result assignment))
  3.5410 -						(constants ~~ results)
  3.5411 -					(* Term.typ *)
  3.5412 -					val HOLogic_prodT = HOLogic.mk_prodT (T1, T2)
  3.5413 -					val HOLogic_setT  = HOLogic.mk_setT HOLogic_prodT
  3.5414 -					(* Term.term *)
  3.5415 -					val HOLogic_empty_set = Const ("{}", HOLogic_setT)
  3.5416 -					val HOLogic_insert    =
  3.5417 -						Const ("insert", HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
  3.5418 -				in
  3.5419 -					SOME (foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc)
  3.5420 -						HOLogic_empty_set pairs)
  3.5421 -				end
  3.5422 -			| Type ("prop", [])      =>
  3.5423 -				(case index_from_interpretation intr of
  3.5424 -				  ~1 => SOME (HOLogic.mk_Trueprop (Const ("arbitrary", HOLogic.boolT)))
  3.5425 -				| 0  => SOME (HOLogic.mk_Trueprop HOLogic.true_const)
  3.5426 -				| 1  => SOME (HOLogic.mk_Trueprop HOLogic.false_const)
  3.5427 -				| _  => raise REFUTE ("stlc_interpreter",
  3.5428 -					"illegal interpretation for a propositional value"))
  3.5429 -			| Type _  => if index_from_interpretation intr = (~1) then
  3.5430 -					SOME (Const ("arbitrary", T))
  3.5431 -				else
  3.5432 -					SOME (Const (string_of_typ T ^
  3.5433 -						string_of_int (index_from_interpretation intr), T))
  3.5434 -			| TFree _ => if index_from_interpretation intr = (~1) then
  3.5435 -					SOME (Const ("arbitrary", T))
  3.5436 -				else
  3.5437 -					SOME (Const (string_of_typ T ^
  3.5438 -						string_of_int (index_from_interpretation intr), T))
  3.5439 -			| TVar _  => if index_from_interpretation intr = (~1) then
  3.5440 -					SOME (Const ("arbitrary", T))
  3.5441 -				else
  3.5442 -					SOME (Const (string_of_typ T ^
  3.5443 -						string_of_int (index_from_interpretation intr), T)))
  3.5444 -		| NONE =>
  3.5445 -			NONE
  3.5446 -	end;
  3.5447 +  fun stlc_printer thy model t intr assignment =
  3.5448 +  let
  3.5449 +    (* Term.term -> Term.typ option *)
  3.5450 +    fun typeof (Free (_, T))  = SOME T
  3.5451 +      | typeof (Var (_, T))   = SOME T
  3.5452 +      | typeof (Const (_, T)) = SOME T
  3.5453 +      | typeof _              = NONE
  3.5454 +    (* string -> string *)
  3.5455 +    fun strip_leading_quote s =
  3.5456 +      (implode o (fn [] => [] | x::xs => if x="'" then xs else x::xs)
  3.5457 +        o explode) s
  3.5458 +    (* Term.typ -> string *)
  3.5459 +    fun string_of_typ (Type (s, _))     = s
  3.5460 +      | string_of_typ (TFree (x, _))    = strip_leading_quote x
  3.5461 +      | string_of_typ (TVar ((x,i), _)) =
  3.5462 +      strip_leading_quote x ^ string_of_int i
  3.5463 +    (* interpretation -> int *)
  3.5464 +    fun index_from_interpretation (Leaf xs) =
  3.5465 +      find_index (PropLogic.eval assignment) xs
  3.5466 +      | index_from_interpretation _ =
  3.5467 +      raise REFUTE ("stlc_printer",
  3.5468 +        "interpretation for ground type is not a leaf")
  3.5469 +  in
  3.5470 +    case typeof t of
  3.5471 +      SOME T =>
  3.5472 +      (case T of
  3.5473 +        Type ("fun", [T1, T2]) =>
  3.5474 +        let
  3.5475 +          (* create all constants of type 'T1' *)
  3.5476 +          val (i, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5477 +            next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T1))
  3.5478 +          val constants = make_constants i
  3.5479 +          (* interpretation list *)
  3.5480 +          val results = (case intr of
  3.5481 +              Node xs => xs
  3.5482 +            | _       => raise REFUTE ("stlc_printer",
  3.5483 +              "interpretation for function type is a leaf"))
  3.5484 +          (* Term.term list *)
  3.5485 +          val pairs = map (fn (arg, result) =>
  3.5486 +            HOLogic.mk_prod
  3.5487 +              (print thy model (Free ("dummy", T1)) arg assignment,
  3.5488 +               print thy model (Free ("dummy", T2)) result assignment))
  3.5489 +            (constants ~~ results)
  3.5490 +          (* Term.typ *)
  3.5491 +          val HOLogic_prodT = HOLogic.mk_prodT (T1, T2)
  3.5492 +          val HOLogic_setT  = HOLogic.mk_setT HOLogic_prodT
  3.5493 +          (* Term.term *)
  3.5494 +          val HOLogic_empty_set = Const ("{}", HOLogic_setT)
  3.5495 +          val HOLogic_insert    =
  3.5496 +            Const ("insert", HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
  3.5497 +        in
  3.5498 +          SOME (foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc)
  3.5499 +            HOLogic_empty_set pairs)
  3.5500 +        end
  3.5501 +      | Type ("prop", [])      =>
  3.5502 +        (case index_from_interpretation intr of
  3.5503 +          ~1 => SOME (HOLogic.mk_Trueprop (Const ("arbitrary", HOLogic.boolT)))
  3.5504 +        | 0  => SOME (HOLogic.mk_Trueprop HOLogic.true_const)
  3.5505 +        | 1  => SOME (HOLogic.mk_Trueprop HOLogic.false_const)
  3.5506 +        | _  => raise REFUTE ("stlc_interpreter",
  3.5507 +          "illegal interpretation for a propositional value"))
  3.5508 +      | Type _  => if index_from_interpretation intr = (~1) then
  3.5509 +          SOME (Const ("arbitrary", T))
  3.5510 +        else
  3.5511 +          SOME (Const (string_of_typ T ^
  3.5512 +            string_of_int (index_from_interpretation intr), T))
  3.5513 +      | TFree _ => if index_from_interpretation intr = (~1) then
  3.5514 +          SOME (Const ("arbitrary", T))
  3.5515 +        else
  3.5516 +          SOME (Const (string_of_typ T ^
  3.5517 +            string_of_int (index_from_interpretation intr), T))
  3.5518 +      | TVar _  => if index_from_interpretation intr = (~1) then
  3.5519 +          SOME (Const ("arbitrary", T))
  3.5520 +        else
  3.5521 +          SOME (Const (string_of_typ T ^
  3.5522 +            string_of_int (index_from_interpretation intr), T)))
  3.5523 +    | NONE =>
  3.5524 +      NONE
  3.5525 +  end;
  3.5526  
  3.5527 -	(* theory -> model -> Term.term -> interpretation -> (int -> bool) ->
  3.5528 -		string option *)
  3.5529 +  (* theory -> model -> Term.term -> interpretation -> (int -> bool) ->
  3.5530 +    string option *)
  3.5531  
  3.5532 -	fun set_printer thy model t intr assignment =
  3.5533 -	let
  3.5534 -		(* Term.term -> Term.typ option *)
  3.5535 -		fun typeof (Free (_, T))  = SOME T
  3.5536 -		  | typeof (Var (_, T))   = SOME T
  3.5537 -		  | typeof (Const (_, T)) = SOME T
  3.5538 -		  | typeof _              = NONE
  3.5539 -	in
  3.5540 -		case typeof t of
  3.5541 -		  SOME (Type ("set", [T])) =>
  3.5542 -			let
  3.5543 -				(* create all constants of type 'T' *)
  3.5544 -				val (i, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5545 -					next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T))
  3.5546 -				val constants = make_constants i
  3.5547 -				(* interpretation list *)
  3.5548 -				val results = (case intr of
  3.5549 -					  Node xs => xs
  3.5550 -					| _       => raise REFUTE ("set_printer",
  3.5551 -						"interpretation for set type is a leaf"))
  3.5552 -				(* Term.term list *)
  3.5553 -				val elements = List.mapPartial (fn (arg, result) =>
  3.5554 -					case result of
  3.5555 -					  Leaf [fmTrue, fmFalse] =>
  3.5556 -						if PropLogic.eval assignment fmTrue then
  3.5557 -							SOME (print thy model (Free ("dummy", T)) arg assignment)
  3.5558 -						else (* if PropLogic.eval assignment fmFalse then *)
  3.5559 -							NONE
  3.5560 -					| _ =>
  3.5561 -						raise REFUTE ("set_printer",
  3.5562 -							"illegal interpretation for a Boolean value"))
  3.5563 -					(constants ~~ results)
  3.5564 -				(* Term.typ *)
  3.5565 -				val HOLogic_setT  = HOLogic.mk_setT T
  3.5566 -				(* Term.term *)
  3.5567 -				val HOLogic_empty_set = Const ("{}", HOLogic_setT)
  3.5568 -				val HOLogic_insert    =
  3.5569 -					Const ("insert", T --> HOLogic_setT --> HOLogic_setT)
  3.5570 -			in
  3.5571 -				SOME (Library.foldl (fn (acc, elem) => HOLogic_insert $ elem $ acc)
  3.5572 -					(HOLogic_empty_set, elements))
  3.5573 -			end
  3.5574 -		| _ =>
  3.5575 -			NONE
  3.5576 -	end;
  3.5577 +  fun set_printer thy model t intr assignment =
  3.5578 +  let
  3.5579 +    (* Term.term -> Term.typ option *)
  3.5580 +    fun typeof (Free (_, T))  = SOME T
  3.5581 +      | typeof (Var (_, T))   = SOME T
  3.5582 +      | typeof (Const (_, T)) = SOME T
  3.5583 +      | typeof _              = NONE
  3.5584 +  in
  3.5585 +    case typeof t of
  3.5586 +      SOME (Type ("set", [T])) =>
  3.5587 +      let
  3.5588 +        (* create all constants of type 'T' *)
  3.5589 +        val (i, _, _) = interpret thy model {maxvars=0, def_eq=false,
  3.5590 +          next_idx=1, bounds=[], wellformed=True} (Free ("dummy", T))
  3.5591 +        val constants = make_constants i
  3.5592 +        (* interpretation list *)
  3.5593 +        val results = (case intr of
  3.5594 +            Node xs => xs
  3.5595 +          | _       => raise REFUTE ("set_printer",
  3.5596 +            "interpretation for set type is a leaf"))
  3.5597 +        (* Term.term list *)
  3.5598 +        val elements = List.mapPartial (fn (arg, result) =>
  3.5599 +          case result of
  3.5600 +            Leaf [fmTrue, fmFalse] =>
  3.5601 +            if PropLogic.eval assignment fmTrue then
  3.5602 +              SOME (print thy model (Free ("dummy", T)) arg assignment)
  3.5603 +            else (* if PropLogic.eval assignment fmFalse then *)
  3.5604 +              NONE
  3.5605 +          | _ =>
  3.5606 +            raise REFUTE ("set_printer",
  3.5607 +              "illegal interpretation for a Boolean value"))
  3.5608 +          (constants ~~ results)
  3.5609 +        (* Term.typ *)
  3.5610 +        val HOLogic_setT  = HOLogic.mk_setT T
  3.5611 +        (* Term.term *)
  3.5612 +        val HOLogic_empty_set = Const ("{}", HOLogic_setT)
  3.5613 +        val HOLogic_insert    =
  3.5614 +          Const ("insert", T --> HOLogic_setT --> HOLogic_setT)
  3.5615 +      in
  3.5616 +        SOME (Library.foldl (fn (acc, elem) => HOLogic_insert $ elem $ acc)
  3.5617 +          (HOLogic_empty_set, elements))
  3.5618 +      end
  3.5619 +    | _ =>
  3.5620 +      NONE
  3.5621 +  end;
  3.5622  
  3.5623 -	(* theory -> model -> Term.term -> interpretation -> (int -> bool) ->
  3.5624 -		Term.term option *)
  3.5625 +  (* theory -> model -> Term.term -> interpretation -> (int -> bool) ->
  3.5626 +    Term.term option *)
  3.5627  
  3.5628 -	fun IDT_printer thy model t intr assignment =
  3.5629 -	let
  3.5630 -		(* Term.term -> Term.typ option *)
  3.5631 -		fun typeof (Free (_, T))  = SOME T
  3.5632 -		  | typeof (Var (_, T))   = SOME T
  3.5633 -		  | typeof (Const (_, T)) = SOME T
  3.5634 -		  | typeof _              = NONE
  3.5635 -	in
  3.5636 -		case typeof t of
  3.5637 -		  SOME (Type (s, Ts)) =>
  3.5638 -			(case DatatypePackage.get_datatype thy s of
  3.5639 -			  SOME info =>  (* inductive datatype *)
  3.5640 -				let
  3.5641 -					val (typs, _)           = model
  3.5642 -					val index               = #index info
  3.5643 -					val descr               = #descr info
  3.5644 -					val (_, dtyps, constrs) = lookup descr index
  3.5645 -					val typ_assoc           = dtyps ~~ Ts
  3.5646 -					(* sanity check: every element in 'dtyps' must be a 'DtTFree' *)
  3.5647 -					val _ = (if Library.exists (fn d =>
  3.5648 -							case d of DatatypeAux.DtTFree _ => false | _ => true) dtyps
  3.5649 -						then
  3.5650 -							raise REFUTE ("IDT_printer", "datatype argument (for type " ^
  3.5651 -								Sign.string_of_typ thy (Type (s, Ts)) ^ ") is not a variable")
  3.5652 -						else
  3.5653 -							())
  3.5654 -					(* the index of the element in the datatype *)
  3.5655 -					val element = (case intr of
  3.5656 -						  Leaf xs => find_index (PropLogic.eval assignment) xs
  3.5657 -						| Node _  => raise REFUTE ("IDT_printer",
  3.5658 -							"interpretation is not a leaf"))
  3.5659 -				in
  3.5660 -					if element < 0 then
  3.5661 -						SOME (Const ("arbitrary", Type (s, Ts)))
  3.5662 -					else let
  3.5663 -						(* takes a datatype constructor, and if for some arguments this  *)
  3.5664 -						(* constructor generates the datatype's element that is given by *)
  3.5665 -						(* 'element', returns the constructor (as a term) as well as the *)
  3.5666 -						(* indices of the arguments                                      *)
  3.5667 -						(* string * DatatypeAux.dtyp list ->
  3.5668 -							(Term.term * int list) option *)
  3.5669 -						fun get_constr_args (cname, cargs) =
  3.5670 -							let
  3.5671 -								val cTerm      = Const (cname,
  3.5672 -									map (typ_of_dtyp descr typ_assoc) cargs ---> Type (s, Ts))
  3.5673 -								val (iC, _, _) = interpret thy (typs, []) {maxvars=0,
  3.5674 -									def_eq=false, next_idx=1, bounds=[], wellformed=True} cTerm
  3.5675 -								(* interpretation -> int list option *)
  3.5676 -								fun get_args (Leaf xs) =
  3.5677 -									if find_index_eq True xs = element then
  3.5678 -										SOME []
  3.5679 -									else
  3.5680 -										NONE
  3.5681 -								  | get_args (Node xs) =
  3.5682 -									let
  3.5683 -										(* interpretation * int -> int list option *)
  3.5684 -										fun search ([], _) =
  3.5685 -											NONE
  3.5686 -										  | search (x::xs, n) =
  3.5687 -											(case get_args x of
  3.5688 -											  SOME result => SOME (n::result)
  3.5689 -											| NONE        => search (xs, n+1))
  3.5690 -									in
  3.5691 -										search (xs, 0)
  3.5692 -									end
  3.5693 -							in
  3.5694 -								Option.map (fn args => (cTerm, cargs, args)) (get_args iC)
  3.5695 -							end
  3.5696 -						(* Term.term * DatatypeAux.dtyp list * int list *)
  3.5697 -						val (cTerm, cargs, args) =
  3.5698 -							(case get_first get_constr_args constrs of
  3.5699 -							  SOME x => x
  3.5700 -							| NONE   => raise REFUTE ("IDT_printer",
  3.5701 -								"no matching constructor found for element " ^
  3.5702 -								string_of_int element))
  3.5703 -						val argsTerms = map (fn (d, n) =>
  3.5704 -							let
  3.5705 -								val dT        = typ_of_dtyp descr typ_assoc d
  3.5706 -								val (i, _, _) = interpret thy (typs, []) {maxvars=0,
  3.5707 -									def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5708 -									(Free ("dummy", dT))
  3.5709 -								(* we only need the n-th element of this list, so there   *)
  3.5710 -								(* might be a more efficient implementation that does not *)
  3.5711 -								(* generate all constants                                 *)
  3.5712 -								val consts    = make_constants i
  3.5713 -							in
  3.5714 -								print thy (typs, []) (Free ("dummy", dT))
  3.5715 -									(List.nth (consts, n)) assignment
  3.5716 -							end) (cargs ~~ args)
  3.5717 -					in
  3.5718 -						SOME (Library.foldl op$ (cTerm, argsTerms))
  3.5719 -					end
  3.5720 -				end
  3.5721 -			| NONE =>  (* not an inductive datatype *)
  3.5722 -				NONE)
  3.5723 -		| _ =>  (* a (free or schematic) type variable *)
  3.5724 -			NONE
  3.5725 -	end;
  3.5726 +  fun IDT_printer thy model t intr assignment =
  3.5727 +  let
  3.5728 +    (* Term.term -> Term.typ option *)
  3.5729 +    fun typeof (Free (_, T))  = SOME T
  3.5730 +      | typeof (Var (_, T))   = SOME T
  3.5731 +      | typeof (Const (_, T)) = SOME T
  3.5732 +      | typeof _              = NONE
  3.5733 +  in
  3.5734 +    case typeof t of
  3.5735 +      SOME (Type (s, Ts)) =>
  3.5736 +      (case DatatypePackage.get_datatype thy s of
  3.5737 +        SOME info =>  (* inductive datatype *)
  3.5738 +        let
  3.5739 +          val (typs, _)           = model
  3.5740 +          val index               = #index info
  3.5741 +          val descr               = #descr info
  3.5742 +          val (_, dtyps, constrs) = lookup descr index
  3.5743 +          val typ_assoc           = dtyps ~~ Ts
  3.5744 +          (* sanity check: every element in 'dtyps' must be a 'DtTFree' *)
  3.5745 +          val _ = (if Library.exists (fn d =>
  3.5746 +              case d of DatatypeAux.DtTFree _ => false | _ => true) dtyps
  3.5747 +            then
  3.5748 +              raise REFUTE ("IDT_printer", "datatype argument (for type " ^
  3.5749 +                Sign.string_of_typ thy (Type (s, Ts)) ^ ") is not a variable")
  3.5750 +            else
  3.5751 +              ())
  3.5752 +          (* the index of the element in the datatype *)
  3.5753 +          val element = (case intr of
  3.5754 +              Leaf xs => find_index (PropLogic.eval assignment) xs
  3.5755 +            | Node _  => raise REFUTE ("IDT_printer",
  3.5756 +              "interpretation is not a leaf"))
  3.5757 +        in
  3.5758 +          if element < 0 then
  3.5759 +            SOME (Const ("arbitrary", Type (s, Ts)))
  3.5760 +          else let
  3.5761 +            (* takes a datatype constructor, and if for some arguments this  *)
  3.5762 +            (* constructor generates the datatype's element that is given by *)
  3.5763 +            (* 'element', returns the constructor (as a term) as well as the *)
  3.5764 +            (* indices of the arguments                                      *)
  3.5765 +            (* string * DatatypeAux.dtyp list ->
  3.5766 +              (Term.term * int list) option *)
  3.5767 +            fun get_constr_args (cname, cargs) =
  3.5768 +              let
  3.5769 +                val cTerm      = Const (cname,
  3.5770 +                  map (typ_of_dtyp descr typ_assoc) cargs ---> Type (s, Ts))
  3.5771 +                val (iC, _, _) = interpret thy (typs, []) {maxvars=0,
  3.5772 +                  def_eq=false, next_idx=1, bounds=[], wellformed=True} cTerm
  3.5773 +                (* interpretation -> int list option *)
  3.5774 +                fun get_args (Leaf xs) =
  3.5775 +                  if find_index_eq True xs = element then
  3.5776 +                    SOME []
  3.5777 +                  else
  3.5778 +                    NONE
  3.5779 +                  | get_args (Node xs) =
  3.5780 +                  let
  3.5781 +                    (* interpretation * int -> int list option *)
  3.5782 +                    fun search ([], _) =
  3.5783 +                      NONE
  3.5784 +                      | search (x::xs, n) =
  3.5785 +                      (case get_args x of
  3.5786 +                        SOME result => SOME (n::result)
  3.5787 +                      | NONE        => search (xs, n+1))
  3.5788 +                  in
  3.5789 +                    search (xs, 0)
  3.5790 +                  end
  3.5791 +              in
  3.5792 +                Option.map (fn args => (cTerm, cargs, args)) (get_args iC)
  3.5793 +              end
  3.5794 +            (* Term.term * DatatypeAux.dtyp list * int list *)
  3.5795 +            val (cTerm, cargs, args) =
  3.5796 +              (case get_first get_constr_args constrs of
  3.5797 +                SOME x => x
  3.5798 +              | NONE   => raise REFUTE ("IDT_printer",
  3.5799 +                "no matching constructor found for element " ^
  3.5800 +                string_of_int element))
  3.5801 +            val argsTerms = map (fn (d, n) =>
  3.5802 +              let
  3.5803 +                val dT        = typ_of_dtyp descr typ_assoc d
  3.5804 +                val (i, _, _) = interpret thy (typs, []) {maxvars=0,
  3.5805 +                  def_eq=false, next_idx=1, bounds=[], wellformed=True}
  3.5806 +                  (Free ("dummy", dT))
  3.5807 +                (* we only need the n-th element of this list, so there   *)
  3.5808 +                (* might be a more efficient implementation that does not *)
  3.5809 +                (* generate all constants                                 *)
  3.5810 +                val consts    = make_constants i
  3.5811 +              in
  3.5812 +                print thy (typs, []) (Free ("dummy", dT))
  3.5813 +                  (List.nth (consts, n)) assignment
  3.5814 +              end) (cargs ~~ args)
  3.5815 +          in
  3.5816 +            SOME (Library.foldl op$ (cTerm, argsTerms))
  3.5817 +          end
  3.5818 +        end
  3.5819 +      | NONE =>  (* not an inductive datatype *)
  3.5820 +        NONE)
  3.5821 +    | _ =>  (* a (free or schematic) type variable *)
  3.5822 +      NONE
  3.5823 +  end;
  3.5824  
  3.5825  
  3.5826  (* ------------------------------------------------------------------------- *)
  3.5827 @@ -3207,31 +3207,31 @@
  3.5828  (*       subterms that are then passed to other interpreters!                *)
  3.5829  (* ------------------------------------------------------------------------- *)
  3.5830  
  3.5831 -	(* (theory -> theory) list *)
  3.5832 +  (* (theory -> theory) list *)
  3.5833  
  3.5834 -	val setup =
  3.5835 -		 RefuteData.init #>
  3.5836 -		 add_interpreter "stlc"    stlc_interpreter #>
  3.5837 -		 add_interpreter "Pure"    Pure_interpreter #>
  3.5838 -		 add_interpreter "HOLogic" HOLogic_interpreter #>
  3.5839 -		 add_interpreter "set"     set_interpreter #>
  3.5840 -		 add_interpreter "IDT"             IDT_interpreter #>
  3.5841 -		 add_interpreter "IDT_constructor" IDT_constructor_interpreter #>
  3.5842 -		 add_interpreter "IDT_recursion"   IDT_recursion_interpreter #>
  3.5843 -		 add_interpreter "Finite_Set.card"    Finite_Set_card_interpreter #>
  3.5844 -		 add_interpreter "Finite_Set.Finites" Finite_Set_Finites_interpreter #>
  3.5845 -		 add_interpreter "Finite_Set.finite"  Finite_Set_finite_interpreter #>
  3.5846 -		 add_interpreter "Nat_Orderings.less" Nat_less_interpreter #>
  3.5847 -		 add_interpreter "Nat_HOL.plus"       Nat_plus_interpreter #>
  3.5848 -		 add_interpreter "Nat_HOL.minus"      Nat_minus_interpreter #>
  3.5849 -		 add_interpreter "Nat_HOL.times"      Nat_times_interpreter #>
  3.5850 -		 add_interpreter "List.op @" List_append_interpreter #>
  3.5851 -		 add_interpreter "Lfp.lfp" Lfp_lfp_interpreter #>
  3.5852 -		 add_interpreter "Gfp.gfp" Gfp_gfp_interpreter #>
  3.5853 -		 add_interpreter "fst" Product_Type_fst_interpreter #>
  3.5854 -		 add_interpreter "snd" Product_Type_snd_interpreter #>
  3.5855 -		 add_printer "stlc" stlc_printer #>
  3.5856 -		 add_printer "set"  set_printer #>
  3.5857 -		 add_printer "IDT"  IDT_printer;
  3.5858 +  val setup =
  3.5859 +     RefuteData.init #>
  3.5860 +     add_interpreter "stlc"    stlc_interpreter #>
  3.5861 +     add_interpreter "Pure"    Pure_interpreter #>
  3.5862 +     add_interpreter "HOLogic" HOLogic_interpreter #>
  3.5863 +     add_interpreter "set"     set_interpreter #>
  3.5864 +     add_interpreter "IDT"             IDT_interpreter #>
  3.5865 +     add_interpreter "IDT_constructor" IDT_constructor_interpreter #>
  3.5866 +     add_interpreter "IDT_recursion"   IDT_recursion_interpreter #>
  3.5867 +     add_interpreter "Finite_Set.card"    Finite_Set_card_interpreter #>
  3.5868 +     add_interpreter "Finite_Set.Finites" Finite_Set_Finites_interpreter #>
  3.5869 +     add_interpreter "Finite_Set.finite"  Finite_Set_finite_interpreter #>
  3.5870 +     add_interpreter "Nat_Orderings.less" Nat_less_interpreter #>
  3.5871 +     add_interpreter "Nat_HOL.plus"       Nat_plus_interpreter #>
  3.5872 +     add_interpreter "Nat_HOL.minus"      Nat_minus_interpreter #>
  3.5873 +     add_interpreter "Nat_HOL.times"      Nat_times_interpreter #>
  3.5874 +     add_interpreter "List.op @" List_append_interpreter #>
  3.5875 +     add_interpreter "Lfp.lfp" Lfp_lfp_interpreter #>
  3.5876 +     add_interpreter "Gfp.gfp" Gfp_gfp_interpreter #>
  3.5877 +     add_interpreter "fst" Product_Type_fst_interpreter #>
  3.5878 +     add_interpreter "snd" Product_Type_snd_interpreter #>
  3.5879 +     add_printer "stlc" stlc_printer #>
  3.5880 +     add_printer "set"  set_printer #>
  3.5881 +     add_printer "IDT"  IDT_printer;
  3.5882  
  3.5883  end  (* structure Refute *)
     4.1 --- a/src/HOL/Tools/sat_solver.ML	Tue Apr 03 19:24:10 2007 +0200
     4.2 +++ b/src/HOL/Tools/sat_solver.ML	Tue Apr 03 19:24:11 2007 +0200
     4.3 @@ -8,47 +8,47 @@
     4.4  
     4.5  signature SAT_SOLVER =
     4.6  sig
     4.7 -	exception NOT_CONFIGURED
     4.8 +  exception NOT_CONFIGURED
     4.9  
    4.10 -	type assignment = int -> bool option
    4.11 -	type proof      = int list Inttab.table * int
    4.12 -	datatype result = SATISFIABLE of assignment
    4.13 -	                | UNSATISFIABLE of proof option
    4.14 -	                | UNKNOWN
    4.15 -	type solver     = PropLogic.prop_formula -> result
    4.16 +  type assignment = int -> bool option
    4.17 +  type proof      = int list Inttab.table * int
    4.18 +  datatype result = SATISFIABLE of assignment
    4.19 +                  | UNSATISFIABLE of proof option
    4.20 +                  | UNKNOWN
    4.21 +  type solver     = PropLogic.prop_formula -> result
    4.22  
    4.23 -	(* auxiliary functions to create external SAT solvers *)
    4.24 -	val write_dimacs_cnf_file : Path.T -> PropLogic.prop_formula -> unit
    4.25 -	val write_dimacs_sat_file : Path.T -> PropLogic.prop_formula -> unit
    4.26 -	val read_std_result_file  : Path.T -> string * string * string -> result
    4.27 -	val make_external_solver  : string -> (PropLogic.prop_formula -> unit) -> (unit -> result) -> solver
    4.28 +  (* auxiliary functions to create external SAT solvers *)
    4.29 +  val write_dimacs_cnf_file : Path.T -> PropLogic.prop_formula -> unit
    4.30 +  val write_dimacs_sat_file : Path.T -> PropLogic.prop_formula -> unit
    4.31 +  val read_std_result_file  : Path.T -> string * string * string -> result
    4.32 +  val make_external_solver  : string -> (PropLogic.prop_formula -> unit) -> (unit -> result) -> solver
    4.33  
    4.34 -	val read_dimacs_cnf_file : Path.T -> PropLogic.prop_formula
    4.35 +  val read_dimacs_cnf_file : Path.T -> PropLogic.prop_formula
    4.36  
    4.37 -	(* generic solver interface *)
    4.38 -	val solvers       : (string * solver) list ref
    4.39 -	val add_solver    : string * solver -> unit
    4.40 -	val invoke_solver : string -> solver  (* exception Option *)
    4.41 +  (* generic solver interface *)
    4.42 +  val solvers       : (string * solver) list ref
    4.43 +  val add_solver    : string * solver -> unit
    4.44 +  val invoke_solver : string -> solver  (* exception Option *)
    4.45  end;
    4.46  
    4.47  structure SatSolver : SAT_SOLVER =
    4.48  struct
    4.49  
    4.50 -	open PropLogic;
    4.51 +  open PropLogic;
    4.52  
    4.53  (* ------------------------------------------------------------------------- *)
    4.54  (* should be raised by an external SAT solver to indicate that the solver is *)
    4.55  (* not configured properly                                                   *)
    4.56  (* ------------------------------------------------------------------------- *)
    4.57  
    4.58 -	exception NOT_CONFIGURED;
    4.59 +  exception NOT_CONFIGURED;
    4.60  
    4.61  (* ------------------------------------------------------------------------- *)
    4.62  (* type of partial (satisfying) assignments: 'a i = NONE' means that 'a' is  *)
    4.63  (*      a satisfying assignment regardless of the value of variable 'i'      *)
    4.64  (* ------------------------------------------------------------------------- *)
    4.65  
    4.66 -	type assignment = int -> bool option;
    4.67 +  type assignment = int -> bool option;
    4.68  
    4.69  (* ------------------------------------------------------------------------- *)
    4.70  (* a proof of unsatisfiability, to be interpreted as follows: each integer   *)
    4.71 @@ -65,7 +65,7 @@
    4.72  (*      but do not need to be consecutive.                                   *)
    4.73  (* ------------------------------------------------------------------------- *)
    4.74  
    4.75 -	type proof = int list Inttab.table * int;
    4.76 +  type proof = int list Inttab.table * int;
    4.77  
    4.78  (* ------------------------------------------------------------------------- *)
    4.79  (* return type of SAT solvers: if the result is 'SATISFIABLE', a satisfying  *)
    4.80 @@ -73,16 +73,16 @@
    4.81  (*      'UNSATISFIABLE', a proof of unsatisfiability may be returned         *)
    4.82  (* ------------------------------------------------------------------------- *)
    4.83  
    4.84 -	datatype result = SATISFIABLE of assignment
    4.85 -	                | UNSATISFIABLE of proof option
    4.86 -	                | UNKNOWN;
    4.87 +  datatype result = SATISFIABLE of assignment
    4.88 +                  | UNSATISFIABLE of proof option
    4.89 +                  | UNKNOWN;
    4.90  
    4.91  (* ------------------------------------------------------------------------- *)
    4.92  (* type of SAT solvers: given a propositional formula, a satisfying          *)
    4.93  (*      assignment may be returned                                           *)
    4.94  (* ------------------------------------------------------------------------- *)
    4.95  
    4.96 -	type solver = prop_formula -> result;
    4.97 +  type solver = prop_formula -> result;
    4.98  
    4.99  (* ------------------------------------------------------------------------- *)
   4.100  (* write_dimacs_cnf_file: serializes a formula 'fm' of propositional logic   *)
   4.101 @@ -92,56 +92,56 @@
   4.102  (* Note: 'fm' must be given in CNF.                                          *)
   4.103  (* ------------------------------------------------------------------------- *)
   4.104  
   4.105 -	(* Path.T -> prop_formula -> unit *)
   4.106 +  (* Path.T -> prop_formula -> unit *)
   4.107  
   4.108 -	fun write_dimacs_cnf_file path fm =
   4.109 -	let
   4.110 -		(* prop_formula -> prop_formula *)
   4.111 -		fun cnf_True_False_elim True =
   4.112 -			Or (BoolVar 1, Not (BoolVar 1))
   4.113 -		  | cnf_True_False_elim False =
   4.114 -			And (BoolVar 1, Not (BoolVar 1))
   4.115 -		  | cnf_True_False_elim fm =
   4.116 -			fm  (* since 'fm' is in CNF, either 'fm'='True'/'False', or 'fm' does not contain 'True'/'False' at all *)
   4.117 -		(* prop_formula -> int *)
   4.118 -		fun cnf_number_of_clauses (And (fm1,fm2)) =
   4.119 -			(cnf_number_of_clauses fm1) + (cnf_number_of_clauses fm2)
   4.120 -		  | cnf_number_of_clauses _ =
   4.121 -			1
   4.122 -		(* prop_formula -> string list *)
   4.123 -		fun cnf_string fm =
   4.124 -		let
   4.125 -			(* prop_formula -> string list -> string list *)
   4.126 -			fun cnf_string_acc True acc =
   4.127 -				error "formula is not in CNF"
   4.128 -			  | cnf_string_acc False acc =
   4.129 -				error "formula is not in CNF"
   4.130 -			  | cnf_string_acc (BoolVar i) acc =
   4.131 -				(assert (i>=1) "formula contains a variable index less than 1";
   4.132 -				string_of_int i :: acc)
   4.133 -			  | cnf_string_acc (Not (BoolVar i)) acc =
   4.134 -				"-" :: cnf_string_acc (BoolVar i) acc
   4.135 -			  | cnf_string_acc (Not _) acc =
   4.136 -				error "formula is not in CNF"
   4.137 -			  | cnf_string_acc (Or (fm1,fm2)) acc =
   4.138 -				cnf_string_acc fm1 (" " :: cnf_string_acc fm2 acc)
   4.139 -			  | cnf_string_acc (And (fm1,fm2)) acc =
   4.140 -				cnf_string_acc fm1 (" 0\n" :: cnf_string_acc fm2 acc)
   4.141 -		in
   4.142 -			cnf_string_acc fm []
   4.143 -		end
   4.144 -		val fm'               = cnf_True_False_elim fm
   4.145 -		val number_of_vars    = maxidx fm'
   4.146 -		val number_of_clauses = cnf_number_of_clauses fm'
   4.147 -	in
   4.148 -		File.write path
   4.149 -			("c This file was generated by SatSolver.write_dimacs_cnf_file\n" ^
   4.150 -			 "p cnf " ^ string_of_int number_of_vars ^ " " ^ string_of_int number_of_clauses ^ "\n");
   4.151 -		File.append_list path
   4.152 -			(cnf_string fm');
   4.153 -		File.append path
   4.154 -			" 0\n"
   4.155 -	end;
   4.156 +  fun write_dimacs_cnf_file path fm =
   4.157 +  let
   4.158 +    (* prop_formula -> prop_formula *)
   4.159 +    fun cnf_True_False_elim True =
   4.160 +      Or (BoolVar 1, Not (BoolVar 1))
   4.161 +      | cnf_True_False_elim False =
   4.162 +      And (BoolVar 1, Not (BoolVar 1))
   4.163 +      | cnf_True_False_elim fm =
   4.164 +      fm  (* since 'fm' is in CNF, either 'fm'='True'/'False', or 'fm' does not contain 'True'/'False' at all *)
   4.165 +    (* prop_formula -> int *)
   4.166 +    fun cnf_number_of_clauses (And (fm1,fm2)) =
   4.167 +      (cnf_number_of_clauses fm1) + (cnf_number_of_clauses fm2)
   4.168 +      | cnf_number_of_clauses _ =
   4.169 +      1
   4.170 +    (* prop_formula -> string list *)
   4.171 +    fun cnf_string fm =
   4.172 +    let
   4.173 +      (* prop_formula -> string list -> string list *)
   4.174 +      fun cnf_string_acc True acc =
   4.175 +        error "formula is not in CNF"
   4.176 +        | cnf_string_acc False acc =
   4.177 +        error "formula is not in CNF"
   4.178 +        | cnf_string_acc (BoolVar i) acc =
   4.179 +        (i>=1 orelse error "formula contains a variable index less than 1";
   4.180 +        string_of_int i :: acc)
   4.181 +        | cnf_string_acc (Not (BoolVar i)) acc =
   4.182 +        "-" :: cnf_string_acc (BoolVar i) acc
   4.183 +        | cnf_string_acc (Not _) acc =
   4.184 +        error "formula is not in CNF"
   4.185 +        | cnf_string_acc (Or (fm1,fm2)) acc =
   4.186 +        cnf_string_acc fm1 (" " :: cnf_string_acc fm2 acc)
   4.187 +        | cnf_string_acc (And (fm1,fm2)) acc =
   4.188 +        cnf_string_acc fm1 (" 0\n" :: cnf_string_acc fm2 acc)
   4.189 +    in
   4.190 +      cnf_string_acc fm []
   4.191 +    end
   4.192 +    val fm'               = cnf_True_False_elim fm
   4.193 +    val number_of_vars    = maxidx fm'
   4.194 +    val number_of_clauses = cnf_number_of_clauses fm'
   4.195 +  in
   4.196 +    File.write path
   4.197 +      ("c This file was generated by SatSolver.write_dimacs_cnf_file\n" ^
   4.198 +       "p cnf " ^ string_of_int number_of_vars ^ " " ^ string_of_int number_of_clauses ^ "\n");
   4.199 +    File.append_list path
   4.200 +      (cnf_string fm');
   4.201 +    File.append path
   4.202 +      " 0\n"
   4.203 +  end;
   4.204  
   4.205  (* ------------------------------------------------------------------------- *)
   4.206  (* write_dimacs_sat_file: serializes a formula 'fm' of propositional logic   *)
   4.207 @@ -150,54 +150,54 @@
   4.208  (* Note: 'fm' must not contain a variable index less than 1.                 *)
   4.209  (* ------------------------------------------------------------------------- *)
   4.210  
   4.211 -	(* Path.T -> prop_formula -> unit *)
   4.212 +  (* Path.T -> prop_formula -> unit *)
   4.213  
   4.214 -	fun write_dimacs_sat_file path fm =
   4.215 -	let
   4.216 -		(* prop_formula -> string list *)
   4.217 -		fun sat_string fm =
   4.218 -		let
   4.219 -			(* prop_formula -> string list -> string list *)
   4.220 -			fun sat_string_acc True acc =
   4.221 -				"*()" :: acc
   4.222 -			  | sat_string_acc False acc =
   4.223 -				"+()" :: acc
   4.224 -			  | sat_string_acc (BoolVar i) acc =
   4.225 -				(assert (i>=1) "formula contains a variable index less than 1";
   4.226 -				string_of_int i :: acc)
   4.227 -			  | sat_string_acc (Not (BoolVar i)) acc =
   4.228 -				"-" :: sat_string_acc (BoolVar i) acc
   4.229 -			  | sat_string_acc (Not fm) acc =
   4.230 -				"-(" :: sat_string_acc fm (")" :: acc)
   4.231 -			  | sat_string_acc (Or (fm1,fm2)) acc =
   4.232 -				"+(" :: sat_string_acc_or fm1 (" " :: sat_string_acc_or fm2 (")" :: acc))
   4.233 -			  | sat_string_acc (And (fm1,fm2)) acc =
   4.234 -				"*(" :: sat_string_acc_and fm1 (" " :: sat_string_acc_and fm2 (")" :: acc))
   4.235 -			(* optimization to make use of n-ary disjunction/conjunction *)
   4.236 -			(* prop_formula -> string list -> string list *)
   4.237 -			and sat_string_acc_or (Or (fm1,fm2)) acc =
   4.238 -				sat_string_acc_or fm1 (" " :: sat_string_acc_or fm2 acc)
   4.239 -			  | sat_string_acc_or fm acc =
   4.240 -				sat_string_acc fm acc
   4.241 -			(* prop_formula -> string list -> string list *)
   4.242 -			and sat_string_acc_and (And (fm1,fm2)) acc =
   4.243 -				sat_string_acc_and fm1 (" " :: sat_string_acc_and fm2 acc)
   4.244 -			  | sat_string_acc_and fm acc =
   4.245 -				sat_string_acc fm acc
   4.246 -		in
   4.247 -			sat_string_acc fm []
   4.248 -		end
   4.249 -		val number_of_vars = Int.max (maxidx fm, 1)
   4.250 -	in
   4.251 -		File.write path
   4.252 -			("c This file was generated by SatSolver.write_dimacs_sat_file\n" ^
   4.253 -			 "p sat " ^ string_of_int number_of_vars ^ "\n" ^
   4.254 -			 "(");
   4.255 -		File.append_list path
   4.256 -			(sat_string fm);
   4.257 -		File.append path
   4.258 -			")\n"
   4.259 -	end;
   4.260 +  fun write_dimacs_sat_file path fm =
   4.261 +  let
   4.262 +    (* prop_formula -> string list *)
   4.263 +    fun sat_string fm =
   4.264 +    let
   4.265 +      (* prop_formula -> string list -> string list *)
   4.266 +      fun sat_string_acc True acc =
   4.267 +        "*()" :: acc
   4.268 +        | sat_string_acc False acc =
   4.269 +        "+()" :: acc
   4.270 +        | sat_string_acc (BoolVar i) acc =
   4.271 +        (i>=1 orelse error "formula contains a variable index less than 1";
   4.272 +        string_of_int i :: acc)
   4.273 +        | sat_string_acc (Not (BoolVar i)) acc =
   4.274 +        "-" :: sat_string_acc (BoolVar i) acc
   4.275 +        | sat_string_acc (Not fm) acc =
   4.276 +        "-(" :: sat_string_acc fm (")" :: acc)
   4.277 +        | sat_string_acc (Or (fm1,fm2)) acc =
   4.278 +        "+(" :: sat_string_acc_or fm1 (" " :: sat_string_acc_or fm2 (")" :: acc))
   4.279 +        | sat_string_acc (And (fm1,fm2)) acc =
   4.280 +        "*(" :: sat_string_acc_and fm1 (" " :: sat_string_acc_and fm2 (")" :: acc))
   4.281 +      (* optimization to make use of n-ary disjunction/conjunction *)
   4.282 +      (* prop_formula -> string list -> string list *)
   4.283 +      and sat_string_acc_or (Or (fm1,fm2)) acc =
   4.284 +        sat_string_acc_or fm1 (" " :: sat_string_acc_or fm2 acc)
   4.285 +        | sat_string_acc_or fm acc =
   4.286 +        sat_string_acc fm acc
   4.287 +      (* prop_formula -> string list -> string list *)
   4.288 +      and sat_string_acc_and (And (fm1,fm2)) acc =
   4.289 +        sat_string_acc_and fm1 (" " :: sat_string_acc_and fm2 acc)
   4.290 +        | sat_string_acc_and fm acc =
   4.291 +        sat_string_acc fm acc
   4.292 +    in
   4.293 +      sat_string_acc fm []
   4.294 +    end
   4.295 +    val number_of_vars = Int.max (maxidx fm, 1)
   4.296 +  in
   4.297 +    File.write path
   4.298 +      ("c This file was generated by SatSolver.write_dimacs_sat_file\n" ^
   4.299 +       "p sat " ^ string_of_int number_of_vars ^ "\n" ^
   4.300 +       "(");
   4.301 +    File.append_list path
   4.302 +      (sat_string fm);
   4.303 +    File.append path
   4.304 +      ")\n"
   4.305 +  end;
   4.306  
   4.307  (* ------------------------------------------------------------------------- *)
   4.308  (* read_std_result_file: scans a SAT solver's output file for a satisfying   *)
   4.309 @@ -213,149 +213,149 @@
   4.310  (*      value of i is taken to be unspecified.                               *)
   4.311  (* ------------------------------------------------------------------------- *)
   4.312  
   4.313 -	(* Path.T -> string * string * string -> result *)
   4.314 +  (* Path.T -> string * string * string -> result *)
   4.315  
   4.316 -	fun read_std_result_file path (satisfiable, assignment_prefix, unsatisfiable) =
   4.317 -	let
   4.318 -		(* string -> int list *)
   4.319 -		fun int_list_from_string s =
   4.320 -			List.mapPartial Int.fromString (space_explode " " s)
   4.321 -		(* int list -> assignment *)
   4.322 -		fun assignment_from_list [] i =
   4.323 -			NONE  (* the SAT solver didn't provide a value for this variable *)
   4.324 -		  | assignment_from_list (x::xs) i =
   4.325 -			if x=i then (SOME true)
   4.326 -			else if x=(~i) then (SOME false)
   4.327 -			else assignment_from_list xs i
   4.328 -		(* int list -> string list -> assignment *)
   4.329 -		fun parse_assignment xs [] =
   4.330 -			assignment_from_list xs
   4.331 -		  | parse_assignment xs (line::lines) =
   4.332 -			if String.isPrefix assignment_prefix line then
   4.333 -				parse_assignment (xs @ int_list_from_string line) lines
   4.334 -			else
   4.335 -				assignment_from_list xs
   4.336 -		(* string -> string -> bool *)
   4.337 -		fun is_substring needle haystack =
   4.338 -		let
   4.339 -			val length1 = String.size needle
   4.340 -			val length2 = String.size haystack
   4.341 -		in
   4.342 -			if length2 < length1 then
   4.343 -				false
   4.344 -			else if needle = String.substring (haystack, 0, length1) then
   4.345 -				true
   4.346 -			else is_substring needle (String.substring (haystack, 1, length2-1))
   4.347 -		end
   4.348 -		(* string list -> result *)
   4.349 -		fun parse_lines [] =
   4.350 -			UNKNOWN
   4.351 -		  | parse_lines (line::lines) =
   4.352 -			if is_substring unsatisfiable line then
   4.353 -				UNSATISFIABLE NONE
   4.354 -			else if is_substring satisfiable line then
   4.355 -				SATISFIABLE (parse_assignment [] lines)
   4.356 -			else
   4.357 -				parse_lines lines
   4.358 -	in
   4.359 -		(parse_lines o (List.filter (fn l => l <> "")) o split_lines o File.read) path
   4.360 -	end;
   4.361 +  fun read_std_result_file path (satisfiable, assignment_prefix, unsatisfiable) =
   4.362 +  let
   4.363 +    (* string -> int list *)
   4.364 +    fun int_list_from_string s =
   4.365 +      List.mapPartial Int.fromString (space_explode " " s)
   4.366 +    (* int list -> assignment *)
   4.367 +    fun assignment_from_list [] i =
   4.368 +      NONE  (* the SAT solver didn't provide a value for this variable *)
   4.369 +      | assignment_from_list (x::xs) i =
   4.370 +      if x=i then (SOME true)
   4.371 +      else if x=(~i) then (SOME false)
   4.372 +      else assignment_from_list xs i
   4.373 +    (* int list -> string list -> assignment *)
   4.374 +    fun parse_assignment xs [] =
   4.375 +      assignment_from_list xs
   4.376 +      | parse_assignment xs (line::lines) =
   4.377 +      if String.isPrefix assignment_prefix line then
   4.378 +        parse_assignment (xs @ int_list_from_string line) lines
   4.379 +      else
   4.380 +        assignment_from_list xs
   4.381 +    (* string -> string -> bool *)
   4.382 +    fun is_substring needle haystack =
   4.383 +    let
   4.384 +      val length1 = String.size needle
   4.385 +      val length2 = String.size haystack
   4.386 +    in
   4.387 +      if length2 < length1 then
   4.388 +        false
   4.389 +      else if needle = String.substring (haystack, 0, length1) then
   4.390 +        true
   4.391 +      else is_substring needle (String.substring (haystack, 1, length2-1))
   4.392 +    end
   4.393 +    (* string list -> result *)
   4.394 +    fun parse_lines [] =
   4.395 +      UNKNOWN
   4.396 +      | parse_lines (line::lines) =
   4.397 +      if is_substring unsatisfiable line then
   4.398 +        UNSATISFIABLE NONE
   4.399 +      else if is_substring satisfiable line then
   4.400 +        SATISFIABLE (parse_assignment [] lines)
   4.401 +      else
   4.402 +        parse_lines lines
   4.403 +  in
   4.404 +    (parse_lines o (List.filter (fn l => l <> "")) o split_lines o File.read) path
   4.405 +  end;
   4.406  
   4.407  (* ------------------------------------------------------------------------- *)
   4.408  (* make_external_solver: call 'writefn', execute 'cmd', call 'readfn'        *)
   4.409  (* ------------------------------------------------------------------------- *)
   4.410  
   4.411 -	(* string -> (PropLogic.prop_formula -> unit) -> (unit -> result) -> solver *)
   4.412 +  (* string -> (PropLogic.prop_formula -> unit) -> (unit -> result) -> solver *)
   4.413  
   4.414 -	fun make_external_solver cmd writefn readfn fm =
   4.415 -		(writefn fm; system cmd; readfn ());
   4.416 +  fun make_external_solver cmd writefn readfn fm =
   4.417 +    (writefn fm; system cmd; readfn ());
   4.418  
   4.419  (* ------------------------------------------------------------------------- *)
   4.420  (* read_dimacs_cnf_file: returns a propositional formula that corresponds to *)
   4.421  (*      a SAT problem given in DIMACS CNF format                             *)
   4.422  (* ------------------------------------------------------------------------- *)
   4.423  
   4.424 -	(* Path.T -> PropLogic.prop_formula *)
   4.425 +  (* Path.T -> PropLogic.prop_formula *)
   4.426  
   4.427 -	fun read_dimacs_cnf_file path =
   4.428 -	let
   4.429 -		(* string list -> string list *)
   4.430 -		fun filter_preamble [] =
   4.431 -			error "problem line not found in DIMACS CNF file"
   4.432 -		  | filter_preamble (line::lines) =
   4.433 -			if String.isPrefix "c " line orelse line = "c" then
   4.434 -				(* ignore comments *)
   4.435 -				filter_preamble lines
   4.436 -			else if String.isPrefix "p " line then
   4.437 -				(* ignore the problem line (which must be the last line of the preamble) *)
   4.438 -				(* Ignoring the problem line implies that if the file contains more clauses *)
   4.439 -				(* or variables than specified in its preamble, we will accept it anyway.   *)
   4.440 -				lines
   4.441 -			else
   4.442 -				error "preamble in DIMACS CNF file contains a line that does not begin with \"c \" or \"p \""
   4.443 -		(* string -> int *)
   4.444 -		fun int_from_string s =
   4.445 -			case Int.fromString s of
   4.446 -			  SOME i => i
   4.447 -			| NONE   => error ("token " ^ quote s ^ "in DIMACS CNF file is not a number")
   4.448 -		(* int list -> int list list *)
   4.449 -		fun clauses xs =
   4.450 -			let
   4.451 -				val (xs1, xs2) = take_prefix (fn i => i <> 0) xs
   4.452 -			in
   4.453 -				case xs2 of
   4.454 -				  []      => [xs1]
   4.455 -				| (0::[]) => [xs1]
   4.456 -				| (0::tl) => xs1 :: clauses tl
   4.457 -				| _       => sys_error "this cannot happen"
   4.458 -			end
   4.459 -		(* int -> PropLogic.prop_formula *)
   4.460 -		fun literal_from_int i =
   4.461 -			(assert (i<>0) "variable index in DIMACS CNF file is 0";
   4.462 -			if i>0 then
   4.463 -				PropLogic.BoolVar i
   4.464 -			else
   4.465 -				PropLogic.Not (PropLogic.BoolVar (~i)))
   4.466 -		(* PropLogic.prop_formula list -> PropLogic.prop_formula *)
   4.467 -		fun disjunction [] =
   4.468 -			error "empty clause in DIMACS CNF file"
   4.469 -		  | disjunction (x::xs) =
   4.470 -			(case xs of
   4.471 -			  [] => x
   4.472 -			| _  => PropLogic.Or (x, disjunction xs))
   4.473 -		(* PropLogic.prop_formula list -> PropLogic.prop_formula *)
   4.474 -		fun conjunction [] =
   4.475 -			error "no clause in DIMACS CNF file"
   4.476 -		  | conjunction (x::xs) =
   4.477 -			(case xs of
   4.478 -			  [] => x
   4.479 -			| _  => PropLogic.And (x, conjunction xs))
   4.480 -	in
   4.481 -		(conjunction
   4.482 -		o (map disjunction)
   4.483 -		o (map (map literal_from_int))
   4.484 -		o clauses
   4.485 -		o (map int_from_string)
   4.486 -		o List.concat
   4.487 -		o (map (String.fields (fn c => c mem [#" ", #"\t", #"\n"])))
   4.488 -		o filter_preamble
   4.489 -		o (List.filter (fn l => l <> ""))
   4.490 -		o split_lines
   4.491 -		o File.read)
   4.492 -			path
   4.493 -	end;
   4.494 +  fun read_dimacs_cnf_file path =
   4.495 +  let
   4.496 +    (* string list -> string list *)
   4.497 +    fun filter_preamble [] =
   4.498 +      error "problem line not found in DIMACS CNF file"
   4.499 +      | filter_preamble (line::lines) =
   4.500 +      if String.isPrefix "c " line orelse line = "c" then
   4.501 +        (* ignore comments *)
   4.502 +        filter_preamble lines
   4.503 +      else if String.isPrefix "p " line then
   4.504 +        (* ignore the problem line (which must be the last line of the preamble) *)
   4.505 +        (* Ignoring the problem line implies that if the file contains more clauses *)
   4.506 +        (* or variables than specified in its preamble, we will accept it anyway.   *)
   4.507 +        lines
   4.508 +      else
   4.509 +        error "preamble in DIMACS CNF file contains a line that does not begin with \"c \" or \"p \""
   4.510 +    (* string -> int *)
   4.511 +    fun int_from_string s =
   4.512 +      case Int.fromString s of
   4.513 +        SOME i => i
   4.514 +      | NONE   => error ("token " ^ quote s ^ "in DIMACS CNF file is not a number")
   4.515 +    (* int list -> int list list *)
   4.516 +    fun clauses xs =
   4.517 +      let
   4.518 +        val (xs1, xs2) = take_prefix (fn i => i <> 0) xs
   4.519 +      in
   4.520 +        case xs2 of
   4.521 +          []      => [xs1]
   4.522 +        | (0::[]) => [xs1]
   4.523 +        | (0::tl) => xs1 :: clauses tl
   4.524 +        | _       => sys_error "this cannot happen"
   4.525 +      end
   4.526 +    (* int -> PropLogic.prop_formula *)
   4.527 +    fun literal_from_int i =
   4.528 +      (i<>0 orelse error "variable index in DIMACS CNF file is 0";
   4.529 +      if i>0 then
   4.530 +        PropLogic.BoolVar i
   4.531 +      else
   4.532 +        PropLogic.Not (PropLogic.BoolVar (~i)))
   4.533 +    (* PropLogic.prop_formula list -> PropLogic.prop_formula *)
   4.534 +    fun disjunction [] =
   4.535 +      error "empty clause in DIMACS CNF file"
   4.536 +      | disjunction (x::xs) =
   4.537 +      (case xs of
   4.538 +        [] => x
   4.539 +      | _  => PropLogic.Or (x, disjunction xs))
   4.540 +    (* PropLogic.prop_formula list -> PropLogic.prop_formula *)
   4.541 +    fun conjunction [] =
   4.542 +      error "no clause in DIMACS CNF file"
   4.543 +      | conjunction (x::xs) =
   4.544 +      (case xs of
   4.545 +        [] => x
   4.546 +      | _  => PropLogic.And (x, conjunction xs))
   4.547 +  in
   4.548 +    (conjunction
   4.549 +    o (map disjunction)
   4.550 +    o (map (map literal_from_int))
   4.551 +    o clauses
   4.552 +    o (map int_from_string)
   4.553 +    o List.concat
   4.554 +    o (map (String.fields (fn c => c mem [#" ", #"\t", #"\n"])))
   4.555 +    o filter_preamble
   4.556 +    o (List.filter (fn l => l <> ""))
   4.557 +    o split_lines
   4.558 +    o File.read)
   4.559 +      path
   4.560 +  end;
   4.561  
   4.562  (* ------------------------------------------------------------------------- *)
   4.563  (* solvers: a (reference to a) table of all registered SAT solvers           *)
   4.564  (* ------------------------------------------------------------------------- *)
   4.565  
   4.566 -	val solvers = ref ([] : (string * solver) list);
   4.567 +  val solvers = ref ([] : (string * solver) list);
   4.568  
   4.569  (* ------------------------------------------------------------------------- *)
   4.570  (* add_solver: updates 'solvers' by adding a new solver                      *)
   4.571  (* ------------------------------------------------------------------------- *)
   4.572  
   4.573 -	(* string * solver -> unit *)
   4.574 +  (* string * solver -> unit *)
   4.575  
   4.576      fun add_solver (name, new_solver) =
   4.577        let
   4.578 @@ -371,10 +371,10 @@
   4.579  (*       raised.                                                             *)
   4.580  (* ------------------------------------------------------------------------- *)
   4.581  
   4.582 -	(* string -> solver *)
   4.583 +  (* string -> solver *)
   4.584  
   4.585 -	fun invoke_solver name =
   4.586 -		(the o AList.lookup (op =) (!solvers)) name;
   4.587 +  fun invoke_solver name =
   4.588 +    (the o AList.lookup (op =) (!solvers)) name;
   4.589  
   4.590  end;  (* SatSolver *)
   4.591  
   4.592 @@ -389,40 +389,40 @@
   4.593  (* ------------------------------------------------------------------------- *)
   4.594  
   4.595  let
   4.596 -	fun enum_solver fm =
   4.597 -	let
   4.598 -		(* int list *)
   4.599 -		val indices = PropLogic.indices fm
   4.600 -		(* int list -> int list -> int list option *)
   4.601 -		(* binary increment: list 'xs' of current bits, list 'ys' of all bits (lower bits first) *)
   4.602 -		fun next_list _ ([]:int list) =
   4.603 -			NONE
   4.604 -		  | next_list [] (y::ys) =
   4.605 -			SOME [y]
   4.606 -		  | next_list (x::xs) (y::ys) =
   4.607 -			if x=y then
   4.608 -				(* reset the bit, continue *)
   4.609 -				next_list xs ys
   4.610 -			else
   4.611 -				(* set the lowest bit that wasn't set before, keep the higher bits *)
   4.612 -				SOME (y::x::xs)
   4.613 -		(* int list -> int -> bool *)
   4.614 -		fun assignment_from_list xs i =
   4.615 -			i mem xs
   4.616 -		(* int list -> SatSolver.result *)
   4.617 -		fun solver_loop xs =
   4.618 -			if PropLogic.eval (assignment_from_list xs) fm then
   4.619 -				SatSolver.SATISFIABLE (SOME o (assignment_from_list xs))
   4.620 -			else
   4.621 -				(case next_list xs indices of
   4.622 -				  SOME xs' => solver_loop xs'
   4.623 -				| NONE     => SatSolver.UNSATISFIABLE NONE)
   4.624 -	in
   4.625 -		(* start with the "first" assignment (all variables are interpreted as 'false') *)
   4.626 -		solver_loop []
   4.627 -	end
   4.628 +  fun enum_solver fm =
   4.629 +  let
   4.630 +    (* int list *)
   4.631 +    val indices = PropLogic.indices fm
   4.632 +    (* int list -> int list -> int list option *)
   4.633 +    (* binary increment: list 'xs' of current bits, list 'ys' of all bits (lower bits first) *)
   4.634 +    fun next_list _ ([]:int list) =
   4.635 +      NONE
   4.636 +      | next_list [] (y::ys) =
   4.637 +      SOME [y]
   4.638 +      | next_list (x::xs) (y::ys) =
   4.639 +      if x=y then
   4.640 +        (* reset the bit, continue *)
   4.641 +        next_list xs ys
   4.642 +      else
   4.643 +        (* set the lowest bit that wasn't set before, keep the higher bits *)
   4.644 +        SOME (y::x::xs)
   4.645 +    (* int list -> int -> bool *)
   4.646 +    fun assignment_from_list xs i =
   4.647 +      i mem xs
   4.648 +    (* int list -> SatSolver.result *)
   4.649 +    fun solver_loop xs =
   4.650 +      if PropLogic.eval (assignment_from_list xs) fm then
   4.651 +        SatSolver.SATISFIABLE (SOME o (assignment_from_list xs))
   4.652 +      else
   4.653 +        (case next_list xs indices of
   4.654 +          SOME xs' => solver_loop xs'
   4.655 +        | NONE     => SatSolver.UNSATISFIABLE NONE)
   4.656 +  in
   4.657 +    (* start with the "first" assignment (all variables are interpreted as 'false') *)
   4.658 +    solver_loop []
   4.659 +  end
   4.660  in
   4.661 -	SatSolver.add_solver ("enumerate", enum_solver)
   4.662 +  SatSolver.add_solver ("enumerate", enum_solver)
   4.663  end;
   4.664  
   4.665  (* ------------------------------------------------------------------------- *)
   4.666 @@ -432,86 +432,86 @@
   4.667  (* ------------------------------------------------------------------------- *)
   4.668  
   4.669  let
   4.670 -	local
   4.671 -		open PropLogic
   4.672 -	in
   4.673 -		fun dpll_solver fm =
   4.674 -		let
   4.675 -			(* We could use 'PropLogic.defcnf fm' instead of 'PropLogic.nnf fm' *)
   4.676 -			(* but that sometimes leads to worse performance due to the         *)
   4.677 -			(* introduction of additional variables.                            *)
   4.678 -			val fm' = PropLogic.nnf fm
   4.679 -			(* int list *)
   4.680 -			val indices = PropLogic.indices fm'
   4.681 -			(* int list -> int -> prop_formula *)
   4.682 -			fun partial_var_eval []      i = BoolVar i
   4.683 -			  | partial_var_eval (x::xs) i = if x=i then True else if x=(~i) then False else partial_var_eval xs i
   4.684 -			(* int list -> prop_formula -> prop_formula *)
   4.685 -			fun partial_eval xs True             = True
   4.686 -			  | partial_eval xs False            = False
   4.687 -			  | partial_eval xs (BoolVar i)      = partial_var_eval xs i
   4.688 -			  | partial_eval xs (Not fm)         = SNot (partial_eval xs fm)
   4.689 -			  | partial_eval xs (Or (fm1, fm2))  = SOr (partial_eval xs fm1, partial_eval xs fm2)
   4.690 -			  | partial_eval xs (And (fm1, fm2)) = SAnd (partial_eval xs fm1, partial_eval xs fm2)
   4.691 -			(* prop_formula -> int list *)
   4.692 -			fun forced_vars True              = []
   4.693 -			  | forced_vars False             = []
   4.694 -			  | forced_vars (BoolVar i)       = [i]
   4.695 -			  | forced_vars (Not (BoolVar i)) = [~i]
   4.696 -			  | forced_vars (Or (fm1, fm2))   = (forced_vars fm1) inter_int (forced_vars fm2)
   4.697 -			  | forced_vars (And (fm1, fm2))  = (forced_vars fm1) union_int (forced_vars fm2)
   4.698 -			  (* Above, i *and* ~i may be forced.  In this case the first occurrence takes   *)
   4.699 -			  (* precedence, and the next partial evaluation of the formula returns 'False'. *)
   4.700 -			  | forced_vars _                 = error "formula is not in negation normal form"
   4.701 -			(* int list -> prop_formula -> (int list * prop_formula) *)
   4.702 -			fun eval_and_force xs fm =
   4.703 -			let
   4.704 -				val fm' = partial_eval xs fm
   4.705 -				val xs' = forced_vars fm'
   4.706 -			in
   4.707 -				if null xs' then
   4.708 -					(xs, fm')
   4.709 -				else
   4.710 -					eval_and_force (xs@xs') fm'  (* xs and xs' should be distinct, so '@' here should have *)
   4.711 -					                             (* the same effect as 'union_int'                         *)
   4.712 -			end
   4.713 -			(* int list -> int option *)
   4.714 -			fun fresh_var xs =
   4.715 -				Library.find_first (fn i => not (i mem_int xs) andalso not ((~i) mem_int xs)) indices
   4.716 -			(* int list -> prop_formula -> int list option *)
   4.717 -			(* partial assignment 'xs' *)
   4.718 -			fun dpll xs fm =
   4.719 -			let
   4.720 -				val (xs', fm') = eval_and_force xs fm
   4.721 -			in
   4.722 -				case fm' of
   4.723 -				  True  => SOME xs'
   4.724 -				| False => NONE
   4.725 -				| _     =>
   4.726 -					let
   4.727 -						val x = valOf (fresh_var xs')  (* a fresh variable must exist since 'fm' did not evaluate to 'True'/'False' *)
   4.728 -					in
   4.729 -						case dpll (x::xs') fm' of  (* passing fm' rather than fm should save some simplification work *)
   4.730 -						  SOME xs'' => SOME xs''
   4.731 -						| NONE      => dpll ((~x)::xs') fm'  (* now try interpreting 'x' as 'False' *)
   4.732 -					end
   4.733 -			end
   4.734 -			(* int list -> assignment *)
   4.735 -			fun assignment_from_list [] i =
   4.736 -				NONE  (* the DPLL procedure didn't provide a value for this variable *)
   4.737 -			  | assignment_from_list (x::xs) i =
   4.738 -				if x=i then (SOME true)
   4.739 -				else if x=(~i) then (SOME false)
   4.740 -				else assignment_from_list xs i
   4.741 -		in
   4.742 -			(* initially, no variable is interpreted yet *)
   4.743 -			case dpll [] fm' of
   4.744 -			  SOME assignment => SatSolver.SATISFIABLE (assignment_from_list assignment)
   4.745 -			| NONE            => SatSolver.UNSATISFIABLE NONE
   4.746 -		end
   4.747 -	end  (* local *)
   4.748 +  local
   4.749 +    open PropLogic
   4.750 +  in
   4.751 +    fun dpll_solver fm =
   4.752 +    let
   4.753 +      (* We could use 'PropLogic.defcnf fm' instead of 'PropLogic.nnf fm' *)
   4.754 +      (* but that sometimes leads to worse performance due to the         *)
   4.755 +      (* introduction of additional variables.                            *)
   4.756 +      val fm' = PropLogic.nnf fm
   4.757 +      (* int list *)
   4.758 +      val indices = PropLogic.indices fm'
   4.759 +      (* int list -> int -> prop_formula *)
   4.760 +      fun partial_var_eval []      i = BoolVar i
   4.761 +        | partial_var_eval (x::xs) i = if x=i then True else if x=(~i) then False else partial_var_eval xs i
   4.762 +      (* int list -> prop_formula -> prop_formula *)
   4.763 +      fun partial_eval xs True             = True
   4.764 +        | partial_eval xs False            = False
   4.765 +        | partial_eval xs (BoolVar i)      = partial_var_eval xs i
   4.766 +        | partial_eval xs (Not fm)         = SNot (partial_eval xs fm)
   4.767 +        | partial_eval xs (Or (fm1, fm2))  = SOr (partial_eval xs fm1, partial_eval xs fm2)
   4.768 +        | partial_eval xs (And (fm1, fm2)) = SAnd (partial_eval xs fm1, partial_eval xs fm2)
   4.769 +      (* prop_formula -> int list *)
   4.770 +      fun forced_vars True              = []
   4.771 +        | forced_vars False             = []
   4.772 +        | forced_vars (BoolVar i)       = [i]
   4.773 +        | forced_vars (Not (BoolVar i)) = [~i]
   4.774 +        | forced_vars (Or (fm1, fm2))   = (forced_vars fm1) inter_int (forced_vars fm2)
   4.775 +        | forced_vars (And (fm1, fm2))  = (forced_vars fm1) union_int (forced_vars fm2)
   4.776 +        (* Above, i *and* ~i may be forced.  In this case the first occurrence takes   *)
   4.777 +        (* precedence, and the next partial evaluation of the formula returns 'False'. *)
   4.778 +        | forced_vars _                 = error "formula is not in negation normal form"
   4.779 +      (* int list -> prop_formula -> (int list * prop_formula) *)
   4.780 +      fun eval_and_force xs fm =
   4.781 +      let
   4.782 +        val fm' = partial_eval xs fm
   4.783 +        val xs' = forced_vars fm'
   4.784 +      in
   4.785 +        if null xs' then
   4.786 +          (xs, fm')
   4.787 +        else
   4.788 +          eval_and_force (xs@xs') fm'  (* xs and xs' should be distinct, so '@' here should have *)
   4.789 +                                       (* the same effect as 'union_int'                         *)
   4.790 +      end
   4.791 +      (* int list -> int option *)
   4.792 +      fun fresh_var xs =
   4.793 +        Library.find_first (fn i => not (i mem_int xs) andalso not ((~i) mem_int xs)) indices
   4.794 +      (* int list -> prop_formula -> int list option *)
   4.795 +      (* partial assignment 'xs' *)
   4.796 +      fun dpll xs fm =
   4.797 +      let
   4.798 +        val (xs', fm') = eval_and_force xs fm
   4.799 +      in
   4.800 +        case fm' of
   4.801 +          True  => SOME xs'
   4.802 +        | False => NONE
   4.803 +        | _     =>
   4.804 +          let
   4.805 +            val x = valOf (fresh_var xs')  (* a fresh variable must exist since 'fm' did not evaluate to 'True'/'False' *)
   4.806 +          in
   4.807 +            case dpll (x::xs') fm' of  (* passing fm' rather than fm should save some simplification work *)
   4.808 +              SOME xs'' => SOME xs''
   4.809 +            | NONE      => dpll ((~x)::xs') fm'  (* now try interpreting 'x' as 'False' *)
   4.810 +          end
   4.811 +      end
   4.812 +      (* int list -> assignment *)
   4.813 +      fun assignment_from_list [] i =
   4.814 +        NONE  (* the DPLL procedure didn't provide a value for this variable *)
   4.815 +        | assignment_from_list (x::xs) i =
   4.816 +        if x=i then (SOME true)
   4.817 +        else if x=(~i) then (SOME false)
   4.818 +        else assignment_from_list xs i
   4.819 +    in
   4.820 +      (* initially, no variable is interpreted yet *)
   4.821 +      case dpll [] fm' of
   4.822 +        SOME assignment => SatSolver.SATISFIABLE (assignment_from_list assignment)
   4.823 +      | NONE            => SatSolver.UNSATISFIABLE NONE
   4.824 +    end
   4.825 +  end  (* local *)
   4.826  in
   4.827 -	SatSolver.add_solver ("dpll", dpll_solver)
   4.828 +  SatSolver.add_solver ("dpll", dpll_solver)
   4.829  end;
   4.830  
   4.831  (* ------------------------------------------------------------------------- *)
   4.832 @@ -521,28 +521,28 @@
   4.833  (* ------------------------------------------------------------------------- *)
   4.834  
   4.835  let
   4.836 -	fun auto_solver fm =
   4.837 -	let
   4.838 -		fun loop [] =
   4.839 -			SatSolver.UNKNOWN
   4.840 -		  | loop ((name, solver)::solvers) =
   4.841 -			if name="auto" then
   4.842 -				(* do not call solver "auto" from within "auto" *)
   4.843 -				loop solvers
   4.844 -			else (
   4.845 -				(if name="dpll" orelse name="enumerate" then
   4.846 -					warning ("Using SAT solver " ^ quote name ^ "; for better performance, consider using an external solver.")
   4.847 -				else
   4.848 -					tracing ("Using SAT solver " ^ quote name ^ "."));
   4.849 -				(* apply 'solver' to 'fm' *)
   4.850 -				solver fm
   4.851 -					handle SatSolver.NOT_CONFIGURED => loop solvers
   4.852 -			)
   4.853 -	in
   4.854 -		loop (!SatSolver.solvers)
   4.855 -	end
   4.856 +  fun auto_solver fm =
   4.857 +  let
   4.858 +    fun loop [] =
   4.859 +      SatSolver.UNKNOWN
   4.860 +      | loop ((name, solver)::solvers) =
   4.861 +      if name="auto" then
   4.862 +        (* do not call solver "auto" from within "auto" *)
   4.863 +        loop solvers
   4.864 +      else (
   4.865 +        (if name="dpll" orelse name="enumerate" then
   4.866 +          warning ("Using SAT solver " ^ quote name ^ "; for better performance, consider using an external solver.")
   4.867 +        else
   4.868 +          tracing ("Using SAT solver " ^ quote name ^ "."));
   4.869 +        (* apply 'solver' to 'fm' *)
   4.870 +        solver fm
   4.871 +          handle SatSolver.NOT_CONFIGURED => loop solvers
   4.872 +      )
   4.873 +  in
   4.874 +    loop (!SatSolver.solvers)
   4.875 +  end
   4.876  in
   4.877 -	SatSolver.add_solver ("auto", auto_solver)
   4.878 +  SatSolver.add_solver ("auto", auto_solver)
   4.879  end;
   4.880  
   4.881  (* ------------------------------------------------------------------------- *)
   4.882 @@ -565,210 +565,210 @@
   4.883  (* from 0 to n-1 (where n is the number of clauses in the formula).          *)
   4.884  
   4.885  let
   4.886 -	exception INVALID_PROOF of string
   4.887 -	fun minisat_with_proofs fm =
   4.888 -	let
   4.889 -		val _          = if (getenv "MINISAT_HOME") = "" then raise SatSolver.NOT_CONFIGURED else ()
   4.890 -		val inpath     = File.tmp_path (Path.explode "isabelle.cnf")
   4.891 -		val outpath    = File.tmp_path (Path.explode "result")
   4.892 -		val proofpath  = File.tmp_path (Path.explode "result.prf")
   4.893 -		val cmd        = (getenv "MINISAT_HOME") ^ "/minisat " ^ (Path.implode inpath) ^ " -r " ^ (Path.implode outpath) ^ " -t " ^ (Path.implode proofpath) ^ "> /dev/null"
   4.894 -		fun writefn fm = SatSolver.write_dimacs_cnf_file inpath fm
   4.895 -		fun readfn ()  = SatSolver.read_std_result_file outpath ("SAT", "", "UNSAT")
   4.896 -		val _          = if File.exists inpath then warning ("overwriting existing file " ^ quote (Path.implode inpath)) else ()
   4.897 -		val _          = if File.exists outpath then warning ("overwriting existing file " ^ quote (Path.implode outpath)) else ()
   4.898 -		val cnf        = PropLogic.defcnf fm
   4.899 -		val result     = SatSolver.make_external_solver cmd writefn readfn cnf
   4.900 -		val _          = try File.rm inpath
   4.901 -		val _          = try File.rm outpath
   4.902 -	in  case result of
   4.903 -	  SatSolver.UNSATISFIABLE NONE =>
   4.904 -		(let
   4.905 -			(* string list *)
   4.906 -			val proof_lines = (split_lines o File.read) proofpath
   4.907 -				handle IO.Io _ => raise INVALID_PROOF "Could not read file \"result.prf\""
   4.908 -			(* representation of clauses as ordered lists of literals (with duplicates removed) *)
   4.909 -			(* prop_formula -> int list *)
   4.910 -			fun clause_to_lit_list (PropLogic.Or (fm1, fm2)) =
   4.911 -				OrdList.union int_ord (clause_to_lit_list fm1) (clause_to_lit_list fm2)
   4.912 -			  | clause_to_lit_list (PropLogic.BoolVar i) =
   4.913 -				[i]
   4.914 -			  | clause_to_lit_list (PropLogic.Not (PropLogic.BoolVar i)) =
   4.915 -				[~i]
   4.916 -			  | clause_to_lit_list _ =
   4.917 -				raise INVALID_PROOF "Error: invalid clause in CNF formula."
   4.918 -			(* prop_formula -> int *)
   4.919 -			fun cnf_number_of_clauses (PropLogic.And (fm1, fm2)) =
   4.920 -				cnf_number_of_clauses fm1 + cnf_number_of_clauses fm2
   4.921 -			  | cnf_number_of_clauses _ =
   4.922 -				1
   4.923 -			val number_of_clauses = cnf_number_of_clauses cnf
   4.924 -			(* int list array *)
   4.925 -			val clauses = Array.array (number_of_clauses, [])
   4.926 -			(* initialize the 'clauses' array *)
   4.927 -			(* prop_formula * int -> int *)
   4.928 -			fun init_array (PropLogic.And (fm1, fm2), n) =
   4.929 -				init_array (fm2, init_array (fm1, n))
   4.930 -			  | init_array (fm, n) =
   4.931 -				(Array.update (clauses, n, clause_to_lit_list fm); n+1)
   4.932 -			val _ = init_array (cnf, 0)
   4.933 -			(* optimization for the common case where MiniSat "R"s clauses in their *)
   4.934 -			(* original order:                                                      *)
   4.935 -			val last_ref_clause = ref (number_of_clauses - 1)
   4.936 -			(* search the 'clauses' array for the given list of literals 'lits', *)
   4.937 -			(* starting at index '!last_ref_clause + 1'                          *)
   4.938 -			(* int list -> int option *)
   4.939 -			fun original_clause_id lits =
   4.940 -			let
   4.941 -				fun original_clause_id_from index =
   4.942 -					if index = number_of_clauses then
   4.943 -						(* search from beginning again *)
   4.944 -						original_clause_id_from 0
   4.945 -					(* both 'lits' and the list of literals used in 'clauses' are sorted, so *)
   4.946 -					(* testing for equality should suffice -- barring duplicate literals     *)
   4.947 -					else if Array.sub (clauses, index) = lits then (
   4.948 -						(* success *)
   4.949 -						last_ref_clause := index;
   4.950 -						SOME index
   4.951 -					) else if index = !last_ref_clause then
   4.952 -						(* failure *)
   4.953 -						NONE
   4.954 -					else
   4.955 -						(* continue search *)
   4.956 -						original_clause_id_from (index + 1)
   4.957 -			in
   4.958 -				original_clause_id_from (!last_ref_clause + 1)
   4.959 -			end
   4.960 -			(* string -> int *)
   4.961 -			fun int_from_string s = (
   4.962 -				case Int.fromString s of
   4.963 -				  SOME i => i
   4.964 -				| NONE   => raise INVALID_PROOF ("File format error: number expected (" ^ quote s ^ " encountered).")
   4.965 -			)
   4.966 -			(* parse the proof file *)
   4.967 -			val clause_table  = ref (Inttab.empty : int list Inttab.table)
   4.968 -			val empty_id      = ref ~1
   4.969 -			(* contains a mapping from clause IDs as used by MiniSat to clause IDs in *)
   4.970 -			(* our proof format, where original clauses are numbered starting from 0  *)
   4.971 -			val clause_id_map = ref (Inttab.empty : int Inttab.table)
   4.972 -			fun sat_to_proof id = (
   4.973 -				case Inttab.lookup (!clause_id_map) id of
   4.974 -				  SOME id' => id'
   4.975 -				| NONE     => raise INVALID_PROOF ("Clause ID " ^ Int.toString id ^ " used, but not defined.")
   4.976 -			)
   4.977 -			val next_id = ref (number_of_clauses - 1)
   4.978 -			(* string list -> unit *)
   4.979 -			fun process_tokens [] =
   4.980 -				()
   4.981 -			  | process_tokens (tok::toks) =
   4.982 -				if tok="R" then (
   4.983 -					case toks of
   4.984 -					  id::sep::lits =>
   4.985 -						let
   4.986 -							val _        = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: \"R\" disallowed after \"X\"."
   4.987 -							val cid      = int_from_string id
   4.988 -							val _        = if sep = "<=" then () else raise INVALID_PROOF ("File format error: \"<=\" expected (" ^ quote sep ^ " encountered).")
   4.989 -							val ls       = sort int_ord (map int_from_string lits)
   4.990 -							val proof_id = case original_clause_id ls of
   4.991 -							                 SOME orig_id => orig_id
   4.992 -							               | NONE         => raise INVALID_PROOF ("Original clause (new ID is " ^ id ^ ") not found.")
   4.993 -						in
   4.994 -							(* extend the mapping of clause IDs with this newly defined ID *)
   4.995 -							clause_id_map := Inttab.update_new (cid, proof_id) (!clause_id_map)
   4.996 -								handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ id ^ " defined more than once (in \"R\").")
   4.997 -							(* the proof itself doesn't change *)
   4.998 -						end
   4.999 -					| _ =>
  4.1000 -						raise INVALID_PROOF "File format error: \"R\" followed by an insufficient number of tokens."
  4.1001 -				) else if tok="C" then (
  4.1002 -					case toks of
  4.1003 -					  id::sep::ids =>
  4.1004 -						let
  4.1005 -							val _        = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: \"C\" disallowed after \"X\"."
  4.1006 -							val cid      = int_from_string id
  4.1007 -							val _        = if sep = "<=" then () else raise INVALID_PROOF ("File format error: \"<=\" expected (" ^ quote sep ^ " encountered).")
  4.1008 -							(* ignore the pivot literals in MiniSat's trace *)
  4.1009 -							fun unevens []             = raise INVALID_PROOF "File format error: \"C\" followed by an even number of IDs."
  4.1010 -							  | unevens (x :: [])      = x :: []
  4.1011 -							  | unevens (x :: _ :: xs) = x :: unevens xs
  4.1012 -							val rs       = (map sat_to_proof o unevens o map int_from_string) ids
  4.1013 -							(* extend the mapping of clause IDs with this newly defined ID *)
  4.1014 -							val proof_id = inc next_id
  4.1015 -							val _        = clause_id_map := Inttab.update_new (cid, proof_id) (!clause_id_map)
  4.1016 -							                 handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ id ^ " defined more than once (in \"C\").")
  4.1017 -						in
  4.1018 -							(* update clause table *)
  4.1019 -							clause_table := Inttab.update_new (proof_id, rs) (!clause_table)
  4.1020 -								handle Inttab.DUP _ => raise INVALID_PROOF ("Error: internal ID for clause " ^ id ^ " already used.")
  4.1021 -						end
  4.1022 -					| _ =>
  4.1023 -						raise INVALID_PROOF "File format error: \"C\" followed by an insufficient number of tokens."
  4.1024 -				) else if tok="D" then (
  4.1025 -					case toks of
  4.1026 -					  [id] =>
  4.1027 -						let
  4.1028 -							val _ = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: \"D\" disallowed after \"X\"."
  4.1029 -							val _ = sat_to_proof (int_from_string id)
  4.1030 -						in
  4.1031 -							(* simply ignore "D" *)
  4.1032 -							()
  4.1033 -						end
  4.1034 -					| _ =>
  4.1035 -						raise INVALID_PROOF "File format error: \"D\" followed by an illegal number of tokens."
  4.1036 -				) else if tok="X" then (
  4.1037 -					case toks of
  4.1038 -					  [id1, id2] =>
  4.1039 -						let
  4.1040 -							val _            = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: more than one end-of-proof statement."
  4.1041 -							val _            = sat_to_proof (int_from_string id1)
  4.1042 -							val new_empty_id = sat_to_proof (int_from_string id2)
  4.1043 -						in
  4.1044 -							(* update conflict id *)
  4.1045 -							empty_id := new_empty_id
  4.1046 -						end
  4.1047 -					| _ =>
  4.1048 -						raise INVALID_PROOF "File format error: \"X\" followed by an illegal number of tokens."
  4.1049 -				) else
  4.1050 -					raise INVALID_PROOF ("File format error: unknown token " ^ quote tok ^ " encountered.")
  4.1051 -			(* string list -> unit *)
  4.1052 -			fun process_lines [] =
  4.1053 -				()
  4.1054 -			  | process_lines (l::ls) = (
  4.1055 -					process_tokens (String.tokens (fn c => c = #" " orelse c = #"\t") l);
  4.1056 -					process_lines ls
  4.1057 -				)
  4.1058 -			(* proof *)
  4.1059 -			val _ = process_lines proof_lines
  4.1060 -			val _ = if !empty_id <> ~1 then () else raise INVALID_PROOF "File format error: no conflicting clause specified."
  4.1061 -		in
  4.1062 -			SatSolver.UNSATISFIABLE (SOME (!clause_table, !empty_id))
  4.1063 -		end handle INVALID_PROOF reason => (warning reason; SatSolver.UNSATISFIABLE NONE))
  4.1064 -	| result =>
  4.1065 -		result
  4.1066 -	end
  4.1067 +  exception INVALID_PROOF of string
  4.1068 +  fun minisat_with_proofs fm =
  4.1069 +  let
  4.1070 +    val _          = if (getenv "MINISAT_HOME") = "" then raise SatSolver.NOT_CONFIGURED else ()
  4.1071 +    val inpath     = File.tmp_path (Path.explode "isabelle.cnf")
  4.1072 +    val outpath    = File.tmp_path (Path.explode "result")
  4.1073 +    val proofpath  = File.tmp_path (Path.explode "result.prf")
  4.1074 +    val cmd        = (getenv "MINISAT_HOME") ^ "/minisat " ^ (Path.implode inpath) ^ " -r " ^ (Path.implode outpath) ^ " -t " ^ (Path.implode proofpath) ^ "> /dev/null"
  4.1075 +    fun writefn fm = SatSolver.write_dimacs_cnf_file inpath fm
  4.1076 +    fun readfn ()  = SatSolver.read_std_result_file outpath ("SAT", "", "UNSAT")
  4.1077 +    val _          = if File.exists inpath then warning ("overwriting existing file " ^ quote (Path.implode inpath)) else ()
  4.1078 +    val _          = if File.exists outpath then warning ("overwriting existing file " ^ quote (Path.implode outpath)) else ()
  4.1079 +    val cnf        = PropLogic.defcnf fm
  4.1080 +    val result     = SatSolver.make_external_solver cmd writefn readfn cnf
  4.1081 +    val _          = try File.rm inpath
  4.1082 +    val _          = try File.rm outpath
  4.1083 +  in  case result of
  4.1084 +    SatSolver.UNSATISFIABLE NONE =>
  4.1085 +    (let
  4.1086 +      (* string list *)
  4.1087 +      val proof_lines = (split_lines o File.read) proofpath
  4.1088 +        handle IO.Io _ => raise INVALID_PROOF "Could not read file \"result.prf\""
  4.1089 +      (* representation of clauses as ordered lists of literals (with duplicates removed) *)
  4.1090 +      (* prop_formula -> int list *)
  4.1091 +      fun clause_to_lit_list (PropLogic.Or (fm1, fm2)) =
  4.1092 +        OrdList.union int_ord (clause_to_lit_list fm1) (clause_to_lit_list fm2)
  4.1093 +        | clause_to_lit_list (PropLogic.BoolVar i) =
  4.1094 +        [i]
  4.1095 +        | clause_to_lit_list (PropLogic.Not (PropLogic.BoolVar i)) =
  4.1096 +        [~i]
  4.1097 +        | clause_to_lit_list _ =
  4.1098 +        raise INVALID_PROOF "Error: invalid clause in CNF formula."
  4.1099 +      (* prop_formula -> int *)
  4.1100 +      fun cnf_number_of_clauses (PropLogic.And (fm1, fm2)) =
  4.1101 +        cnf_number_of_clauses fm1 + cnf_number_of_clauses fm2
  4.1102 +        | cnf_number_of_clauses _ =
  4.1103 +        1
  4.1104 +      val number_of_clauses = cnf_number_of_clauses cnf
  4.1105 +      (* int list array *)
  4.1106 +      val clauses = Array.array (number_of_clauses, [])
  4.1107 +      (* initialize the 'clauses' array *)
  4.1108 +      (* prop_formula * int -> int *)
  4.1109 +      fun init_array (PropLogic.And (fm1, fm2), n) =
  4.1110 +        init_array (fm2, init_array (fm1, n))
  4.1111 +        | init_array (fm, n) =
  4.1112 +        (Array.update (clauses, n, clause_to_lit_list fm); n+1)
  4.1113 +      val _ = init_array (cnf, 0)
  4.1114 +      (* optimization for the common case where MiniSat "R"s clauses in their *)
  4.1115 +      (* original order:                                                      *)
  4.1116 +      val last_ref_clause = ref (number_of_clauses - 1)
  4.1117 +      (* search the 'clauses' array for the given list of literals 'lits', *)
  4.1118 +      (* starting at index '!last_ref_clause + 1'                          *)
  4.1119 +      (* int list -> int option *)
  4.1120 +      fun original_clause_id lits =
  4.1121 +      let
  4.1122 +        fun original_clause_id_from index =
  4.1123 +          if index = number_of_clauses then
  4.1124 +            (* search from beginning again *)
  4.1125 +            original_clause_id_from 0
  4.1126 +          (* both 'lits' and the list of literals used in 'clauses' are sorted, so *)
  4.1127 +          (* testing for equality should suffice -- barring duplicate literals     *)
  4.1128 +          else if Array.sub (clauses, index) = lits then (
  4.1129 +            (* success *)
  4.1130 +            last_ref_clause := index;
  4.1131 +            SOME index
  4.1132 +          ) else if index = !last_ref_clause then
  4.1133 +            (* failure *)
  4.1134 +            NONE
  4.1135 +          else
  4.1136 +            (* continue search *)
  4.1137 +            original_clause_id_from (index + 1)
  4.1138 +      in
  4.1139 +        original_clause_id_from (!last_ref_clause + 1)
  4.1140 +      end
  4.1141 +      (* string -> int *)
  4.1142 +      fun int_from_string s = (
  4.1143 +        case Int.fromString s of
  4.1144 +          SOME i => i
  4.1145 +        | NONE   => raise INVALID_PROOF ("File format error: number expected (" ^ quote s ^ " encountered).")
  4.1146 +      )
  4.1147 +      (* parse the proof file *)
  4.1148 +      val clause_table  = ref (Inttab.empty : int list Inttab.table)
  4.1149 +      val empty_id      = ref ~1
  4.1150 +      (* contains a mapping from clause IDs as used by MiniSat to clause IDs in *)
  4.1151 +      (* our proof format, where original clauses are numbered starting from 0  *)
  4.1152 +      val clause_id_map = ref (Inttab.empty : int Inttab.table)
  4.1153 +      fun sat_to_proof id = (
  4.1154 +        case Inttab.lookup (!clause_id_map) id of
  4.1155 +          SOME id' => id'
  4.1156 +        | NONE     => raise INVALID_PROOF ("Clause ID " ^ Int.toString id ^ " used, but not defined.")
  4.1157 +      )
  4.1158 +      val next_id = ref (number_of_clauses - 1)
  4.1159 +      (* string list -> unit *)
  4.1160 +      fun process_tokens [] =
  4.1161 +        ()
  4.1162 +        | process_tokens (tok::toks) =
  4.1163 +        if tok="R" then (
  4.1164 +          case toks of
  4.1165 +            id::sep::lits =>
  4.1166 +            let
  4.1167 +              val _        = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: \"R\" disallowed after \"X\"."
  4.1168 +              val cid      = int_from_string id
  4.1169 +              val _        = if sep = "<=" then () else raise INVALID_PROOF ("File format error: \"<=\" expected (" ^ quote sep ^ " encountered).")
  4.1170 +              val ls       = sort int_ord (map int_from_string lits)
  4.1171 +              val proof_id = case original_clause_id ls of
  4.1172 +                               SOME orig_id => orig_id
  4.1173 +                             | NONE         => raise INVALID_PROOF ("Original clause (new ID is " ^ id ^ ") not found.")
  4.1174 +            in
  4.1175 +              (* extend the mapping of clause IDs with this newly defined ID *)
  4.1176 +              clause_id_map := Inttab.update_new (cid, proof_id) (!clause_id_map)
  4.1177 +                handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ id ^ " defined more than once (in \"R\").")
  4.1178 +              (* the proof itself doesn't change *)
  4.1179 +            end
  4.1180 +          | _ =>
  4.1181 +            raise INVALID_PROOF "File format error: \"R\" followed by an insufficient number of tokens."
  4.1182 +        ) else if tok="C" then (
  4.1183 +          case toks of
  4.1184 +            id::sep::ids =>
  4.1185 +            let
  4.1186 +              val _        = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: \"C\" disallowed after \"X\"."
  4.1187 +              val cid      = int_from_string id
  4.1188 +              val _        = if sep = "<=" then () else raise INVALID_PROOF ("File format error: \"<=\" expected (" ^ quote sep ^ " encountered).")
  4.1189 +              (* ignore the pivot literals in MiniSat's trace *)
  4.1190 +              fun unevens []             = raise INVALID_PROOF "File format error: \"C\" followed by an even number of IDs."
  4.1191 +                | unevens (x :: [])      = x :: []
  4.1192 +                | unevens (x :: _ :: xs) = x :: unevens xs
  4.1193 +              val rs       = (map sat_to_proof o unevens o map int_from_string) ids
  4.1194 +              (* extend the mapping of clause IDs with this newly defined ID *)
  4.1195 +              val proof_id = inc next_id
  4.1196 +              val _        = clause_id_map := Inttab.update_new (cid, proof_id) (!clause_id_map)
  4.1197 +                               handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ id ^ " defined more than once (in \"C\").")
  4.1198 +            in
  4.1199 +              (* update clause table *)
  4.1200 +              clause_table := Inttab.update_new (proof_id, rs) (!clause_table)
  4.1201 +                handle Inttab.DUP _ => raise INVALID_PROOF ("Error: internal ID for clause " ^ id ^ " already used.")
  4.1202 +            end
  4.1203 +          | _ =>
  4.1204 +            raise INVALID_PROOF "File format error: \"C\" followed by an insufficient number of tokens."
  4.1205 +        ) else if tok="D" then (
  4.1206 +          case toks of
  4.1207 +            [id] =>
  4.1208 +            let
  4.1209 +              val _ = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: \"D\" disallowed after \"X\"."
  4.1210 +              val _ = sat_to_proof (int_from_string id)
  4.1211 +            in
  4.1212 +              (* simply ignore "D" *)
  4.1213 +              ()
  4.1214 +            end
  4.1215 +          | _ =>
  4.1216 +            raise INVALID_PROOF "File format error: \"D\" followed by an illegal number of tokens."
  4.1217 +        ) else if tok="X" then (
  4.1218 +          case toks of
  4.1219 +            [id1, id2] =>
  4.1220 +            let
  4.1221 +              val _            = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: more than one end-of-proof statement."
  4.1222 +              val _            = sat_to_proof (int_from_string id1)
  4.1223 +              val new_empty_id = sat_to_proof (int_from_string id2)
  4.1224 +            in
  4.1225 +              (* update conflict id *)
  4.1226 +              empty_id := new_empty_id
  4.1227 +            end
  4.1228 +          | _ =>
  4.1229 +            raise INVALID_PROOF "File format error: \"X\" followed by an illegal number of tokens."
  4.1230 +        ) else
  4.1231 +          raise INVALID_PROOF ("File format error: unknown token " ^ quote tok ^ " encountered.")
  4.1232 +      (* string list -> unit *)
  4.1233 +      fun process_lines [] =
  4.1234 +        ()
  4.1235 +        | process_lines (l::ls) = (
  4.1236 +          process_tokens (String.tokens (fn c => c = #" " orelse c = #"\t") l);
  4.1237 +          process_lines ls
  4.1238 +        )
  4.1239 +      (* proof *)
  4.1240 +      val _ = process_lines proof_lines
  4.1241 +      val _ = if !empty_id <> ~1 then () else raise INVALID_PROOF "File format error: no conflicting clause specified."
  4.1242 +    in
  4.1243 +      SatSolver.UNSATISFIABLE (SOME (!clause_table, !empty_id))
  4.1244 +    end handle INVALID_PROOF reason => (warning reason; SatSolver.UNSATISFIABLE NONE))
  4.1245 +  | result =>
  4.1246 +    result
  4.1247 +  end
  4.1248  in
  4.1249 -	SatSolver.add_solver ("minisat_with_proofs", minisat_with_proofs)
  4.1250 +  SatSolver.add_solver ("minisat_with_proofs", minisat_with_proofs)
  4.1251  end;
  4.1252  
  4.1253  let
  4.1254 -	fun minisat fm =
  4.1255 -	let
  4.1256 -		val _          = if (getenv "MINISAT_HOME") = "" then raise SatSolver.NOT_CONFIGURED else ()
  4.1257 -		val inpath     = File.tmp_path (Path.explode "isabelle.cnf")
  4.1258 -		val outpath    = File.tmp_path (Path.explode "result")
  4.1259 -		val cmd        = (getenv "MINISAT_HOME") ^ "/minisat " ^ (Path.implode inpath) ^ " -r " ^ (Path.implode outpath) ^ " > /dev/null"
  4.1260 -		fun writefn fm = SatSolver.write_dimacs_cnf_file inpath (PropLogic.defcnf fm)
  4.1261 -		fun readfn ()  = SatSolver.read_std_result_file outpath ("SAT", "", "UNSAT")
  4.1262 -		val _          = if File.exists inpath then warning ("overwriting existing file " ^ quote (Path.implode inpath)) else ()
  4.1263 -		val _          = if File.exists outpath then warning ("overwriting existing file " ^ quote (Path.implode outpath)) else ()
  4.1264 -		val result     = SatSolver.make_external_solver cmd writefn readfn fm
  4.1265 -		val _          = try File.rm inpath
  4.1266 -		val _          = try File.rm outpath
  4.1267 -	in
  4.1268 -		result
  4.1269 -	end
  4.1270 +  fun minisat fm =
  4.1271 +  let
  4.1272 +    val _          = if (getenv "MINISAT_HOME") = "" then raise SatSolver.NOT_CONFIGURED else ()
  4.1273 +    val inpath     = File.tmp_path (Path.explode "isabelle.cnf")
  4.1274 +    val outpath    = File.tmp_path (Path.explode "result")
  4.1275 +    val cmd        = (getenv "MINISAT_HOME") ^ "/minisat " ^ (Path.implode inpath) ^ " -r " ^ (Path.implode outpath) ^ " > /dev/null"
  4.1276 +    fun writefn fm = SatSolver.write_dimacs_cnf_file inpath (PropLogic.defcnf fm)
  4.1277 +    fun readfn ()  = SatSolver.read_std_result_file outpath ("SAT", "", "UNSAT")
  4.1278 +    val _          = if File.exists inpath then warning ("overwriting existing file " ^ quote (Path.implode inpath)) else ()
  4.1279 +    val _          = if File.exists outpath then warning ("overwriting existing file " ^ quote (Path.implode outpath)) else ()
  4.1280 +    val result     = SatSolver.make_external_solver cmd writefn readfn fm
  4.1281 +    val _          = try File.rm inpath
  4.1282 +    val _          = try File.rm outpath
  4.1283 +  in
  4.1284 +    result
  4.1285 +  end
  4.1286  in
  4.1287 -	SatSolver.add_solver ("minisat", minisat)
  4.1288 +  SatSolver.add_solver ("minisat", minisat)
  4.1289  end;
  4.1290  
  4.1291  (* ------------------------------------------------------------------------- *)
  4.1292 @@ -787,150 +787,150 @@
  4.1293  (* that the latter is preferred by the "auto" solver                         *)
  4.1294  
  4.1295  let
  4.1296 -	exception INVALID_PROOF of string
  4.1297 -	fun zchaff_with_proofs fm =
  4.1298 -	case SatSolver.invoke_solver "zchaff" fm of
  4.1299 -	  SatSolver.UNSATISFIABLE NONE =>
  4.1300 -		(let
  4.1301 -			(* string list *)
  4.1302 -			val proof_lines = ((split_lines o File.read) (Path.explode "resolve_trace"))
  4.1303 -				handle IO.Io _ => raise INVALID_PROOF "Could not read file \"resolve_trace\""
  4.1304 -			(* PropLogic.prop_formula -> int *)
  4.1305 -			fun cnf_number_of_clauses (PropLogic.And (fm1, fm2)) = cnf_number_of_clauses fm1 + cnf_number_of_clauses fm2
  4.1306 -			  | cnf_number_of_clauses _                          = 1
  4.1307 -			(* string -> int *)
  4.1308 -			fun int_from_string s = (
  4.1309 -				case Int.fromString s of
  4.1310 -				  SOME i => i
  4.1311 -				| NONE   => raise INVALID_PROOF ("File format error: number expected (" ^ quote s ^ " encountered).")
  4.1312 -			)
  4.1313 -			(* parse the "resolve_trace" file *)
  4.1314 -			val clause_offset = ref ~1
  4.1315 -			val clause_table  = ref (Inttab.empty : int list Inttab.table)
  4.1316 -			val empty_id      = ref ~1
  4.1317 -			(* string list -> unit *)
  4.1318 -			fun process_tokens [] =
  4.1319 -				()
  4.1320 -			  | process_tokens (tok::toks) =
  4.1321 -				if tok="CL:" then (
  4.1322 -					case toks of
  4.1323 -					  id::sep::ids =>
  4.1324 -						let
  4.1325 -							val _   = if !clause_offset = ~1 then () else raise INVALID_PROOF ("File format error: \"CL:\" disallowed after \"VAR:\".")
  4.1326 -							val _   = if !empty_id = ~1 then () else raise INVALID_PROOF ("File format error: \"CL:\" disallowed after \"CONF:\".")
  4.1327 -							val cid = int_from_string id
  4.1328 -							val _   = if sep = "<=" then () else raise INVALID_PROOF ("File format error: \"<=\" expected (" ^ quote sep ^ " encountered).")
  4.1329 -							val rs  = map int_from_string ids
  4.1330 -						in
  4.1331 -							(* update clause table *)
  4.1332 -							clause_table := Inttab.update_new (cid, rs) (!clause_table)
  4.1333 -								handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ id ^ " defined more than once.")
  4.1334 -						end
  4.1335 -					| _ =>
  4.1336 -						raise INVALID_PROOF "File format error: \"CL:\" followed by an insufficient number of tokens."
  4.1337 -				) else if tok="VAR:" then (
  4.1338 -					case toks of
  4.1339 -					  id::levsep::levid::valsep::valid::antesep::anteid::litsep::lits =>
  4.1340 -						let
  4.1341 -							val _   = if !empty_id = ~1 then () else raise INVALID_PROOF ("File format error: \"VAR:\" disallowed after \"CONF:\".")
  4.1342 -							(* set 'clause_offset' to the largest used clause ID *)
  4.1343 -							val _   = if !clause_offset = ~1 then clause_offset :=
  4.1344 -								(case Inttab.max_key (!clause_table) of
  4.1345 -								  SOME id => id
  4.1346 -								| NONE    => cnf_number_of_clauses (PropLogic.defcnf fm) - 1  (* the first clause ID is 0, not 1 *))
  4.1347 -								else
  4.1348 -									()
  4.1349 -							val vid = int_from_string id
  4.1350 -							val _   = if levsep = "L:" then () else raise INVALID_PROOF ("File format error: \"L:\" expected (" ^ quote levsep ^ " encountered).")
  4.1351 -							val _   = int_from_string levid
  4.1352 -							val _   = if valsep = "V:" then () else raise INVALID_PROOF ("File format error: \"V:\" expected (" ^ quote valsep ^ " encountered).")
  4.1353 -							val _   = int_from_string valid
  4.1354 -							val _   = if antesep = "A:" then () else raise INVALID_PROOF ("File format error: \"A:\" expected (" ^ quote antesep ^ " encountered).")
  4.1355 -							val aid = int_from_string anteid
  4.1356 -							val _   = if litsep = "Lits:" then () else raise INVALID_PROOF ("File format error: \"Lits:\" expected (" ^ quote litsep ^ " encountered).")
  4.1357 -							val ls  = map int_from_string lits
  4.1358 -							(* convert the data provided by zChaff to our resolution-style proof format *)
  4.1359 -							(* each "VAR:" line defines a unit clause, the resolvents are implicitly    *)
  4.1360 -							(* given by the literals in the antecedent clause                           *)
  4.1361 -							(* we use the sum of '!clause_offset' and the variable ID as clause ID for the unit clause *)
  4.1362 -							val cid = !clause_offset + vid
  4.1363 -							(* the low bit of each literal gives its sign (positive/negative), therefore  *)
  4.1364 -							(* we have to divide each literal by 2 to obtain the proper variable ID; then *)
  4.1365 -							(* we add '!clause_offset' to obtain the ID of the corresponding unit clause  *)
  4.1366 -							val vids = filter (not_equal vid) (map (fn l => l div 2) ls)
  4.1367 -							val rs   = aid :: map (fn v => !clause_offset + v) vids
  4.1368 -						in
  4.1369 -							(* update clause table *)
  4.1370 -							clause_table := Inttab.update_new (cid, rs) (!clause_table)
  4.1371 -								handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ string_of_int cid ^ " (derived from antecedent for variable " ^ id ^ ") already defined.")
  4.1372 -						end
  4.1373 -					| _ =>
  4.1374 -						raise INVALID_PROOF "File format error: \"VAR:\" followed by an insufficient number of tokens."
  4.1375 -				) else if tok="CONF:" then (
  4.1376 -					case toks of
  4.1377 -					  id::sep::ids =>
  4.1378 -						let
  4.1379 -							val _   = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: more than one conflicting clause specified."
  4.1380 -							val cid = int_from_string id
  4.1381 -							val _   = if sep = "==" then () else raise INVALID_PROOF ("File format error: \"==\" expected (" ^ quote sep ^ " encountered).")
  4.1382 -							val ls  = map int_from_string ids
  4.1383 -							(* the conflict clause must be resolved with the unit clauses *)
  4.1384 -							(* for its literals to obtain the empty clause                *)
  4.1385 -							val vids         = map (fn l => l div 2) ls
  4.1386 -							val rs           = cid :: map (fn v => !clause_offset + v) vids
  4.1387 -							val new_empty_id = getOpt (Inttab.max_key (!clause_table), !clause_offset) + 1
  4.1388 -						in
  4.1389 -							(* update clause table and conflict id *)
  4.1390 -							clause_table := Inttab.update_new (new_empty_id, rs) (!clause_table)
  4.1391 -								handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ string_of_int new_empty_id ^ " (empty clause derived from clause " ^ id ^ ") already defined.");
  4.1392 -							empty_id     := new_empty_id
  4.1393 -						end
  4.1394 -					| _ =>
  4.1395 -						raise INVALID_PROOF "File format error: \"CONF:\" followed by an insufficient number of tokens."
  4.1396 -				) else
  4.1397 -					raise INVALID_PROOF ("File format error: unknown token " ^ quote tok ^ " encountered.")
  4.1398 -			(* string list -> unit *)
  4.1399 -			fun process_lines [] =
  4.1400 -				()
  4.1401 -			  | process_lines (l::ls) = (
  4.1402 -					process_tokens (String.tokens (fn c => c = #" " orelse c = #"\t") l);
  4.1403 -					process_lines ls
  4.1404 -				)
  4.1405 -			(* proof *)
  4.1406 -			val _ = process_lines proof_lines
  4.1407 -			val _ = if !empty_id <> ~1 then () else raise INVALID_PROOF "File format error: no conflicting clause specified."
  4.1408 -		in
  4.1409 -			SatSolver.UNSATISFIABLE (SOME (!clause_table, !empty_id))
  4.1410 -		end handle INVALID_PROOF reason => (warning reason; SatSolver.UNSATISFIABLE NONE))
  4.1411 -	| result =>
  4.1412 -		result
  4.1413 +  exception INVALID_PROOF of string
  4.1414 +  fun zchaff_with_proofs fm =
  4.1415 +  case SatSolver.invoke_solver "zchaff" fm of
  4.1416 +    SatSolver.UNSATISFIABLE NONE =>
  4.1417 +    (let
  4.1418 +      (* string list *)
  4.1419 +      val proof_lines = ((split_lines o File.read) (Path.explode "resolve_trace"))
  4.1420 +        handle IO.Io _ => raise INVALID_PROOF "Could not read file \"resolve_trace\""
  4.1421 +      (* PropLogic.prop_formula -> int *)
  4.1422 +      fun cnf_number_of_clauses (PropLogic.And (fm1, fm2)) = cnf_number_of_clauses fm1 + cnf_number_of_clauses fm2
  4.1423 +        | cnf_number_of_clauses _                          = 1
  4.1424 +      (* string -> int *)
  4.1425 +      fun int_from_string s = (
  4.1426 +        case Int.fromString s of
  4.1427 +          SOME i => i
  4.1428 +        | NONE   => raise INVALID_PROOF ("File format error: number expected (" ^ quote s ^ " encountered).")
  4.1429 +      )
  4.1430 +      (* parse the "resolve_trace" file *)
  4.1431 +      val clause_offset = ref ~1
  4.1432 +      val clause_table  = ref (Inttab.empty : int list Inttab.table)
  4.1433 +      val empty_id      = ref ~1
  4.1434 +      (* string list -> unit *)
  4.1435 +      fun process_tokens [] =
  4.1436 +        ()
  4.1437 +        | process_tokens (tok::toks) =
  4.1438 +        if tok="CL:" then (
  4.1439 +          case toks of
  4.1440 +            id::sep::ids =>
  4.1441 +            let
  4.1442 +              val _   = if !clause_offset = ~1 then () else raise INVALID_PROOF ("File format error: \"CL:\" disallowed after \"VAR:\".")
  4.1443 +              val _   = if !empty_id = ~1 then () else raise INVALID_PROOF ("File format error: \"CL:\" disallowed after \"CONF:\".")
  4.1444 +              val cid = int_from_string id
  4.1445 +              val _   = if sep = "<=" then () else raise INVALID_PROOF ("File format error: \"<=\" expected (" ^ quote sep ^ " encountered).")
  4.1446 +              val rs  = map int_from_string ids
  4.1447 +            in
  4.1448 +              (* update clause table *)
  4.1449 +              clause_table := Inttab.update_new (cid, rs) (!clause_table)
  4.1450 +                handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ id ^ " defined more than once.")
  4.1451 +            end
  4.1452 +          | _ =>
  4.1453 +            raise INVALID_PROOF "File format error: \"CL:\" followed by an insufficient number of tokens."
  4.1454 +        ) else if tok="VAR:" then (
  4.1455 +          case toks of
  4.1456 +            id::levsep::levid::valsep::valid::antesep::anteid::litsep::lits =>
  4.1457 +            let
  4.1458 +              val _   = if !empty_id = ~1 then () else raise INVALID_PROOF ("File format error: \"VAR:\" disallowed after \"CONF:\".")
  4.1459 +              (* set 'clause_offset' to the largest used clause ID *)
  4.1460 +              val _   = if !clause_offset = ~1 then clause_offset :=
  4.1461 +                (case Inttab.max_key (!clause_table) of
  4.1462 +                  SOME id => id
  4.1463 +                | NONE    => cnf_number_of_clauses (PropLogic.defcnf fm) - 1  (* the first clause ID is 0, not 1 *))
  4.1464 +                else
  4.1465 +                  ()
  4.1466 +              val vid = int_from_string id
  4.1467 +              val _   = if levsep = "L:" then () else raise INVALID_PROOF ("File format error: \"L:\" expected (" ^ quote levsep ^ " encountered).")
  4.1468 +              val _   = int_from_string levid
  4.1469 +              val _   = if valsep = "V:" then () else raise INVALID_PROOF ("File format error: \"V:\" expected (" ^ quote valsep ^ " encountered).")
  4.1470 +              val _   = int_from_string valid
  4.1471 +              val _   = if antesep = "A:" then () else raise INVALID_PROOF ("File format error: \"A:\" expected (" ^ quote antesep ^ " encountered).")
  4.1472 +              val aid = int_from_string anteid
  4.1473 +              val _   = if litsep = "Lits:" then () else raise INVALID_PROOF ("File format error: \"Lits:\" expected (" ^ quote litsep ^ " encountered).")
  4.1474 +              val ls  = map int_from_string lits
  4.1475 +              (* convert the data provided by zChaff to our resolution-style proof format *)
  4.1476 +              (* each "VAR:" line defines a unit clause, the resolvents are implicitly    *)
  4.1477 +              (* given by the literals in the antecedent clause                           *)
  4.1478 +              (* we use the sum of '!clause_offset' and the variable ID as clause ID for the unit clause *)
  4.1479 +              val cid = !clause_offset + vid
  4.1480 +              (* the low bit of each literal gives its sign (positive/negative), therefore  *)
  4.1481 +              (* we have to divide each literal by 2 to obtain the proper variable ID; then *)
  4.1482 +              (* we add '!clause_offset' to obtain the ID of the corresponding unit clause  *)
  4.1483 +              val vids = filter (not_equal vid) (map (fn l => l div 2) ls)
  4.1484 +              val rs   = aid :: map (fn v => !clause_offset + v) vids
  4.1485 +            in
  4.1486 +              (* update clause table *)
  4.1487 +              clause_table := Inttab.update_new (cid, rs) (!clause_table)
  4.1488 +                handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ string_of_int cid ^ " (derived from antecedent for variable " ^ id ^ ") already defined.")
  4.1489 +            end
  4.1490 +          | _ =>
  4.1491 +            raise INVALID_PROOF "File format error: \"VAR:\" followed by an insufficient number of tokens."
  4.1492 +        ) else if tok="CONF:" then (
  4.1493 +          case toks of
  4.1494 +            id::sep::ids =>
  4.1495 +            let
  4.1496 +              val _   = if !empty_id = ~1 then () else raise INVALID_PROOF "File format error: more than one conflicting clause specified."
  4.1497 +              val cid = int_from_string id
  4.1498 +              val _   = if sep = "==" then () else raise INVALID_PROOF ("File format error: \"==\" expected (" ^ quote sep ^ " encountered).")
  4.1499 +              val ls  = map int_from_string ids
  4.1500 +              (* the conflict clause must be resolved with the unit clauses *)
  4.1501 +              (* for its literals to obtain the empty clause                *)
  4.1502 +              val vids         = map (fn l => l div 2) ls
  4.1503 +              val rs           = cid :: map (fn v => !clause_offset + v) vids
  4.1504 +              val new_empty_id = getOpt (Inttab.max_key (!clause_table), !clause_offset) + 1
  4.1505 +            in
  4.1506 +              (* update clause table and conflict id *)
  4.1507 +              clause_table := Inttab.update_new (new_empty_id, rs) (!clause_table)
  4.1508 +                handle Inttab.DUP _ => raise INVALID_PROOF ("File format error: clause " ^ string_of_int new_empty_id ^ " (empty clause derived from clause " ^ id ^ ") already defined.");
  4.1509 +              empty_id     := new_empty_id