minor changes (comments/code refactoring)
authorwebertj
Wed Nov 17 16:24:07 2004 +0100 (2004-11-17)
changeset 1529209e218879265
parent 15291 dd4648ae6eff
child 15293 7797a04cc188
minor changes (comments/code refactoring)
src/HOL/Tools/refute.ML
     1.1 --- a/src/HOL/Tools/refute.ML	Wed Nov 17 07:35:50 2004 +0100
     1.2 +++ b/src/HOL/Tools/refute.ML	Wed Nov 17 16:24:07 2004 +0100
     1.3 @@ -999,7 +999,7 @@
     1.4  
     1.5  
     1.6  (* ------------------------------------------------------------------------- *)
     1.7 -(* INTERPRETERS                                                              *)
     1.8 +(* INTERPRETERS: Auxiliary Functions                                         *)
     1.9  (* ------------------------------------------------------------------------- *)
    1.10  
    1.11  (* ------------------------------------------------------------------------- *)
    1.12 @@ -1125,6 +1125,24 @@
    1.13  		Leaf [equal (i1, i2), not_equal (i1, i2)]
    1.14  	end;
    1.15  
    1.16 +(* ------------------------------------------------------------------------- *)
    1.17 +(* eta_expand: eta-expands a term 't' by adding 'i' lambda abstractions      *)
    1.18 +(* ------------------------------------------------------------------------- *)
    1.19 +
    1.20 +	(* Term.term -> int -> Term.term *)
    1.21 +
    1.22 +	fun eta_expand t i =
    1.23 +	let
    1.24 +		val Ts = binder_types (fastype_of t)
    1.25 +	in
    1.26 +		foldr (fn (T, t) => Abs ("<eta_expand>", T, t))
    1.27 +			(take (i, Ts), list_comb (t, map Bound (i-1 downto 0)))
    1.28 +	end;
    1.29 +
    1.30 +
    1.31 +(* ------------------------------------------------------------------------- *)
    1.32 +(* INTERPRETERS: Actual Interpreters                                         *)
    1.33 +(* ------------------------------------------------------------------------- *)
    1.34  
    1.35  	(* theory -> model -> arguments -> Term.term -> (interpretation * model * arguments) option *)
    1.36  
    1.37 @@ -1315,16 +1333,6 @@
    1.38  	(* theory -> model -> arguments -> Term.term -> (interpretation * model * arguments) option *)
    1.39  
    1.40  	fun HOLogic_interpreter thy model args t =
    1.41 -	let
    1.42 -		(* Term.term -> int -> Term.term *)
    1.43 -		fun eta_expand t i =
    1.44 -		let
    1.45 -			val Ts = binder_types (fastype_of t)
    1.46 -		in
    1.47 -			foldr (fn (T, t) => Abs ("<eta_expand>", T, t))
    1.48 -				(take (i, Ts), list_comb (t, map Bound (i-1 downto 0)))
    1.49 -		end
    1.50 -	in
    1.51  	(* ------------------------------------------------------------------------- *)
    1.52  	(* Providing interpretations directly is more efficient than unfolding the   *)
    1.53  	(* logical constants.  In HOL however, logical constants can themselves be   *)
    1.54 @@ -1340,7 +1348,11 @@
    1.55  			Some (TT, model, args)
    1.56  		| Const ("False", _) =>  (* redundant, since 'False' is also an IDT constructor *)
    1.57  			Some (FF, model, args)
    1.58 -		| Const ("All", _) $ t1 =>
    1.59 +		| Const ("All", _) $ t1 =>  (* if 'All' occurs without an argument (i.e.   *)
    1.60 +		                            (* as argument to a higher-order function or   *)
    1.61 +		                            (* predicate), it is handled by the            *)
    1.62 +		                            (* 'stlc_interpreter' (i.e. by unfolding its   *)
    1.63 +		                            (* definition)                                 *)
    1.64  			let
    1.65  				val (i, m, a) = interpret thy model args t1
    1.66  			in
    1.67 @@ -1353,9 +1365,13 @@
    1.68  						Some (Leaf [fmTrue, fmFalse], m, a)
    1.69  					end
    1.70  				| _ =>
    1.71 -					raise REFUTE ("HOLogic_interpreter", "\"All\" is not followed by a function")
    1.72 +					raise REFUTE ("HOLogic_interpreter", "\"All\" is followed by a non-function")
    1.73  			end
    1.74 -		| Const ("Ex", _) $ t1 =>
    1.75 +		| Const ("Ex", _) $ t1 =>  (* if 'Ex' occurs without an argument (i.e. as  *)
    1.76 +		                           (* argument to a higher-order function or       *)
    1.77 +		                           (* predicate), it is handled by the             *)
    1.78 +		                           (* 'stlc_interpreter' (i.e. by unfolding its    *)
    1.79 +		                           (* definition)                                  *)
    1.80  			let
    1.81  				val (i, m, a) = interpret thy model args t1
    1.82  			in
    1.83 @@ -1368,7 +1384,7 @@
    1.84  						Some (Leaf [fmTrue, fmFalse], m, a)
    1.85  					end
    1.86  				| _ =>
    1.87 -					raise REFUTE ("HOLogic_interpreter", "\"Ex\" is not followed by a function")
    1.88 +					raise REFUTE ("HOLogic_interpreter", "\"Ex\" is followed by a non-function")
    1.89  			end
    1.90  		| Const ("op =", _) $ t1 $ t2 =>
    1.91  			let
    1.92 @@ -1387,8 +1403,7 @@
    1.93  			Some (Node [Node [TT, TT], Node [TT, FF]], model, args)
    1.94  		| Const ("op -->", _) =>
    1.95  			Some (Node [Node [TT, FF], Node [TT, TT]], model, args)
    1.96 -		| _ => None
    1.97 -	end;
    1.98 +		| _ => None;
    1.99  
   1.100  	(* theory -> model -> arguments -> Term.term -> (interpretation * model * arguments) option *)
   1.101  
   1.102 @@ -1396,14 +1411,6 @@
   1.103  	(* "T set" is isomorphic to "T --> bool" *)
   1.104  	let
   1.105  		val (typs, terms) = model
   1.106 -		(* Term.term -> int -> Term.term *)
   1.107 -		fun eta_expand t i =
   1.108 -		let
   1.109 -			val Ts = binder_types (fastype_of t)
   1.110 -		in
   1.111 -			foldr (fn (T, t) => Abs ("<eta_expand>", T, t))
   1.112 -				(take (i, Ts), list_comb (t, map Bound (i-1 downto 0)))
   1.113 -		end
   1.114  	in
   1.115  		case assoc (terms, t) of
   1.116  		  Some intr =>